81 CHARACTER(LEN=*),
INTENT(IN) :: filename
85 INTEGER,
INTENT(IN) :: psf_type
87 CHARACTER(len=*),
PARAMETER :: routinen =
'read_topology_psf'
89 CHARACTER(LEN=2*default_string_length) :: psf_format
90 CHARACTER(LEN=3) :: c_int
91 CHARACTER(LEN=default_string_length) :: dummy_field, field, label, strtmp1, &
93 INTEGER :: handle, i, iatom, ibond, idum, index_now, iphi, itheta, iw, natom, natom_prev, &
94 nbond, nbond_prev, nphi, nphi_prev, ntheta, ntheta_prev, output_unit
105 extension=
".subsysLog")
106 CALL timeset(routinen, handle)
112 IF (
ASSOCIATED(atom_info%id_molname)) natom_prev =
SIZE(atom_info%id_molname)
116 IF (.NOT. found)
THEN
117 IF (output_unit > 0)
THEN
118 WRITE (output_unit,
'(A)')
"ERROR| Missing PSF specification line"
124 SELECT CASE (field(1:3))
128 psf_format =
'(I8,1X,A4,I5,1X,A4,1X,A4,1X,A4,1X,2G14.6,I8)'
133 psf_format =
'(I10,T12,A7,T21,I8,T30,A7,T39,A6,T47,A6,T53,F10.6,T69,F8.3,T88,I1)'
136 cpabort(
"PSF_INFO| "//field(1:3)//
" :: not available for UPSF format!")
139 cpabort(
"PSF_INFO| "//field(1:3)//
" :: Unimplemented keyword in CP2K PSF/UPSF format!")
142 IF (iw > 0)
WRITE (iw,
'(T2,A)')
'PSF_INFO| Parsing the NATOM section'
148 IF (.NOT. found)
THEN
149 IF (iw > 0)
WRITE (iw,
'(T2,A)')
'PSF_INFO| No NATOM section '
153 IF (natom_prev + natom >
topology%natoms) &
154 CALL cp_abort(__location__, &
155 "Number of atoms in connectivity control is larger than the "// &
156 "number of atoms in coordinate control. check coordinates and "// &
158 IF (iw > 0)
WRITE (iw,
'(T2,A,'//trim(c_int)//
')')
'PSF_INFO| NATOM = ', natom
160 CALL reallocate(atom_info%id_molname, 1, natom_prev + natom)
161 CALL reallocate(atom_info%resid, 1, natom_prev + natom)
162 CALL reallocate(atom_info%id_resname, 1, natom_prev + natom)
163 CALL reallocate(atom_info%id_atmname, 1, natom_prev + natom)
164 CALL reallocate(atom_info%atm_charge, 1, natom_prev + natom)
165 CALL reallocate(atom_info%atm_mass, 1, natom_prev + natom)
169 index_now = iatom + natom_prev
171 READ (parser%input_line, fmt=*, err=9) i, &
173 atom_info%resid(index_now), &
177 atom_info%atm_charge(index_now), &
178 atom_info%atm_mass(index_now)
179 atom_info%id_molname(index_now) =
str2id(
s2s(strtmp1))
180 atom_info%id_resname(index_now) =
str2id(
s2s(strtmp2))
181 atom_info%id_atmname(index_now) =
str2id(
s2s(strtmp3))
185 index_now = iatom + natom_prev
187 READ (parser%input_line, fmt=psf_format) &
190 atom_info%resid(index_now), &
194 atom_info%atm_charge(index_now), &
195 atom_info%atm_mass(index_now), &
197 atom_info%id_molname(index_now) =
str2id(
s2s(strtmp1))
198 atom_info%id_resname(index_now) =
str2id(
s2s(strtmp2))
199 atom_info%id_atmname(index_now) =
str2id(
s2s(adjustl(strtmp3)))
208 IF (
ASSOCIATED(conn_info%bond_a)) nbond_prev =
SIZE(conn_info%bond_a)
210 IF (iw > 0)
WRITE (iw,
'(T2,A)')
'PSF_INFO| Parsing the NBOND section'
211 IF (iw > 0)
WRITE (iw,
'(T2,A,I8)')
'PSF_INFO| Previous number of allocated BOND: ', nbond_prev
214 IF (.NOT. found)
THEN
215 IF (iw > 0)
WRITE (iw,
'(T2,A)')
'PSF_INFO| No NBOND section '
219 IF (iw > 0)
WRITE (iw,
'(T2,A,'//trim(c_int)//
')')
'PSF_INFO| NBOND = ', nbond
221 CALL reallocate(conn_info%bond_a, 1, nbond_prev + nbond)
222 CALL reallocate(conn_info%bond_b, 1, nbond_prev + nbond)
225 DO ibond = 1, nbond, 4
227 index_now = nbond_prev + ibond - 1
228 READ (parser%input_line, fmt=*, err=9) (conn_info%bond_a(index_now + i), &
229 conn_info%bond_b(index_now + i), &
230 i=1, min(4, (nbond - ibond + 1)))
233 DO ibond = 1, nbond, 4
235 index_now = nbond_prev + ibond - 1
236 READ (parser%input_line, fmt=
'(8'//trim(c_int)//
')') &
237 (conn_info%bond_a(index_now + i), &
238 conn_info%bond_b(index_now + i), &
239 i=1, min(4, (nbond - ibond + 1)))
242 IF (any(conn_info%bond_a(nbond_prev + 1:) <= 0) .OR. &
243 any(conn_info%bond_a(nbond_prev + 1:) > natom) .OR. &
244 any(conn_info%bond_b(nbond_prev + 1:) <= 0) .OR. &
245 any(conn_info%bond_b(nbond_prev + 1:) > natom))
THEN
246 cpabort(
"topology_read, invalid bond")
248 conn_info%bond_a(nbond_prev + 1:) = conn_info%bond_a(nbond_prev + 1:) + natom_prev
249 conn_info%bond_b(nbond_prev + 1:) = conn_info%bond_b(nbond_prev + 1:) + natom_prev
255 IF (
ASSOCIATED(conn_info%theta_a)) ntheta_prev =
SIZE(conn_info%theta_a)
257 IF (iw > 0)
WRITE (iw,
'(T2,A)')
'PSF_INFO| Parsing the NTHETA section'
258 IF (iw > 0)
WRITE (iw,
'(T2,A,I8)')
'PSF_INFO| Previous number of allocated THETA: ', ntheta_prev
261 IF (.NOT. found)
THEN
262 IF (iw > 0)
WRITE (iw,
'(T2,A)')
'PSF_INFO| No NTHETA section '
266 IF (iw > 0)
WRITE (iw,
'(T2,A,'//trim(c_int)//
')')
'PSF_INFO| NTHETA = ', ntheta
268 CALL reallocate(conn_info%theta_a, 1, ntheta_prev + ntheta)
269 CALL reallocate(conn_info%theta_b, 1, ntheta_prev + ntheta)
270 CALL reallocate(conn_info%theta_c, 1, ntheta_prev + ntheta)
273 DO itheta = 1, ntheta, 3
275 index_now = ntheta_prev + itheta - 1
276 READ (parser%input_line, fmt=*, err=9) (conn_info%theta_a(index_now + i), &
277 conn_info%theta_b(index_now + i), &
278 conn_info%theta_c(index_now + i), &
279 i=1, min(3, (ntheta - itheta + 1)))
282 DO itheta = 1, ntheta, 3
284 index_now = ntheta_prev + itheta - 1
285 READ (parser%input_line, fmt=
'(9'//trim(c_int)//
')') &
286 (conn_info%theta_a(index_now + i), &
287 conn_info%theta_b(index_now + i), &
288 conn_info%theta_c(index_now + i), &
289 i=1, min(3, (ntheta - itheta + 1)))
292 conn_info%theta_a(ntheta_prev + 1:) = conn_info%theta_a(ntheta_prev + 1:) + natom_prev
293 conn_info%theta_b(ntheta_prev + 1:) = conn_info%theta_b(ntheta_prev + 1:) + natom_prev
294 conn_info%theta_c(ntheta_prev + 1:) = conn_info%theta_c(ntheta_prev + 1:) + natom_prev
300 IF (
ASSOCIATED(conn_info%phi_a)) nphi_prev =
SIZE(conn_info%phi_a)
302 IF (iw > 0)
WRITE (iw,
'(T2,A)')
'PSF_INFO| Parsing the NPHI section'
303 IF (iw > 0)
WRITE (iw,
'(T2,A,I8)')
'PSF_INFO| Previous number of allocated PHI: ', nphi_prev
306 IF (.NOT. found)
THEN
307 IF (iw > 0)
WRITE (iw,
'(T2,A)')
'PSF_INFO| No NPHI section '
311 IF (iw > 0)
WRITE (iw,
'(T2,A,'//trim(c_int)//
')')
'PSF_INFO| NPHI = ', nphi
313 CALL reallocate(conn_info%phi_a, 1, nphi_prev + nphi)
314 CALL reallocate(conn_info%phi_b, 1, nphi_prev + nphi)
315 CALL reallocate(conn_info%phi_c, 1, nphi_prev + nphi)
316 CALL reallocate(conn_info%phi_d, 1, nphi_prev + nphi)
321 index_now = nphi_prev + iphi - 1
322 READ (parser%input_line, fmt=*, err=9) (conn_info%phi_a(index_now + i), &
323 conn_info%phi_b(index_now + i), &
324 conn_info%phi_c(index_now + i), &
325 conn_info%phi_d(index_now + i), &
326 i=1, min(2, (nphi - iphi + 1)))
331 index_now = nphi_prev + iphi - 1
332 READ (parser%input_line, fmt=
'(8'//trim(c_int)//
')') &
333 (conn_info%phi_a(index_now + i), &
334 conn_info%phi_b(index_now + i), &
335 conn_info%phi_c(index_now + i), &
336 conn_info%phi_d(index_now + i), &
337 i=1, min(2, (nphi - iphi + 1)))
340 conn_info%phi_a(nphi_prev + 1:) = conn_info%phi_a(nphi_prev + 1:) + natom_prev
341 conn_info%phi_b(nphi_prev + 1:) = conn_info%phi_b(nphi_prev + 1:) + natom_prev
342 conn_info%phi_c(nphi_prev + 1:) = conn_info%phi_c(nphi_prev + 1:) + natom_prev
343 conn_info%phi_d(nphi_prev + 1:) = conn_info%phi_d(nphi_prev + 1:) + natom_prev
349 IF (
ASSOCIATED(conn_info%impr_a)) nphi_prev =
SIZE(conn_info%impr_a)
351 IF (iw > 0)
WRITE (iw,
'(T2,A)')
'PSF_INFO| Parsing the NIMPHI section'
352 IF (iw > 0)
WRITE (iw,
'(T2,A,I8)')
'PSF_INFO| Previous number of allocated IMPHI: ', nphi_prev
355 IF (.NOT. found)
THEN
356 IF (iw > 0)
WRITE (iw,
'(T2,A)')
'PSF_INFO| No NIMPHI section '
360 IF (iw > 0)
WRITE (iw,
'(T2,A,'//trim(c_int)//
')')
'PSF_INFO| NIMPR = ', nphi
362 CALL reallocate(conn_info%impr_a, 1, nphi_prev + nphi)
363 CALL reallocate(conn_info%impr_b, 1, nphi_prev + nphi)
364 CALL reallocate(conn_info%impr_c, 1, nphi_prev + nphi)
365 CALL reallocate(conn_info%impr_d, 1, nphi_prev + nphi)
370 index_now = nphi_prev + iphi - 1
371 READ (parser%input_line, fmt=*, err=9) (conn_info%impr_a(index_now + i), &
372 conn_info%impr_b(index_now + i), &
373 conn_info%impr_c(index_now + i), &
374 conn_info%impr_d(index_now + i), &
375 i=1, min(2, (nphi - iphi + 1)))
380 index_now = nphi_prev + iphi - 1
381 READ (parser%input_line, fmt=
'(8'//trim(c_int)//
')') &
382 (conn_info%impr_a(index_now + i), &
383 conn_info%impr_b(index_now + i), &
384 conn_info%impr_c(index_now + i), &
385 conn_info%impr_d(index_now + i), &
386 i=1, min(2, (nphi - iphi + 1)))
389 conn_info%impr_a(nphi_prev + 1:) = conn_info%impr_a(nphi_prev + 1:) + natom_prev
390 conn_info%impr_b(nphi_prev + 1:) = conn_info%impr_b(nphi_prev + 1:) + natom_prev
391 conn_info%impr_c(nphi_prev + 1:) = conn_info%impr_c(nphi_prev + 1:) + natom_prev
392 conn_info%impr_d(nphi_prev + 1:) = conn_info%impr_d(nphi_prev + 1:) + natom_prev
396 CALL timestop(handle)
398 "PRINT%TOPOLOGY_INFO/PSF_INFO")
402 IF (output_unit > 0)
THEN
403 WRITE (output_unit,
'(T2,A)') &
404 "PSF_INFO| Error while reading PSF using the unformatted PSF reading option!", &
405 "PSF_INFO| Try using PSF instead of UPSF."
408 cpabort(
"Error while reading PSF data!")
421 CHARACTER(len=*),
PARAMETER :: routinen =
'psf_post_process'
423 INTEGER :: handle, i, iatom, ibond, ionfo, iw, &
424 jatom, n, natom, nbond, nonfo, nphi, &
434 extension=
".subsysLog")
435 CALL timeset(routinen, handle)
444 IF (
ASSOCIATED(atom_info%id_molname)) natom =
SIZE(atom_info%id_molname)
445 IF (
ASSOCIATED(conn_info%bond_a)) nbond =
SIZE(conn_info%bond_a)
446 IF (
ASSOCIATED(conn_info%c_bond_a)) i =
SIZE(conn_info%c_bond_a)
448 iatom = conn_info%bond_a(ibond)
449 jatom = conn_info%bond_b(ibond)
451 IF ((atom_info%id_molname(iatom) /= atom_info%id_molname(jatom)) .OR. &
452 (atom_info%resid(iatom) /= atom_info%resid(jatom)) .OR. &
453 (atom_info%id_resname(iatom) /= atom_info%id_resname(jatom)))
THEN
454 IF (iw > 0)
WRITE (iw,
'(T2,A,2I6)')
"PSF_INFO| PARA_RES, bond between molecules atom ", &
459 conn_info%c_bond_a(i) = iatom
460 conn_info%c_bond_b(i) = jatom
463 IF (atom_info%id_molname(iatom) /= atom_info%id_molname(jatom))
THEN
472 IF (
ASSOCIATED(conn_info%theta_a)) ntheta =
SIZE(conn_info%theta_a)
476 conn_info%ub_a(:) = conn_info%theta_a(:)
477 conn_info%ub_b(:) = conn_info%theta_b(:)
478 conn_info%ub_c(:) = conn_info%theta_c(:)
484 IF (
ASSOCIATED(conn_info%phi_a)) nphi =
SIZE(conn_info%phi_a)
487 conn_info%onfo_a(1:) = conn_info%phi_a(1:)
488 conn_info%onfo_b(1:) = conn_info%phi_d(1:)
490 ALLOCATE (ex_bond_list(natom))
492 ALLOCATE (ex_bond_list(i)%array1(0))
495 IF (
ASSOCIATED(conn_info%bond_a)) n =
SIZE(conn_info%bond_a)
498 ALLOCATE (ex_bend_list(natom))
500 ALLOCATE (ex_bend_list(i)%array1(0))
503 IF (
ASSOCIATED(conn_info%theta_a)) n =
SIZE(conn_info%theta_a)
507 IF (any(ex_bond_list(conn_info%onfo_a(ionfo))%array1 == conn_info%onfo_b(ionfo)) .OR. &
508 any(ex_bend_list(conn_info%onfo_a(ionfo))%array1 == conn_info%onfo_b(ionfo))) cycle
510 conn_info%onfo_a(nonfo) = conn_info%onfo_a(ionfo)
511 conn_info%onfo_b(nonfo) = conn_info%onfo_b(ionfo)
515 DEALLOCATE (ex_bend_list(i)%array1)
517 DEALLOCATE (ex_bend_list)
520 DEALLOCATE (ex_bond_list(i)%array1)
522 DEALLOCATE (ex_bond_list)
524 ALLOCATE (ex_bond_list(natom))
526 ALLOCATE (ex_bond_list(i)%array1(0))
529 IF (
ASSOCIATED(conn_info%onfo_a)) n = nonfo
533 DO ionfo = 1,
SIZE(ex_bond_list(i)%array1)
534 IF (count(ex_bond_list(i)%array1 == ex_bond_list(i)%array1(ionfo)) /= 1)
THEN
535 ex_bond_list(i)%array1(ionfo) = 0
537 IF (ex_bond_list(i)%array1(ionfo) <= i) cycle
539 conn_info%onfo_a(nonfo) = i
540 conn_info%onfo_b(nonfo) = ex_bond_list(i)%array1(ionfo)
545 DEALLOCATE (ex_bond_list(i)%array1)
547 DEALLOCATE (ex_bond_list)
551 CALL timestop(handle)
553 "PRINT%TOPOLOGY_INFO/PSF_INFO")
563 SUBROUTINE idm_psf(topology, section, subsys_section)
567 CHARACTER(len=*),
PARAMETER :: routinen =
'idm_psf'
569 INTEGER :: handle, i, iend, iend1, istart, istart1, &
570 item, iw, j, mol_id, n_rep, natom, &
571 nbond, nimpr, noe, nphi, ntheta
572 INTEGER,
DIMENSION(:),
POINTER :: tag_mols, tmp, wrk
583 extension=
".subsysLog")
584 CALL timeset(routinen, handle)
590 IF (
ASSOCIATED(atom_info%id_molname)) natom =
SIZE(atom_info%id_molname)
592 IF (
ASSOCIATED(conn_info%bond_a)) nbond =
SIZE(conn_info%bond_a)
594 IF (
ASSOCIATED(conn_info%theta_a)) ntheta =
SIZE(conn_info%theta_a)
596 IF (
ASSOCIATED(conn_info%phi_a)) nphi =
SIZE(conn_info%phi_a)
598 IF (
ASSOCIATED(conn_info%impr_a)) nimpr =
SIZE(conn_info%impr_a)
604 CALL reallocate(conn_info%bond_a, 1, n_rep + nbond)
605 CALL reallocate(conn_info%bond_b, 1, n_rep + nbond)
608 conn_info%bond_a(nbond + i) = tmp(1)
609 conn_info%bond_b(nbond + i) = tmp(2)
612 ALLOCATE (ex_bond_list(natom))
613 ALLOCATE (tag_mols(natom))
614 ALLOCATE (wrk(natom))
616 ALLOCATE (ex_bond_list(j)%array1(0))
618 CALL reorder_structure(ex_bond_list, conn_info%bond_a, conn_info%bond_b, nbond + n_rep)
623 IF (tag_mols(i) /= -1) cycle
628 IF (iw > 0)
WRITE (iw,
'(T2,A,I8)')
'PSF_INFO| Number of molecules detected after merging: ', mol_id
630 CALL sort(tag_mols, natom, wrk)
634 IF (tag_mols(i) == item) cycle
636 noe = iend - istart + 1
637 istart1 = minval(wrk(istart:iend))
638 iend1 = maxval(wrk(istart:iend))
639 cpassert(iend1 - istart1 + 1 == noe)
645 noe = iend - istart + 1
646 istart1 = minval(wrk(istart:iend))
647 iend1 = maxval(wrk(istart:iend))
648 cpassert(iend1 - istart1 + 1 == noe)
652 DEALLOCATE (ex_bond_list(i)%array1)
654 DEALLOCATE (ex_bond_list)
655 DEALLOCATE (tag_mols)
663 CALL reallocate(conn_info%theta_a, 1, n_rep + ntheta)
664 CALL reallocate(conn_info%theta_b, 1, n_rep + ntheta)
665 CALL reallocate(conn_info%theta_c, 1, n_rep + ntheta)
668 conn_info%theta_a(ntheta + i) = tmp(1)
669 conn_info%theta_b(ntheta + i) = tmp(2)
670 conn_info%theta_c(ntheta + i) = tmp(3)
678 CALL reallocate(conn_info%phi_a, 1, n_rep + nphi)
679 CALL reallocate(conn_info%phi_b, 1, n_rep + nphi)
680 CALL reallocate(conn_info%phi_c, 1, n_rep + nphi)
681 CALL reallocate(conn_info%phi_d, 1, n_rep + nphi)
684 conn_info%phi_a(nphi + i) = tmp(1)
685 conn_info%phi_b(nphi + i) = tmp(2)
686 conn_info%phi_c(nphi + i) = tmp(3)
687 conn_info%phi_d(nphi + i) = tmp(4)
695 CALL reallocate(conn_info%impr_a, 1, n_rep + nimpr)
696 CALL reallocate(conn_info%impr_b, 1, n_rep + nimpr)
697 CALL reallocate(conn_info%impr_c, 1, n_rep + nimpr)
698 CALL reallocate(conn_info%impr_d, 1, n_rep + nimpr)
701 conn_info%impr_a(nimpr + i) = tmp(1)
702 conn_info%impr_b(nimpr + i) = tmp(2)
703 conn_info%impr_c(nimpr + i) = tmp(3)
704 conn_info%impr_d(nimpr + i) = tmp(4)
708 CALL timestop(handle)
710 "PRINT%TOPOLOGY_INFO/PSF_INFO")
723 INTEGER,
INTENT(IN) :: file_unit
727 CHARACTER(len=*),
PARAMETER :: routinen =
'write_topology_psf'
729 CHARACTER(LEN=2*default_string_length) :: psf_format
730 CHARACTER(LEN=default_path_length) :: record
731 CHARACTER(LEN=default_string_length) :: c_int, my_tag1, my_tag2, my_tag3
732 CHARACTER(LEN=default_string_length), &
733 DIMENSION(:),
POINTER :: charge_atm
734 INTEGER :: handle, i, iw, j, my_index, nchg
735 LOGICAL :: explicit, ldum
736 REAL(kind=
dp),
DIMENSION(:),
POINTER :: charge_inp, charges
746 extension=
".subsysLog")
747 CALL timeset(routinen, handle)
754 charges = atom_info%atm_charge
756 NULLIFY (tmp_section)
760 ALLOCATE (charge_atm(nchg))
761 ALLOCATE (charge_inp(nchg))
764 record =
id2str(atom_info%id_atmname(j))
768 IF (record == charge_atm(i))
THEN
769 charges(j) = charge_inp(i)
774 DEALLOCATE (charge_atm)
775 DEALLOCATE (charge_inp)
779 IF (charges(j) .EQ. -huge(0.0_dp)) charges(j) = -99.0_dp
782 extension=
".psf", my_local=.false.)
785 psf_format =
'(I10,T12,A,T21,I0,T30,A,T39,A,T47,A,T53,F10.6,T69,F8.3,T88,I1)'
786 IF (iw > 0)
WRITE (iw,
'(T2,A)') &
787 "PSF_WRITE| Writing out PSF file with CHARMM31 EXTErnal format: ", trim(record)
789 WRITE (file_unit, fmt=
'(A)')
"PSF EXT"
790 WRITE (file_unit, fmt=
'(A)')
""
791 WRITE (file_unit, fmt=
'('//trim(c_int)//
',A)') 1,
" !NTITLE"
792 WRITE (file_unit, fmt=
'(A)')
" CP2K generated DUMP of connectivity"
793 WRITE (file_unit, fmt=
'(A)')
""
795 WRITE (file_unit, fmt=
'('//trim(c_int)//
',A)')
topology%natoms,
" !NATOM"
798 my_tag1 =
id2str(atom_info%id_molname(i))
799 my_tag2 =
id2str(atom_info%id_resname(i))
800 my_tag3 =
id2str(atom_info%id_atmname(i))
804 WRITE (file_unit, fmt=psf_format) &
812 atom_info%atm_mass(i), &
815 IF ((atom_info%map_mol_num(i) /= atom_info%map_mol_num(i - 1)) .OR. &
816 (atom_info%map_mol_res(i) /= atom_info%map_mol_res(i - 1))) my_index = my_index + 1
817 my_tag1 =
id2str(atom_info%id_molname(i))
818 my_tag2 =
id2str(atom_info%id_resname(i))
819 my_tag3 =
id2str(atom_info%id_atmname(i))
823 WRITE (file_unit, fmt=psf_format) &
831 atom_info%atm_mass(i), &
834 WRITE (file_unit, fmt=
'(/)')
837 WRITE (file_unit, fmt=
'('//trim(c_int)//
',A)')
SIZE(conn_info%bond_a),
" !NBOND"
838 DO i = 1,
SIZE(conn_info%bond_a), 4
840 DO WHILE ((j < 4) .AND. ((i + j) <=
SIZE(conn_info%bond_a)))
841 WRITE (file_unit, fmt=
'(2('//trim(c_int)//
'))', advance=
"NO") &
842 conn_info%bond_a(i + j), conn_info%bond_b(i + j)
845 WRITE (file_unit, fmt=
'(/)', advance=
"NO")
847 WRITE (file_unit, fmt=
'(/)')
849 WRITE (file_unit, fmt=
'('//trim(c_int)//
',A)')
SIZE(conn_info%theta_a),
" !NTHETA"
850 DO i = 1,
SIZE(conn_info%theta_a), 3
852 DO WHILE ((j < 3) .AND. ((i + j) <=
SIZE(conn_info%theta_a)))
853 WRITE (file_unit, fmt=
'(3('//trim(c_int)//
'))', advance=
"NO") &
854 conn_info%theta_a(i + j), conn_info%theta_b(i + j), &
855 conn_info%theta_c(i + j)
858 WRITE (file_unit, fmt=
'(/)', advance=
"NO")
860 WRITE (file_unit, fmt=
'(/)')
862 WRITE (file_unit, fmt=
'('//trim(c_int)//
',A)')
SIZE(conn_info%phi_a),
" !NPHI"
863 DO i = 1,
SIZE(conn_info%phi_a), 2
865 DO WHILE ((j < 2) .AND. ((i + j) <=
SIZE(conn_info%phi_a)))
866 WRITE (file_unit, fmt=
'(4('//trim(c_int)//
'))', advance=
"NO") &
867 conn_info%phi_a(i + j), conn_info%phi_b(i + j), &
868 conn_info%phi_c(i + j), conn_info%phi_d(i + j)
871 WRITE (file_unit, fmt=
'(/)', advance=
"NO")
873 WRITE (file_unit, fmt=
'(/)')
875 WRITE (file_unit, fmt=
'('//trim(c_int)//
',A)')
SIZE(conn_info%impr_a),
" !NIMPHI"
876 DO i = 1,
SIZE(conn_info%impr_a), 2
878 DO WHILE ((j < 2) .AND. ((i + j) <=
SIZE(conn_info%impr_a)))
879 WRITE (file_unit, fmt=
'(4('//trim(c_int)//
'))', advance=
"NO") &
880 conn_info%impr_a(i + j), conn_info%impr_b(i + j), &
881 conn_info%impr_c(i + j), conn_info%impr_d(i + j)
884 WRITE (file_unit, fmt=
'(/)', advance=
"NO")
886 WRITE (file_unit, fmt=
'(/)')
888 WRITE (file_unit, fmt=
'('//trim(c_int)//
',A)') 0,
" !NDON"
889 WRITE (file_unit, fmt=
'(/)')
890 WRITE (file_unit, fmt=
'('//trim(c_int)//
',A)') 0,
" !NACC"
891 WRITE (file_unit, fmt=
'(/)')
892 WRITE (file_unit, fmt=
'('//trim(c_int)//
',A)') 0,
" !NNB"
893 WRITE (file_unit, fmt=
'(/)')
896 "PRINT%TOPOLOGY_INFO/PSF_INFO")
897 CALL timestop(handle)