1 subroutine enecalc(islice,*)
4 include "DIMENSIONS.ZSCOPT"
5 include "DIMENSIONS.FREE"
8 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
11 include "COMMON.CHAIN"
12 include "COMMON.IOUNITS"
13 include "COMMON.PROTFILES"
14 include "COMMON.NAMES"
16 include "COMMON.SBRIDGE"
18 include "COMMON.FFIELD"
19 include "COMMON.ENEPS"
20 include "COMMON.LOCAL"
21 include "COMMON.WEIGHTS"
22 include "COMMON.INTERACT"
24 include "COMMON.ENERGIES"
25 include "COMMON.CONTROL"
26 include "COMMON.TORCNSTR"
30 double precision qwolynes
32 integer errmsg_count,maxerrmsg_count /100/
33 double precision rmsnat,gyrate
34 external rmsnat,gyrate
35 c double precision tole /1.0d-1/
36 integer i,itj,ii,iii,j,k,l,licz,ipermin
37 integer ir,ib,ipar,iparm
38 integer iscor,islice,scount_buff(0:99)
39 real*4 csingle(3,maxres2)
40 double precision energ
44 double precision energia(0:max_ene),rmsdev,efree,eini
45 double precision fT(6),quot,quotl,kfacl,kfac /2.4d0/,T0 /3.0d2/
47 integer snk_p(MaxR,MaxT_h,Max_parm)
49 character*64 bprotfile_temp
50 call opentmp(islice,ientout,bprotfile_temp)
54 c write (iout,*) "enecalc: nparmset ",nparmset
55 c write (iout,*) "enecalc: tormode ",tor_mode
64 write (iout,*) "indstart(me1),indend(me1)"
65 &,indstart(me1),indend(me1)
66 do i=indstart(me1),indend(me1)
78 read(ientout,rec=i,err=101)
79 & ((csingle(l,k),l=1,3),k=1,nres),
80 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
81 & nss,(ihpb(k),jhpb(k),k=1,nss),
82 & eini,efree,rmsdev,(q(j,iii+1),j=1,nQ),iR,ib,ipar
91 c(l,k+nres)=csingle(l,k+nres)
94 anatemp= 1.0d0/(beta_h(ib,ipar)*1.987D-3)
95 q(nQ+1,iii+1)=rmsnat(iii+1,ipermin)
97 q(nQ+2,iii+1)=gyrate(iii+1)
98 c fT=T0*beta_h(ib,ipar)*1.987D-3
99 c ft=2.0d0/(1.0d0+1.0d0/(T0*beta_h(ib,ipar)*1.987D-3))
100 if (rescale_mode.eq.1) then
101 quot=1.0d0/(T0*beta_h(ib,ipar)*1.987D-3)
103 tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
104 ft(6)=(320.0+80.0*dtanh((tt-320.0)/80.0))/320.0
115 fT(l)=kfacl/(kfacl-1.0d0+quotl)
117 else if (rescale_mode.eq.2) then
118 quot=1.0d0/(T0*beta_h(ib,ipar)*1.987D-3)
120 tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
121 ft(6)=(320.0+80.0*dtanh((tt-320.0)/80.0))/320.0
130 fT(l)=1.12692801104297249644d0/
131 & dlog(dexp(quotl)+dexp(-quotl))
133 else if (rescale_mode.eq.0) then
138 write (iout,*) "Error in ECECALC: wrong RESCALE_MODE",
144 c write (iout,*) "T",1.0d0/(beta_h(ib,ipar)*1.987D-3)," T0",T0,
145 c & " kfac",kfac,"quot",quot," fT",fT
151 call int_from_cart1(.false.)
155 call restore_parm(iparm)
157 write (iout,*) wsc,wscp,welec,wvdwpp,wang,wtor,wscloc,
158 & wcorr,wcorr5,wcorr6,wturn4,wturn3,wturn6,wel_loc,
159 & wtor_d,wsccor,wbond
161 C write (iout,*) "tuz przed energia"
162 call etotal(energia(0),fT)
163 C write (iout,*) "tuz za energia"
165 write (iout,*) "Conformation",i
166 c write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres),
167 c & ((c(l,k+nres),l=1,3),k=nnt,nct)
168 call enerprint(energia(0),fT)
169 c write (iout,'(2i5,21f8.2)') i,iparm,(energia(k),k=1,21)
170 c write (iout,*) "ftors(1)",ftors(1)
171 c call briefout(i,energia(0))
172 c temp=1.0d0/(beta_h(ib,ipar)*1.987D-3)
173 c write (iout,*) "temp", temp
174 c call pdbout(i,temp,energia(0),energia(0),0.0d0,0.0d0)
176 if (isnan(energia(0)) .or. energia(1).ge.1.0d20
177 & .or. energia(0).ge.1.0d20) then
178 write (iout,*) "NaNs detected in some of the energy",
179 & " components for conformation",ii+1
180 write (iout,*) "The Cartesian geometry is:"
181 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
182 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
183 write (iout,*) "The internal geometry is:"
185 c call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev)
186 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
187 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
188 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
189 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
190 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
191 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
192 write (iout,*) "The components of the energy are:"
193 call enerprint(energia(0),fT)
195 & "This conformation WILL NOT be added to the database."
200 if (ipar.eq.iparm) write (iout,*) i,iparm,
201 & 1.0d0/(beta_h(ib,ipar)*1.987D-3),eini,energia(0)
203 if (ipar.eq.iparm .and. einicheck.gt.0 .and.
204 ! & dabs(eini-energia(0)-energia(27)).gt.tole) then
205 & dabs(eini-energia(0)).gt.tole) then
206 if (errmsg_count.le.maxerrmsg_count) then
207 write (iout,'(2a,2e15.5,a,2i8,a,f8.1)')
208 & "Warning: energy differs remarkably from ",
209 ! & " the value read in: ",energia(0)+energia(27),eini," point",
210 & " the value read in: ",energia(0),eini," point",
211 & iii+1,indstart(me1)+iii," T",
212 & 1.0d0/(1.987D-3*beta_h(ib,ipar))
213 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres),
214 & ((c(l,k+nres),l=1,3),k=nnt,nct)
216 call pdbout(indstart(me1)+iii,
217 & 1.0d0/(1.987D-3*beta_h(ib,ipar)),energia(0),eini,0.0d0,0.0d0)
218 call enerprint(energia(0),fT)
219 errmsg_count=errmsg_count+1
220 if (errmsg_count.gt.maxerrmsg_count)
221 & write (iout,*) "Too many warning messages"
222 if (einicheck.gt.1) then
223 write (iout,*) "Calculation stopped."
226 call MPI_Abort(WHAM_COMM,IERROR,ERRCODE)
233 C write (iout,*) "Czy tu dochodze"
234 potE(iii+1,iparm)=energia(0)
236 enetb(k,iii+1,iparm)=energia(k)
239 write (iout,'(2i5,f10.1,3e15.5)') i,iii,
240 & 1.0d0/(beta_h(ib,ipar)*1.987D-3),energia(0),eini,efree
241 c call enerprint(energia(0),fT)
244 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
245 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
246 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
247 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
248 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
249 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
250 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
251 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
252 write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
253 write (iout,'(8f10.5)') (q(k,iii+1),k=1,nQ)
254 write (iout,'(f10.5,i10)') rmsdev,iscor
255 call enerprint(energia(0),fT)
256 call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev)
263 if (q(1,iii).le.0.0d0 .and. indpdb.gt.0)
264 & q(1,iii)=qwolynes(0,0,ipermin)
265 write (ientout,rec=iii)
266 & ((csingle(l,k),l=1,3),k=1,nres),
267 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
268 & nss,(ihpb(k),jhpb(k),k=1,nss),
269 & potE(iii,ipar),efree,rmsdev,(q(k,iii),k=1,nQ),iR,ib,ipar
270 c write (iout,'(2i5,2e15.5)') ii,iii,potE(iii,ipar),efree
272 if (separate_parset) then
273 snk_p(iR,ib,1)=snk_p(iR,ib,1)+1
275 snk_p(iR,ib,ipar)=snk_p(iR,ib,ipar)+1
277 c write (iout,*) "iii",iii," iR",iR," ib",ib," ipar",ipar,
278 c & " snk",snk_p(iR,ib,ipar)
280 snk(iR,ib,ipar,islice)=snk(iR,ib,ipar,islice)+1
286 write (iout,*) "Me",me," scount_buff",scount_buff(me)
288 c Master gathers updated numbers of conformations written by all procs.
289 c call MPI_AllGather(MPI_IN_PLACE,1,MPI_DATATYPE_NULL,scount(0),1,
290 c & MPI_INTEGER, WHAM_COMM, IERROR)
291 call MPI_AllGather( scount_buff(me), 1, MPI_INTEGER, scount(0), 1,
292 & MPI_INTEGER, WHAM_COMM, IERROR)
297 indstart(i)=indend(i-1)+1
298 indend(i)=indstart(i)+scount(i)-1
301 write (iout,*) "Revised conformation counts"
303 write (iout,'(a,i5,a,i7,a,i7,a,i7)')
304 & "Processor",i," indstart",indstart(i),
305 & " indend",indend(i)," count",scount(i)
308 call MPI_AllReduce(snk_p(1,1,1),snk(1,1,1,islice),
309 & MaxR*MaxT_h*nParmSet,
310 & MPI_INTEGER,MPI_SUM,WHAM_COMM,IERROR)
316 stot(islice)=stot(islice)+snk(i,ib,iparm,islice)
320 write (iout,*) "Revised SNK"
323 write (iout,'("Param",i3," Temp",f6.1,3x,32i8)')
324 & iparm,1.0d0/(1.987D-3*beta_h(ib,iparm)),
325 & (snk(i,ib,iparm,islice),i=1,nR(ib,iparm))
326 write (iout,*) "snk_p",(snk_p(i,ib,iparm),i=1,nR(ib,iparm))
329 write (iout,'("Total",i10)') stot(islice)
332 101 write (iout,*) "Error in scratchfile."
336 c------------------------------------------------------------------------------
337 subroutine write_dbase(islice,*)
340 include "DIMENSIONS.ZSCOPT"
341 include "DIMENSIONS.FREE"
342 include "DIMENSIONS.COMPAR"
345 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
348 include "COMMON.CONTROL"
349 include "COMMON.CHAIN"
350 include "COMMON.IOUNITS"
351 include "COMMON.PROTFILES"
352 include "COMMON.NAMES"
354 include "COMMON.SBRIDGE"
356 include "COMMON.FFIELD"
357 include "COMMON.ENEPS"
358 include "COMMON.LOCAL"
359 include "COMMON.WEIGHTS"
360 include "COMMON.INTERACT"
361 include "COMMON.FREE"
362 include "COMMON.ENERGIES"
363 include "COMMON.COMPAR"
364 include "COMMON.PROT"
365 include "COMMON.CONTACTS1"
367 character*80 bxname,cxname
368 character*64 bprotfile_temp
369 character*3 liczba,licz
371 integer i,itj,ii,iii,j,k,l
374 double precision rmsdev,efree,eini
375 real*4 csingle(3,maxres2)
376 double precision energ
379 integer ir,ib,iparm, scount_buff(0:99)
380 integer isecstr(maxres)
381 write (licz2,'(bz,i2.2)') islice
382 call opentmp(islice,ientout,bprotfile_temp)
383 write (iout,*) "bprotfile_temp ",bprotfile_temp
385 if (.not.bxfile .and. .not. cxfile .and. indpdb.eq.0
386 & .and. ensembles.eq.0) then
387 close(ientout,status="delete")
391 write (liczba,'(bz,i3.3)') me
392 if (bxfile .or. cxfile .or. ensembles.gt.0) then
393 if (.not.separate_parset) then
394 bxname = prefix(:ilen(prefix))//liczba//".bx"
396 write (licz,'(bz,i3.3)') myparm
397 bxname = prefix(:ilen(prefix))//liczba//"_par"//licz//".bx"
399 open (ientin,file=bxname,status="unknown",
400 & form="unformatted",access="direct",recl=lenrec1)
403 if (bxfile .or. cxfile .or. ensembles.gt.0) then
404 if (nslice.eq.1) then
405 bxname = prefix(:ilen(prefix))//".bx"
407 bxname = prefix(:ilen(prefix))//
408 & "_slice_"//licz2//".bx"
410 open (ientin,file=bxname,status="unknown",
411 & form="unformatted",access="direct",recl=lenrec1)
412 write (iout,*) "Calculating energies; writing geometry",
413 & " and energy components to ",bxname(:ilen(bxname))
415 #if (defined(AIX) && !defined(JUBL))
416 call xdrfopen_(ixdrf,cxname, "w", iret)
418 call xdrfopen(ixdrf,cxname, "w", iret)
421 write (iout,*) "Error opening cxfile ",cxname(:ilen(cxname))
426 if (indpdb.gt.0) then
427 if (nslice.eq.1) then
429 if (.not.separate_parset) then
430 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))
433 write (licz,'(bz,i3.3)') myparm
434 statname=prefix(:ilen(prefix))//'_par'//licz//'_'//
435 & pot(:ilen(pot))//liczba//'.stat'
439 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))//'.stat'
443 if (.not.separate_parset) then
444 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))//
445 & "_slice_"//licz2//liczba//'.stat'
447 write (licz,'(bz,i3.3)') myparm
448 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))//
449 & '_par'//licz//"_slice_"//licz2//liczba//'.stat'
452 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))
453 & //"_slice_"//licz2//'.stat'
456 open(istat,file=statname,status="unknown")
464 read(ientout,rec=i,err=101)
465 & ((csingle(l,k),l=1,3),k=1,nres),
466 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
467 & nss,(ihpb(k),jhpb(k),k=1,nss),
468 & eini,efree,rmsdev,(q(k,i),k=1,nQ),iR,ib,iparm
469 c write (iout,*) iR,ib,iparm,eini,efree
475 call int_from_cart1(.false.)
477 c write (iout,*) "Calling conf_compar",i
479 anatemp= 1.0d0/(beta_h(ib,iparm)*1.987D-3)
480 if (indpdb.gt.0) then
481 call conf_compar(i,.false.,.true.)
483 c call elecont(.false.,ncont,icont,nnt,nct)
484 c call secondary2(.false.,.false.,ncont,icont,isecstr)
486 c write (iout,*) "Exit conf_compar",i
488 if (bxfile .or.cxfile .or. ensembles.gt.0) write (ientin,rec=i)
489 & ((csingle(l,k),l=1,3),k=1,nres),
490 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
491 & nss,(ihpb(k),jhpb(k),k=1,nss),
492 c & potE(i,iparm),-entfac(i),rms_nat,iscore
493 & potE(i,nparmset),-entfac(i),rms_nat,iscore
494 c write (iout,'(2i5,3e15.5)') i,me,potE(i,iparm),-entfac(i)
496 if (cxfile) call cxwrite(ixdrf,csingle,potE(i,nparmset),
497 & -entfac(i),rms_nat,iscore)
500 close(ientout,status="delete")
502 if (bxfile .or. cxfile .or. ensembles.gt.0) close(ientin)
504 call MPI_Barrier(WHAM_COMM,IERROR)
505 if (me.ne.Master .or. .not.bxfile .and. .not. cxfile
506 & .and. ensembles.eq.0) return
508 if (bxfile .or. ensembles.gt.0) then
509 if (nslice.eq.1) then
510 if (.not.separate_parset) then
511 bxname = prefix(:ilen(prefix))//".bx"
513 write (licz,'(bz,i3.3)') myparm
514 bxname = prefix(:ilen(prefix))//"_par"//licz//".bx"
517 if (.not.separate_parset) then
518 bxname = prefix(:ilen(prefix))//"_slice_"//licz2//".bx"
520 write (licz,'(bz,i3.3)') myparm
521 bxname = prefix(:ilen(prefix))//"par_"//licz//
522 & "_slice_"//licz2//".bx"
525 open (ientout,file=bxname,status="unknown",
526 & form="unformatted",access="direct",recl=lenrec1)
527 write (iout,*) "Master is creating binary database ",
528 & bxname(:ilen(bxname))
531 if (nslice.eq.1) then
532 if (.not.separate_parset) then
533 cxname = prefix(:ilen(prefix))//".cx"
535 cxname = prefix(:ilen(prefix))//"_par"//licz//".cx"
538 if (.not.separate_parset) then
539 cxname = prefix(:ilen(prefix))//
540 & "_slice_"//licz2//".cx"
542 cxname = prefix(:ilen(prefix))//"_par"//licz//
543 & "_slice_"//licz2//".cx"
546 #if (defined(AIX) && !defined(JUBL))
547 call xdrfopen_(ixdrf,cxname, "w", iret)
549 call xdrfopen(ixdrf,cxname, "w", iret)
552 write (iout,*) "Error opening cxfile ",cxname(:ilen(cxname))
557 write (liczba,'(bz,i3.3)') j
558 if (separate_parset) then
559 write (licz,'(bz,i3.3)') myparm
560 bxname = prefix(:ilen(prefix))//liczba//"_par"//licz//".bx"
562 bxname = prefix(:ilen(prefix))//liczba//".bx"
564 open (ientin,file=bxname,status="unknown",
565 & form="unformatted",access="direct",recl=lenrec1)
566 write (iout,*) "Master is reading conformations from ",
567 & bxname(:ilen(bxname))
569 c write (iout,*) "j",j," indstart",indstart(j)," indend",indend(j)
571 do i=indstart(j),indend(j)
573 read(ientin,rec=iii,err=101)
574 & ((csingle(l,k),l=1,3),k=1,nres),
575 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
576 & nss,(ihpb(k),jhpb(k),k=1,nss),
577 & eini,efree,rmsdev,iscor
578 if (bxfile .or. ensembles.gt.0) then
579 write (ientout,rec=i)
580 & ((csingle(l,k),l=1,3),k=1,nres),
581 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
582 & nss,(ihpb(k),jhpb(k),k=1,nss),
583 & eini,efree,rmsdev,iscor
585 if(cxfile)call cxwrite(ixdrf,csingle,eini,efree,rmsdev,iscor)
592 call int_from_cart1(.false.)
593 write (iout,'(2i5,3e15.5)') i,iii,eini,efree
594 write (iout,*) "The Cartesian geometry is:"
595 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
596 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
597 write (iout,*) "The internal geometry is:"
598 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
599 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
600 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
601 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
602 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
603 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
604 write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
605 write (iout,'(f10.5,i5)') rmsdev,iscor
608 write (iout,*) iii," conformations (from",indstart(j)," to",
609 & indend(j),") read from ",
610 & bxname(:ilen(bxname))
611 close (ientin,status="delete")
613 if (bxfile .or. cxfile .or. ensembles.gt.0) close (ientout)
614 #if (defined(AIX) && !defined(JUBL))
615 if (cxfile) call xdrfclose_(ixdrf,cxname,iret)
617 if (cxfile) call xdrfclose(ixdrf,cxname,iret)
621 101 write (iout,*) "Error in scratchfile."
625 c-------------------------------------------------------------------------------
626 subroutine cxwrite(ixdrf,csingle,eini,efree,rmsdev,iscor)
629 include "DIMENSIONS.ZSCOPT"
630 include "DIMENSIONS.FREE"
631 include "DIMENSIONS.COMPAR"
634 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
637 include "COMMON.CONTROL"
638 include "COMMON.CHAIN"
639 include "COMMON.IOUNITS"
640 include "COMMON.PROTFILES"
641 include "COMMON.NAMES"
643 include "COMMON.SBRIDGE"
645 include "COMMON.FFIELD"
646 include "COMMON.ENEPS"
647 include "COMMON.LOCAL"
648 include "COMMON.WEIGHTS"
649 include "COMMON.INTERACT"
650 include "COMMON.FREE"
651 include "COMMON.ENERGIES"
652 include "COMMON.COMPAR"
653 include "COMMON.PROT"
654 integer i,j,itmp,iscor,iret,ixdrf
655 double precision rmsdev,efree,eini
656 real*4 csingle(3,maxres2),xoord(3,maxres2+2)
659 c write (iout,*) "cxwrite"
664 xoord(j,i)=csingle(j,i)
669 xoord(j,nres+i-nnt+1)=csingle(j,i+nres)
675 c write (iout,*) "itmp",itmp
677 #if (defined(AIX) && !defined(JUBL))
678 call xdrf3dfcoord_(ixdrf, xoord, itmp, prec, iret)
680 c write (iout,*) "xdrf3dfcoord"
682 call xdrfint_(ixdrf, nss, iret)
685 call xdrfint(ixdrf, idssb(j)+nres, iret)
686 call xdrfint(ixdrf, jdssb(j)+nres, iret)
688 call xdrfint_(ixdrf, ihpb(j), iret)
689 call xdrfint_(ixdrf, jhpb(j), iret)
692 call xdrffloat_(ixdrf,real(eini),iret)
693 call xdrffloat_(ixdrf,real(efree),iret)
694 call xdrffloat_(ixdrf,real(rmsdev),iret)
695 call xdrfint_(ixdrf,iscor,iret)
697 call xdrf3dfcoord(ixdrf, xoord, itmp, prec, iret)
699 call xdrfint(ixdrf, nss, iret)
702 call xdrfint(ixdrf, idssb(j)+nres, iret)
703 call xdrfint(ixdrf, jdssb(j)+nres, iret)
705 call xdrfint(ixdrf, ihpb(j), iret)
706 call xdrfint(ixdrf, jhpb(j), iret)
709 call xdrffloat(ixdrf,real(eini),iret)
710 call xdrffloat(ixdrf,real(efree),iret)
711 call xdrffloat(ixdrf,real(rmsdev),iret)
712 call xdrfint(ixdrf,iscor,iret)
717 c------------------------------------------------------------------------------
718 logical function conf_check(ii,iprint)
721 include "DIMENSIONS.ZSCOPT"
722 include "DIMENSIONS.FREE"
725 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
728 include "COMMON.CHAIN"
729 include "COMMON.IOUNITS"
730 include "COMMON.PROTFILES"
731 include "COMMON.NAMES"
733 include "COMMON.SBRIDGE"
735 include "COMMON.FFIELD"
736 include "COMMON.ENEPS"
737 include "COMMON.LOCAL"
738 include "COMMON.WEIGHTS"
739 include "COMMON.INTERACT"
740 include "COMMON.FREE"
741 include "COMMON.ENERGIES"
742 include "COMMON.CONTROL"
743 include "COMMON.TORCNSTR"
744 integer j,k,l,ii,itj,iprint
745 c if (.not.check_conf) then
749 call int_from_cart1(.false.)
751 if (itype(j-1).ne.ntyp1 .and. itype(j).ne.ntyp1 .and.
752 & (vbld(j).lt.2.0d0 .or. vbld(j).gt.6.5d0)) then
754 & write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),
755 & " for conformation",ii
756 if (iprint.gt.1) then
757 write (iout,*) "The Cartesian geometry is:"
758 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
759 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
760 write (iout,*) "The internal geometry is:"
761 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
762 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
763 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
764 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
765 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
766 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
768 if (iprint.gt.0) write (iout,*)
769 & "This conformation WILL NOT be added to the database."
776 if (itype(j).ne.10 .and.itype(j).ne.ntyp1 .and.
777 & (vbld(nres+j)-dsc(iabs(itj))).gt.2.0d0) then
779 & write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j),
780 & restyp(itj),itj,dsc(iabs(itj))," for conformation",ii
781 if (iprint.gt.1) then
782 write (iout,*) "The Cartesian geometry is:"
783 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
784 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
785 write (iout,*) "The internal geometry is:"
786 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
787 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
788 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
789 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
790 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
791 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
793 if (iprint.gt.0) write (iout,*)
794 & "This conformation WILL NOT be added to the database."
800 if (theta(j).le.0.0d0) then
802 & write (iout,*) "Zero theta angle(s) in conformation",ii
803 if (iprint.gt.1) then
804 write (iout,*) "The Cartesian geometry is:"
805 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
806 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
807 write (iout,*) "The internal geometry is:"
808 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
809 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
810 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
811 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
812 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
813 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
815 if (iprint.gt.0) write (iout,*)
816 & "This conformation WILL NOT be added to the database."
820 if (theta(j).gt.179.97*deg2rad) theta(j)=179.97*deg2rad
823 c write (iout,*) "conf_check passed",ii