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 integer scount_t(0:maxprocs-1)
51 call opentmp(islice,ientout,bprotfile_temp)
55 write (iout,*) "enecalc: nparmset ",nparmset
64 do i=indstart(me1),indend(me1)
75 read(ientout,rec=i,err=101)
76 & ((csingle(l,k),l=1,3),k=1,nres),
77 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
78 & nss,(ihpb(k),jhpb(k),k=1,nss),
79 & eini,efree,rmsdev,(q(j,iii+1),j=1,nQ),iR,ib,ipar
80 cc write(iout,*), 'NAWEJ',i,eini
89 c(l,k+nres)=csingle(l,k+nres)
92 q(nQ+1,iii+1)=rmsnat(iii+1)
94 q(nQ+2,iii+1)=gyrate(iii+1)
95 c fT=T0*beta_h(ib,ipar)*1.987D-3
96 c ft=2.0d0/(1.0d0+1.0d0/(T0*beta_h(ib,ipar)*1.987D-3))
97 if (rescale_mode.eq.1) then
98 quot=1.0d0/(T0*beta_h(ib,ipar)*1.987D-3)
100 tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
101 ft(6)=(320.0+80.0*dtanh((tt-320.0)/80.0))/320.0
112 fT(l)=kfacl/(kfacl-1.0d0+quotl)
114 else if (rescale_mode.eq.2) then
115 quot=1.0d0/(T0*beta_h(ib,ipar)*1.987D-3)
117 tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
118 ft(6)=(320.0+80.0*dtanh((tt-320.0)/80.0))/320.0
127 fT(l)=1.12692801104297249644d0/
128 & dlog(dexp(quotl)+dexp(-quotl))
130 else if (rescale_mode.eq.0) then
135 write (iout,*) "Error in ECECALC: wrong RESCALE_MODE",
141 c write (iout,*) "T",1.0d0/(beta_h(ib,ipar)*1.987D-3)," T0",T0,
142 c & " kfac",kfac,"quot",quot," fT",fT
148 call int_from_cart1(.false.)
152 call restore_parm(iparm)
154 write (iout,*) wsc,wscp,welec,wvdwpp,wang,wtor,wscloc,
155 & wcorr,wcorr5,wcorr6,wturn4,wturn3,wturn6,wel_loc,
156 & wtor_d,wsccor,wbond
158 call etotal(energia(0),fT)
160 write (iout,*) "Conformation",i
161 call enerprint(energia(0),fT)
162 c write (iout,'(2i5,21f8.2)') i,iparm,(energia(k),k=1,21)
163 c write (iout,*) "ftors",ftors
164 write (iout,'(a,3(3x,a5),5x,3(3x,a5))')
165 & "Residue","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)"
167 write (iout,'(a3,1x,i3,3f8.3,5x,3f8.3)')
168 & restyp(itype(ires)),ires,(c(j,ires),j=1,3),
169 & (c(j,ires+nres),j=1,3)
173 if (energia(0).ge.1.0d20) then
174 write (iout,*) "NaNs detected in some of the energy",
175 & " components for conformation",ii+1
176 write (iout,*) "The Cartesian geometry is:"
177 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
178 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
179 write (iout,*) "The internal geometry is:"
181 c call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev)
182 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
183 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
184 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
185 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
186 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
187 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
188 write (iout,*) "The components of the energy are:"
189 call enerprint(energia(0),fT)
191 & "This conformation WILL NOT be added to the database."
196 if (ipar.eq.iparm) write (iout,*) i,iparm,
197 & 1.0d0/(beta_h(ib,ipar)*1.987D-3),eini,energia(0)
199 if (ipar.eq.iparm .and. einicheck.gt.0 .and.
200 & dabs(eini-energia(0)).gt.tole) then
201 if (errmsg_count.le.maxerrmsg_count) then
202 write (iout,'(2a,2e15.5,a,2i8,a,f8.1)')
203 & "Warning: energy differs remarkably from ",
204 & " the value read in: ",energia(0),eini," point",
205 & iii+1,indstart(me1)+iii," T",
206 & 1.0d0/(1.987D-3*beta_h(ib,ipar))
208 call enerprint(energia(0),fT)
209 write (iout,'(4f10.5,2i5)') 0.0,energia(0),0.0,
210 & 1.0d0/(beta_h(ib,ipar)*1.987D-3),
212 write(iout,'(8f10.5)')
213 & ((c(l,k),l=1,3),k=1,nres),
214 & ((c(l,k+nres),l=1,3),k=nnt,nct)
217 call pdbout(iii+1,beta_h(ib,ipar),
218 & eini,energia(0),0.0d0,rmsdev)
222 errmsg_count=errmsg_count+1
223 if (errmsg_count.gt.maxerrmsg_count)
224 & write (iout,*) "Too many warning messages"
225 if (einicheck.gt.1) then
226 write (iout,*) "Calculation stopped."
229 call MPI_Abort(WHAM_COMM,IERROR,ERRCODE)
236 potE(iii+1,iparm)=energia(0)
238 enetb(k,iii+1,iparm)=energia(k)
240 c write(iout,*) "iCHUJ TU STRZELI",i,iii,entfac(i)
241 c call enerprint(energia(0),fT)
243 write (iout,'(2i5,f10.1,3e15.5)') i,iii,
244 & 1.0d0/(beta_h(ib,ipar)*1.987D-3),energia(0),eini,efree
245 call enerprint(energia(0),fT)
246 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
247 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
248 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
249 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
250 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
251 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
252 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
253 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
254 write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
255 write (iout,'(8f10.5)') (q(k,iii+1),k=1,nQ)
256 write (iout,'(f10.5,i10)') rmsdev,iscor
257 call enerprint(energia(0),fT)
258 write(liczba,'(bz,i3.3)') me
259 nazwa="test"//liczba//".pdb"
260 write (iout,*) "pdb file",nazwa
261 open (ipdb,file=nazwa,position="append")
262 call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev)
270 if (q(1,iii).le.0.0d0 .and. indpdb.gt.0) q(1,iii)=qwolynes(0,0)
271 write (ientout,rec=iii)
272 & ((csingle(l,k),l=1,3),k=1,nres),
273 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
274 & nss,(ihpb(k),jhpb(k),k=1,nss),
275 & potE(iii,ipar),efree,rmsdev,(q(k,iii),k=1,nQ),iR,ib,ipar
276 c write (iout,'(2i5,2e15.5)') ii,iii,potE(iii,ipar),efree
278 if (separate_parset) then
279 snk_p(iR,ib,1)=snk_p(iR,ib,1)+1
281 snk_p(iR,ib,ipar)=snk_p(iR,ib,ipar)+1
283 c write (iout,*) "iii",iii," iR",iR," ib",ib," ipar",ipar,
284 c & " snk",snk_p(iR,ib,ipar)
286 snk(iR,ib,ipar,islice)=snk(iR,ib,ipar,islice)+1
292 write (iout,*) "Me",me," scount",scount(me)
294 c Master gathers updated numbers of conformations written by all procs.
296 call MPI_AllGather( scount(me), 1, MPI_INTEGER, scount_t(0), 1,
297 & MPI_INTEGER, WHAM_COMM, IERROR)
299 scount(k) = scount_t(k)
304 indstart(i)=indend(i-1)+1
305 indend(i)=indstart(i)+scount(i)-1
308 write (iout,*) "Revised conformation counts"
310 write (iout,'(a,i5,a,i7,a,i7,a,i7)')
311 & "Processor",i," indstart",indstart(i),
312 & " indend",indend(i)," count",scount(i)
315 call MPI_AllReduce(snk_p(1,1,1),snk(1,1,1,islice),
316 & MaxR*MaxT_h*nParmSet,
317 & MPI_INTEGER,MPI_SUM,WHAM_COMM,IERROR)
323 stot(islice)=stot(islice)+snk(i,ib,iparm,islice)
327 write (iout,*) "Revised SNK"
330 write (iout,'("Param",i3," Temp",f6.1,3x,32i8)')
331 & iparm,1.0d0/(1.987D-3*beta_h(ib,iparm)),
332 & (snk(i,ib,iparm,islice),i=1,nR(ib,iparm))
333 write (iout,*) "snk_p",(snk_p(i,ib,iparm),i=1,nR(ib,iparm))
336 write (iout,'("Total",i10)') stot(islice)
339 101 write (iout,*) "Error in scratchfile."
343 c------------------------------------------------------------------------------
344 subroutine write_dbase(islice,*)
347 include "DIMENSIONS.ZSCOPT"
348 include "DIMENSIONS.FREE"
349 include "DIMENSIONS.COMPAR"
352 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
355 include "COMMON.CONTROL"
356 include "COMMON.CHAIN"
357 include "COMMON.IOUNITS"
358 include "COMMON.PROTFILES"
359 include "COMMON.NAMES"
361 include "COMMON.SBRIDGE"
363 include "COMMON.FFIELD"
364 include "COMMON.ENEPS"
365 include "COMMON.LOCAL"
366 include "COMMON.WEIGHTS"
367 include "COMMON.INTERACT"
368 include "COMMON.FREE"
369 include "COMMON.ENERGIES"
370 include "COMMON.COMPAR"
371 include "COMMON.PROT"
373 character*80 bxname,cxname
374 character*64 bprotfile_temp
375 character*3 liczba,licz
377 integer i,itj,ii,iii,j,k,l
380 double precision rmsdev,efree,eini
381 real*4 csingle(3,maxres2)
382 double precision energ
386 write (licz2,'(bz,i2.2)') islice
387 call opentmp(islice,ientout,bprotfile_temp)
388 write (iout,*) "bprotfile_temp ",bprotfile_temp
390 if (.not.bxfile .and. .not. cxfile .and. indpdb.eq.0
391 & .and. ensembles.eq.0) then
392 close(ientout,status="delete")
396 write (liczba,'(bz,i3.3)') me
397 if (bxfile .or. cxfile .or. ensembles.gt.0) then
398 if (.not.separate_parset) then
399 bxname = prefix(:ilen(prefix))//liczba//".bx"
401 write (licz,'(bz,i3.3)') myparm
402 bxname = prefix(:ilen(prefix))//liczba//"_par"//licz//".bx"
404 open (ientin,file=bxname,status="unknown",
405 & form="unformatted",access="direct",recl=lenrec1)
408 if (bxfile .or. cxfile .or. ensembles.gt.0) then
409 if (nslice.eq.1) then
410 bxname = prefix(:ilen(prefix))//".bx"
412 bxname = prefix(:ilen(prefix))//
413 & "_slice_"//licz2//".bx"
415 open (ientin,file=bxname,status="unknown",
416 & form="unformatted",access="direct",recl=lenrec1)
417 write (iout,*) "Calculating energies; writing geometry",
418 & " and energy components to ",bxname(:ilen(bxname))
420 #if (defined(AIX) && !defined(JUBL))
421 call xdrfopen_(ixdrf,cxname, "w", iret)
423 call xdrfopen(ixdrf,cxname, "w", iret)
426 write (iout,*) "Error opening cxfile ",cxname(:ilen(cxname))
431 if (indpdb.gt.0) then
432 if (nslice.eq.1) then
434 if (.not.separate_parset) then
435 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))
438 write (licz,'(bz,i3.3)') myparm
439 statname=prefix(:ilen(prefix))//'_par'//licz//'_'//
440 & pot(:ilen(pot))//liczba//'.stat'
444 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))//'.stat'
448 if (.not.separate_parset) then
449 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))//
450 & "_slice_"//licz2//liczba//'.stat'
452 write (licz,'(bz,i3.3)') myparm
453 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))//
454 & '_par'//licz//"_slice_"//licz2//liczba//'.stat'
457 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))
458 & //"_slice_"//licz2//'.stat'
461 open(istat,file=statname,status="unknown")
470 cc read(ientout,rec=i,err=101)
471 cc & ((csingle(l,k),l=1,3),k=1,nres),
472 cc & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
473 cc & nss,(idssb(k),jdssb(k),k=1,nss),
474 cc & eini,efree,rmsdev,(q(k,i),k=1,nQ),iR,ib,iparm
475 cc idssb(k)=idssb(k)-nres
476 cc jdssb(k)=jdssb(k)-nres
478 read(ientout,rec=i,err=101)
479 & ((csingle(l,k),l=1,3),k=1,nres),
480 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
481 & nss,(ihpb(k),jhpb(k),k=1,nss),
482 & eini,efree,rmsdev,(q(k,i),k=1,nQ),iR,ib,iparm
484 cc write (iout,*) 'CC', iR,ib,iparm,eini,efree
490 call int_from_cart1(.false.)
492 if (indpdb.gt.0) then
493 call conf_compar(i,.false.,.true.)
496 if (bxfile .or.cxfile .or. ensembles.gt.0) write (ientin,rec=i)
497 & ((csingle(l,k),l=1,3),k=1,nres),
498 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
499 & nss,(ihpb(k),jhpb(k),k=1,nss),
500 c & potE(i,iparm),-entfac(i),rms_nat,iscore
501 & potE(i,nparmset),-entfac(i),rms_nat,iscore
503 if (bxfile .or.cxfile .or. ensembles.gt.0) write
505 & ((csingle(l,k),l=1,3),k=1,nres),
506 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
507 & nss,(ihpb(k),jhpb(k),k=1,nss),
508 c & potE(i,iparm),-entfac(i),rms_nat,iscore
509 & potE(i,nparmset),-entfac(i),rms_nat,iscore
511 write (iout,'(2i5,3e15.5)') i,me,potE(i,iparm),-entfac(i)
513 if (cxfile) call cxwrite(ixdrf,csingle,potE(i,nparmset),
514 & -entfac(i),rms_nat,iscore)
517 close(ientout,status="delete")
519 if (bxfile .or. cxfile .or. ensembles.gt.0) close(ientin)
521 call MPI_Barrier(WHAM_COMM,IERROR)
522 if (me.ne.Master .or. .not.bxfile .and. .not. cxfile
523 & .and. ensembles.eq.0) return
525 if (bxfile .or. ensembles.gt.0) then
526 if (nslice.eq.1) then
527 if (.not.separate_parset) then
528 bxname = prefix(:ilen(prefix))//".bx"
530 write (licz,'(bz,i3.3)') myparm
531 bxname = prefix(:ilen(prefix))//"_par"//licz//".bx"
534 if (.not.separate_parset) then
535 bxname = prefix(:ilen(prefix))//"_slice_"//licz2//".bx"
537 write (licz,'(bz,i3.3)') myparm
538 bxname = prefix(:ilen(prefix))//"par_"//licz//
539 & "_slice_"//licz2//".bx"
542 open (ientout,file=bxname,status="unknown",
543 & form="unformatted",access="direct",recl=lenrec1)
544 write (iout,*) "Master is creating binary database ",
545 & bxname(:ilen(bxname))
548 if (nslice.eq.1) then
549 if (.not.separate_parset) then
550 cxname = prefix(:ilen(prefix))//".cx"
552 cxname = prefix(:ilen(prefix))//"_par"//licz//".cx"
555 if (.not.separate_parset) then
556 cxname = prefix(:ilen(prefix))//
557 & "_slice_"//licz2//".cx"
559 cxname = prefix(:ilen(prefix))//"_par"//licz//
560 & "_slice_"//licz2//".cx"
563 #if (defined(AIX) && !defined(JUBL))
564 call xdrfopen_(ixdrf,cxname, "w", iret)
566 call xdrfopen(ixdrf,cxname, "w", iret)
569 write (iout,*) "Error opening cxfile ",cxname(:ilen(cxname))
574 write (liczba,'(bz,i3.3)') j
575 if (separate_parset) then
576 write (licz,'(bz,i3.3)') myparm
577 bxname = prefix(:ilen(prefix))//liczba//"_par"//licz//".bx"
579 bxname = prefix(:ilen(prefix))//liczba//".bx"
581 open (ientin,file=bxname,status="unknown",
582 & form="unformatted",access="direct",recl=lenrec1)
583 write (iout,*) "Master is reading conformations from ",
584 & bxname(:ilen(bxname))
586 c write (iout,*) "j",j," indstart",indstart(j)," indend",indend(j)
588 do i=indstart(j),indend(j)
591 cc read(ientin,rec=iii,err=101)
592 cc & ((csingle(l,k),l=1,3),k=1,nres),
593 cc & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
594 cc & nss,(idssb(k),jdssb(k),k=1,nss),
595 cc & eini,efree,rmsdev,iscor
596 cc idssb(k)=idssb(k)-nres
597 cc jdssb(k)=jdssb(k)-nres
599 read(ientin,rec=iii,err=101)
600 & ((csingle(l,k),l=1,3),k=1,nres),
601 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
602 & nss,(ihpb(k),jhpb(k),k=1,nss),
603 & eini,efree,rmsdev,iscor
605 if (bxfile .or. ensembles.gt.0) then
607 cc write (ientout,rec=i)
608 cc & ((csingle(l,k),l=1,3),k=1,nres),
609 cc & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
610 cc & nss,(idssb(k)+nres,jdssb(k)+nres,k=1,nss),
611 cc & eini,efree,rmsdev,iscor
613 write (ientout,rec=i)
614 & ((csingle(l,k),l=1,3),k=1,nres),
615 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
616 & nss,(ihpb(k),jhpb(k),k=1,nss),
617 & eini,efree,rmsdev,iscor
618 cc write(iout,*) "W poszukiwaniu zlotych galotow"
619 cc write(iout,*) "efree=",efree,iii
622 if(cxfile)call cxwrite(ixdrf,csingle,eini,efree,rmsdev,iscor)
629 call int_from_cart1(.false.)
630 write (iout,'(2i5,3e15.5)') i,iii,eini,efree
631 write (iout,*) "The Cartesian geometry is:"
632 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
633 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
634 write (iout,*) "The internal geometry is:"
635 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
636 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
637 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
638 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
639 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
640 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
641 write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
642 write (iout,'(f10.5,i5)') rmsdev,iscor
645 write (iout,*) iii," conformations (from",indstart(j)," to",
646 & indend(j),") read from ",
647 & bxname(:ilen(bxname))
648 close (ientin,status="delete")
650 if (bxfile .or. cxfile .or. ensembles.gt.0) close (ientout)
651 #if (defined(AIX) && !defined(JUBL))
652 if (cxfile) call xdrfclose_(ixdrf,cxname,iret)
654 if (cxfile) call xdrfclose(ixdrf,cxname,iret)
658 101 write (iout,*) "Error in scratchfile."
662 c-------------------------------------------------------------------------------
663 subroutine cxwrite(ixdrf,csingle,eini,efree,rmsdev,iscor)
666 include "DIMENSIONS.ZSCOPT"
667 include "DIMENSIONS.FREE"
668 include "DIMENSIONS.COMPAR"
671 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
674 include "COMMON.CONTROL"
675 include "COMMON.CHAIN"
676 include "COMMON.IOUNITS"
677 include "COMMON.PROTFILES"
678 include "COMMON.NAMES"
680 include "COMMON.SBRIDGE"
682 include "COMMON.FFIELD"
683 include "COMMON.ENEPS"
684 include "COMMON.LOCAL"
685 include "COMMON.WEIGHTS"
686 include "COMMON.INTERACT"
687 include "COMMON.FREE"
688 include "COMMON.ENERGIES"
689 include "COMMON.COMPAR"
690 include "COMMON.PROT"
691 integer i,j,itmp,iscor,iret,ixdrf
692 double precision rmsdev,efree,eini
693 real*4 csingle(3,maxres2),xoord(3,maxres2+2)
696 c write (iout,*) "cxwrite"
701 xoord(j,i)=csingle(j,i)
706 xoord(j,nres+i-nnt+1)=csingle(j,i+nres)
712 c write (iout,*) "itmp",itmp
714 c write (iout,*) "CNZ",eini,dyn_ss
715 #if (defined(AIX) && !defined(JUBL))
716 call xdrf3dfcoord_(ixdrf, xoord, itmp, prec, iret)
718 c write (iout,*) "xdrf3dfcoord"
720 call xdrfint_(ixdrf, nss, iret)
723 cc call xdrfint_(ixdrf, idssb(j)+nres, iret)
724 cc call xdrfint_(ixdrf, jdssb(j)+nres, iret)
726 call xdrfint_(ixdrf, ihpb(j), iret)
727 call xdrfint_(ixdrf, jhpb(j), iret)
730 call xdrffloat_(ixdrf,real(eini),iret)
731 call xdrffloat_(ixdrf,real(efree),iret)
732 call xdrffloat_(ixdrf,real(rmsdev),iret)
733 call xdrfint_(ixdrf,iscor,iret)
735 call xdrf3dfcoord(ixdrf, xoord, itmp, prec, iret)
737 call xdrfint(ixdrf, nss, iret)
740 cc call xdrfint(ixdrf, idssb(j), iret)
741 cc call xdrfint(ixdrf, jdssb(j), iret)
742 cc idssb(j)=idssb(j)-nres
743 cc jdssb(j)=jdssb(j)-nres
745 call xdrfint(ixdrf, ihpb(j), iret)
746 call xdrfint(ixdrf, jhpb(j), iret)
749 call xdrffloat(ixdrf,real(eini),iret)
750 call xdrffloat(ixdrf,real(efree),iret)
751 call xdrffloat(ixdrf,real(rmsdev),iret)
752 call xdrfint(ixdrf,iscor,iret)
757 c------------------------------------------------------------------------------
758 logical function conf_check(ii,iprint)
761 include "DIMENSIONS.ZSCOPT"
762 include "DIMENSIONS.FREE"
765 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
768 include "COMMON.CHAIN"
769 include "COMMON.IOUNITS"
770 include "COMMON.PROTFILES"
771 include "COMMON.NAMES"
773 include "COMMON.SBRIDGE"
775 include "COMMON.FFIELD"
776 include "COMMON.ENEPS"
777 include "COMMON.LOCAL"
778 include "COMMON.WEIGHTS"
779 include "COMMON.INTERACT"
780 include "COMMON.FREE"
781 include "COMMON.ENERGIES"
782 include "COMMON.CONTROL"
783 include "COMMON.TORCNSTR"
784 integer j,k,l,ii,itj,iprint
785 if (.not.check_conf) then
789 call int_from_cart1(.false.)
791 if (vbld(j).lt.2.0d0 .or. vbld(j).gt.5.0d0) then
793 & write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),
794 & " for conformation",ii
795 if (iprint.gt.1) then
796 write (iout,*) "The Cartesian geometry is:"
797 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
798 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
799 write (iout,*) "The internal geometry is:"
800 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
801 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
802 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
803 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
804 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
805 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
807 if (iprint.gt.0) write (iout,*)
808 & "This conformation WILL NOT be added to the database."
815 if (itype(j).ne.10 .and. (vbld(nres+j)-dsc(itj)).gt.2.0d0) then
817 & write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j),
818 & " for 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."
838 if (theta(j).le.0.0d0) then
840 & write (iout,*) "Zero theta angle(s) in conformation",ii
841 if (iprint.gt.1) then
842 write (iout,*) "The Cartesian geometry is:"
843 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
844 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
845 write (iout,*) "The internal geometry is:"
846 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
847 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
848 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
849 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
850 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
851 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
853 if (iprint.gt.0) write (iout,*)
854 & "This conformation WILL NOT be added to the database."
858 if (theta(j).gt.179.97*deg2rad) theta(j)=179.97*deg2rad
861 c write (iout,*) "conf_check passed",ii