1 subroutine read_general_data(*)
4 include "DIMENSIONS.ZSCOPT"
8 integer ierror,kolor,klucz
10 include "COMMON.WEIGHTS"
11 include "COMMON.NAMES"
12 include "COMMON.VMCPAR"
13 include "COMMON.TORSION"
14 include "COMMON.INTERACT"
15 include "COMMON.ENERGIES"
16 include "COMMON.MINPAR"
17 include "COMMON.IOUNITS"
18 include "COMMON.TIME1"
19 include "COMMON.PROTFILES"
20 include "COMMON.CHAIN"
21 include "COMMON.CLASSES"
22 include "COMMON.THERMAL"
23 include "COMMON.FFIELD"
24 include "COMMON.OPTIM"
25 include "COMMON.CONTROL"
26 include "COMMON.SCCOR"
27 include "COMMON.SPLITELE"
28 character*800 controlcard
29 integer i,j,k,l,ii,n_ene_found,ist1,iet1,ist2,iet2,ls,le
30 integer ind,itype1,itype2,itypf,itypsc,itypp,itypt1,itypt2
31 integer ilen,lenpot,lenpre
33 character*4 liczba,liczba1
40 double precision xchuj,weitemp,weitemp_low,weitemp_up
45 c write (iout,*) "Enter read_general_data"
53 C Read first record: seed and number of energy components
54 call card_concat(controlcard,.true.)
55 c write (iout,*) "card1",controlcard
57 call readi(controlcard,"ISEED",iseed,0)
58 if (iseed.eq.0) stop "Seed is zero!"
59 c print *,me," iseed",iseed
60 call readi(controlcard,"NPARMSET",nparmset,1)
61 c print *,me," nparmset",nparmset
63 c Split processor pool if multiple parameter sets are treated
64 if (nparmset.eq.1) then
65 WHAM_COMM = MPI_COMM_WORLD
66 c print *,me," opening ",outname," opened"
67 open(iout,file=outname,status='unknown')
69 c print *,me," outname ",outname," opened"
71 if (nprocs.lt.nparmset) then
73 & "*** Cannot split parameter sets for fewer processors than sets",
75 call MPI_Finalize(ierror)
78 c write (iout,*) "nparmset",nparmset
79 nprocs = nprocs/nparmset
81 klucz = mod(me,nprocs)
82 c write (*,*) "My old rank",me," kolor",kolor," klucz",klucz
83 call MPI_Comm_split(MPI_COMM_WORLD,kolor,klucz,WHAM_COMM,ierror)
84 call MPI_Comm_size(WHAM_COMM,nprocs,ierror)
85 call MPI_Comm_rank(WHAM_COMM,me,ierror)
86 c write (*,*) "My new rank",me," comm size",nprocs
87 c write (*,*) "MPI_COMM_WORLD",MPI_COMM_WORLD,
88 c & " WHAM_COMM",WHAM_COMM
90 c write (*,*) "My parameter set is",myparm
91 write(liczba,'(bz,i4.4)') me
92 write(liczba1,'(bz,i4.4)') myparm
93 outname=prefix(:lenpre)//'.out_par'//liczba1//'_'//
94 & pot(:lenpot)//liczba
95 open(iout,file=outname,status='unknown')
98 c print *,me," checkpoint 1"
99 energy_dec=(index(controlcard,'ENERGY_DEC').gt.0)
100 call readi(controlcard,'TORMODE',tor_mode,0)
101 c print *,me," tor_mode",tor_mode
102 call readi(controlcard,'SHIELD',shield_mode,0)
103 call readi(controlcard,"N_ENE",n_ene,max_ene)
104 c print *,"iseed",iseed," n_ene",n_ene
105 call readi(controlcard,"NPARMSET",nparmset,1)
106 geom_and_wham_weights =
107 & index(controlcard,"GEOM_AND_WHAM_WEIGHTS").gt.0
108 c write (iout,*) "GEOM_AND_WHAM_WEIGHTS",geom_and_wham_weights
109 if (iseed.gt.0) iseed=-iseed
111 out_newe=index(controlcard,"OUT_NEWE").gt.0
112 unres_pdb = index(controlcard,"UNRES_PDB").gt.0
113 c write (iout,*) "UNRES_PDB ",unres_pdb
114 c Energy calculation settings section
115 call readi(controlcard,'TORMODE',tor_mode,0)
116 C if(me.eq.king .or. .not. out1file .and. fg_rank.eq.0) then
117 call reada(controlcard,'BOXX',boxxsize,100.0d0)
118 call reada(controlcard,'BOXY',boxysize,100.0d0)
119 call reada(controlcard,'BOXZ',boxzsize,100.0d0)
120 c print *,me," checkpoint 2"
121 c Cutoff range for interactions
122 call reada(controlcard,"R_CUT",r_cut,15.0d0)
123 call reada(controlcard,"LAMBDA",rlamb,0.3d0)
124 call reada(controlcard,"LIPTHICK",lipthick,0.0d0)
125 call reada(controlcard,"LIPAQBUF",lipbufthick,0.0d0)
126 if (lipthick.gt.0.0d0) then
127 bordliptop=(boxzsize+lipthick)/2.0
128 bordlipbot=bordliptop-lipthick
130 if ((bordliptop.gt.boxzsize).or.(bordlipbot.lt.0.0))
131 & write(iout,*) "WARNING WRONG SIZE OF LIPIDIC PHASE"
132 buflipbot=bordlipbot+lipbufthick
133 bufliptop=bordliptop-lipbufthick
134 if ((lipbufthick*2.0d0).gt.lipthick)
135 &write(iout,*) "WARNING WRONG SIZE OF LIP AQ BUF"
137 c write(iout,*) "bordliptop=",bordliptop
138 c write(iout,*) "bordlipbot=",bordlipbot
139 c write(iout,*) "bufliptop=",bufliptop
140 c write(iout,*) "buflipbot=",buflipbot
141 call readi(controlcard,'SYM',symetr,1)
142 c print *,me," checkpoint 3"
143 c write (iout,*) "n_ene",n_ene
145 c Energy-term-weights section
147 C Read third record: weights
151 c print *,me," checkpoint 4"
152 C Read fourth record: masks
153 call card_concat(controlcard,.true.)
154 c write (iout,*) "card2",controlcard
156 key = "MASK_"//wname(i)(2:ilen(wname(i)))
157 call readi(controlcard,key(:ilen(key)),imask(i),0)
159 c print *,me," checkpoint 5"
160 C Read fifth record: lower limits of weights
161 call card_concat(controlcard,.true.)
162 c write (iout,*) "card3",controlcard
164 key = "WLOW_"//wname(i)(2:ilen(wname(i)))
165 call reada(controlcard,key(:ilen(key)),ww_low(i),ww(i))
167 C Read sixth record: upper limits of weights
168 call card_concat(controlcard,.true.)
169 c write (iout,*) "card4",controlcard
171 key = "WUP_"//wname(i)(2:ilen(wname(i)))
172 call reada(controlcard,key(:ilen(key)),ww_up(i),ww(i))
174 C Read seventh record: VMC parameters
175 call card_concat(controlcard,.true.)
176 c write (iout,*) "card5",controlcard
177 call readi(controlcard,"MODE",mode,3)
178 call readi(controlcard,"NSCANCYCLE",nscancycle,3)
179 call readi(controlcard,"MAXSTEP_SCAN",maxstep_scan,50)
180 call reada(controlcard,"RSTEP_SCAN",step_scan,1.0d-1)
181 call readi(controlcard,"READ_STAT",read_stat,3)
182 call readi(controlcard,"RESCALE_MODE",rescale_mode,2)
183 c init_ene = index(controlcard,"INIT_ENE").gt.0 .and. read_stat.gt.1
185 call readi(controlcard,"NMCM",nmcm,0)
186 call readi(controlcard,"MAXSCAN",maxscan,0)
187 call readi(controlcard,"MAXMIN",maxmin,100)
188 call readi(controlcard,"MAXFUN",maxfun,100)
189 call reada(controlcard,"TOLF",tolf,1.0d-6)
190 call reada(controlcard,"RTOLF",rtolf,1.0d-6)
192 if (index(controlcard,"OUT_MINIM").gt.0) out_minim=iout
194 if (index(controlcard,"PRINT_INI").gt.0) print_ini=1
196 if (index(controlcard,"PRINT_FIN").gt.0) print_fin=1
198 if (index(controlcard,"PRINT_STAT").gt.0) print_stat=1
199 call reada(controlcard,"RSTIME",rstime,9.0d2)
200 call reads(controlcard,"MINIMIZER",minimizer,"SUMSL")
201 call readi(controlcard,"OPT_MODE",opt_mode,0)
202 mod_other_params=index(controlcard,"OPTIMIZE_OTHER").gt.0
203 if (read_stat.eq.0 .and. mod_other_params) then
204 write (iout,*) "Error: only optimization of energy-term",
205 & " weights can be performed with READ_STAT=",read_stat
209 if (index(controlcard,"RESTART").gt.0) then
214 c print *,me," checkpoint 6"
217 c-----------------------------------------------------------------------
218 subroutine read_optim_parm(*)
221 include "DIMENSIONS.ZSCOPT"
225 integer ierror,kolor,klucz
227 include "COMMON.WEIGHTS"
228 include "COMMON.NAMES"
229 include "COMMON.VMCPAR"
230 include "COMMON.TORSION"
231 include "COMMON.LOCAL"
232 include "COMMON.INTERACT"
233 include "COMMON.ENERGIES"
234 include "COMMON.MINPAR"
235 include "COMMON.IOUNITS"
236 include "COMMON.TIME1"
237 include "COMMON.PROTFILES"
238 include "COMMON.CHAIN"
239 include "COMMON.CLASSES"
240 include "COMMON.THERMAL"
241 include "COMMON.FFIELD"
242 include "COMMON.OPTIM"
243 include "COMMON.CONTROL"
244 include "COMMON.SCCOR"
245 character*800 controlcard
247 integer i,j,k,l,ii,n_ene_found,ist1,iet1,ist2,iet2,ls,le
248 integer ind,ind1,ind2,itype1,itype2,itypf,itypsc,itypp,
249 & itypt1,itypt2,masktemp,iblock,iaux,itypa
250 integer ilen,lenpot,lenpre
252 double precision aux,vb_low,vb_up,vb_rel
253 character*4 liczba,liczba1
260 double precision xchuj,weitemp,weitemp_low,weitemp_up
262 character*3 typf,typa
265 integer ind_shield /25/
269 write (iout,*) "MOD_OTHER_PARAMS ",mod_other_params
273 mask_tor(0,itypt1,itypt2,iblock)=0
274 weitor(0,itypt1,itypt2,iblock)=1.0d0
275 weitor_low(0,itypt1,itypt2,iblock)=1.0d0
276 weitor_up(0,itypt1,itypt2,iblock)=1.0d0
282 mask_tor(l,itypt1,itypt2,iblock)=0
283 weitor(l,itypt1,itypt2,iblock)=1.0
284 weitor_low(l,itypt1,itypt2,iblock)=1.0
285 weitor_up(l,itypt1,itypt2,iblock)=1.0
291 write (iout,*) "ntyp",ntyp
294 write (iout,*) "itypt1",itypt1," itypt2",itypt2,
295 & "weitor",weitor(0,itypt1,itypt2,1),eitor(0,itypt1,itypt2,2)
299 if (mod_other_params) then
301 c &"Internal parameters of UNRES energy components will be optimized"
302 call card_concat(controlcard,.true.)
303 write (iout,*) "mod_side ",controlcard
305 mod_side = (index(controlcard,"MOD_SIDE").gt.0)
309 call card_concat(controlcard,.true.)
310 do while ( index(controlcard,"END").eq.0 )
311 call split_string(controlcard,item(1),4,nitem)
312 if (nitem.eq.1 .or. item(2)(:1).eq."*") then
313 nsingle_sc=nsingle_sc+1
314 ityp_ssc(nsingle_sc)=rescode(1,item(1),0)
316 epss_low(nsingle_sc)=0.02d0
318 read (item(3),*) epss_low(nsingle_sc)
321 epss_up(nsingle_sc)=0.0d0
323 read (item(4),*) epss_up(nsingle_sc)
327 ityp_psc(1,npair_sc)=rescode(1,item(1),0)
328 ityp_psc(2,npair_sc)=rescode(1,item(2),0)
330 epsp_low(npair_sc)=0.02d0
332 read (item(3),*) epsp_low(npair_sc)
335 epsp_up(npair_sc)=0.0d0
337 read (item(4),*) epsp_up(npair_sc)
340 call card_concat(controlcard,.true.)
342 if (nsingle_sc+npair_sc.eq.0) mod_side=.false.
343 call card_concat(controlcard,.true.)
346 & index(controlcard,"MOD_SIDE_OTHER").gt.0
347 write (iout,*) "mod_side_other ",controlcard,mod_side_other
348 if (mod_side_other) then
349 mod_side_other=.false.
355 call card_concat(controlcard,.true.)
356 c write (iout,*) "mod_side_oter ",controlcard
357 do while ( index(controlcard,"END").eq.0 )
358 call reads(controlcard,"RESKIND",reskind," ")
359 itypsc=rescode(1,reskind,0)
360 if (itypsc.lt.1 .or. itypsc.gt.20) then
361 write (iout,*) "Error in SC optimization data;",
362 & " SC type must not be dummy, type is" ,restyp," ",itypsc
363 write (*,*) "Error in SC optimization data;",
364 & " SC type must not be dummy, type is" ,restyp," ",itypsc
367 call readi(controlcard,"MASK_SIGMA0",mask_sigma(1,itypsc),0)
368 call readi(controlcard,"MASK_SIGMAII",mask_sigma(2,itypsc),0)
369 call readi(controlcard,"MASK_CHIP",mask_sigma(3,itypsc),0)
370 call readi(controlcard,"MASK_ALP",mask_sigma(4,itypsc),0)
371 call reada(controlcard,"SIGMA0_LOW",sigma_low(1,itypsc),0.d0)
372 call reada(controlcard,"SIGMA0_UP",sigma_up(1,itypsc),0.0d0)
373 call reada(controlcard,"SIGMAII_LOW",sigma_low(2,itypsc),
375 call reada(controlcard,"SIGMAII_UP",sigma_up(2,itypsc),0.0d0)
376 call reada(controlcard,"CHIP_LOW",sigma_low(3,itypsc),0.d0)
377 call reada(controlcard,"CHIP_UP",sigma_up(3,itypsc),0.0d0)
378 call reada(controlcard,"ALP_LOW",sigma_low(4,itypsc),0.d0)
379 call reada(controlcard,"ALP_UP",sigma_up(4,itypsc),0.0d0)
381 if (sigma_low(k,itypsc).eq.0.0d0 .and.
382 & sigma_up(k,itypsc).eq.0.0d0) mask_sigma(k,itypsc)=0
385 mod_side_other=mod_side_other.or.mask_sigma(k,itypsc).gt.0
387 write (iout,'(a4,i3,4(i2,2f8.3))') reskind,itypsc,
388 & (mask_sigma(k,itypsc),
389 & sigma_low(k,itypsc),sigma_up(k,itypsc),k=1,4)
390 call card_concat(controlcard,.true.)
391 c write (iout,*) "mod_side_oter ",controlcard
393 write (iout,*) "Optimization flags of one-body SC parameters"
395 write (iout,'(a4,i3,4(i2,2f8.3))') restyp(i),i,
396 & (mask_sigma(k,i),sigma_low(k,i),sigma_up(k,i),k=1,4)
398 call card_concat(controlcard,.true.)
400 c write (iout,*) "mod_side_other ",mod_side_other
401 c write (iout,*) "mod_tor ",controlcard
403 mod_tor = index(controlcard,"MOD_TOR").gt.0
406 do i=-ntortyp,ntortyp
407 do j=-ntortyp,ntortyp
408 mask_tor(0,i,j,iblock)=0
409 weitor(0,i,j,iblock)=1.0d0
410 weitor_low(0,i,j,iblock)=0.0d0
411 weitor_up(0,i,j,iblock)=2.0d0
415 call card_concat(controlcard,.true.)
416 write (iout,*) controlcard
417 do while ( index(controlcard,"END").eq.0 )
418 call split_string(controlcard,item(1),7,nitem)
420 write (*,*) "Error in torsional optimization data;",
421 & " must specify both residues and type"
429 write (iout,*) "item3 ",item(3)," item4 ",item(4),
432 if (nitem.gt.2) read(item(3),*) masktemp
433 if (nitem.gt.3) read(item(4),*) weitemp
434 if (nitem.gt.4) read(item(5),*) weitemp_low
435 if (nitem.gt.5) read(item(6),*) weitemp_up
436 if (nitem.gt.6) read(item(7),*) iblock
437 write (iout,*) controlcard
438 write (iout,*) item(1)," ",item(2),weitemp,
439 & weitemp_low,weitemp_up
440 if (index(item(1),"*").gt.0) then
444 ist1=itortyp(rescode(1,item(1),0))
447 if (index(item(2),"*").gt.0) then
451 ist2=itortyp(rescode(1,item(2),0))
454 c write (iout,*) "ist1",ist1," iet1",iet1," ist2",ist2,
459 c write (iout,*) "itypt1",itypt1," itypt2",itypt2,
460 c & weitemp,weitemp_low,weitemp_up
461 mask_tor(0,itypt1,itypt2,iblock)=masktemp
462 weitor(0,itypt1,itypt2,iblock)=weitemp
463 weitor_low(0,itypt1,itypt2,iblock)=weitemp_low
464 weitor_up(0,itypt1,itypt2,iblock)=weitemp_up
465 c write (iout,*) "itypt1",itypt1," itypt2",itypt2,
466 c & mask_tor(0,itypt1,itypt2,iblock),
467 c & weitor(0,itypt1,itypt2,iblock),
468 c & weitor_low(0,itypt1,itypt2,iblock),
469 c & weitor_up(0,itypt1,itypt2,iblock)
472 call card_concat(controlcard,.true.)
473 write (iout,*) controlcard
476 if (tor_mode.gt.1) then
477 write (iout,*) "TORMODE is",tor_mode,
478 & " torsional constants are computed from energy map expansion."
482 write (iout,*) "Initialized torsional parameters:"
484 do itypt1=-ntortyp,ntortyp
485 do itypt2=-ntortyp,ntortyp
486 write (iout,'(3i5,3f10.5)') itypt1,itypt2,
487 & mask_tor(0,itypt1,itypt2,iblock),
488 & weitor(0,itypt1,itypt2,iblock),
489 & weitor_low(0,itypt1,itypt2,iblock),
490 & weitor_up(0,itypt1,itypt2,iblock)
495 if (tor_mode.eq.1) then
496 c Exchange indices because the residue order in new torsionals is reversed
498 do itypt1=-ntortyp,ntortyp
499 do itypt2=itypt1+1,ntortyp
500 iaux=mask_tor(0,itypt1,itypt2,iblock)
501 mask_tor(0,itypt1,itypt2,iblock)=
502 & mask_tor(0,itypt2,itypt1,iblock)
503 mask_tor(0,itypt2,itypt1,iblock)=iaux
504 aux=weitor(0,itypt1,itypt2,iblock)
505 weitor(0,itypt1,itypt2,iblock)=
506 & weitor(0,itypt2,itypt1,iblock)
507 weitor(0,itypt2,itypt1,iblock)=aux
508 aux=weitor_low(0,itypt1,itypt2,iblock)
509 weitor_low(0,itypt1,itypt2,iblock)=
510 & weitor_low(0,itypt2,itypt1,iblock)
511 weitor_low(0,itypt2,itypt1,iblock)=aux
512 aux=weitor_up(0,itypt1,itypt2,iblock)
513 weitor_up(0,itypt1,itypt2,iblock)=
514 & weitor_up(0,itypt2,itypt1,iblock)
515 weitor_up(0,itypt2,itypt1,iblock)=aux
520 call card_concat(controlcard,.true.)
522 write (iout,*) "mod_sccor ",controlcard
524 mod_sccor = index(controlcard,"MOD_SCCOR").gt.0
526 call card_concat(controlcard,.true.)
529 do i=-nsccortyp,nsccortyp
530 do j=-nsccortyp,nsccortyp
531 mask_tor(l,i,j,iblock)=0
532 weitor(l,i,j,iblock)=1.0d0
533 weitor_low(l,i,j,iblock)=0.0d0
534 weitor_up(l,i,j,iblock)=2.0d0
539 do while ( index(controlcard,"END").eq.0 )
540 call split_string(controlcard,item(1),7,nitem)
542 write (*,*) "Error in torsional optimization data;",
543 & " must specify both residues and type"
549 if (nitem.gt.3) read(item(4),*) masktemp
550 if (nitem.gt.4) read(item(5),*) weitemp
551 if (nitem.gt.5) read(item(6),*) weitemp_low
552 if (nitem.gt.6) read(item(7),*) weitemp_up
553 if (index(item(1),"*").gt.0) then
557 ist1=isccortyp(rescode(1,item(1),0))
560 if (index(item(2),"*").gt.0) then
564 ist2=isccortyp(rescode(1,item(2),0))
567 if (index(item(3),"*").gt.0) then
577 mask_tor(l,itypt1,itypt2,1)=masktemp
578 weitor(l,itypt1,itypt2,1)=weitemp
579 weitor_low(l,itypt1,itypt2,1)=weitemp_low
580 weitor_up(l,itypt1,itypt2,1)=weitemp_up
584 call card_concat(controlcard,.true.)
586 call card_concat(controlcard,.true.)
589 write (iout,*) "Optimizable sidechain-torsional parameters:"
590 do itypt1=-nsccortyp,nsccortyp
591 do itypt2=-nsccortyp,nsccortyp
593 if (mask_tor(l,itypt1,itypt2,1).gt.0)
594 & write (iout,'(4i5,3f10.5)') itypt1,itypt2,l,
595 & mask_tor(l,itypt1,itypt2,1),weitor(l,itypt1,itypt2,1),
596 & weitor_low(l,itypt1,itypt2,1),weitor_up(l,itypt1,itypt2,1)
601 mod_ang=tor_mode.gt.0 .and. index(controlcard,"MOD_ANGLE").gt.0
602 write (iout,*) "mod_angle ",controlcard
603 write (iout,*) "mod_ang",mod_ang
610 call card_concat(controlcard,.true.)
611 do while (index(controlcard,'END').eq.0)
612 write (iout,'(a)') "angle: ",controlcard
613 call reads(controlcard,"TYPE",typa," ")
614 itypa=rescode(1,typa,0)
615 c write (iout,*) "TYPA ",typa," itypa",itypa
616 if (itypa.eq.0 .or. itypa.gt.ntyp) then
617 write (*,*) "Error specifying angle parms"
622 write (iout,*) "bend type",itypa
623 call reada(controlcard,"VB_LOW",vb_low,-1.0d5)
624 call reada(controlcard,"VB_UP",vb_up,1.0d5)
625 call reada(controlcard,"VB_REL",vb_rel,0.0d0)
626 write (iout,*) "VB_LOW",vb_low," VB_UP",vb_up," VB_REL",vb_rel
627 do i=1,nbend_kcc_TB(itypa)
628 if (vb_rel.gt.0) then
629 write (iout,*) "v1bend_chyb=",v1bend_chyb(i,itypa)
630 v1bend_low(i,itypa)=v1bend_chyb(i,itypa)*(1.0d0
631 & -dsign(vb_rel,v1bend_chyb(i,itypa)))
632 v1bend_up(i,itypa)=v1bend_chyb(i,itypa)*(1.0d0
633 & +dsign(vb_rel,v1bend_chyb(i,itypa)))
635 v1bend_low(i,itypa)=vb_low
636 v1bend_up(i,itypa)=vb_up
639 call card_concat(controlcard,.true.)
642 call card_concat(controlcard,.true.)
644 write (iout,*) "Boundaries of angle potential coefficients"
645 write (iout,'(3a)') "Index"," Low bound"," Up bound"
647 if (mask_ang(i).eq.0) cycle
648 write (iout,'(2a)') 'Type ',restyp(iloctyp(i))
649 do j=1,nbend_kcc_TB(i)
650 write (iout,'(i5,2f15.1)') j,v1bend_low(j,i),v1bend_up(j,i)
656 write (iout,*) "mod_fourier ",controlcard
658 mod_fourier(nloctyp)=index(controlcard,"MOD_FOURIER")
660 if (mod_fourier(nloctyp).gt.0) then
661 mod_fourier(nloctyp)=0
675 mask_eenew(ii,j,k,i)=0
683 call card_concat(controlcard,.true.)
684 do while ( index(controlcard,"END").eq.0 )
685 c write(iout,*) controlcard
686 call reads(controlcard,"TYPF",typf," ")
687 itypf=rescode(1,typf,0)
688 c write (iout,*) "TYPF ",typf," itypf",itypf
689 if (itypf.eq.0 .or. itypf.gt.ntyp) then
690 write (*,*) "Error specifying fourier parms"
693 itypf=itype2loc(itypf)
694 write (iout,*) "local type",itypf
696 if (index(controlcard,"B1_LOW").gt.0) then
698 call readi(controlcard,"IND",ind,0)
699 call readi(controlcard,"COEFF",ii,0)
700 if (ind.eq.0 .or. ii.eq.0 .or. ii.gt.3) then
702 & "Error specifying B1, components undefined",ind,ii
705 mask_bnew1(ii,ind,itypf)=1
706 call reada(controlcard,"B1_LOW",bnew1_low(ii,ind,itypf),
708 call reada(controlcard,"B1_UP",bnew1_up(ii,ind,itypf),
710 mod_fourier(itypf)=mod_fourier(itypf)
711 & +mask_bnew1(ii,ind,itypf)
713 else if (index(controlcard,"B2_LOW").gt.0) then
715 mask_bnew2(ii,ind,itypf)=1
716 call readi(controlcard,"IND",ind,0)
717 call readi(controlcard,"COEFF",ii,0)
718 if (ind.eq.0 .or. ii.eq.0 .or. ii.gt.3) then
720 & "Error specifying B2, components undefined",ind,ii
723 call reada(controlcard,"B2_LOW",bnew2_low(ii,ind,itypf),
725 call reada(controlcard,"B2_UP",bnew2_up(ii,ind,itypf),
727 mod_fourier(itypf)=mod_fourier(itypf)
728 & +mask_bnew2(ii,ind,itypf)
730 else if (index(controlcard,"C_LOW").gt.0) then
732 call readi(controlcard,"IND",ind,0)
733 call readi(controlcard,"COEFF",ii,0)
734 if (ind.eq.0 .or. ii.eq.0 .or. ii.gt.3) then
736 & "Error specifying C, components undefined",ind,ii
739 mask_ccnew(ii,ind,itypf)=1
740 call reada(controlcard,"C_LOW",ccnew_low(ii,ind,itypf),.1d0)
741 call reada(controlcard,"C_UP",ccnew_up(ii,ind,itypf),0.0d0)
742 mod_fourier(itypf)=mod_fourier(itypf)
743 & +mask_ccnew(ii,ind,itypf)
745 else if (index(controlcard,"D_LOW").gt.0) then
747 call readi(controlcard,"IND",ind,0)
748 call readi(controlcard,"COEFF",ii,0)
749 if (ind.eq.0 .or. ii.eq.0 .or. ii.gt.3) then
751 & "Error specifying D, components undefined",ind,ii
754 mask_ddnew(ii,ind,itypf)=1
755 call reada(controlcard,"D_LOW",ddnew_low(ii,ind,itypf),
757 call reada(controlcard,"D_UP",ddnew_up(ii,ind,itypf),
759 mod_fourier(itypf)=mod_fourier(itypf)
760 & +mask_ddnew(ii,ind,itypf)
762 else if (index(controlcard,"E0_LOW").gt.0) then
764 call readi(controlcard,"COEFF",ii,0)
765 if (ii.eq.0 .or. ii.gt.3) then
767 & "Error specifying E0, components undefined",ii
770 mask_e0new(ii,itypf)=1
771 call reada(controlcard,"E0_LOW",e0new_low(ii,itypf),
773 call reada(controlcard,"E0_UP",e0new_up(ii,itypf),
775 mod_fourier(itypf)=mod_fourier(itypf)
776 & +mask_e0new(ii,itypf)
778 else if (index(controlcard,"E_LOW").gt.0) then
780 call readi(controlcard,"IND1",ind1,0)
781 call readi(controlcard,"IND2",ind2,0)
782 call readi(controlcard,"COEFF",ii,0)
783 if (ind1.eq.0 .or. ind2.eq.0 .or. ii.eq.0 .or. ii.gt.2) then
785 & "Error specifying E, components undefined",ind1,ind2,ii
788 mask_eenew(ii,ind1,ind2,itypf)=1
789 call reada(controlcard,"E_LOW",
790 & eenew_low(ii,ind1,ind2,itypf),0.1d0)
791 call reada(controlcard,"E_UP",
792 & eenew_up(ii,ind1,ind2,itypf),0.0d0)
793 mod_fourier(itypf)=mod_fourier(itypf)
794 & +mask_eenew(ii,ind1,ind2,itypf)
796 call card_concat(controlcard,.true.)
798 call card_concat(controlcard,.true.)
799 write (iout,*) "mod_fouriertor card ",controlcard
800 mod_fouriertor(nloctyp)=index(controlcard,"MOD_FOURIERTOR")
801 write (iout,*) "mod_fouriertor value",mod_fouriertor(nloctyp)
802 write (2,*) "SPLIT_FOURIERTOR",SPLIT_FOURIERTOR,
803 & " tor_mode",tor_mode
804 IF (SPLIT_FOURIERTOR .and. tor_mode.eq.2
805 & .and. mod_fouriertor(nloctyp).gt.0) THEN
810 mask_bnew1tor(ii,j,i)=0
811 mask_bnew2tor(ii,j,i)=0
812 mask_ccnewtor(ii,j,i)=0
813 mask_ddnewtor(ii,j,i)=0
819 mask_eenewtor(ii,j,k,i)=0
824 mask_e0newtor(ii,i)=0
827 call card_concat(controlcard,.true.)
828 do while ( index(controlcard,"END").eq.0 )
829 c write(iout,*) controlcard
830 call reads(controlcard,"TYPF",typf," ")
831 itypf=rescode(1,typf,0)
832 c write (iout,*) "TYPF ",typf," itypf",itypf
833 if (itypf.eq.0 .or. itypf.gt.ntyp) then
834 write (*,*) "Error specifying fourier parms"
837 itypf=itype2loc(itypf)
838 write (iout,*) "local type",itypf
840 if (index(controlcard,"B1_LOW").gt.0) then
842 call readi(controlcard,"IND",ind,0)
843 call readi(controlcard,"COEFF",ii,0)
844 if (ind.eq.0 .or. ii.eq.0 .or. ii.gt.3) then
846 & "Error specifying B1, components undefined",ind,ii
849 mask_bnew1tor(ii,ind,itypf)=1
850 call reada(controlcard,"B1_LOW",bnew1tor_low(ii,ind,itypf),
852 call reada(controlcard,"B1_UP",bnew1tor_up(ii,ind,itypf),
854 mod_fouriertor(itypf)=mod_fouriertor(itypf)
855 & +mask_bnew1tor(ii,ind,itypf)
857 else if (index(controlcard,"B2_LOW").gt.0) then
859 mask_bnew2tor(ii,ind,itypf)=1
860 call readi(controlcard,"IND",ind,0)
861 call readi(controlcard,"COEFF",ii,0)
862 if (ind.eq.0 .or. ii.eq.0 .or. ii.gt.3) then
864 & "Error specifying B2, components undefined",ind,ii
867 call reada(controlcard,"B2_LOW",bnew2tor_low(ii,ind,itypf),
869 call reada(controlcard,"B2_UP",bnew2tor_up(ii,ind,itypf),
871 mod_fouriertor(itypf)=mod_fouriertor(itypf)
872 & +mask_bnew2tor(ii,ind,itypf)
874 else if (index(controlcard,"C_LOW").gt.0) then
876 call readi(controlcard,"IND",ind,0)
877 call readi(controlcard,"COEFF",ii,0)
878 if (ind.eq.0 .or. ii.eq.0 .or. ii.gt.3) then
880 & "Error specifying C, components undefined",ind,ii
883 mask_ccnewtor(ii,ind,itypf)=1
884 call reada(controlcard,"C_LOW",ccnewtor_low(ii,ind,itypf),
886 call reada(controlcard,"C_UP",ccnewtor_up(ii,ind,itypf),
888 mod_fouriertor(itypf)=mod_fouriertor(itypf)
889 & +mask_ccnewtor(ii,ind,itypf)
891 else if (index(controlcard,"D_LOW").gt.0) then
893 call readi(controlcard,"IND",ind,0)
894 call readi(controlcard,"COEFF",ii,0)
895 if (ind.eq.0 .or. ii.eq.0 .or. ii.gt.3) then
897 & "Error specifying D, components undefined",ind,ii
900 mask_ddnewtor(ii,ind,itypf)=1
901 call reada(controlcard,"D_LOW",ddnewtor_low(ii,ind,itypf),
903 call reada(controlcard,"D_UP",ddnewtor_up(ii,ind,itypf),
905 mod_fouriertor(itypf)=mod_fouriertor(itypf)
906 & +mask_ddnewtor(ii,ind,itypf)
908 else if (index(controlcard,"E0_LOW").gt.0) then
910 call readi(controlcard,"COEFF",ii,0)
911 if (ii.eq.0 .or. ii.gt.3) then
913 & "Error specifying E0, components undefined",ii
916 mask_e0newtor(ii,itypf)=1
917 call reada(controlcard,"E0_LOW",e0newtor_low(ii,itypf),
919 call reada(controlcard,"E0_UP",e0newtor_up(ii,itypf),
921 mod_fouriertor(itypf)=mod_fouriertor(itypf)
922 & +mask_e0newtor(ii,itypf)
924 else if (index(controlcard,"E_LOW").gt.0) then
926 call readi(controlcard,"IND1",ind1,0)
927 call readi(controlcard,"IND2",ind2,0)
928 call readi(controlcard,"COEFF",ii,0)
929 if (ind1.eq.0 .or. ind2.eq.0 .or. ii.eq.0 .or. ii.gt.2) then
931 & "Error specifying E, components undefined",ind1,ind2,ii
934 mask_eenewtor(ii,ind1,ind2,itypf)=1
935 call reada(controlcard,"E_LOW",
936 & eenewtor_low(ii,ind1,ind2,itypf),0.1d0)
937 call reada(controlcard,"E_UP",
938 & eenewtor_up(ii,ind1,ind2,itypf),0.0d0)
939 mod_fouriertor(itypf)=mod_fouriertor(itypf)
940 & +mask_eenewtor(ii,ind1,ind2,itypf)
942 call card_concat(controlcard,.true.)
944 call card_concat(controlcard,.true.)
945 write (2,*) "End read FOURIERTOR ",controlcard
947 ENDIF ! SPLIT_FOURIERTOR
951 write (iout,*) "itypf",itypf," mod_fourier",
953 mod_fourier(nloctyp)=mod_fourier(nloctyp)
954 & +mod_fourier(itypf)
956 write (iout,*) "mod_fourier all",mod_fourier(nloctyp)
958 write (iout,*) "itypf",itypf," mod_fouriertor",
959 & mod_fouriertor(itypf)
960 mod_fouriertor(nloctyp)=mod_fouriertor(nloctyp)
961 & +mod_fouriertor(itypf)
963 write (iout,*) "mod_fouriertor all",mod_fouriertor(nloctyp)
965 if (mod_fourier(nloctyp).gt.0) then
966 call card_concat(controlcard,.true.)
967 do while ( index(controlcard,"END").eq.0 )
968 call readi(controlcard,"TYPF",typf," ")
969 itypf=rescode(1,typf,0)
970 if (itypf.eq.0 .or. itypf.gt.ntyp) then
971 write (*,*) "Error specifying fourier parms"
974 itypf=itype2loc(itypf)
975 call readi(controlcard,"IND",ind,0)
976 call reada(controlcard,"B_LOW",b_low(ind,itypf),0.1d0)
977 call reada(controlcard,"B_UP",b_up(ind,itypf),0.0d0)
978 mask_fourier(ind,itypf)=1
979 mod_fourier(itypf)=mod_fourier(itypf)
980 & +mask_fourier(ind,itypf)
981 mod_fourier(nloctyp)=mod_fourier(nloctyp)
982 & +mask_fourier(ind,itypf)
983 call card_concat(controlcard,.true.)
985 call card_concat(controlcard,.true.)
988 write (iout,*) "itypf",itypf," mod_fourier",mod_fourier(itypf)
989 mod_fourier(nloctyp)=mod_fourier(nloctyp)+mod_fourier(itypf)
991 write (iout,*) "mod_fourier all",mod_fourier(nloctyp)
1000 mod_elec=index(controlcard,"MOD_ELEC").gt.0
1003 call card_concat(controlcard,.true.)
1004 do while ( index(controlcard,"END").eq.0 )
1005 c write (iout,*) "controlcard ",controlcard
1006 call readi(controlcard,"TYPE1",itype1,0)
1007 call readi(controlcard,"TYPE2",itype2,0)
1008 c write (iout,*) "itype1",itype1," itype2",itype2
1009 if (itype1.eq.0 .or. itype1.gt.2 .or. itype2.eq.0
1010 & .or. itype2.gt.2) then
1011 write (iout,*) "Error specifying elec parms"
1014 if (index(controlcard,"EPP").gt.0) then
1016 mask_elec(itype1,itype2,1)=1
1017 mask_elec(itype2,itype1,1)=1
1018 call reada(controlcard,"EPP_LOW",epp_low(itype1,itype2),
1020 epp_low(itype2,itype1)=epp_low(itype1,itype2)
1021 call reada(controlcard,"EPP_UP",epp_up(itype1,itype2),
1023 epp_up(itype2,itype1)=epp_up(itype1,itype2)
1025 if (index(controlcard,"RPP").gt.0) then
1027 mask_elec(itype1,itype2,2)=1
1028 mask_elec(itype2,itype1,2)=1
1029 call reada(controlcard,"RPP_LOW",rpp_low(itype1,itype2),
1031 rpp_low(itype2,itype1)=rpp_low(itype1,itype2)
1032 call reada(controlcard,"RPP_UP",rpp_up(itype1,itype2),
1034 rpp_up(itype2,itype1)=rpp_up(itype1,itype2)
1036 if (index(controlcard,"ELPP6").gt.0) then
1038 mask_elec(itype1,itype2,3)=1
1039 mask_elec(itype2,itype1,3)=1
1040 call reada(controlcard,"ELPP6_LOW",
1041 & elpp6_low(itype1,itype2),0.1d0)
1042 elpp6_low(itype2,itype1)=elpp6_low(itype1,itype2)
1043 call reada(controlcard,"ELPP6_UP",
1044 & elpp6_up(itype1,itype2),0.0d0)
1045 elpp6_up(itype2,itype1)=elpp6_up(itype1,itype2)
1047 if (index(controlcard,"ELPP3").gt.0) then
1049 mask_elec(itype1,itype2,4)=1
1050 mask_elec(itype2,itype1,4)=1
1051 call reada(controlcard,"ELPP3_LOW",
1052 & elpp3_low(itype1,itype2),0.1d0)
1053 elpp3_low(itype2,itype1)=elpp3_low(itype1,itype2)
1054 call reada(controlcard,"ELPP3_UP",
1055 & elpp3_up(itype1,itype2),0.0d0)
1056 elpp3_up(itype2,itype1)=elpp3_up(itype1,itype2)
1058 call card_concat(controlcard,.true.)
1060 call card_concat(controlcard,.true.)
1069 mod_scp=index(controlcard,"MOD_SCP").gt.0
1072 call card_concat(controlcard,.true.)
1073 do while (index(controlcard,"END").eq.0)
1074 if (index(controlcard,"EPSCP").gt.0) then
1076 call readi(controlcard,"ITYPSC",itypsc,0)
1077 call readi(controlcard,"ITYPP",itypp,0)
1078 if (itypsc.gt.20 .or. itypp.eq.0 .or. itypp.gt.2) then
1079 write (iout,*) "Error specifying scp parms"
1082 mask_scp(itypsc,itypp,1)=1
1083 call reada(controlcard,"EPSCP_LOW",
1084 & epscp_low(itypsc,itypp),0.1d0)
1085 call reada(controlcard,"EPSCP_UP",
1086 & epscp_up(itypsc,itypp),0.0d0)
1088 if (index(controlcard,"RSCP").gt.0) then
1090 call readi(controlcard,"ITYPSC",itypsc,0)
1091 call readi(controlcard,"ITYPP",itypp,0)
1092 mask_scp(itypsc,itypp,2)=1
1093 call readi(controlcard,"ITYPSC",itypsc,0)
1094 call readi(controlcard,"ITYPP",itypp,0)
1095 if (itypsc.gt.20 .or. itypp.eq.0 .or. itypp.gt.2) then
1096 write (iout,*) "Error specifying scp parms"
1099 call reada(controlcard,"RSCP_LOW",
1100 & rscp_low(itypsc,itypp),0.1d0)
1101 c write(iout,*)itypsc,itypp,rscp_low(itypsc,itypp)
1102 call reada(controlcard,"RSCP_UP",
1103 & rscp_up(itypsc,itypp),0.0d0)
1104 c write(iout,*)itypsc,itypp,rscp_up(itypsc,itypp)
1106 call card_concat(controlcard,.true.)
1109 write (iout,*) "END ",controlcard
1112 & mod_fourier(nloctyp).gt.0 .or. mod_elec .or. mod_scp
1113 & .or. mod_sccor .or. mod_ang .or. imask(ind_shield).eq.1
1114 if (read_stat.lt.2. .and. mod_other_params) then
1115 write (iout,*)"Error - only weights and sidechain parameters",
1116 & " can be optimized with READ_STAT=",read_stat
1120 init_ene = init_ene .or. read_stat.eq.2
1122 write (iout,*) "End read: MOD_OTHER_PARAMS ",mod_other_params
1123 c write (*,*) "MOD_SIDE ",mod_side," MOD_FOURIER",
1124 c & mod_fourier(nloctyp),
1125 c & " MOD_ELEC ",mod_elec," MOD_SCP ",mod_scp
1126 init_ene=init_ene .or. mod_other_params
1127 c write (iout,*) "init_ene",init_ene
1132 c-----------------------------------------------------------------------------
1133 subroutine print_general_data(*)
1135 include "DIMENSIONS"
1136 include "DIMENSIONS.ZSCOPT"
1139 include "COMMON.MPI"
1140 integer ierror,kolor,klucz
1142 include "COMMON.WEIGHTS"
1143 include "COMMON.NAMES"
1144 include "COMMON.VMCPAR"
1145 include "COMMON.TORSION"
1146 include "COMMON.LOCAL"
1147 include "COMMON.INTERACT"
1148 include "COMMON.ENERGIES"
1149 include "COMMON.MINPAR"
1150 include "COMMON.IOUNITS"
1151 include "COMMON.TIME1"
1152 include "COMMON.PROTFILES"
1153 include "COMMON.CHAIN"
1154 include "COMMON.CLASSES"
1155 include "COMMON.THERMAL"
1156 include "COMMON.FFIELD"
1157 include "COMMON.OPTIM"
1158 include "COMMON.CONTROL"
1159 include "COMMON.SCCOR"
1160 character*800 controlcard
1161 integer i,j,k,l,ii,n_ene_found,itypt,jtypt
1162 integer ind,itype1,itype2,itypf,itypsc,itypp
1163 integer ilen,lenpot,lenpre
1165 character*4 liczba,liczba1
1167 write (iout,*) "Single-point target function evaluation"
1168 else if (mode.eq.2) then
1169 write (iout,*) "Grid search of the parameter space"
1170 else if (mode.eq.3) then
1171 write (iout,*) "Minimization of the target function"
1173 write (iout,*) "Wrong MODE",mode,", should be 1, 2, or 3"
1177 write (iout,*) "RESCALE_MODE",rescale_mode
1178 c mod_other_params=index(controlcard,"OPTIMIZE_OTHER").gt.0
1179 c if (read_stat.eq.0 .and. mod_other_params) then
1180 c write (iout,*) "Error: only optimization of energy-term",
1181 c & " weights can be performed with READ_STAT=",read_stat
1186 write (iout,*) "Parameters of the SUMSL procedure:"
1187 write (iout,'(a,t15,i5)') "MAXMIN",maxmin
1188 write (iout,'(a,t15,i5)') "MAXFUN",maxfun
1189 write (iout,'(a,t15,e15.7)') "TOLF",tolf
1190 write (iout,'(a,t15,e15.7)') "RTOLF",rtolf
1192 if (mod_other_params) then
1194 &"Internal parameters of UNRES energy components will be optimized"
1195 c call card_concat(controlcard,.true.)
1196 c mod_side = (index(controlcard,"MOD_SIDE").gt.0)
1198 write (iout,*) "SC epsilons to be optimized:"
1199 write (iout,*) "Single: eps(i,j)=eps(i,j)+(x(i)+x(j))/2"
1201 write (iout,*) restyp(ityp_ssc(i)),epss_low(i),epss_up(i)
1203 write (iout,*) "Pairs: eps(i,j)=eps(i,j)+x(i,j):"
1205 write (iout,*) restyp(ityp_psc(1,i)),
1206 & restyp(ityp_psc(2,i)),epsp_low(i),epsp_up(i)
1210 write (iout,*)"Torsional weights/coefficients to be optimized"
1211 write(iout,'(a)') "TYP1 TYP2 WEIGHT",
1212 & " LOWER BOUND UPPER BOUND"
1213 do itypt=-nsccortyp,nsccortyp
1214 do jtypt=-nsccortyp,nsccortyp
1216 if (mask_tor(l,itypt,jtypt,1).gt.0) then
1217 write(iout,'(3a4,3f10.5)')l,restyp(itypt),restyp(jtypt),
1218 & weitor(l,itypt,jtypt,1),weitor_low(l,itypt,jtypt,1),
1219 & weitor_up(l,itypt,jtypt,1)
1225 c 7/8/17 AL: Optimization of the bending parameters
1227 write (iout,*) "Boundaries of angle potential coefficients"
1228 write (iout,'(3a)') "Index"," Low bound"," Up bound"
1230 if (mask_ang(i).eq.0) cycle
1231 write (iout,'(2a)') 'Type ',restyp(iloctyp(i))
1232 do j=1,nbend_kcc_TB(i)
1233 write (iout,'(i5,2f15.3)') j,v1bend_low(j,i),v1bend_up(j,i)
1237 if (mod_fourier(nloctyp).gt.0) then
1238 write (iout,*) "Fourier coefficients to be optimized"
1239 do itypf=0,nloctyp-1
1240 if (mod_fourier(itypf).gt.0) then
1241 write (iout,'(3a,i2)') "Type ",restyp(iloctyp(itypf)),
1242 & " number of coeffs",mod_fourier(itypf)
1243 write(iout,'(a)') "NAME COEFF LOWER BOUND UPPER BOUND"
1247 if (mask_bnew1(k,j,itypf).gt.0)
1248 & write (iout,'(2hB1,2i2,f10.5)') k,j,bnew1(k,j,itypf),
1249 & bnew1_low(k,j,itypf),bnew1_up(k,j,itypf)
1254 if (mask_bnew2(k,j,itypf).gt.0)
1255 & write (iout,'(2hB2,2i2,3f11.5)') k,j,bnew2(k,j,itypf),
1256 & bnew2_low(k,j,itypf),bnew2_up(k,j,itypf)
1261 if (mask_ccnew(k,j,itypf).gt.0)
1262 & write (iout,'(2hCC,2i2,3f11.5)') k,j,ccnew(k,j,itypf),
1263 & ccnew_low(k,j,itypf),ccnew_up(k,j,itypf)
1268 if (mask_ddnew(k,j,itypf).gt.0)
1269 & write (iout,'(2hDD,2i2,3f11.5)') k,j,ddnew(k,j,itypf),
1270 & ddnew_low(k,j,itypf),ddnew_up(k,j,itypf)
1274 if (mask_e0new(j,itypf).gt.0)
1275 & write (iout,'(2hE0,i2,3f11.5)') j,e0new(j,itypf),
1276 & e0new_low(j,itypf),e0new_up(j,itypf)
1281 if (mask_eenew(l,k,j,itypf).gt.0)
1282 & write (iout,'(2hEE,3i2,3f11.5)')
1283 & l,k,j,eenew(l,k,j,itypf),eenew_low(l,k,j,itypf),
1284 & eenew_up(l,k,j,itypf)
1290 if (mask_fourier(i,itypf).gt.0) then
1291 write (iout,'(1hB,i2,3f11.5)')
1292 & i,b(i,itypf),b_low(i,itypf),b_up(i,itypf)
1301 write (iout,*) "Electrostatic parameters to be optimized"
1304 if (mask_elec(itype1,itype2,1).gt.0)
1305 & write (iout,'(2i3," EPP",f8.3," EPP_LOW",f8.3,
1307 & itype1,itype2,epp(itype1,itype2),epp_low(itype1,itype2),
1308 & epp_up(itype1,itype2)
1309 if (mask_elec(itype1,itype2,2).gt.0)
1310 & write (iout,'(2i3," RPP",f8.3," RPP_LOW",f8.3,
1312 & itype1,itype2,rpp(itype1,itype2),rpp_low(itype1,itype2),
1313 & rpp_up(itype1,itype2)
1314 if (mask_elec(itype1,itype2,3).gt.0)
1315 & write (iout,'(2i3," ELPP6",f8.3," ELPP6_LOW",f8.3,
1316 & " ELPP6_UP",f8.3)')
1317 & itype1,itype2,elpp6(itype1,itype2),
1318 & elpp6_low(itype1,itype2),elpp6_up(itype1,itype2)
1319 if (mask_elec(itype1,itype2,4).gt.0)
1320 & write (iout,'(2i3," ELPP3",f8.3," ELPP3_LOW",f8.3,
1321 & " ELPP3_UP",f8.3)')
1322 & itype1,itype2,elpp3(itype1,itype2),
1323 & elpp3_low(itype1,itype2),elpp3_up(itype1,itype2)
1330 write (iout,*) "SCP parameters to be optimized:"
1331 if (mask_scp(0,1,1)+mask_scp(0,2,1)+mask_scp(0,1,2)+
1332 & mask_scp(0,2,2) .gt. 0) then
1334 & "SCP parameters are assumed to depend on peptide group type only"
1336 if (mask_scp(0,j,1).gt.0)
1337 & write (iout,'(i3," EPSCP",f8.3," EPSCP_LOW",f8.3,
1338 & " EPSCP_UP",f8.3)') j,eps_scp(1,j),epscp_low(0,j),
1340 if (mask_scp(0,j,2).gt.0)
1341 & write (iout,'(i3," RSCP",f8.3," RSCP_LOW",f8.3,
1342 & " RSCP_UP",f8.3)') j,rscp(1,j),rscp_low(0,j),
1348 if (mask_scp(i,j,1).gt.0)
1349 & write (iout,'(2i3," EPSCP",f8.3," EPSCP_LOW",f8.3,
1350 & " EPSCP_UP",f8.3)') i,j,eps_scp(i,j),epscp_low(i,j),
1352 if (mask_scp(i,j,2).gt.0)
1353 & write (iout,'(2i3," RSCP",f8.3," RSCP_LOW",f8.3,
1354 & " RSCP_UP",f8.3)') i,j,rscp(i,j),rscp_low(i,j),
1361 write (iout,*) "MOD_OTHER_PARAMS ",mod_other_params
1362 write (iout,*) "MOD_SIDE ",mod_side," MOD_FOURIER",
1363 & mod_fourier(nloctyp),
1364 & " MOD_ELEC ",mod_elec," MOD_SCP ",mod_scp," mod_ang",mod_ang
1365 init_ene=init_ene .or. mod_other_params
1366 write (iout,*) "init_ene",init_ene
1371 c-----------------------------------------------------------------------------
1372 subroutine read_protein_data(*)
1374 include "DIMENSIONS"
1375 include "DIMENSIONS.ZSCOPT"
1378 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
1379 include "COMMON.MPI"
1381 include "COMMON.CONTROL"
1382 include "COMMON.CHAIN"
1383 include "COMMON.CLASSES"
1384 include "COMMON.COMPAR"
1385 include "COMMON.ENERGIES"
1386 include "COMMON.IOUNITS"
1387 include "COMMON.PROTFILES"
1388 include "COMMON.PROTNAME"
1389 include "COMMON.VMCPAR"
1390 include "COMMON.OPTIM"
1391 include "COMMON.WEIGHTS"
1392 include "COMMON.NAMES"
1393 include "COMMON.ALLPROT"
1394 include "COMMON.THERMAL"
1395 include "COMMON.TIME1"
1396 include "COMMON.WEIGHTDER"
1397 character*64 nazwa,key
1398 character*16000 controlcard
1399 character*16000 all_protfiles
1400 integer i,j,k,kk,l,iprot,ii,if,ib,ibatch,nn,nn1,iww,maskcheck,
1401 & il,inat,ilevel,weightread,jfrag,jclass,nfragm,iparm
1402 integer nrec,nlines,iscor
1403 double precision energ,wangnorm(maxT),wq(maxT),wrms(maxT),
1404 & wrgy(maxT),wsign(maxT),wangnat(maxT),wqnat(maxT),wrmsnat(maxT),
1405 & wrgynat(maxT),wcorangnorm(maxT),wcorq(maxT),
1406 & wcorrms(maxT),wcorrgy(maxT),wcorsign(maxT),wcorangnat(maxT),
1407 & wcorqnat(maxT),wcorrmsnat(maxT),wcorrgynat(maxT),
1408 & angnormlow(maxT),qlow(maxT),rmslow(maxT),
1409 & rgylow(maxT),signlow(maxT),angnatlow(maxT),
1410 & qnatlow(maxT),rmsnatlow(maxT),rgynatlow(maxT),
1411 & angcorlow(maxT),qcorlow(maxT),rmscorlow(maxT),rgycorlow(maxT),
1412 & signcorlow(maxT),angcornatlow(maxT),qcornatlow(maxT),
1413 & rmscornatlow(maxT),rgycornatlow(maxT),signcornatlow(maxT),
1414 & angnormup(maxT),qup(maxT),rmsup(maxT),rgyup(maxT),signup(maxT),
1415 & angnatup(maxT),qnatup(maxT),rmsnatup(maxT),rgynatup(maxT),
1416 & angcorup(maxT),qcorup(maxT),rmscorup(maxT),rgycorup(maxT),
1418 & angcornatup(maxT),qcornatup(maxT),rmscornatup(maxT),
1419 & rgycornatup(maxT),signcornatup(MaxT)
1422 double precision ebia(maxprot),rjunk
1424 character*64 zeros /
1425 &'0000000000000000000000000000000000000000000000000000000000000000'
1428 c print *,"Processor",me," calls read_protein_data"
1430 C Read seventh record: general data of proteins used for calibration
1431 call card_concat(controlcard,.true.)
1432 c write(2, *)controlcard
1433 call readi(controlcard,"NPROT",nprot,0)
1434 pdbref=index(controlcard,"PDBREF").gt.0
1435 print_refstr=index(controlcard,"PRINT_REFSTR").gt.0
1436 if (nprot.eq.0) then
1437 write(iout,*) "Error: at least one protein must be specified."
1443 read (inp,'(a)') protname(iprot)
1445 write (iout,*) "Reading data of protein",iprot," named ",
1447 call card_concat(controlcard,.true.)
1448 call reada(controlcard,"ENECUT_MIN",enecut_min(iprot),15.0d0)
1449 call reada(controlcard,"ENECUT_MAX",enecut_max(iprot),100.0d0)
1450 call reada(controlcard,"ENECUT",enecut(iprot),enecut_min(iprot))
1451 if (enecut(iprot).lt.enecut_min(iprot))
1452 & enecut(iprot)=enecut_min(iprot)
1453 if (enecut_max(iprot).le.enecut_min(iprot))
1454 & enecut_max(iprot)=2*enecut_min(iprot)
1455 write (iout,'(3(a,f9.1))') "ENECUT",enecut(iprot)," ENECUT_MIN",
1456 & enecut_min(iprot)," ENECUT_MAX",enecut_max(iprot)
1457 call readi(controlcard,"HEFAC",hefac(iprot),50)
1458 call readi(controlcard,"HTFAC",htfac(iprot),50)
1459 call readi(controlcard,"HELOW",hemax_low(iprot),20)
1460 call readi(controlcard,"HTLOW",htmax_low(iprot),20)
1461 write (iout,*) "iprot",iprot,
1462 & " hefac",hefac(iprot)," helow",hemax_low(iprot),
1463 & " htfac",htfac(iprot)," htlow",htmax_low(iprot)
1464 c 7/27/2013 AL Read maximum likelihood data
1465 call card_concat(controlcard,.true.)
1466 call readi(controlcard,"NBETA_L",nbeta(1,iprot),0)
1467 write (iout,*) "NBETA_L",nbeta(1,iprot)
1468 caonly(iprot)=index(controlcard,"CAONLY").gt.0
1469 sconly(iprot)=index(controlcard,"SCONLY").gt.0
1470 rmscomp(iprot)=index(controlcard,"RMSCOMP").gt.0
1471 anglecomp(iprot)=index(controlcard,"ANGLECOMP").gt.0
1472 sidecomp(iprot)=index(controlcard,"SIDECOMP").gt.0
1473 call reada(controlcard,"SIGMA",sigma2(iprot),4.0d0)
1474 call reada(controlcard,"SIGMAANG",sigmaang2(iprot),4.0d0)
1475 call reada(controlcard,"SIGMASIDE",sigmaside2(iprot),4.0d0)
1476 write (iout,*) "RMSCOMP",rmscomp(iprot)," SIGMA",sigma2(iprot),
1477 & " CAONLY ",caonly(iprot)," SCONLY",sconly(iprot)
1478 write (iout,*) "ANGLECOMP",anglecomp(iprot),
1479 & " SIGMAANG",sigmaang2(iprot)
1480 write (iout,*) "SIDECOMP",sidecomp(iprot),
1481 & " SIGMASIDE",sigmaside2(iprot)
1482 do ib=1,nbeta(1,iprot)
1483 read(inp,*)betaT(ib,1,iprot),weilik(ib,iprot),
1485 write (iout,*) i,betaT(ib,1,iprot),weilik(ib,iprot),
1488 c 7/27/2013 AL Read heat-capacity data
1489 call card_concat(controlcard,.true.)
1490 call readi(controlcard,"NBETA_CV",nbeta(2,iprot),0)
1491 call reada(controlcard,"WCV",wcv(iprot),1.0d0)
1492 call reada(controlcard,"BASE",heatbase(iprot),0.0d0)
1493 write (iout,*) "NBETA_CV",nbeta(2,iprot)," WCV",wcv(iprot)
1494 do ib=1,nbeta(2,iprot)
1495 read(inp,*) betaT(ib,2,iprot),target_cv(ib,iprot),
1497 weiCv(ib,iprot)=weiCv(ib,iprot)*wcv(iprot)
1498 write (iout,*) betaT(ib,2,iprot),target_cv(ib,iprot),
1501 write (iout,*) "Experimental heat capacity curve"
1502 do ib=1,nbeta(2,iprot)
1503 write (iout,'(f6.2,2f10.5)') betaT(ib,2,iprot),
1504 & target_cv(ib,iprot),weiCv(ib,iprot)
1506 write (iout,'(a,f10.5)') "Baseline",heatbase(iprot)
1508 c Conformation-dependent averages
1509 call card_concat(controlcard,.true.)
1510 call readi(controlcard,"NATLIKE",natlike(iprot),0)
1511 do i=1,natlike(iprot)
1512 call card_concat(controlcard,.true.)
1513 call reada(controlcard,"WNAT",wnat(i,iprot),1.0d0)
1514 call readi(controlcard,"NUMNAT",numnat(i,iprot),1)
1515 call readi(controlcard,"NATDIM",natdim(i,iprot),1)
1516 do ib=1,nbeta(i+2,iprot)
1517 read(inp,*)betaT(ib,i+2,iprot),(weinat(k,ib,i,iprot),
1518 & nuexp(k,ib,i,iprot),k=1,natdim(i,iprot))
1521 do i=1,natlike(iprot)+2
1522 do j=1,nbeta(i,iprot)
1523 betaT(j,i,iprot)=1.0d0/(Rgas*betaT(j,i,iprot))
1524 write (2,*) "R i",i," j",j," beta",betaT(j,i,iprot)
1529 C Read names of files with the data for protein IPROT
1530 call card_concat(controlcard,.false.)
1532 if (iparm.eq.myparm) then
1533 call split_string(controlcard,protfiles(1,iprot),
1534 & maxfile_prot,nfile_prot(iprot))
1536 write(iout,*)"iprot",iprot," nfile",nfile_prot(iprot)
1538 & (protfiles(i,iprot),i=1,nfile_prot(iprot))
1544 c Read molecular information of the protein
1545 call molread_zs(iprot)
1546 c 3/31/04 AL Read the reference structures of protein iprot
1547 c print *,"Calling read_ref_structure"
1548 call read_ref_structure(iprot,*11)
1550 write (iout,*) "Protein",iprot," left READ_REF_STRUCTURE"
1556 c-------------------------------------------------------------------------------
1557 subroutine read_database(*)
1559 include "DIMENSIONS"
1560 include "DIMENSIONS.ZSCOPT"
1563 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
1564 include "COMMON.MPI"
1566 include "COMMON.CHAIN"
1567 include "COMMON.INTERACT"
1568 include "COMMON.CLASSES"
1569 include "COMMON.ENERGIES"
1570 include "COMMON.IOUNITS"
1571 include "COMMON.PROTFILES"
1572 include "COMMON.PROTNAME"
1573 include "COMMON.VMCPAR"
1574 include "COMMON.NAMES"
1575 include "COMMON.ALLPROT"
1576 include "COMMON.WEIGHTS"
1577 include "COMMON.WEIGHTDER"
1578 include "COMMON.VAR"
1579 include "COMMON.SBRIDGE"
1580 include "COMMON.GEO"
1581 include "COMMON.COMPAR"
1582 include "COMMON.OPTIM"
1584 character*16000 controlcard
1585 character*16000 all_protfiles
1586 character*4 liczba,liczba1
1587 integer i,j,jj,jjj,jj_old,icount,k,kk,l,iprot,ii,if,ib,ibatch,
1589 integer ixdrf,iret,itmp
1590 integer nrec,nlines,iscor
1591 double precision energ,t_acq,tcpu
1594 double precision rjunk
1595 integer ntot_all(0:maxprot,0:maxprocs-1)
1597 double precision energia(0:max_ene),etot
1598 real*4 csingle(3,maxres2),reini,refree,rmsdev,prec
1599 integer Previous,Next
1600 c print *,"Processor",me," calls read_protein_data"
1602 if (me.eq.master) then
1603 Previous=MPI_PROC_NULL
1607 if (me.eq.nprocs-1) then
1613 c Set the scratchfile names
1614 write (liczba,'(bz,i4.4)') me
1615 write (liczba1,'(bz,i4.4)') myparm
1617 c 1/27/05 AL Change stored coordinates to single precision and don't store
1618 c energy components in the binary databases.
1619 lenrec(iprot)=12*(nres_zs(iprot)+nct_zs(iprot)-nnt_zs(iprot)+1)
1620 & +4*(2*nss_zs(1,iprot)+1)+8*natlike(iprot)*maxdimnat+16
1621 c 4/13/04 AL Add space for similarity measure
1622 lenrec_ene(iprot) = (2*nntyp+3*n_ene+2)*8
1623 & +8*natlike(iprot)*maxdimnat
1626 write (iout,*) "Protein i"," lenrec",lenrec(iprot)
1627 write (iout,*) "lenrec_ene",lenrec_ene(iprot)
1630 bprotfiles(iprot) = scratchdir(:ilen(scratchdir))//
1631 & "/"//protname(iprot)(:ilen(protname(iprot)))//
1632 & "_par"//liczba1//"_"//liczba//".xbin"
1633 benefiles(iprot) = scratchdir(:ilen(scratchdir))//
1634 & "/"//protname(iprot)(:ilen(protname(iprot)))//
1635 & "_par"//liczba1//"_"//liczba//".enebin"
1636 c write (iout,*) "scratchfile ",
1637 c & bprotfiles(iprot)(:ilen(bprotfiles(iprot)))
1646 call restore_molinfo(iprot)
1647 open (ientout,file=bprotfiles(iprot),status="unknown",
1648 & form="unformatted",access="direct",recl=lenrec(iprot))
1649 c Change AL 12/30/2017
1650 if (.not.mod_other_params)
1651 & open (istat,file=benefiles(iprot),status="unknown",
1652 & form="unformatted",access="direct",recl=lenrec_ene(iprot))
1653 c Read conformations from binary DA files (one per batch) and write them to
1654 c a binary DA scratchfile.
1657 write (liczba,'(bz,i4.4)') me
1659 IF (ME.EQ.MASTER) THEN
1660 c Only the master reads the database; it'll send it to the other procs
1666 do if=1,nfile_prot(iprot)
1667 nazwa=protfiles(if,iprot)
1668 & (:ilen(protfiles(if,iprot)))//".cx"
1670 write (iout,*) "Opening file ",nazwa(:ilen(nazwa))
1672 #if (defined(AIX) && !defined(JUBL))
1673 call xdrfopen_(ixdrf,nazwa, "r", iret)
1675 call xdrfopen(ixdrf,nazwa, "r", iret)
1677 if (iret.eq.0) goto 1111
1681 #if (defined(AIX) && !defined(JUBL))
1682 call xdrf3dfcoord_(ixdrf, csingle, itmp, prec, iret)
1683 if (iret.eq.0) goto 102
1684 call xdrfint_(ixdrf, nss, iret)
1685 if (iret.eq.0) goto 102
1687 call xdrfint_(ixdrf, ihpb(j), iret)
1688 if (iret.eq.0) goto 102
1689 call xdrfint_(ixdrf, jhpb(j), iret)
1690 if (iret.eq.0) goto 102
1692 call xdrffloat_(ixdrf,reini,iret)
1693 if (iret.eq.0) goto 102
1694 call xdrffloat_(ixdrf,refree,iret)
1695 if (iret.eq.0) goto 102
1696 call xdrfint_(ixdrf,natlik,iret)
1697 if (iret.eq.0) goto 102
1699 call xdrfint(ixdrf,natliktemp(j),iret)
1700 if (iret.eq.0) goto 102
1701 do k=1,natliktemp(j)
1702 call xdrffloat(ixdrf,nutemp(k,j),iret)
1703 if (iret.eq.0) goto 102
1707 c write (0,*) "me",me," iprot",iprot," i",i
1708 call xdrf3dfcoord(ixdrf, csingle, itmp, prec, iret)
1709 if (iret.eq.0) goto 102
1710 call xdrfint(ixdrf, nss, iret)
1711 if (iret.eq.0) goto 102
1713 call xdrfint(ixdrf, ihpb(k), iret)
1714 if (iret.eq.0) goto 102
1715 call xdrfint(ixdrf, jhpb(k), iret)
1716 if (iret.eq.0) goto 102
1718 call xdrffloat(ixdrf,reini,iret)
1719 if (iret.eq.0) goto 102
1720 call xdrffloat(ixdrf,refree,iret)
1721 if (iret.eq.0) goto 102
1723 call xdrfint(ixdrf,natlik,iret)
1724 if (iret.eq.0) goto 102
1726 call xdrfint(ixdrf,natliktemp(j),iret)
1727 if (iret.eq.0) goto 102
1728 do k=1,natliktemp(j)
1729 call xdrffloat(ixdrf,nutemp(k,j),iret)
1730 if (iret.eq.0) goto 102
1735 call xdrffloat(ixdrf,rmsdev,iret)
1736 if (iret.eq.0) goto 102
1737 c write (2,*) "rmsdev",rmsdev
1738 call xdrfint(ixdrf,iscor,iret)
1739 if (iret.eq.0) goto 102
1740 c write (2,*) "iscor",iscor
1743 eini(jj+1,iprot)=reini
1744 entfac(jj+1,iprot)=refree
1752 c(l,nres+k)=csingle(l,nres+k-nnt+1)
1756 write (iout,'(5hREAD ,i5,2f15.4)')
1757 & jj+1,eini(jj+1,iprot),entfac(jj+1,iprot)
1758 write (iout,*) "natlik",natlik
1760 write (iout,*) "natliketemp",natliktemp(l)
1761 write(iout,*) (nutemp(k,l),k=1,natliktemp(l))
1763 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
1764 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
1767 call add_new_cconf(jjj,jj,jj_old,icount,iprot,
1771 write (iout,*) "Protein ",protname(iprot),
1772 & i-1," conformations read from DA file ",
1773 & nazwa(:ilen(nazwa))
1774 write (iout,*) jj," conformations read so far"
1775 #if (defined(AIX) && !defined(JUBL))
1776 call xdrfclose_(ixdrf,nazwa,iret)
1778 call xdrfclose(ixdrf,nazwa,iret)
1780 c print *,"file ",nazwa(:ilen(nazwa))," closed"
1784 write (iout,*) "jj_old",jj_old," jj",jj
1786 call write_and_send_cconf(icount,jj_old,jj,iprot,Next)
1787 if (icount.gt.0) call MPI_Send(0,1,MPI_INTEGER,Next,570,
1791 call write_and_send_cconf(icount,jj_old,jj,iprot,Next)
1793 t_acq = tcpu() - t_acq
1794 write (iout,*) "Processor",me," protein",iprot,
1795 & " batch",ibatch," time for conformation read/send",t_acq
1798 c A worker gets the confs from the master and sends them to its neighbor
1800 call receive_and_pass_cconf(icount,jj_old,jj,iprot,
1802 t_acq = tcpu() - t_acq
1803 write (iout,*) "Processor",me," protein",iprot,
1805 & " time for conformation receive/send",t_acq
1809 write (iout,*) "Protein",
1810 & protname(iprot)(:ilen(protname(iprot))),", ",ntot(iprot),
1811 & " conformatons read ",ntot(iprot)," conformations written to ",
1812 & bprotfiles(iprot)(:ilen(bprotfiles(iprot)))
1813 ntot(0) = ntot(0)+ntot(iprot)
1818 write(iout,*)"A total of",ntot(0)," conformations read."
1820 c Check if everyone has the same number of conformations
1821 call MPI_Allgather(ntot(0),maxprot+1,MPI_INTEGER,
1822 & ntot_all(0,0),maxprot+1,MPI_INTEGER,MPI_Comm_World,IERROR)
1827 if (ntot(j).ne.ntot_all(j,i)) then
1828 write (iout,*) "Number of conformations at processor",i,
1829 & " for protein",j," differs from that at processor",me,
1830 & ntot(j),ntot_all(j,i)
1837 c----------- Temporary; reading probs from external file
1838 open (88,file='1LE1_wham_last_2.rms',status='old')
1840 read (88,*) ii,weirms(i,1)
1843 write (iout,*) "i",i," weirms",weirms(i,1)
1846 call MPI_Bcast(weirms(1,1), ntot(1), MPI_Double_Precision,
1847 & Master, MPI_COMM_WORLD, IERROR)
1848 c----------- end temportary stuff
1852 write (iout,*) "Number of conformations read by processors"
1853 write (iout,'(10x,7a10)') (protname(i),i=0,nprot)
1856 write (iout,'(8i10)') i,(ntot_all(j,i),j=0,nprot)
1858 write (iout,*) "Calculation terminated."
1864 1111 write(iout,*) "Error opening coordinate file ",nazwa(:ilen(nazwa))
1867 call MPI_Abort(MPI_COMM_WORLD,IERROR,ERRCODE)
1871 c------------------------------------------------------------------------------
1872 subroutine add_new_cconf(jjj,jj,jj_old,icount,iprot,Next)
1874 include "DIMENSIONS"
1875 include "DIMENSIONS.ZSCOPT"
1876 include "COMMON.CHAIN"
1877 include "COMMON.INTERACT"
1878 include "COMMON.LOCAL"
1879 include "COMMON.CLASSES"
1880 include "COMMON.ENERGIES"
1881 include "COMMON.IOUNITS"
1882 include "COMMON.PROTFILES"
1883 include "COMMON.PROTNAME"
1884 include "COMMON.VMCPAR"
1885 include "COMMON.WEIGHTS"
1886 include "COMMON.NAMES"
1887 include "COMMON.ALLPROT"
1888 include "COMMON.WEIGHTDER"
1889 include "COMMON.VAR"
1890 include "COMMON.SBRIDGE"
1891 include "COMMON.GEO"
1892 include "COMMON.COMPAR"
1896 integer i,j,jj,jjj,jj_old,icount,k,kk,l,iprot,ii,ib,ibatch,
1897 & nn,nn1,inan,Next,itj
1898 double precision etot,energia(0:max_ene)
1900 c if (entfac(jj+1,iprot).gt.-10.0d0
1901 c & .or. entfac(jj+1,iprot).lt.-150.0d0) then
1902 c write (iout,*) "Entropy factor out of range for conformation",
1903 c & jjj,entfac(jj+1,iprot),", conformation skipped."
1906 call int_from_cart1(.false.)
1908 if (vbld(j).lt.2.0d0 .or. vbld(j).gt.6.5d0) then
1909 write (iout,*) "nnt",nnt," nct",nct
1910 write (iout,*) "Bad CA-CA bond length",j," ",vbld(j)
1911 write (iout,*) "Bad CA-SC bond length",ii," ",vbld(nres+j)
1912 write (iout,*) "The Cartesian geometry is:"
1913 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
1914 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
1915 write (iout,*) "The internal geometry is:"
1916 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
1917 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
1918 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
1919 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
1920 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
1921 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
1923 & "This conformation WILL NOT be added to the database."
1929 if (itype(j).ne.10 .and. (vbld(nres+j)-dsc(itj)).gt.2.0d0) then
1930 write (iout,*) "nnt",nnt," nct",nct
1931 write (iout,*) "Bad CA-SC bond length",ii," ",vbld(nres+j)
1932 write (iout,*) "The Cartesian geometry is:"
1933 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
1934 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
1935 write (iout,*) "The internal geometry is:"
1936 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
1937 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
1938 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
1939 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
1940 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
1941 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
1943 & "This conformation WILL NOT be added to the database."
1948 if (theta(j).le.0.0d0) then
1950 & "Zero theta angle(s) in conformation",ii
1951 write (iout,*) "The Cartesian geometry is:"
1952 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
1953 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
1954 write (iout,*) "The internal geometry is:"
1955 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
1956 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
1957 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
1958 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
1959 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
1960 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
1962 & "This conformation WILL NOT be added to the database."
1965 if (theta(j).gt.179.97*deg2rad) theta(j)=179.97*deg2rad
1967 if (.not. init_ene) then
1970 etot=etot+ww(j)*enetb(icount+1,j,iprot)
1976 if (isnan(etot).ne.0) inan=1
1978 if (isnan(etot)) inan=1
1982 idumm=proc_proc(etot,inan)
1984 call proc_proc(etot,inan)
1991 write (iout,*) "NaNs detected in some of the energy",
1992 & " components for protein",iprot," batch",ibatch,
1993 & " conformation",jjj
1994 write (iout,*) "etot",etot
1995 write (iout,*) "The Cartesian geometry is:"
1996 write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
1997 write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
1998 write (iout,*) "The internal geometry is:"
1999 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
2000 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
2001 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
2002 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
2003 write (iout,'(8f10.4)') (vbld(k+nres),k=nnt,nct)
2004 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
2005 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
2006 write (iout,*) "The components of the energy are:"
2009 energia(k)=enetb(jj+1,k,iprot)
2011 call enerprint(energia(0))
2013 & "This conformation WILL NOT be added to the database."
2018 write (iout,'(e15.5,16i5)') entfac(icount+1,iprot),
2019 & iscore(icount+1,0,iprot),ibatch
2020 write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
2021 write (iout,'(8f10.5)') ((c(j,i+nres),j=1,3),i=nnt,nct)
2022 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
2023 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
2024 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
2025 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
2026 write (iout,'(8f10.4)') (vbld(k+nres),k=nnt,nct)
2027 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
2028 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
2029 write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
2030 write (iout,'(5e15.5)') (enetb(icount+1,j,iprot),j=1,n_ene)
2031 c write (iout,'(2e15.5)') (eneps(1,j,icount+1,iprot),
2032 c & eneps(2,j,icount+1,iprot),j=1,nntyp)
2034 c write (iout,*) "First nu in readrtms"
2037 list_conf(jj,iprot)=jj
2038 call store_cconf_from_file(jj,icount,iprot)
2039 do j=1,natlike(iprot)
2041 if (k.eq.numnat(j,iprot)) then
2042 do l=1,natdim(j,iprot)
2043 nu(l,k,j,iprot)=nutemp(l,k)
2049 c write (iout,*) "End First nu in readrtms"
2051 if (icount.eq.maxstr_proc) then
2053 write (iout,* ) "jj_old",jj_old," jj",jj
2054 write (iout,*) "Calling write_and_send_cconf"
2057 call write_and_send_cconf(icount,jj_old,jj,iprot,Next)
2060 write (iout,*) "Exited write_and_send_cconf"
2068 c------------------------------------------------------------------------------
2069 subroutine store_cconf_from_file(jj,icount,iprot)
2071 include "DIMENSIONS"
2072 include "DIMENSIONS.ZSCOPT"
2073 include "COMMON.CHAIN"
2074 include "COMMON.SBRIDGE"
2075 include "COMMON.INTERACT"
2076 include "COMMON.IOUNITS"
2077 include "COMMON.CLASSES"
2078 include "COMMON.ALLPROT"
2079 include "COMMON.VAR"
2080 integer i,j,jj,icount,ibatch,iprot
2081 c Store the conformation that has been read in
2084 c_zs(j,i,icount,iprot)=c(j,i)
2087 nss_zs(icount,iprot)=nss
2089 ihpb_zs(i,icount,iprot)=ihpb(i)
2090 jhpb_zs(i,icount,iprot)=jhpb(i)
2094 c------------------------------------------------------------------------------
2095 subroutine write_and_send_cconf(icount,jj_old,jj,iprot,Next)
2097 include "DIMENSIONS"
2098 include "DIMENSIONS.ZSCOPT"
2102 include "COMMON.MPI"
2104 include "COMMON.WEIGHTS"
2105 include "COMMON.CHAIN"
2106 include "COMMON.SBRIDGE"
2107 include "COMMON.INTERACT"
2108 include "COMMON.IOUNITS"
2109 include "COMMON.CLASSES"
2110 include "COMMON.VAR"
2111 include "COMMON.ALLPROT"
2112 include "COMMON.ENERGIES"
2113 include "COMMON.WEIGHTDER"
2114 include "COMMON.OPTIM"
2115 include "COMMON.COMPAR"
2116 integer icount,jj_old,jj,Next,iprot
2117 c Write the structures to a scratch file
2119 c Master sends the portion of conformations that have been read in to the neighbor
2121 write (iout,*) "Processor",me," entered WRITE_AND_SEND_CONF"
2124 call MPI_Send(icount,1,MPI_INTEGER,Next,570,WHAM_COMM,IERROR)
2126 write (iout,*) "Processor",me," Next",next," sent icount=",icount
2127 write (iout,*) "Processor",me," jj_old",jj_old," jj",jj
2130 if (icount.gt.0) then
2131 call MPI_Send(nss_zs(1,iprot),icount,MPI_INTEGER,
2132 & Next,571,WHAM_COMM,IERROR)
2133 call MPI_Send(ihpb_zs(1,1,iprot),icount,MPI_INTEGER,
2134 & Next,572,WHAM_COMM,IERROR)
2135 if (.not. init_ene) call MPI_Send(enetb(jj_old,1,iprot),
2137 & MPI_DOUBLE_PRECISION,Next,576,WHAM_COMM,IERROR)
2138 call MPI_Send(nu(1,1,jj_old,iprot),
2139 & maxdimnat*natlike(iprot)*icount,
2140 & MPI_DOUBLE_PRECISION,
2141 & Next,577,WHAM_COMM,IERROR)
2142 call MPI_Send(eini(jj_old,iprot),icount,
2143 & MPI_DOUBLE_PRECISION,Next,578,WHAM_COMM,IERROR)
2144 call MPI_Send(entfac(jj_old,iprot),icount,MPI_DOUBLE_PRECISION,
2145 & Next,579,WHAM_COMM,IERROR)
2146 call MPI_Send(c_zs(1,1,1,iprot),3*icount*maxres2,
2147 & MPI_REAL,Next,580,WHAM_COMM,IERROR)
2148 if (.not. init_ene) call MPI_Send(eneps(1,1,1,iprot),
2150 & MPI_DOUBLE_PRECISION,Next,582,WHAM_COMM,IERROR)
2154 call dawrite_ccoords(iprot,jj_old,jj,ientout)
2155 c Change AL 20/12/2017
2156 if (.not. mod_other_params)
2157 &call dawrite_ene(iprot,jj_old,jj,istat)
2160 c------------------------------------------------------------------------------
2162 subroutine receive_and_pass_cconf(icount,jj_old,jj,iprot,Previous,
2165 include "DIMENSIONS"
2166 include "DIMENSIONS.ZSCOPT"
2168 integer IERROR,STATUS(MPI_STATUS_SIZE)
2169 include "COMMON.MPI"
2170 include "COMMON.CHAIN"
2171 include "COMMON.SBRIDGE"
2172 include "COMMON.INTERACT"
2173 include "COMMON.IOUNITS"
2174 include "COMMON.CLASSES"
2175 include "COMMON.ALLPROT"
2176 include "COMMON.ENERGIES"
2177 include "COMMON.VAR"
2178 include "COMMON.GEO"
2179 include "COMMON.WEIGHTS"
2180 include "COMMON.WEIGHTDER"
2181 include "COMMON.COMPAR"
2182 include "COMMON.OPTIM"
2183 integer i,j,k,icount,jj_old,jj,iprot,Previous,Next
2186 write (iout,*) "Processor",me," entered RECEIVE_AND_PASS_CONF"
2189 do while (icount.gt.0)
2190 c call MPI_Probe(Previous,570,WHAM_COMM,STATUS,IERROR)
2191 call MPI_Recv(icount,1,MPI_INTEGER,Previous,570,WHAM_COMM,
2194 write (iout,*)"Processor",me," previous",previous," icount",icount
2197 call MPI_Send(icount,1,MPI_INTEGER,Next,570,WHAM_COMM,
2200 write (iout,*) "Processor",me," icount",icount
2203 if (icount.eq.0) return
2204 call MPI_Recv(nss_zs(1,iprot),icount,MPI_INTEGER,
2205 & Previous,571,WHAM_COMM,STATUS,IERROR)
2206 call MPI_Send(nss_zs(1,iprot),icount,MPI_INTEGER,
2207 & Next,571,WHAM_COMM,IERROR)
2208 call MPI_Recv(ihpb_zs(1,1,iprot),icount,MPI_INTEGER,
2209 & Previous,572,WHAM_COMM,STATUS,IERROR)
2210 call MPI_Send(ihpb_zs(1,1,iprot),icount,MPI_INTEGER,
2211 & Next,572,WHAM_COMM,IERROR)
2212 if (.not. init_ene) then
2213 call MPI_Recv(enetb(jj_old,1,iprot),maxstr*n_ene,
2214 & MPI_DOUBLE_PRECISION,Previous,576,WHAM_COMM,STATUS,IERROR)
2215 call MPI_Send(enetb(jj_old,1,iprot),maxstr*n_ene,
2216 & MPI_DOUBLE_PRECISION,Next,576,WHAM_COMM,STATUS,IERROR)
2218 call MPI_Recv(nu(1,1,jj_old,iprot),
2219 & maxdimnat*natlike(iprot)*icount,
2220 & MPI_DOUBLE_PRECISION,
2221 & Previous,577,WHAM_COMM,STATUS,IERROR)
2222 call MPI_Send(nu(1,1,jj_old,iprot),
2223 & maxdimnat*natlike(iprot)*icount,
2224 & MPI_DOUBLE_PRECISION,
2225 & Next,577,WHAM_COMM,IERROR)
2226 call MPI_Recv(eini(jj_old,iprot),icount,
2227 & MPI_DOUBLE_PRECISION,Previous,578,WHAM_COMM,STATUS,IERROR)
2228 call MPI_Send(eini(jj_old,iprot),icount,
2229 & MPI_DOUBLE_PRECISION,Next,578,WHAM_COMM,IERROR)
2230 call MPI_Recv(entfac(jj_old,iprot),icount,MPI_DOUBLE_PRECISION,
2231 & Previous,579,WHAM_COMM,STATUS,IERROR)
2232 call MPI_Send(entfac(jj_old,iprot),icount,MPI_DOUBLE_PRECISION,
2233 & Next,579,WHAM_COMM,IERROR)
2234 call MPI_Recv(c_zs(1,1,1,iprot),3*icount*maxres2,
2235 & MPI_REAL,Previous,580,WHAM_COMM,STATUS,IERROR)
2236 call MPI_Send(c_zs(1,1,1,iprot),3*icount*maxres2,
2237 & MPI_REAL,Next,580,WHAM_COMM,IERROR)
2238 if (.not. init_ene) then
2239 call MPI_Recv(eneps(1,1,1,iprot),2*icount*nntyp,
2240 & MPI_DOUBLE_PRECISION,Previous,582,WHAM_COMM,STATUS,IERROR)
2241 call MPI_Send(eneps(1,1,1,iprot),2*icount*nntyp,
2242 & MPI_DOUBLE_PRECISION,Next,582,WHAM_COMM,IERROR)
2246 list_conf(i,iprot)=i
2248 call dawrite_ccoords(iprot,jj_old,jj,ientout)
2249 c Change AL 12/20/2017
2250 if (.not. mod_other_params)
2251 &call dawrite_ene(iprot,jj_old,jj,istat)
2254 write (iout,*) "Protein",iprot
2255 write (iout,*) "Processor",me," received",icount," conformations"
2257 write (iout,'(8f10.4)') ((c_zs(l,k,i,iprot),l=1,3,k=1,nres)
2258 write (iout,'(8f10.4)')((c_zs(l,k,i+nres,iprot),l=1,3,k=nnt,nct)
2259 write (iout,'(16i5)') nss_zs(i,iprot),(ihpb_zs(k,i,iprot),
2260 & jhpb_zs(k,i,iprot),k=1,nss_zs(i,iprot))
2261 write (iout,'(5e15.5)') (enetb(i,j,iprot),j=1,n_ene)
2262 write (iout,'(2e15.5)') (eneps(1,j,i,iprot),
2263 & eneps(2,j,i,iprot),j=1,nntyp)
2264 write (iout,'(e15.5,16i5)') entfac(i),iscore(i,0,iprot),
2272 c------------------------------------------------------------------------------
2273 subroutine read_thermal
2275 include "DIMENSIONS"
2276 include "DIMENSIONS.ZSCOPT"
2277 include "COMMON.CHAIN"
2278 include "COMMON.SBRIDGE"
2279 include "COMMON.INTERACT"
2280 include "COMMON.IOUNITS"
2281 include "COMMON.CLASSES"
2282 include "COMMON.VAR"
2283 include "COMMON.THERMAL"
2284 character*800 controlcard
2285 call card_concat(controlcard,.true.)
2286 call readi(controlcard,"NGRIDT",NGridT,200)
2287 call reada(controlcard,"DELTAT",deltaT,5.0d0)
2288 call reada(controlcard,"T0",GridT0,2.0d2)
2289 write (iout,*) "Parameters of thermal curves"
2290 write (iout,*) "NGRIDT",NGridT," DELTAT",deltaT," T0",GridT0
2293 c------------------------------------------------------------------------------
2294 subroutine daread_ene(iprot,istart_conf,iend_conf)
2296 include "DIMENSIONS"
2297 include "DIMENSIONS.ZSCOPT"
2300 include "COMMON.MPI"
2302 include "COMMON.CHAIN"
2303 include "COMMON.CLASSES"
2304 include "COMMON.ENERGIES"
2305 include "COMMON.IOUNITS"
2306 include "COMMON.PROTFILES"
2307 include "COMMON.ALLPROT"
2308 include "COMMON.WEIGHTDER"
2309 include "COMMON.COMPAR"
2310 include "COMMON.VMCPAR"
2311 integer iprot,istart_conf,iend_conf
2312 integer i,ii,iii,j,k
2314 write (iout,*) "Calling DAREAD_ENE"
2316 c write (iout,*) "Reading: n_ene",n_ene
2318 c write (iout,*) "DAREAD_ENE",istart_conf,iend_conf
2320 c Read conformations off a DA scratchfile.
2322 do ii=istart_conf,iend_conf
2323 iii=list_conf(ii,iprot)
2324 i = ii - istart_conf + 1
2325 read(ientin,rec=iii) (enetb(i,j,iprot),j=1,n_ene),
2326 & (enetb_orig(i,j,iprot),j=1,n_ene),
2327 & (enetb_oorig(i,j,iprot),j=1,n_ene),
2328 & eini(ii,iprot),entfac(ii,iprot),
2329 & (eneps(1,j,i,iprot),eneps(2,j,i,iprot),j=1,nntyp),
2330 & ((nu(k,j,i,iprot),k=1,maxdimnat),j=1,natlike(iprot))
2332 write (iout,'(3i5,3e15.4,i5,i10)') ii,iii,i,eini(ii,iprot),
2334 write (iout,'(20(1pe12.4)') (enetb(i,j,iprot),j=1,n_ene)
2335 write (iout,'(18(1pe12.4))')
2336 & ((nu(k,j,i,iprot)k=1,maxdimnat),j=1,natlike(iprot))
2343 c------------------------------------------------------------------------------
2344 subroutine dawrite_ene(iprot,istart_conf,iend_conf,unit_out)
2346 include "DIMENSIONS"
2347 include "DIMENSIONS.ZSCOPT"
2350 include "COMMON.MPI"
2352 include "COMMON.CHAIN"
2353 include "COMMON.CLASSES"
2354 include "COMMON.ENERGIES"
2355 include "COMMON.IOUNITS"
2356 include "COMMON.PROTFILES"
2357 include "COMMON.ALLPROT"
2358 include "COMMON.WEIGHTDER"
2359 include "COMMON.VMCPAR"
2360 include "COMMON.COMPAR"
2361 integer iprot,istart_conf,iend_conf,unit_out
2362 integer i,ii,iii,j,k
2363 c write (iout,*) "Writing: n_ene",n_ene
2365 c write (iout,*) "DAWRITE_ENE",istart_conf,iend_conf
2367 c Write conformations to a DA scratchfile.
2369 do ii=istart_conf,iend_conf
2370 iii=list_conf(ii,iprot)
2371 i = ii - istart_conf + 1
2372 write(unit_out,rec=iii) (enetb(i,j,iprot),j=1,n_ene),
2373 & (enetb_orig(i,j,iprot),j=1,n_ene),
2374 & (enetb_oorig(i,j,iprot),j=1,n_ene),
2375 & eini(ii,iprot),entfac(ii,iprot),
2376 & (eneps(1,j,i,iprot),eneps(2,j,i,iprot),j=1,nntyp),
2377 & ((nu(k,j,i,iprot),k=1,maxdimnat),j=1,natlike(iprot))
2379 write (iout,'(3i5,3e15.4,i5,i10)') ii,iii,i,eini(ii,iprot),
2381 write (iout,'(20(1pe12.4)') (enetb(i,j,iprot),j=1,n_ene)
2382 write (iout,'(18(1pe12.4))')
2383 & ((nu(kj,i,iprot),k=1,maxdimnat),j=1,natlike(iprot))
2390 c------------------------------------------------------------------------------
2391 subroutine daread_ccoords(iprot,istart_conf,iend_conf)
2393 include "DIMENSIONS"
2394 include "DIMENSIONS.ZSCOPT"
2397 include "COMMON.MPI"
2399 include "COMMON.CHAIN"
2400 include "COMMON.CLASSES"
2401 include "COMMON.ENERGIES"
2402 include "COMMON.IOUNITS"
2403 include "COMMON.PROTFILES"
2404 include "COMMON.ALLPROT"
2405 include "COMMON.INTERACT"
2406 include "COMMON.VAR"
2407 include "COMMON.SBRIDGE"
2408 include "COMMON.GEO"
2409 include "COMMON.COMPAR"
2410 include "COMMON.VMCPAR"
2411 include "COMMON.WEIGHTDER"
2412 integer iprot,istart_conf,iend_conf
2413 integer i,j,k,ij,ii,iii
2415 real*4 csingle(3,maxres2)
2416 character*16 form,acc
2419 c Read conformations off a DA scratchfile.
2422 write (iout,*) "DAREAD_COORDS"
2423 write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf
2424 write (iout,*) "lenrec",lenrec(iprot)
2425 inquire(unit=ientin,name=nam,recl=len,form=form,access=acc)
2426 write (iout,*) "len=",len," form=",form," acc=",acc
2427 write (iout,*) "nam=",nam
2430 do ii=istart_conf,iend_conf
2431 iii=list_conf(ii,iprot)
2432 ij = ii - istart_conf + 1
2434 write (iout,*) "Reading binary file, record",iii," ii",ii
2437 read(icbase,rec=iii) ((csingle(j,i),j=1,3),i=1,nres),
2438 & ((csingle(j,i),j=1,3),i=nnt+nres,nct+nres),
2439 & nss,(ihpb(i),jhpb(i),i=1,nss),eini(ii,iprot),
2441 & ((nu(k,i,ij,iprot),k=1,maxdimnat),i=1,natlike(iprot))
2448 write (iout,*) "iprot",iprot," ii",ii
2449 write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
2450 write (iout,'(8f10.4)') ((c(j,i),j=1,3),i=nnt+nres,nct+nres)
2451 write (iout,'(2e15.5)') eini(ii,iprot),entfac(ii,iprot)
2452 write (iout,'(16i5)') nss,(ihpb(i),jhpb(i),i=1,nss)
2455 call store_ccoords(iprot,ii-istart_conf+1)
2459 c------------------------------------------------------------------------------
2460 subroutine dawrite_ccoords(iprot,istart_conf,iend_conf,unit_out)
2462 include "DIMENSIONS"
2463 include "DIMENSIONS.ZSCOPT"
2466 include "COMMON.MPI"
2468 include "COMMON.CHAIN"
2469 include "COMMON.INTERACT"
2470 include "COMMON.CLASSES"
2471 include "COMMON.ENERGIES"
2472 include "COMMON.IOUNITS"
2473 include "COMMON.PROTFILES"
2474 include "COMMON.ALLPROT"
2475 include "COMMON.VAR"
2476 include "COMMON.SBRIDGE"
2477 include "COMMON.GEO"
2478 include "COMMON.COMPAR"
2479 include "COMMON.WEIGHTDER"
2480 include "COMMON.VMCPAR"
2481 real*4 csingle(3,maxres2)
2482 integer iprot,istart_conf,iend_conf
2483 integer i,j,k,ii,ij,iii,unit_out
2485 character*16 form,acc
2488 c Write conformations to a DA scratchfile.
2491 write (iout,*) "DAWRITE_COORDS"
2492 write (iout,*) "istart_conf",istart_conf," iend_conf",iend_conf
2493 write (iout,*) "lenrec",lenrec(iprot)
2494 inquire(unit=unit_out,name=nam,recl=len,form=form,access=acc)
2495 write (iout,*) "len=",len," form=",form," acc=",acc
2496 write (iout,*) "nam=",nam
2499 do ii=istart_conf,iend_conf
2500 iii=list_conf(ii,iprot)
2501 ij = ii - istart_conf + 1
2502 call restore_ccoords(iprot,ii-istart_conf+1)
2504 write (iout,*) "Writing binary file, record",iii," ii",ii
2512 write(unit_out,rec=iii) ((csingle(j,i),j=1,3),i=1,nres),
2513 & ((csingle(j,i),j=1,3),i=nnt+nres,nct+nres),
2514 & nss,(ihpb(i),jhpb(i),i=1,nss),eini(ii,iprot),
2516 & ((nu(k,i,ij,iprot),k=1,maxdimnat),i=1,natlike(iprot))
2518 write (iout,*) "kbatch",kbatch(ii,iprot)," iscore",
2519 & iscore(ii,0,iprot)
2520 write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
2521 write (iout,'(8f10.4)') ((c(j,i),j=1,3),i=nnt+nres,nct+nres)
2522 write (iout,'(2e15.5)') eini(ii,iprot),entfac(ii,iprot)
2523 write (iout,'(16i5)') nss,(ihpb(i),jhpb(i),i=1,nss)
2529 c------------------------------------------------------------------------------
2530 subroutine store_ccoords(iprot,ii)
2532 include "DIMENSIONS"
2533 include "DIMENSIONS.ZSCOPT"
2534 include "COMMON.VAR"
2535 include "COMMON.CHAIN"
2536 include "COMMON.ALLPROT"
2537 include "COMMON.IOUNITS"
2538 include "COMMON.GEO"
2539 include "COMMON.SBRIDGE"
2540 double precision thetnorm
2541 integer iprot,i,j,ii
2542 do i=1,nres_zs(iprot)
2544 c_zs(j,i,ii,iprot)=c(j,i)
2547 do i=nnt_zs(iprot),nct_zs(iprot)
2549 c_zs(j,i+nres,ii,iprot)=c(j,i+nres)
2552 c 5/7/02 AL: store sbridge info
2553 nss_zs(ii,iprot)=nss
2555 ihpb_zs(i,ii,iprot)=ihpb(i)
2556 jhpb_zs(i,ii,iprot)=jhpb(i)
2560 c------------------------------------------------------------------------------
2561 subroutine restore_ccoords(iprot,ii)
2563 include "DIMENSIONS"
2564 include "DIMENSIONS.ZSCOPT"
2565 include "COMMON.INTERACT"
2566 include "COMMON.VAR"
2567 include "COMMON.ALLPROT"
2568 include "COMMON.SBRIDGE"
2569 include "COMMON.CHAIN"
2570 include "COMMON.IOUNITS"
2571 integer iprot,i,j,ii
2572 do i=1,nres_zs(iprot)
2574 c(j,i)=c_zs(j,i,ii,iprot)
2577 do i=nnt_zs(iprot),nct_zs(iprot)
2579 c(j,i+nres)=c_zs(j,i+nres,ii,iprot)
2582 c 5/7/02 AL: restore sbridge info
2583 nss=nss_zs(ii,iprot)
2585 ihpb(i)=ihpb_zs(i,ii,iprot)+nres
2586 jhpb(i)=jhpb_zs(i,ii,iprot)+nres
2591 write (iout,*) "restore_ccoords",ii
2592 write (iout,'(8f10.5)') ((c(j,i),j=1,3),i=1,nres)
2593 write (iout,'(8f10.4)') ((c(j,i),j=1,3),i=nnt+nres,nct+nres)
2594 write (iout,'(16i5)') nss,(ihpb(i),jhpb(i),i=1,nss)
2599 c------------------------------------------------------------------------------
2600 subroutine card_concat(card,to_upper)
2602 include 'DIMENSIONS.ZSCOPT'
2603 include "COMMON.IOUNITS"
2605 character*80 karta,ucase
2609 read (inp,'(a)') karta
2610 if (to_upper) karta=ucase(karta)
2612 do while (karta(80:80).eq.'&')
2613 card=card(:ilen(card)+1)//karta(:79)
2614 read (inp,'(a)') karta
2615 if (to_upper) karta=ucase(karta)
2617 card=card(:ilen(card)+1)//karta
2620 c------------------------------------------------------------------------------
2621 subroutine readi(rekord,lancuch,wartosc,default)
2623 character*(*) rekord,lancuch
2624 integer wartosc,default
2627 iread=index(rekord,lancuch(:ilen(lancuch))//"=")
2628 if (iread.eq.0) then
2632 iread=iread+ilen(lancuch)+1
2633 read (rekord(iread:),*) wartosc
2636 c----------------------------------------------------------------------------
2637 subroutine reada(rekord,lancuch,wartosc,default)
2639 character*(*) rekord,lancuch
2641 double precision wartosc,default
2644 iread=index(rekord,lancuch(:ilen(lancuch))//"=")
2645 if (iread.eq.0) then
2649 iread=iread+ilen(lancuch)+1
2650 read (rekord(iread:),*) wartosc
2653 c----------------------------------------------------------------------------
2654 subroutine multreadi(rekord,lancuch,tablica,dim,default)
2657 integer tablica(dim),default
2658 character*(*) rekord,lancuch
2665 iread=index(rekord,lancuch(:ilen(lancuch))//"=")
2666 if (iread.eq.0) return
2667 iread=iread+ilen(lancuch)+1
2668 read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim)
2671 c----------------------------------------------------------------------------
2672 subroutine multreada(rekord,lancuch,tablica,dim,default)
2675 double precision tablica(dim),default
2676 character*(*) rekord,lancuch
2683 iread=index(rekord,lancuch(:ilen(lancuch))//"=")
2684 if (iread.eq.0) return
2685 iread=iread+ilen(lancuch)+1
2686 read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim)
2689 c----------------------------------------------------------------------------
2690 subroutine reads(rekord,lancuch,wartosc,default)
2692 character*(*) rekord,lancuch,wartosc,default
2694 integer ilen,lenlan,lenrec,iread,ireade
2698 lenlan=ilen(lancuch)
2700 iread=index(rekord,lancuch(:lenlan)//"=")
2701 c print *,"rekord",rekord," lancuch",lancuch
2702 c print *,"iread",iread," lenlan",lenlan," lenrec",lenrec
2703 if (iread.eq.0) then
2707 iread=iread+lenlan+1
2708 c print *,"iread",iread
2709 c print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread))
2710 do while (iread.le.lenrec .and. iblnk(rekord(iread:iread)))
2712 c print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread))
2714 c print *,"iread",iread
2715 if (iread.gt.lenrec) then
2720 c print *,"ireade",ireade
2721 do while (ireade.lt.lenrec .and.
2722 & .not.iblnk(rekord(ireade:ireade)))
2725 wartosc=rekord(iread:ireade)
2728 c----------------------------------------------------------------------------
2729 subroutine multreads(rekord,lancuch,tablica,dim,default)
2732 character*(*) rekord,lancuch,tablica(dim),default
2734 integer ilen,lenlan,lenrec,iread,ireade
2741 lenlan=ilen(lancuch)
2743 iread=index(rekord,lancuch(:lenlan)//"=")
2744 c print *,"rekord",rekord," lancuch",lancuch
2745 c print *,"iread",iread," lenlan",lenlan," lenrec",lenrec
2746 if (iread.eq.0) return
2747 iread=iread+lenlan+1
2749 c print *,"iread",iread
2750 c print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread))
2751 do while (iread.le.lenrec .and. iblnk(rekord(iread:iread)))
2753 c print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread))
2755 c print *,"iread",iread
2756 if (iread.gt.lenrec) return
2758 c print *,"ireade",ireade
2759 do while (ireade.lt.lenrec .and.
2760 & .not.iblnk(rekord(ireade:ireade)))
2763 tablica(i)=rekord(iread:ireade)
2767 c----------------------------------------------------------------------------
2768 subroutine split_string(rekord,tablica,dim,nsub)
2770 integer dim,nsub,i,ii,ll,kk
2771 character*(*) tablica(dim)
2772 character*(*) rekord
2782 C Find the start of term name
2784 do while (ii.le.ll .and. rekord(ii:ii).eq." ")
2787 C Parse the name into TABLICA(i) until blank found
2788 do while (ii.le.ll .and. rekord(ii:ii).ne." ")
2790 tablica(i)(kk:kk)=rekord(ii:ii)
2793 if (kk.gt.0) nsub=nsub+1
2794 if (ii.gt.ll) return
2798 c-------------------------------------------------------------------------------
2799 integer function iroof(n,m)
2801 if (ii*m .lt. n) ii=ii+1