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
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.
276 call MPI_AllGather( scount(me), 1, MPI_INTEGER, scount(0), 1,
277 & MPI_INTEGER, WHAM_COMM, IERROR)
281 indstart(i)=indend(i-1)+1
282 indend(i)=indstart(i)+scount(i)-1
285 write (iout,*) "Revised conformation counts"
287 write (iout,'(a,i5,a,i7,a,i7,a,i7)')
288 & "Processor",i," indstart",indstart(i),
289 & " indend",indend(i)," count",scount(i)
292 call MPI_AllReduce(snk_p(1,1,1),snk(1,1,1,islice),
293 & MaxR*MaxT_h*nParmSet,
294 & MPI_INTEGER,MPI_SUM,WHAM_COMM,IERROR)
300 stot(islice)=stot(islice)+snk(i,ib,iparm,islice)
304 write (iout,*) "Revised SNK"
307 write (iout,'("Param",i3," Temp",f6.1,3x,32i8)')
308 & iparm,1.0d0/(1.987D-3*beta_h(ib,iparm)),
309 & (snk(i,ib,iparm,islice),i=1,nR(ib,iparm))
310 write (iout,*) "snk_p",(snk_p(i,ib,iparm),i=1,nR(ib,iparm))
313 write (iout,'("Total",i10)') stot(islice)
316 101 write (iout,*) "Error in scratchfile."
320 c------------------------------------------------------------------------------
321 subroutine write_dbase(islice,*)
324 include "DIMENSIONS.ZSCOPT"
325 include "DIMENSIONS.FREE"
326 include "DIMENSIONS.COMPAR"
329 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
332 include "COMMON.CONTROL"
333 include "COMMON.CHAIN"
334 include "COMMON.IOUNITS"
335 include "COMMON.PROTFILES"
336 include "COMMON.NAMES"
338 include "COMMON.SBRIDGE"
340 include "COMMON.FFIELD"
341 include "COMMON.ENEPS"
342 include "COMMON.LOCAL"
343 include "COMMON.WEIGHTS"
344 include "COMMON.INTERACT"
345 include "COMMON.FREE"
346 include "COMMON.ENERGIES"
347 include "COMMON.COMPAR"
348 include "COMMON.PROT"
350 character*80 bxname,cxname
351 character*64 bprotfile_temp
352 character*3 liczba,licz
354 integer i,itj,ii,iii,j,k,l
357 double precision rmsdev,efree,eini
358 real*4 csingle(3,maxres2)
359 double precision energ
363 write (licz2,'(bz,i2.2)') islice
364 call opentmp(islice,ientout,bprotfile_temp)
365 write (iout,*) "bprotfile_temp ",bprotfile_temp
367 if (.not.bxfile .and. .not. cxfile .and. indpdb.eq.0
368 & .and. ensembles.eq.0) then
369 close(ientout,status="delete")
373 write (liczba,'(bz,i3.3)') me
374 if (bxfile .or. cxfile .or. ensembles.gt.0) then
375 if (.not.separate_parset) then
376 bxname = prefix(:ilen(prefix))//liczba//".bx"
378 write (licz,'(bz,i3.3)') myparm
379 bxname = prefix(:ilen(prefix))//liczba//"_par"//licz//".bx"
381 open (ientin,file=bxname,status="unknown",
382 & form="unformatted",access="direct",recl=lenrec1)
385 if (bxfile .or. cxfile .or. ensembles.gt.0) then
386 if (nslice.eq.1) then
387 bxname = prefix(:ilen(prefix))//".bx"
389 bxname = prefix(:ilen(prefix))//
390 & "_slice_"//licz2//".bx"
392 open (ientin,file=bxname,status="unknown",
393 & form="unformatted",access="direct",recl=lenrec1)
394 write (iout,*) "Calculating energies; writing geometry",
395 & " and energy components to ",bxname(:ilen(bxname))
397 #if (defined(AIX) && !defined(JUBL))
398 call xdrfopen_(ixdrf,cxname, "w", iret)
400 call xdrfopen(ixdrf,cxname, "w", iret)
403 write (iout,*) "Error opening cxfile ",cxname(:ilen(cxname))
408 if (indpdb.gt.0) then
409 if (nslice.eq.1) then
411 if (.not.separate_parset) then
412 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))
415 write (licz,'(bz,i3.3)') myparm
416 statname=prefix(:ilen(prefix))//'_par'//licz//'_'//
417 & pot(:ilen(pot))//liczba//'.stat'
421 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))//'.stat'
425 if (.not.separate_parset) then
426 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))//
427 & "_slice_"//licz2//liczba//'.stat'
429 write (licz,'(bz,i3.3)') myparm
430 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))//
431 & '_par'//licz//"_slice_"//licz2//liczba//'.stat'
434 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))
435 & //"_slice_"//licz2//'.stat'
438 open(istat,file=statname,status="unknown")
447 cc read(ientout,rec=i,err=101)
448 cc & ((csingle(l,k),l=1,3),k=1,nres),
449 cc & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
450 cc & nss,(idssb(k),jdssb(k),k=1,nss),
451 cc & eini,efree,rmsdev,(q(k,i),k=1,nQ),iR,ib,iparm
452 cc idssb(k)=idssb(k)-nres
453 cc jdssb(k)=jdssb(k)-nres
455 read(ientout,rec=i,err=101)
456 & ((csingle(l,k),l=1,3),k=1,nres),
457 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
458 & nss,(ihpb(k),jhpb(k),k=1,nss),
459 & eini,efree,rmsdev,(q(k,i),k=1,nQ),iR,ib,iparm
461 cc write (iout,*) 'CC', iR,ib,iparm,eini,efree
467 call int_from_cart1(.false.)
469 if (indpdb.gt.0) then
470 call conf_compar(i,.false.,.true.)
473 if (bxfile .or.cxfile .or. ensembles.gt.0) write (ientin,rec=i)
474 & ((csingle(l,k),l=1,3),k=1,nres),
475 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
476 & nss,(ihpb(k),jhpb(k),k=1,nss),
477 c & potE(i,iparm),-entfac(i),rms_nat,iscore
478 & potE(i,nparmset),-entfac(i),rms_nat,iscore
480 if (bxfile .or.cxfile .or. ensembles.gt.0) write
482 & ((csingle(l,k),l=1,3),k=1,nres),
483 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
484 & nss,(ihpb(k),jhpb(k),k=1,nss),
485 c & potE(i,iparm),-entfac(i),rms_nat,iscore
486 & potE(i,nparmset),-entfac(i),rms_nat,iscore
488 write (iout,'(2i5,3e15.5)') i,me,potE(i,iparm),-entfac(i)
490 if (cxfile) call cxwrite(ixdrf,csingle,potE(i,nparmset),
491 & -entfac(i),rms_nat,iscore)
494 close(ientout,status="delete")
496 if (bxfile .or. cxfile .or. ensembles.gt.0) close(ientin)
498 call MPI_Barrier(WHAM_COMM,IERROR)
499 if (me.ne.Master .or. .not.bxfile .and. .not. cxfile
500 & .and. ensembles.eq.0) return
502 if (bxfile .or. ensembles.gt.0) then
503 if (nslice.eq.1) then
504 if (.not.separate_parset) then
505 bxname = prefix(:ilen(prefix))//".bx"
507 write (licz,'(bz,i3.3)') myparm
508 bxname = prefix(:ilen(prefix))//"_par"//licz//".bx"
511 if (.not.separate_parset) then
512 bxname = prefix(:ilen(prefix))//"_slice_"//licz2//".bx"
514 write (licz,'(bz,i3.3)') myparm
515 bxname = prefix(:ilen(prefix))//"par_"//licz//
516 & "_slice_"//licz2//".bx"
519 open (ientout,file=bxname,status="unknown",
520 & form="unformatted",access="direct",recl=lenrec1)
521 write (iout,*) "Master is creating binary database ",
522 & bxname(:ilen(bxname))
525 if (nslice.eq.1) then
526 if (.not.separate_parset) then
527 cxname = prefix(:ilen(prefix))//".cx"
529 cxname = prefix(:ilen(prefix))//"_par"//licz//".cx"
532 if (.not.separate_parset) then
533 cxname = prefix(:ilen(prefix))//
534 & "_slice_"//licz2//".cx"
536 cxname = prefix(:ilen(prefix))//"_par"//licz//
537 & "_slice_"//licz2//".cx"
540 #if (defined(AIX) && !defined(JUBL))
541 call xdrfopen_(ixdrf,cxname, "w", iret)
543 call xdrfopen(ixdrf,cxname, "w", iret)
546 write (iout,*) "Error opening cxfile ",cxname(:ilen(cxname))
551 write (liczba,'(bz,i3.3)') j
552 if (separate_parset) then
553 write (licz,'(bz,i3.3)') myparm
554 bxname = prefix(:ilen(prefix))//liczba//"_par"//licz//".bx"
556 bxname = prefix(:ilen(prefix))//liczba//".bx"
558 open (ientin,file=bxname,status="unknown",
559 & form="unformatted",access="direct",recl=lenrec1)
560 write (iout,*) "Master is reading conformations from ",
561 & bxname(:ilen(bxname))
563 c write (iout,*) "j",j," indstart",indstart(j)," indend",indend(j)
565 do i=indstart(j),indend(j)
568 cc read(ientin,rec=iii,err=101)
569 cc & ((csingle(l,k),l=1,3),k=1,nres),
570 cc & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
571 cc & nss,(idssb(k),jdssb(k),k=1,nss),
572 cc & eini,efree,rmsdev,iscor
573 cc idssb(k)=idssb(k)-nres
574 cc jdssb(k)=jdssb(k)-nres
576 read(ientin,rec=iii,err=101)
577 & ((csingle(l,k),l=1,3),k=1,nres),
578 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
579 & nss,(ihpb(k),jhpb(k),k=1,nss),
580 & eini,efree,rmsdev,iscor
582 if (bxfile .or. ensembles.gt.0) then
584 cc write (ientout,rec=i)
585 cc & ((csingle(l,k),l=1,3),k=1,nres),
586 cc & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
587 cc & nss,(idssb(k)+nres,jdssb(k)+nres,k=1,nss),
588 cc & eini,efree,rmsdev,iscor
590 write (ientout,rec=i)
591 & ((csingle(l,k),l=1,3),k=1,nres),
592 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
593 & nss,(ihpb(k),jhpb(k),k=1,nss),
594 & eini,efree,rmsdev,iscor
595 cc write(iout,*) "W poszukiwaniu zlotych galotow"
596 cc write(iout,*) "efree=",efree,iii
599 if(cxfile)call cxwrite(ixdrf,csingle,eini,efree,rmsdev,iscor)
606 call int_from_cart1(.false.)
607 write (iout,'(2i5,3e15.5)') i,iii,eini,efree
608 write (iout,*) "The Cartesian geometry is:"
609 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
610 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
611 write (iout,*) "The internal geometry is:"
612 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
613 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
614 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
615 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
616 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
617 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
618 write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
619 write (iout,'(f10.5,i5)') rmsdev,iscor
622 write (iout,*) iii," conformations (from",indstart(j)," to",
623 & indend(j),") read from ",
624 & bxname(:ilen(bxname))
625 close (ientin,status="delete")
627 if (bxfile .or. cxfile .or. ensembles.gt.0) close (ientout)
628 #if (defined(AIX) && !defined(JUBL))
629 if (cxfile) call xdrfclose_(ixdrf,cxname,iret)
631 if (cxfile) call xdrfclose(ixdrf,cxname,iret)
635 101 write (iout,*) "Error in scratchfile."
639 c-------------------------------------------------------------------------------
640 subroutine cxwrite(ixdrf,csingle,eini,efree,rmsdev,iscor)
643 include "DIMENSIONS.ZSCOPT"
644 include "DIMENSIONS.FREE"
645 include "DIMENSIONS.COMPAR"
648 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
651 include "COMMON.CONTROL"
652 include "COMMON.CHAIN"
653 include "COMMON.IOUNITS"
654 include "COMMON.PROTFILES"
655 include "COMMON.NAMES"
657 include "COMMON.SBRIDGE"
659 include "COMMON.FFIELD"
660 include "COMMON.ENEPS"
661 include "COMMON.LOCAL"
662 include "COMMON.WEIGHTS"
663 include "COMMON.INTERACT"
664 include "COMMON.FREE"
665 include "COMMON.ENERGIES"
666 include "COMMON.COMPAR"
667 include "COMMON.PROT"
668 integer i,j,itmp,iscor,iret,ixdrf
669 double precision rmsdev,efree,eini
670 real*4 csingle(3,maxres2),xoord(3,maxres2+2)
673 c write (iout,*) "cxwrite"
678 xoord(j,i)=csingle(j,i)
683 xoord(j,nres+i-nnt+1)=csingle(j,i+nres)
689 c write (iout,*) "itmp",itmp
691 c write (iout,*) "CNZ",eini,dyn_ss
692 #if (defined(AIX) && !defined(JUBL))
693 call xdrf3dfcoord_(ixdrf, xoord, itmp, prec, iret)
695 c write (iout,*) "xdrf3dfcoord"
697 call xdrfint_(ixdrf, nss, iret)
700 cc call xdrfint_(ixdrf, idssb(j)+nres, iret)
701 cc call xdrfint_(ixdrf, jdssb(j)+nres, iret)
703 call xdrfint_(ixdrf, ihpb(j), iret)
704 call xdrfint_(ixdrf, jhpb(j), iret)
707 call xdrffloat_(ixdrf,real(eini),iret)
708 call xdrffloat_(ixdrf,real(efree),iret)
709 call xdrffloat_(ixdrf,real(rmsdev),iret)
710 call xdrfint_(ixdrf,iscor,iret)
712 call xdrf3dfcoord(ixdrf, xoord, itmp, prec, iret)
714 call xdrfint(ixdrf, nss, iret)
717 cc call xdrfint(ixdrf, idssb(j), iret)
718 cc call xdrfint(ixdrf, jdssb(j), iret)
719 cc idssb(j)=idssb(j)-nres
720 cc jdssb(j)=jdssb(j)-nres
722 call xdrfint(ixdrf, ihpb(j), iret)
723 call xdrfint(ixdrf, jhpb(j), iret)
726 call xdrffloat(ixdrf,real(eini),iret)
727 call xdrffloat(ixdrf,real(efree),iret)
728 call xdrffloat(ixdrf,real(rmsdev),iret)
729 call xdrfint(ixdrf,iscor,iret)
734 c------------------------------------------------------------------------------
735 logical function conf_check(ii,iprint)
738 include "DIMENSIONS.ZSCOPT"
739 include "DIMENSIONS.FREE"
742 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
745 include "COMMON.CHAIN"
746 include "COMMON.IOUNITS"
747 include "COMMON.PROTFILES"
748 include "COMMON.NAMES"
750 include "COMMON.SBRIDGE"
752 include "COMMON.FFIELD"
753 include "COMMON.ENEPS"
754 include "COMMON.LOCAL"
755 include "COMMON.WEIGHTS"
756 include "COMMON.INTERACT"
757 include "COMMON.FREE"
758 include "COMMON.ENERGIES"
759 include "COMMON.CONTROL"
760 include "COMMON.TORCNSTR"
761 integer j,k,l,ii,itj,iprint
762 if (.not.check_conf) then
766 call int_from_cart1(.false.)
768 if (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0) then
770 & write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),
771 & " for conformation",ii
772 if (iprint.gt.1) then
773 write (iout,*) "The Cartesian geometry is:"
774 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
775 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
776 write (iout,*) "The internal geometry is:"
777 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
778 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
779 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
780 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
781 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
782 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
784 if (iprint.gt.0) write (iout,*)
785 & "This conformation WILL NOT be added to the database."
792 if (itype(j).ne.10 .and. (vbld(nres+j)-dsc(itj)).gt.2.0d0) then
794 & write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j),
795 & " for conformation",ii
796 if (iprint.gt.1) then
797 write (iout,*) "The Cartesian geometry is:"
798 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
799 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
800 write (iout,*) "The internal geometry is:"
801 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
802 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
803 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
804 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
805 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
806 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
808 if (iprint.gt.0) write (iout,*)
809 & "This conformation WILL NOT be added to the database."
815 if (theta(j).le.0.0d0) then
817 & write (iout,*) "Zero theta angle(s) in conformation",ii
818 if (iprint.gt.1) then
819 write (iout,*) "The Cartesian geometry is:"
820 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
821 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
822 write (iout,*) "The internal geometry is:"
823 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
824 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
825 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
826 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
827 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
828 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
830 if (iprint.gt.0) write (iout,*)
831 & "This conformation WILL NOT be added to the database."
835 if (theta(j).gt.179.97*deg2rad) theta(j)=179.97*deg2rad
838 c write (iout,*) "conf_check passed",ii