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 double precision tole /1.0d-1/
36 integer i,itj,ii,iii,j,k,l,licz,scme
37 integer ir,ib,ipar,iparm
39 real*4 csingle(3,maxres2)
40 double precision energ
43 double precision energia(0:max_ene),rmsdev,efree,eini
44 double precision fT(6),quot,quotl,kfacl,kfac /2.4d0/,T0 /3.0d2/
46 integer snk_p(MaxR,MaxT_h,Max_parm)
48 character*64 bprotfile_temp
49 call opentmp(islice,ientout,bprotfile_temp)
53 write (iout,*) "enecalc: nparmset ",nparmset
62 do i=indstart(me1),indend(me1)
73 read(ientout,rec=i,err=101)
74 & ((csingle(l,k),l=1,3),k=1,nres),
75 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
76 & nss,(ihpb(k),jhpb(k),k=1,nss),
77 & eini,efree,rmsdev,(q(j,iii+1),j=1,nQ),iR,ib,ipar
78 cc write(iout,*), 'NAWEJ',i,eini
87 c(l,k+nres)=csingle(l,k+nres)
90 q(nQ+1,iii+1)=rmsnat(iii+1)
92 q(nQ+2,iii+1)=gyrate(iii+1)
93 c fT=T0*beta_h(ib,ipar)*1.987D-3
94 c ft=2.0d0/(1.0d0+1.0d0/(T0*beta_h(ib,ipar)*1.987D-3))
95 if (rescale_mode.eq.1) then
96 quot=1.0d0/(T0*beta_h(ib,ipar)*1.987D-3)
98 tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
99 ft(6)=(320.0+80.0*dtanh((tt-320.0)/80.0))/320.0
110 fT(l)=kfacl/(kfacl-1.0d0+quotl)
112 else if (rescale_mode.eq.2) then
113 quot=1.0d0/(T0*beta_h(ib,ipar)*1.987D-3)
115 tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
116 ft(6)=(320.0+80.0*dtanh((tt-320.0)/80.0))/320.0
125 fT(l)=1.12692801104297249644d0/
126 & dlog(dexp(quotl)+dexp(-quotl))
128 else if (rescale_mode.eq.0) then
133 write (iout,*) "Error in ECECALC: wrong RESCALE_MODE",
139 c write (iout,*) "T",1.0d0/(beta_h(ib,ipar)*1.987D-3)," T0",T0,
140 c & " kfac",kfac,"quot",quot," fT",fT
146 call int_from_cart1(.false.)
150 call restore_parm(iparm)
152 write (iout,*) wsc,wscp,welec,wvdwpp,wang,wtor,wscloc,
153 & wcorr,wcorr5,wcorr6,wturn4,wturn3,wturn6,wel_loc,
154 & wtor_d,wsccor,wbond
156 call etotal(energia(0),fT)
158 write (iout,*) "Conformation",i
159 call enerprint(energia(0),fT)
160 c write (iout,'(2i5,21f8.2)') i,iparm,(energia(k),k=1,21)
161 c write (iout,*) "ftors",ftors
164 if (energia(0).ge.1.0d20) then
165 write (iout,*) "NaNs detected in some of the energy",
166 & " components for conformation",ii+1
167 write (iout,*) "The Cartesian geometry is:"
168 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
169 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
170 write (iout,*) "The internal geometry is:"
172 c call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev)
173 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
174 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
175 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
176 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
177 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
178 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
179 write (iout,*) "The components of the energy are:"
180 call enerprint(energia(0),fT)
182 & "This conformation WILL NOT be added to the database."
187 if (ipar.eq.iparm) write (iout,*) i,iparm,
188 & 1.0d0/(beta_h(ib,ipar)*1.987D-3),eini,energia(0)
190 if (ipar.eq.iparm .and. einicheck.gt.0 .and.
191 & dabs(eini-energia(0)).gt.tole) then
192 if (errmsg_count.le.maxerrmsg_count) then
193 write (iout,'(2a,2e15.5,a,2i8,a,f8.1)')
194 & "Warning: energy differs remarkably from ",
195 & " the value read in: ",energia(0),eini," point",
196 & iii+1,indstart(me1)+iii," T",
197 & 1.0d0/(1.987D-3*beta_h(ib,ipar))
198 call enerprint(energia(0),fT)
199 call pdbout(iii+1,beta_h(ib,ipar),
200 & eini,energia(0),0.0d0,rmsdev)
203 errmsg_count=errmsg_count+1
204 if (errmsg_count.gt.maxerrmsg_count)
205 & write (iout,*) "Too many warning messages"
206 if (einicheck.gt.1) then
207 write (iout,*) "Calculation stopped."
210 call MPI_Abort(WHAM_COMM,IERROR,ERRCODE)
217 potE(iii+1,iparm)=energia(0)
219 enetb(k,iii+1,iparm)=energia(k)
221 c write(iout,*) "iCHUJ TU STRZELI",i,iii,entfac(i)
222 c call enerprint(energia(0),fT)
224 write (iout,'(2i5,f10.1,3e15.5)') i,iii,
225 & 1.0d0/(beta_h(ib,ipar)*1.987D-3),energia(0),eini,efree
226 call enerprint(energia(0),fT)
227 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
228 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
229 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
230 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
231 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
232 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
233 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
234 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
235 write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
236 write (iout,'(8f10.5)') (q(k,iii+1),k=1,nQ)
237 write (iout,'(f10.5,i10)') rmsdev,iscor
238 call enerprint(energia(0),fT)
239 write(liczba,'(bz,i3.3)') me
240 nazwa="test"//liczba//".pdb"
241 write (iout,*) "pdb file",nazwa
242 open (ipdb,file=nazwa,position="append")
243 call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev)
251 if (q(1,iii).le.0.0d0 .and. indpdb.gt.0) q(1,iii)=qwolynes(0,0)
252 write (ientout,rec=iii)
253 & ((csingle(l,k),l=1,3),k=1,nres),
254 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
255 & nss,(ihpb(k),jhpb(k),k=1,nss),
256 & potE(iii,ipar),efree,rmsdev,(q(k,iii),k=1,nQ),iR,ib,ipar
257 c write (iout,'(2i5,2e15.5)') ii,iii,potE(iii,ipar),efree
259 if (separate_parset) then
260 snk_p(iR,ib,1)=snk_p(iR,ib,1)+1
262 snk_p(iR,ib,ipar)=snk_p(iR,ib,ipar)+1
264 c write (iout,*) "iii",iii," iR",iR," ib",ib," ipar",ipar,
265 c & " snk",snk_p(iR,ib,ipar)
267 snk(iR,ib,ipar,islice)=snk(iR,ib,ipar,islice)+1
273 write (iout,*) "Me",me," scount",scount(me)
275 c Master gathers updated numbers of conformations written by all procs.
277 call MPI_AllGather( scount(me), 1, MPI_INTEGER, scount(0), 1,
278 & MPI_INTEGER, WHAM_COMM, IERROR)
282 indstart(i)=indend(i-1)+1
283 indend(i)=indstart(i)+scount(i)-1
286 write (iout,*) "Revised conformation counts"
288 write (iout,'(a,i5,a,i7,a,i7,a,i7)')
289 & "Processor",i," indstart",indstart(i),
290 & " indend",indend(i)," count",scount(i)
293 call MPI_AllReduce(snk_p(1,1,1),snk(1,1,1,islice),
294 & MaxR*MaxT_h*nParmSet,
295 & MPI_INTEGER,MPI_SUM,WHAM_COMM,IERROR)
301 stot(islice)=stot(islice)+snk(i,ib,iparm,islice)
305 write (iout,*) "Revised SNK"
308 write (iout,'("Param",i3," Temp",f6.1,3x,32i8)')
309 & iparm,1.0d0/(1.987D-3*beta_h(ib,iparm)),
310 & (snk(i,ib,iparm,islice),i=1,nR(ib,iparm))
311 write (iout,*) "snk_p",(snk_p(i,ib,iparm),i=1,nR(ib,iparm))
314 write (iout,'("Total",i10)') stot(islice)
317 101 write (iout,*) "Error in scratchfile."
321 c------------------------------------------------------------------------------
322 subroutine write_dbase(islice,*)
325 include "DIMENSIONS.ZSCOPT"
326 include "DIMENSIONS.FREE"
327 include "DIMENSIONS.COMPAR"
330 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
333 include "COMMON.CONTROL"
334 include "COMMON.CHAIN"
335 include "COMMON.IOUNITS"
336 include "COMMON.PROTFILES"
337 include "COMMON.NAMES"
339 include "COMMON.SBRIDGE"
341 include "COMMON.FFIELD"
342 include "COMMON.ENEPS"
343 include "COMMON.LOCAL"
344 include "COMMON.WEIGHTS"
345 include "COMMON.INTERACT"
346 include "COMMON.FREE"
347 include "COMMON.ENERGIES"
348 include "COMMON.COMPAR"
349 include "COMMON.PROT"
351 character*80 bxname,cxname
352 character*64 bprotfile_temp
353 character*3 liczba,licz
355 integer i,itj,ii,iii,j,k,l
358 double precision rmsdev,efree,eini
359 real*4 csingle(3,maxres2)
360 double precision energ
364 write (licz2,'(bz,i2.2)') islice
365 call opentmp(islice,ientout,bprotfile_temp)
366 write (iout,*) "bprotfile_temp ",bprotfile_temp
368 if (.not.bxfile .and. .not. cxfile .and. indpdb.eq.0
369 & .and. ensembles.eq.0) then
370 close(ientout,status="delete")
374 write (liczba,'(bz,i3.3)') me
375 if (bxfile .or. cxfile .or. ensembles.gt.0) then
376 if (.not.separate_parset) then
377 bxname = prefix(:ilen(prefix))//liczba//".bx"
379 write (licz,'(bz,i3.3)') myparm
380 bxname = prefix(:ilen(prefix))//liczba//"_par"//licz//".bx"
382 open (ientin,file=bxname,status="unknown",
383 & form="unformatted",access="direct",recl=lenrec1)
386 if (bxfile .or. cxfile .or. ensembles.gt.0) then
387 if (nslice.eq.1) then
388 bxname = prefix(:ilen(prefix))//".bx"
390 bxname = prefix(:ilen(prefix))//
391 & "_slice_"//licz2//".bx"
393 open (ientin,file=bxname,status="unknown",
394 & form="unformatted",access="direct",recl=lenrec1)
395 write (iout,*) "Calculating energies; writing geometry",
396 & " and energy components to ",bxname(:ilen(bxname))
398 #if (defined(AIX) && !defined(JUBL))
399 call xdrfopen_(ixdrf,cxname, "w", iret)
401 call xdrfopen(ixdrf,cxname, "w", iret)
404 write (iout,*) "Error opening cxfile ",cxname(:ilen(cxname))
409 if (indpdb.gt.0) then
410 if (nslice.eq.1) then
412 if (.not.separate_parset) then
413 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))
416 write (licz,'(bz,i3.3)') myparm
417 statname=prefix(:ilen(prefix))//'_par'//licz//'_'//
418 & pot(:ilen(pot))//liczba//'.stat'
422 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))//'.stat'
426 if (.not.separate_parset) then
427 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))//
428 & "_slice_"//licz2//liczba//'.stat'
430 write (licz,'(bz,i3.3)') myparm
431 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))//
432 & '_par'//licz//"_slice_"//licz2//liczba//'.stat'
435 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))
436 & //"_slice_"//licz2//'.stat'
439 open(istat,file=statname,status="unknown")
448 cc read(ientout,rec=i,err=101)
449 cc & ((csingle(l,k),l=1,3),k=1,nres),
450 cc & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
451 cc & nss,(idssb(k),jdssb(k),k=1,nss),
452 cc & eini,efree,rmsdev,(q(k,i),k=1,nQ),iR,ib,iparm
453 cc idssb(k)=idssb(k)-nres
454 cc jdssb(k)=jdssb(k)-nres
456 read(ientout,rec=i,err=101)
457 & ((csingle(l,k),l=1,3),k=1,nres),
458 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
459 & nss,(ihpb(k),jhpb(k),k=1,nss),
460 & eini,efree,rmsdev,(q(k,i),k=1,nQ),iR,ib,iparm
462 cc write (iout,*) 'CC', iR,ib,iparm,eini,efree
468 call int_from_cart1(.false.)
470 if (indpdb.gt.0) then
471 call conf_compar(i,.false.,.true.)
474 if (bxfile .or.cxfile .or. ensembles.gt.0) write (ientin,rec=i)
475 & ((csingle(l,k),l=1,3),k=1,nres),
476 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
477 & nss,(ihpb(k),jhpb(k),k=1,nss),
478 c & potE(i,iparm),-entfac(i),rms_nat,iscore
479 & potE(i,nparmset),-entfac(i),rms_nat,iscore
481 if (bxfile .or.cxfile .or. ensembles.gt.0) write
483 & ((csingle(l,k),l=1,3),k=1,nres),
484 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
485 & nss,(ihpb(k),jhpb(k),k=1,nss),
486 c & potE(i,iparm),-entfac(i),rms_nat,iscore
487 & potE(i,nparmset),-entfac(i),rms_nat,iscore
489 write (iout,'(2i5,3e15.5)') i,me,potE(i,iparm),-entfac(i)
491 if (cxfile) call cxwrite(ixdrf,csingle,potE(i,nparmset),
492 & -entfac(i),rms_nat,iscore)
495 close(ientout,status="delete")
497 if (bxfile .or. cxfile .or. ensembles.gt.0) close(ientin)
499 call MPI_Barrier(WHAM_COMM,IERROR)
500 if (me.ne.Master .or. .not.bxfile .and. .not. cxfile
501 & .and. ensembles.eq.0) return
503 if (bxfile .or. ensembles.gt.0) then
504 if (nslice.eq.1) then
505 if (.not.separate_parset) then
506 bxname = prefix(:ilen(prefix))//".bx"
508 write (licz,'(bz,i3.3)') myparm
509 bxname = prefix(:ilen(prefix))//"_par"//licz//".bx"
512 if (.not.separate_parset) then
513 bxname = prefix(:ilen(prefix))//"_slice_"//licz2//".bx"
515 write (licz,'(bz,i3.3)') myparm
516 bxname = prefix(:ilen(prefix))//"par_"//licz//
517 & "_slice_"//licz2//".bx"
520 open (ientout,file=bxname,status="unknown",
521 & form="unformatted",access="direct",recl=lenrec1)
522 write (iout,*) "Master is creating binary database ",
523 & bxname(:ilen(bxname))
526 if (nslice.eq.1) then
527 if (.not.separate_parset) then
528 cxname = prefix(:ilen(prefix))//".cx"
530 cxname = prefix(:ilen(prefix))//"_par"//licz//".cx"
533 if (.not.separate_parset) then
534 cxname = prefix(:ilen(prefix))//
535 & "_slice_"//licz2//".cx"
537 cxname = prefix(:ilen(prefix))//"_par"//licz//
538 & "_slice_"//licz2//".cx"
541 #if (defined(AIX) && !defined(JUBL))
542 call xdrfopen_(ixdrf,cxname, "w", iret)
544 call xdrfopen(ixdrf,cxname, "w", iret)
547 write (iout,*) "Error opening cxfile ",cxname(:ilen(cxname))
552 write (liczba,'(bz,i3.3)') j
553 if (separate_parset) then
554 write (licz,'(bz,i3.3)') myparm
555 bxname = prefix(:ilen(prefix))//liczba//"_par"//licz//".bx"
557 bxname = prefix(:ilen(prefix))//liczba//".bx"
559 open (ientin,file=bxname,status="unknown",
560 & form="unformatted",access="direct",recl=lenrec1)
561 write (iout,*) "Master is reading conformations from ",
562 & bxname(:ilen(bxname))
564 c write (iout,*) "j",j," indstart",indstart(j)," indend",indend(j)
566 do i=indstart(j),indend(j)
569 cc read(ientin,rec=iii,err=101)
570 cc & ((csingle(l,k),l=1,3),k=1,nres),
571 cc & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
572 cc & nss,(idssb(k),jdssb(k),k=1,nss),
573 cc & eini,efree,rmsdev,iscor
574 cc idssb(k)=idssb(k)-nres
575 cc jdssb(k)=jdssb(k)-nres
577 read(ientin,rec=iii,err=101)
578 & ((csingle(l,k),l=1,3),k=1,nres),
579 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
580 & nss,(ihpb(k),jhpb(k),k=1,nss),
581 & eini,efree,rmsdev,iscor
583 if (bxfile .or. ensembles.gt.0) then
585 cc write (ientout,rec=i)
586 cc & ((csingle(l,k),l=1,3),k=1,nres),
587 cc & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
588 cc & nss,(idssb(k)+nres,jdssb(k)+nres,k=1,nss),
589 cc & eini,efree,rmsdev,iscor
591 write (ientout,rec=i)
592 & ((csingle(l,k),l=1,3),k=1,nres),
593 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
594 & nss,(ihpb(k),jhpb(k),k=1,nss),
595 & eini,efree,rmsdev,iscor
596 cc write(iout,*) "W poszukiwaniu zlotych galotow"
597 cc write(iout,*) "efree=",efree,iii
600 if(cxfile)call cxwrite(ixdrf,csingle,eini,efree,rmsdev,iscor)
607 call int_from_cart1(.false.)
608 write (iout,'(2i5,3e15.5)') i,iii,eini,efree
609 write (iout,*) "The Cartesian geometry is:"
610 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
611 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
612 write (iout,*) "The internal geometry is:"
613 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
614 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
615 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
616 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
617 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
618 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
619 write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
620 write (iout,'(f10.5,i5)') rmsdev,iscor
623 write (iout,*) iii," conformations (from",indstart(j)," to",
624 & indend(j),") read from ",
625 & bxname(:ilen(bxname))
626 close (ientin,status="delete")
628 if (bxfile .or. cxfile .or. ensembles.gt.0) close (ientout)
629 #if (defined(AIX) && !defined(JUBL))
630 if (cxfile) call xdrfclose_(ixdrf,cxname,iret)
632 if (cxfile) call xdrfclose(ixdrf,cxname,iret)
636 101 write (iout,*) "Error in scratchfile."
640 c-------------------------------------------------------------------------------
641 subroutine cxwrite(ixdrf,csingle,eini,efree,rmsdev,iscor)
644 include "DIMENSIONS.ZSCOPT"
645 include "DIMENSIONS.FREE"
646 include "DIMENSIONS.COMPAR"
649 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
652 include "COMMON.CONTROL"
653 include "COMMON.CHAIN"
654 include "COMMON.IOUNITS"
655 include "COMMON.PROTFILES"
656 include "COMMON.NAMES"
658 include "COMMON.SBRIDGE"
660 include "COMMON.FFIELD"
661 include "COMMON.ENEPS"
662 include "COMMON.LOCAL"
663 include "COMMON.WEIGHTS"
664 include "COMMON.INTERACT"
665 include "COMMON.FREE"
666 include "COMMON.ENERGIES"
667 include "COMMON.COMPAR"
668 include "COMMON.PROT"
669 integer i,j,itmp,iscor,iret,ixdrf
670 double precision rmsdev,efree,eini
671 real*4 csingle(3,maxres2),xoord(3,maxres2+2)
674 c write (iout,*) "cxwrite"
679 xoord(j,i)=csingle(j,i)
684 xoord(j,nres+i-nnt+1)=csingle(j,i+nres)
690 c write (iout,*) "itmp",itmp
692 c write (iout,*) "CNZ",eini,dyn_ss
693 #if (defined(AIX) && !defined(JUBL))
694 call xdrf3dfcoord_(ixdrf, xoord, itmp, prec, iret)
696 c write (iout,*) "xdrf3dfcoord"
698 call xdrfint_(ixdrf, nss, iret)
701 cc call xdrfint_(ixdrf, idssb(j)+nres, iret)
702 cc call xdrfint_(ixdrf, jdssb(j)+nres, iret)
704 call xdrfint_(ixdrf, ihpb(j), iret)
705 call xdrfint_(ixdrf, jhpb(j), iret)
708 call xdrffloat_(ixdrf,real(eini),iret)
709 call xdrffloat_(ixdrf,real(efree),iret)
710 call xdrffloat_(ixdrf,real(rmsdev),iret)
711 call xdrfint_(ixdrf,iscor,iret)
713 call xdrf3dfcoord(ixdrf, xoord, itmp, prec, iret)
715 call xdrfint(ixdrf, nss, iret)
718 cc call xdrfint(ixdrf, idssb(j), iret)
719 cc call xdrfint(ixdrf, jdssb(j), iret)
720 cc idssb(j)=idssb(j)-nres
721 cc jdssb(j)=jdssb(j)-nres
723 call xdrfint(ixdrf, ihpb(j), iret)
724 call xdrfint(ixdrf, jhpb(j), iret)
727 call xdrffloat(ixdrf,real(eini),iret)
728 call xdrffloat(ixdrf,real(efree),iret)
729 call xdrffloat(ixdrf,real(rmsdev),iret)
730 call xdrfint(ixdrf,iscor,iret)
735 c------------------------------------------------------------------------------
736 logical function conf_check(ii,iprint)
739 include "DIMENSIONS.ZSCOPT"
740 include "DIMENSIONS.FREE"
743 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
746 include "COMMON.CHAIN"
747 include "COMMON.IOUNITS"
748 include "COMMON.PROTFILES"
749 include "COMMON.NAMES"
751 include "COMMON.SBRIDGE"
753 include "COMMON.FFIELD"
754 include "COMMON.ENEPS"
755 include "COMMON.LOCAL"
756 include "COMMON.WEIGHTS"
757 include "COMMON.INTERACT"
758 include "COMMON.FREE"
759 include "COMMON.ENERGIES"
760 include "COMMON.CONTROL"
761 include "COMMON.TORCNSTR"
762 integer j,k,l,ii,itj,iprint
763 if (.not.check_conf) then
767 call int_from_cart1(.false.)
769 if (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0) then
771 & write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),
772 & " for conformation",ii
773 if (iprint.gt.1) then
774 write (iout,*) "The Cartesian geometry is:"
775 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
776 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
777 write (iout,*) "The internal geometry is:"
778 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
779 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
780 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
781 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
782 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
783 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
785 if (iprint.gt.0) write (iout,*)
786 & "This conformation WILL NOT be added to the database."
793 if (itype(j).ne.10 .and. (vbld(nres+j)-dsc(itj)).gt.2.0d0) then
795 & write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j),
796 & " for conformation",ii
797 if (iprint.gt.1) then
798 write (iout,*) "The Cartesian geometry is:"
799 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
800 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
801 write (iout,*) "The internal geometry is:"
802 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
803 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
804 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
805 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
806 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
807 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
809 if (iprint.gt.0) write (iout,*)
810 & "This conformation WILL NOT be added to the database."
816 if (theta(j).le.0.0d0) then
818 & write (iout,*) "Zero theta angle(s) in conformation",ii
819 if (iprint.gt.1) then
820 write (iout,*) "The Cartesian geometry is:"
821 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
822 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
823 write (iout,*) "The internal geometry is:"
824 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
825 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
826 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
827 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
828 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
829 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
831 if (iprint.gt.0) write (iout,*)
832 & "This conformation WILL NOT be added to the database."
836 if (theta(j).gt.179.97*deg2rad) theta(j)=179.97*deg2rad
839 c write (iout,*) "conf_check passed",ii