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,itmp
38 integer ir,ib,ipar,iparm
40 real*4 csingle(3,maxres2)
41 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 write (iout,*) "enecalc: nparmset ",nparmset
63 do i=indstart(me1),indend(me1)
74 read(ientout,rec=i,err=101)
75 & ((csingle(l,k),l=1,3),k=1,nres),
76 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
77 & nss,(ihpb(k),jhpb(k),k=1,nss),
78 & eini,efree,rmsdev,(q(j,iii+1),j=1,nQ),iR,ib,ipar
79 cc write(iout,*), 'NAWEJ',i,eini
88 c(l,k+nres)=csingle(l,k+nres)
91 q(nQ+1,iii+1)=rmsnat(iii+1)
93 q(nQ+2,iii+1)=gyrate(iii+1)
94 c fT=T0*beta_h(ib,ipar)*1.987D-3
95 c ft=2.0d0/(1.0d0+1.0d0/(T0*beta_h(ib,ipar)*1.987D-3))
96 if (rescale_mode.eq.1) then
97 quot=1.0d0/(T0*beta_h(ib,ipar)*1.987D-3)
99 tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
100 ft(6)=(320.0+80.0*dtanh((tt-320.0)/80.0))/320.0
111 fT(l)=kfacl/(kfacl-1.0d0+quotl)
113 else if (rescale_mode.eq.2) then
114 quot=1.0d0/(T0*beta_h(ib,ipar)*1.987D-3)
116 tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
117 ft(6)=(320.0+80.0*dtanh((tt-320.0)/80.0))/320.0
126 fT(l)=1.12692801104297249644d0/
127 & dlog(dexp(quotl)+dexp(-quotl))
129 else if (rescale_mode.eq.0) then
134 write (iout,*) "Error in ECECALC: wrong RESCALE_MODE",
140 c write (iout,*) "T",1.0d0/(beta_h(ib,ipar)*1.987D-3)," T0",T0,
141 c & " kfac",kfac,"quot",quot," fT",fT
147 call int_from_cart1(.false.)
151 call restore_parm(iparm)
153 write (iout,*) wsc,wscp,welec,wvdwpp,wang,wtor,wscloc,
154 & wcorr,wcorr5,wcorr6,wturn4,wturn3,wturn6,wel_loc,
155 & wtor_d,wsccor,wbond
157 call etotal(energia(0),fT)
159 write (iout,*) "Conformation",i
160 call enerprint(energia(0),fT)
161 c write (iout,'(2i5,21f8.2)') i,iparm,(energia(k),k=1,21)
162 c write (iout,*) "ftors",ftors
163 write (iout,'(a,3(3x,a5),5x,3(3x,a5))')
164 & "Residue","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)"
166 write (iout,'(a3,1x,i3,3f8.3,5x,3f8.3)')
167 & restyp(itype(ires)),ires,(c(j,ires),j=1,3),
168 & (c(j,ires+nres),j=1,3)
172 if (energia(0).ge.1.0d20) then
173 write (iout,*) "NaNs detected in some of the energy",
174 & " components for conformation",ii+1
175 write (iout,*) "The Cartesian geometry is:"
176 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
177 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
178 write (iout,*) "The internal geometry is:"
180 c call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev)
181 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
182 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
183 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
184 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
185 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
186 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
187 write (iout,*) "The components of the energy are:"
188 call enerprint(energia(0),fT)
190 & "This conformation WILL NOT be added to the database."
195 if (ipar.eq.iparm) write (iout,*) i,iparm,
196 & 1.0d0/(beta_h(ib,ipar)*1.987D-3),eini,energia(0)
198 if (ipar.eq.iparm .and. einicheck.gt.0 .and.
199 & dabs(eini-energia(0)).gt.tole) then
200 if (errmsg_count.le.maxerrmsg_count) then
201 write (iout,'(2a,2e15.5,a,2i8,a,f8.1)')
202 & "Warning: energy differs remarkably from ",
203 & " the value read in: ",energia(0),eini," point",
204 & iii+1,indstart(me1)+iii," T",
205 & 1.0d0/(1.987D-3*beta_h(ib,ipar))
206 call enerprint(energia(0),fT)
207 write (iout,'(4f10.5,2i5)') 0.0,energia(0),0.0,
208 & 1.0d0/(beta_h(ib,ipar)*1.987D-3),
210 write(iout,'(8f10.5)')
211 & ((c(l,k),l=1,3),k=1,nres),
212 & ((c(l,k+nres),l=1,3),k=nnt,nct)
215 c call pdbout(iii+1,beta_h(ib,ipar),
216 c & eini,energia(0),0.0d0,rmsdev)
220 errmsg_count=errmsg_count+1
221 if (errmsg_count.gt.maxerrmsg_count)
222 & write (iout,*) "Too many warning messages"
223 if (einicheck.gt.1) then
224 write (iout,*) "Calculation stopped."
227 call MPI_Abort(WHAM_COMM,IERROR,ERRCODE)
234 potE(iii+1,iparm)=energia(0)
236 enetb(k,iii+1,iparm)=energia(k)
238 c write(iout,*) "iCHUJ TU STRZELI",i,iii,entfac(i)
239 c call enerprint(energia(0),fT)
241 write (iout,'(2i5,f10.1,3e15.5)') i,iii,
242 & 1.0d0/(beta_h(ib,ipar)*1.987D-3),energia(0),eini,efree
243 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 write(liczba,'(bz,i3.3)') me
257 nazwa="test"//liczba//".pdb"
258 write (iout,*) "pdb file",nazwa
259 open (ipdb,file=nazwa,position="append")
260 call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev)
268 if (q(1,iii).le.0.0d0 .and. indpdb.gt.0) q(1,iii)=qwolynes(0,0)
269 write (ientout,rec=iii)
270 & ((csingle(l,k),l=1,3),k=1,nres),
271 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
272 & nss,(ihpb(k),jhpb(k),k=1,nss),
273 & potE(iii,ipar),efree,rmsdev,(q(k,iii),k=1,nQ),iR,ib,ipar
274 c write (iout,'(2i5,2e15.5)') ii,iii,potE(iii,ipar),efree
276 if (separate_parset) then
277 snk_p(iR,ib,1)=snk_p(iR,ib,1)+1
279 snk_p(iR,ib,ipar)=snk_p(iR,ib,ipar)+1
281 c write (iout,*) "iii",iii," iR",iR," ib",ib," ipar",ipar,
282 c & " snk",snk_p(iR,ib,ipar)
284 snk(iR,ib,ipar,islice)=snk(iR,ib,ipar,islice)+1
290 write (iout,*) "Me",me," scount",scount(me)
292 c Master gathers updated numbers of conformations written by all procs.
294 call MPI_AllGather( scount(me), 1, MPI_INTEGER, scount(0), 1,
295 & MPI_INTEGER, WHAM_COMM, IERROR)
299 indstart(i)=indend(i-1)+1
300 indend(i)=indstart(i)+scount(i)-1
303 write (iout,*) "Revised conformation counts"
305 write (iout,'(a,i5,a,i7,a,i7,a,i7)')
306 & "Processor",i," indstart",indstart(i),
307 & " indend",indend(i)," count",scount(i)
310 call MPI_AllReduce(snk_p(1,1,1),snk(1,1,1,islice),
311 & MaxR*MaxT_h*nParmSet,
312 & MPI_INTEGER,MPI_SUM,WHAM_COMM,IERROR)
318 stot(islice)=stot(islice)+snk(i,ib,iparm,islice)
322 write (iout,*) "Revised SNK"
325 write (iout,'("Param",i3," Temp",f6.1,3x,32i8)')
326 & iparm,1.0d0/(1.987D-3*beta_h(ib,iparm)),
327 & (snk(i,ib,iparm,islice),i=1,nR(ib,iparm))
328 write (iout,*) "snk_p",(snk_p(i,ib,iparm),i=1,nR(ib,iparm))
331 write (iout,'("Total",i10)') stot(islice)
334 101 write (iout,*) "Error in scratchfile."
338 c------------------------------------------------------------------------------
339 subroutine write_dbase(islice,*)
342 include "DIMENSIONS.ZSCOPT"
343 include "DIMENSIONS.FREE"
344 include "DIMENSIONS.COMPAR"
347 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
350 include "COMMON.CONTROL"
351 include "COMMON.CHAIN"
352 include "COMMON.IOUNITS"
353 include "COMMON.PROTFILES"
354 include "COMMON.NAMES"
356 include "COMMON.SBRIDGE"
358 include "COMMON.FFIELD"
359 include "COMMON.ENEPS"
360 include "COMMON.LOCAL"
361 include "COMMON.WEIGHTS"
362 include "COMMON.INTERACT"
363 include "COMMON.FREE"
364 include "COMMON.ENERGIES"
365 include "COMMON.COMPAR"
366 include "COMMON.PROT"
368 character*80 bxname,cxname
369 character*64 bprotfile_temp
370 character*3 liczba,licz
372 integer i,itj,ii,iii,j,k,l
375 double precision rmsdev,efree,eini
376 real*4 csingle(3,maxres2)
377 double precision energ
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")
465 cc read(ientout,rec=i,err=101)
466 cc & ((csingle(l,k),l=1,3),k=1,nres),
467 cc & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
468 cc & nss,(idssb(k),jdssb(k),k=1,nss),
469 cc & eini,efree,rmsdev,(q(k,i),k=1,nQ),iR,ib,iparm
470 cc idssb(k)=idssb(k)-nres
471 cc jdssb(k)=jdssb(k)-nres
473 read(ientout,rec=i,err=101)
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 & eini,efree,rmsdev,(q(k,i),k=1,nQ),iR,ib,iparm
479 cc write (iout,*) 'CC', iR,ib,iparm,eini,efree
485 call int_from_cart1(.false.)
487 if (indpdb.gt.0) then
488 call conf_compar(i,.false.,.true.)
491 if (bxfile .or.cxfile .or. ensembles.gt.0) write (ientin,rec=i)
492 & ((csingle(l,k),l=1,3),k=1,nres),
493 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
494 & nss,(ihpb(k),jhpb(k),k=1,nss),
495 c & potE(i,iparm),-entfac(i),rms_nat,iscore
496 & potE(i,nparmset),-entfac(i),rms_nat,iscore
498 if (bxfile .or.cxfile .or. ensembles.gt.0) write
500 & ((csingle(l,k),l=1,3),k=1,nres),
501 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
502 & nss,(ihpb(k),jhpb(k),k=1,nss),
503 c & potE(i,iparm),-entfac(i),rms_nat,iscore
504 & potE(i,nparmset),-entfac(i),rms_nat,iscore
506 write (iout,'(2i5,3e15.5)') i,me,potE(i,iparm),-entfac(i)
508 if (cxfile) call cxwrite(ixdrf,csingle,potE(i,nparmset),
509 & -entfac(i),rms_nat,iscore)
512 close(ientout,status="delete")
514 if (bxfile .or. cxfile .or. ensembles.gt.0) close(ientin)
516 call MPI_Barrier(WHAM_COMM,IERROR)
517 if (me.ne.Master .or. .not.bxfile .and. .not. cxfile
518 & .and. ensembles.eq.0) return
520 if (bxfile .or. ensembles.gt.0) then
521 if (nslice.eq.1) then
522 if (.not.separate_parset) then
523 bxname = prefix(:ilen(prefix))//".bx"
525 write (licz,'(bz,i3.3)') myparm
526 bxname = prefix(:ilen(prefix))//"_par"//licz//".bx"
529 if (.not.separate_parset) then
530 bxname = prefix(:ilen(prefix))//"_slice_"//licz2//".bx"
532 write (licz,'(bz,i3.3)') myparm
533 bxname = prefix(:ilen(prefix))//"par_"//licz//
534 & "_slice_"//licz2//".bx"
537 open (ientout,file=bxname,status="unknown",
538 & form="unformatted",access="direct",recl=lenrec1)
539 write (iout,*) "Master is creating binary database ",
540 & bxname(:ilen(bxname))
543 if (nslice.eq.1) then
544 if (.not.separate_parset) then
545 cxname = prefix(:ilen(prefix))//".cx"
547 cxname = prefix(:ilen(prefix))//"_par"//licz//".cx"
550 if (.not.separate_parset) then
551 cxname = prefix(:ilen(prefix))//
552 & "_slice_"//licz2//".cx"
554 cxname = prefix(:ilen(prefix))//"_par"//licz//
555 & "_slice_"//licz2//".cx"
558 #if (defined(AIX) && !defined(JUBL))
559 call xdrfopen_(ixdrf,cxname, "w", iret)
561 call xdrfopen(ixdrf,cxname, "w", iret)
564 write (iout,*) "Error opening cxfile ",cxname(:ilen(cxname))
569 write (liczba,'(bz,i3.3)') j
570 if (separate_parset) then
571 write (licz,'(bz,i3.3)') myparm
572 bxname = prefix(:ilen(prefix))//liczba//"_par"//licz//".bx"
574 bxname = prefix(:ilen(prefix))//liczba//".bx"
576 open (ientin,file=bxname,status="unknown",
577 & form="unformatted",access="direct",recl=lenrec1)
578 write (iout,*) "Master is reading conformations from ",
579 & bxname(:ilen(bxname))
581 c write (iout,*) "j",j," indstart",indstart(j)," indend",indend(j)
583 do i=indstart(j),indend(j)
586 cc read(ientin,rec=iii,err=101)
587 cc & ((csingle(l,k),l=1,3),k=1,nres),
588 cc & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
589 cc & nss,(idssb(k),jdssb(k),k=1,nss),
590 cc & eini,efree,rmsdev,iscor
591 cc idssb(k)=idssb(k)-nres
592 cc jdssb(k)=jdssb(k)-nres
594 read(ientin,rec=iii,err=101)
595 & ((csingle(l,k),l=1,3),k=1,nres),
596 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
597 & nss,(ihpb(k),jhpb(k),k=1,nss),
598 & eini,efree,rmsdev,iscor
600 if (bxfile .or. ensembles.gt.0) then
602 cc write (ientout,rec=i)
603 cc & ((csingle(l,k),l=1,3),k=1,nres),
604 cc & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
605 cc & nss,(idssb(k)+nres,jdssb(k)+nres,k=1,nss),
606 cc & eini,efree,rmsdev,iscor
608 write (ientout,rec=i)
609 & ((csingle(l,k),l=1,3),k=1,nres),
610 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
611 & nss,(ihpb(k),jhpb(k),k=1,nss),
612 & eini,efree,rmsdev,iscor
613 cc write(iout,*) "W poszukiwaniu zlotych galotow"
614 cc write(iout,*) "efree=",efree,iii
617 if(cxfile)call cxwrite(ixdrf,csingle,eini,efree,rmsdev,iscor)
624 call int_from_cart1(.false.)
625 write (iout,'(2i5,3e15.5)') i,iii,eini,efree
626 write (iout,*) "The Cartesian geometry is:"
627 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
628 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
629 write (iout,*) "The internal geometry is:"
630 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
631 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
632 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
633 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
634 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
635 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
636 write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
637 write (iout,'(f10.5,i5)') rmsdev,iscor
640 write (iout,*) iii," conformations (from",indstart(j)," to",
641 & indend(j),") read from ",
642 & bxname(:ilen(bxname))
643 close (ientin,status="delete")
645 if (bxfile .or. cxfile .or. ensembles.gt.0) close (ientout)
646 #if (defined(AIX) && !defined(JUBL))
647 if (cxfile) call xdrfclose_(ixdrf,cxname,iret)
649 if (cxfile) call xdrfclose(ixdrf,cxname,iret)
653 101 write (iout,*) "Error in scratchfile."
657 c-------------------------------------------------------------------------------
658 subroutine cxwrite(ixdrf,csingle,eini,efree,rmsdev,iscor)
661 include "DIMENSIONS.ZSCOPT"
662 include "DIMENSIONS.FREE"
663 include "DIMENSIONS.COMPAR"
666 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
669 include "COMMON.CONTROL"
670 include "COMMON.CHAIN"
671 include "COMMON.IOUNITS"
672 include "COMMON.PROTFILES"
673 include "COMMON.NAMES"
675 include "COMMON.SBRIDGE"
677 include "COMMON.FFIELD"
678 include "COMMON.ENEPS"
679 include "COMMON.LOCAL"
680 include "COMMON.WEIGHTS"
681 include "COMMON.INTERACT"
682 include "COMMON.FREE"
683 include "COMMON.ENERGIES"
684 include "COMMON.COMPAR"
685 include "COMMON.PROT"
686 integer i,j,itmp,iscor,iret,ixdrf
687 double precision rmsdev,efree,eini
688 real*4 csingle(3,maxres2),xoord(3,maxres2+2)
691 c write (iout,*) "cxwrite"
696 xoord(j,i)=csingle(j,i)
701 xoord(j,nres+i-nnt+1)=csingle(j,i+nres)
707 c write (iout,*) "itmp",itmp
709 c write (iout,*) "CNZ",eini,dyn_ss
710 #if (defined(AIX) && !defined(JUBL))
711 call xdrf3dfcoord_(ixdrf, xoord, itmp, prec, iret)
713 c write (iout,*) "xdrf3dfcoord"
715 call xdrfint_(ixdrf, nss, iret)
718 cc call xdrfint_(ixdrf, idssb(j)+nres, iret)
719 cc call xdrfint_(ixdrf, jdssb(j)+nres, iret)
721 call xdrfint_(ixdrf, ihpb(j), iret)
722 call xdrfint_(ixdrf, jhpb(j), iret)
725 call xdrffloat_(ixdrf,real(eini),iret)
726 call xdrffloat_(ixdrf,real(efree),iret)
727 call xdrffloat_(ixdrf,real(rmsdev),iret)
728 call xdrfint_(ixdrf,iscor,iret)
730 call xdrf3dfcoord(ixdrf, xoord, itmp, prec, iret)
732 call xdrfint(ixdrf, nss, iret)
735 cc call xdrfint(ixdrf, idssb(j), iret)
736 cc call xdrfint(ixdrf, jdssb(j), iret)
737 cc idssb(j)=idssb(j)-nres
738 cc jdssb(j)=jdssb(j)-nres
740 call xdrfint(ixdrf, ihpb(j), iret)
741 call xdrfint(ixdrf, jhpb(j), iret)
744 call xdrffloat(ixdrf,real(eini),iret)
745 call xdrffloat(ixdrf,real(efree),iret)
746 call xdrffloat(ixdrf,real(rmsdev),iret)
747 call xdrfint(ixdrf,iscor,iret)
752 c------------------------------------------------------------------------------
753 logical function conf_check(ii,iprint)
756 include "DIMENSIONS.ZSCOPT"
757 include "DIMENSIONS.FREE"
760 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
763 include "COMMON.CHAIN"
764 include "COMMON.IOUNITS"
765 include "COMMON.PROTFILES"
766 include "COMMON.NAMES"
768 include "COMMON.SBRIDGE"
770 include "COMMON.FFIELD"
771 include "COMMON.ENEPS"
772 include "COMMON.LOCAL"
773 include "COMMON.WEIGHTS"
774 include "COMMON.INTERACT"
775 include "COMMON.FREE"
776 include "COMMON.ENERGIES"
777 include "COMMON.CONTROL"
778 include "COMMON.TORCNSTR"
779 integer j,k,l,ii,itj,iprint
780 if (.not.check_conf) then
784 call int_from_cart1(.false.)
786 if (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0) then
788 & write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),
789 & " for conformation",ii
790 if (iprint.gt.1) then
791 write (iout,*) "The Cartesian geometry is:"
792 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
793 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
794 write (iout,*) "The internal geometry is:"
795 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
796 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
797 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
798 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
799 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
800 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
802 if (iprint.gt.0) write (iout,*)
803 & "This conformation WILL NOT be added to the database."
810 if (itype(j).ne.10 .and. (vbld(nres+j)-dsc(itj)).gt.2.0d0) then
812 & write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j),
813 & " for conformation",ii
814 if (iprint.gt.1) then
815 write (iout,*) "The Cartesian geometry is:"
816 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
817 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
818 write (iout,*) "The internal geometry is:"
819 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
820 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
821 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
822 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
823 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
824 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
826 if (iprint.gt.0) write (iout,*)
827 & "This conformation WILL NOT be added to the database."
833 if (theta(j).le.0.0d0) then
835 & write (iout,*) "Zero theta angle(s) in conformation",ii
836 if (iprint.gt.1) then
837 write (iout,*) "The Cartesian geometry is:"
838 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
839 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
840 write (iout,*) "The internal geometry is:"
841 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
842 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
843 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
844 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
845 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
846 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
848 if (iprint.gt.0) write (iout,*)
849 & "This conformation WILL NOT be added to the database."
853 if (theta(j).gt.179.97*deg2rad) theta(j)=179.97*deg2rad
856 c write (iout,*) "conf_check passed",ii