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 integer ncont,icont(2,maxcont),isecstr(maxres)
50 character*256 bprotfile_temp
51 double precision totlength
52 call opentmp(islice,ientout,bprotfile_temp)
56 c write (iout,*) "enecalc: nparmset ",nparmset
57 c write (iout,*) "enecalc: tormode ",tor_mode
58 write (iout,*) "ns",ns," dyn_ss",dyn_ss,(iss(i),i=1,ns)
59 if (ns.gt.0.and.dyn_ss) then
63 forcon(i-nss)=forcon(i)
70 dyn_ss_mask(iss(i))=.true.
73 write (iout,*) "dyn_ss_mask",(dyn_ss_mask(i),i=1,nres)
82 write (iout,*) "indstart(me1),indend(me1)"
83 &,indstart(me1),indend(me1)
84 do i=indstart(me1),indend(me1)
96 read(ientout,rec=i,err=101)
97 & ((csingle(l,k),l=1,3),k=1,nres),
98 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
99 & nss,(ihpb(k),jhpb(k),k=1,nss),
100 & eini,efree,rmsdev,(q(j,iii+1),j=1,nQ),iR,ib,ipar
101 if (indpdb.gt.0) then
109 c(l,k+nres)=csingle(l,k+nres)
112 anatemp= 1.0d0/(beta_h(ib,ipar)*1.987D-3)
113 q(nQ+1,iii+1)=rmsnat(iii+1,ipermin)
115 c write (iout,*) iii+1,q(nQ+3,iii+1),q(nQ+4,iii+1),q(nQ+5,iii+1)
116 c fT=T0*beta_h(ib,ipar)*1.987D-3
117 c ft=2.0d0/(1.0d0+1.0d0/(T0*beta_h(ib,ipar)*1.987D-3))
118 if (rescale_mode.eq.1) then
119 quot=1.0d0/(T0*beta_h(ib,ipar)*1.987D-3)
121 tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
122 ft(6)=(320.0+80.0*dtanh((tt-320.0)/80.0))/320.0
133 fT(l)=kfacl/(kfacl-1.0d0+quotl)
135 else if (rescale_mode.eq.2) then
136 quot=1.0d0/(T0*beta_h(ib,ipar)*1.987D-3)
138 tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
139 ft(6)=(320.0+80.0*dtanh((tt-320.0)/80.0))/320.0
148 fT(l)=1.12692801104297249644d0/
149 & dlog(dexp(quotl)+dexp(-quotl))
151 else if (rescale_mode.eq.0) then
156 write (iout,*) "Error in ECECALC: wrong RESCALE_MODE",
162 c write (iout,*) "T",1.0d0/(beta_h(ib,ipar)*1.987D-3)," T0",T0,
163 c & " kfac",kfac,"quot",quot," fT",fT
169 call int_from_cart1(.false.)
173 call restore_parm(iparm)
175 write (iout,*) wsc,wscp,welec,wvdwpp,wang,wtor,wscloc,
176 & wcorr,wcorr5,wcorr6,wturn4,wturn3,wturn6,wel_loc,
177 & wtor_d,wsccor,wbond
179 c write (iout,*) "tuz przed energia"
180 call etotal(energia(0),fT)
181 c write (iout,*) "tuz za energia"
183 write (iout,*) "Conformation",i
184 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres),
185 & ((c(l,k+nres),l=1,3),k=nnt,nct)
186 call enerprint(energia(0),fT)
187 c write (iout,'(2i5,21f8.2)') i,iparm,(energia(k),k=1,21)
188 c write (iout,*) "ftors(1)",ftors(1)
189 c call briefout(i,energia(0))
190 c temp=1.0d0/(beta_h(ib,ipar)*1.987D-3)
191 c write (iout,*) "temp", temp
192 c call pdbout(i,temp,energia(0),energia(0),0.0d0,0.0d0)
194 if (isnan(energia(0)) .or. energia(1).ge.1.0d20
195 & .or. energia(0).ge.1.0d20) then
196 write (iout,*) "NaNs detected in some of the energy",
197 & " components for conformation",ii+1
198 write (iout,*) "The Cartesian geometry is:"
199 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
200 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
201 write (iout,*) "The internal geometry is:"
203 c call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev)
204 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
205 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
206 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
207 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
208 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
209 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
210 write (iout,*) "The components of the energy are:"
211 call enerprint(energia(0),fT)
213 & "This conformation WILL NOT be added to the database."
218 if (ipar.eq.iparm) write (iout,*) i,iparm,
219 & 1.0d0/(beta_h(ib,ipar)*1.987D-3),eini,energia(0)
221 c write (iout,*) "eini",eini,"energia(0)",energia(0)," diff",
223 if (ipar.eq.iparm .and. einicheck.gt.0 .and.
224 ! & dabs(eini-energia(0)-energia(27)).gt.tole) then
225 & dabs(eini-energia(0)).gt.tole) then
226 if (errmsg_count.le.maxerrmsg_count) then
227 write (iout,'(2a,2e15.5,a,2i8,a,f8.1)')
228 & "Warning: energy differs remarkably from ",
229 ! & " the value read in: ",energia(0)+energia(27),eini," point",
230 & " the value read in: ",energia(0),eini," point",
231 & iii+1,indstart(me1)+iii," T",
232 & 1.0d0/(1.987D-3*beta_h(ib,ipar))
233 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres),
234 & ((c(l,k+nres),l=1,3),k=nnt,nct)
236 c call pdbout(indstart(me1)+iii,
237 c & 1.0d0/(1.987D-3*beta_h(ib,ipar)),energia(0),eini,0.0d0,0.0d0)
238 call enerprint(energia(0),fT)
239 errmsg_count=errmsg_count+1
240 if (errmsg_count.gt.maxerrmsg_count)
241 & write (iout,*) "Too many warning messages"
242 if (einicheck.gt.1) then
243 write (iout,*) "Calculation stopped."
246 call MPI_Abort(WHAM_COMM,IERROR,ERRCODE)
253 C write (iout,*) "Czy tu dochodze"
254 potE(iii+1,iparm)=energia(0)
256 enetb(k,iii+1,iparm)=energia(k)
259 write (iout,'(2i5,f10.1,3e15.5)') i,iii,
260 & 1.0d0/(beta_h(ib,ipar)*1.987D-3),energia(0),eini,efree
261 c call enerprint(energia(0),fT)
264 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
265 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
266 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
267 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
268 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
269 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
270 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
271 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
272 write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
273 write (iout,'(8f10.5)') (q(k,iii+1),k=1,nQ)
274 write (iout,'(f10.5,i10)') rmsdev,iscor
275 call enerprint(energia(0),fT)
276 call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev)
281 q(nQ+2,iii+1)=gyrate(iii+1)
282 c 8/28/2020 Adam - determine the fraction of secondary structures.
283 call elecont(.false.,ncont,icont,nnt,nct-1,1)
284 call secondary2(.false.,.false.,ncont,icont,isecstr)
286 write (iout,*) "secondary structure"
287 write (iout,'(80i1)') (isecstr(k),k=1,nres)
294 if (itype(k).eq.ntyp1) cycle
295 totlength=totlength+1.0d0
297 q(nQ+3+l,iii+1)=q(nQ+3+l,iii+1)+1.0d0
299 q(nQ+3,iii+1)=q(nQ+3,iii+1)/totlength
300 q(nQ+4,iii+1)=q(nQ+4,iii+1)/totlength
301 q(nQ+5,iii+1)=q(nQ+5,iii+1)/totlength
302 c write (iout,*) "iii",iii," nssbond",nssbond,nss
303 c q(nQ+6,iii+1)=nssbond
307 if (q(1,iii).le.0.0d0 .and. indpdb.gt.0)
308 & q(1,iii)=qwolynes(0,0,ipermin)
309 c write (iout,*) "iii",iii," q",q(1,iii)
310 write (ientout,rec=iii)
311 & ((csingle(l,k),l=1,3),k=1,nres),
312 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
313 & nss,(ihpb(k),jhpb(k),k=1,nss),
314 & potE(iii,ipar),efree,rmsdev,(q(k,iii),k=1,nQ),iR,ib,ipar
315 c write (iout,'(2i5,2e15.5)') ii,iii,potE(iii,ipar),efree
317 if (separate_parset) then
318 snk_p(iR,ib,1)=snk_p(iR,ib,1)+1
320 snk_p(iR,ib,ipar)=snk_p(iR,ib,ipar)+1
322 c write (iout,*) "iii",iii," iR",iR," ib",ib," ipar",ipar,
323 c & " snk",snk_p(iR,ib,ipar)
325 snk(iR,ib,ipar,islice)=snk(iR,ib,ipar,islice)+1
331 write (iout,*) "Me",me," scount_buff",scount_buff(me)
333 c Master gathers updated numbers of conformations written by all procs.
334 c call MPI_AllGather(MPI_IN_PLACE,1,MPI_DATATYPE_NULL,scount(0),1,
335 c & MPI_INTEGER, WHAM_COMM, IERROR)
336 call MPI_AllGather( scount_buff(me), 1, MPI_INTEGER, scount(0), 1,
337 & MPI_INTEGER, WHAM_COMM, IERROR)
342 indstart(i)=indend(i-1)+1
343 indend(i)=indstart(i)+scount(i)-1
346 write (iout,*) "Revised conformation counts"
348 write (iout,'(a,i5,a,i7,a,i7,a,i7)')
349 & "Processor",i," indstart",indstart(i),
350 & " indend",indend(i)," count",scount(i)
353 call MPI_AllReduce(snk_p(1,1,1),snk(1,1,1,islice),
354 & MaxR*MaxT_h*nParmSet,
355 & MPI_INTEGER,MPI_SUM,WHAM_COMM,IERROR)
361 stot(islice)=stot(islice)+snk(i,ib,iparm,islice)
365 write (iout,*) "Revised SNK"
368 write (iout,'("Param",i3," Temp",f6.1,3x,32i8)')
369 & iparm,1.0d0/(1.987D-3*beta_h(ib,iparm)),
370 & (snk(i,ib,iparm,islice),i=1,nR(ib,iparm))
371 write (iout,*) "snk_p",(snk_p(i,ib,iparm),i=1,nR(ib,iparm))
374 write (iout,'("Total",i10)') stot(islice)
377 101 write (iout,*) "Error in scratchfile."
381 c------------------------------------------------------------------------------
382 subroutine write_dbase(islice,*)
385 include "DIMENSIONS.ZSCOPT"
386 include "DIMENSIONS.FREE"
387 include "DIMENSIONS.COMPAR"
390 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
393 include "COMMON.CONTROL"
394 include "COMMON.CHAIN"
395 include "COMMON.IOUNITS"
396 include "COMMON.PROTFILES"
397 include "COMMON.NAMES"
399 include "COMMON.SBRIDGE"
401 include "COMMON.FFIELD"
402 include "COMMON.ENEPS"
403 include "COMMON.LOCAL"
404 include "COMMON.WEIGHTS"
405 include "COMMON.INTERACT"
406 include "COMMON.FREE"
407 include "COMMON.ENERGIES"
408 include "COMMON.COMPAR"
409 include "COMMON.PROT"
410 include "COMMON.CONTACTS1"
412 character*80 bxname,cxname
413 character*256 bprotfile_temp
414 character*3 liczba,licz
416 integer i,itj,ii,iii,j,k,l
419 double precision rmsdev,efree,eini
420 real*4 csingle(3,maxres2)
421 double precision energ
424 integer ir,ib,iparm, scount_buff(0:99)
425 integer isecstr(maxres)
426 write (licz2,'(bz,i2.2)') islice
427 call opentmp(islice,ientout,bprotfile_temp)
428 write (iout,*) "bprotfile_temp ",bprotfile_temp
430 if (.not.bxfile .and. .not. cxfile .and. indpdb.eq.0
431 & .and. ensembles.eq.0) then
432 close(ientout,status="delete")
436 write (liczba,'(bz,i3.3)') me
437 if (bxfile .or. cxfile .or. ensembles.gt.0) then
438 if (.not.separate_parset) then
439 bxname = prefix(:ilen(prefix))//liczba//".bx"
441 write (licz,'(bz,i3.3)') myparm
442 bxname = prefix(:ilen(prefix))//liczba//"_par"//licz//".bx"
444 open (ientin,file=bxname,status="unknown",
445 & form="unformatted",access="direct",recl=lenrec1)
448 if (bxfile .or. cxfile .or. ensembles.gt.0) then
449 if (nslice.eq.1) then
450 bxname = prefix(:ilen(prefix))//".bx"
452 bxname = prefix(:ilen(prefix))//
453 & "_slice_"//licz2//".bx"
455 open (ientin,file=bxname,status="unknown",
456 & form="unformatted",access="direct",recl=lenrec1)
457 write (iout,*) "Calculating energies; writing geometry",
458 & " and energy components to ",bxname(:ilen(bxname))
460 #if (defined(AIX) && !defined(JUBL))
461 call xdrfopen_(ixdrf,cxname, "w", iret)
463 call xdrfopen(ixdrf,cxname, "w", iret)
466 write (iout,*) "Error opening cxfile ",cxname(:ilen(cxname))
471 if (indpdb.gt.0) then
472 if (nslice.eq.1) then
474 if (.not.separate_parset) then
475 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))
478 write (licz,'(bz,i3.3)') myparm
479 statname=prefix(:ilen(prefix))//'_par'//licz//'_'//
480 & pot(:ilen(pot))//liczba//'.stat'
484 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))//'.stat'
488 if (.not.separate_parset) then
489 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))//
490 & "_slice_"//licz2//liczba//'.stat'
492 write (licz,'(bz,i3.3)') myparm
493 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))//
494 & '_par'//licz//"_slice_"//licz2//liczba//'.stat'
497 statname=prefix(:ilen(prefix))//'_'//pot(:ilen(pot))
498 & //"_slice_"//licz2//'.stat'
501 open(istat,file=statname,status="unknown")
509 read(ientout,rec=i,err=101)
510 & ((csingle(l,k),l=1,3),k=1,nres),
511 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
512 & nss,(ihpb(k),jhpb(k),k=1,nss),
513 & eini,efree,rmsdev,(q(k,i),k=1,nQ),iR,ib,iparm
514 c write (iout,*) iR,ib,iparm,eini,efree
520 call int_from_cart1(.false.)
522 c write (iout,*) "Calling conf_compar",i
524 anatemp= 1.0d0/(beta_h(ib,iparm)*1.987D-3)
525 if (indpdb.gt.0) then
526 call conf_compar(i,.false.,.true.)
528 c call elecont(.false.,ncont,icont,nnt,nct)
529 c call secondary2(.false.,.false.,ncont,icont,isecstr)
531 c write (iout,*) "Exit conf_compar",i
533 if (bxfile .or.cxfile .or. ensembles.gt.0) write (ientin,rec=i)
534 & ((csingle(l,k),l=1,3),k=1,nres),
535 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
536 & nss,(ihpb(k),jhpb(k),k=1,nss),
537 c & potE(i,iparm),-entfac(i),rms_nat,iscore
538 & potE(i,nparmset),-entfac(i),rms_nat,iscore
539 c write (iout,'(2i5,3e15.5)') i,me,potE(i,iparm),-entfac(i)
541 if (cxfile) call cxwrite(ixdrf,csingle,potE(i,nparmset),
542 & -entfac(i),rms_nat,iscore)
545 close(ientout,status="delete")
547 if (bxfile .or. cxfile .or. ensembles.gt.0) close(ientin)
549 call MPI_Barrier(WHAM_COMM,IERROR)
550 if (me.ne.Master .or. .not.bxfile .and. .not. cxfile
551 & .and. ensembles.eq.0) return
553 if (bxfile .or. ensembles.gt.0) then
554 if (nslice.eq.1) then
555 if (.not.separate_parset) then
556 bxname = prefix(:ilen(prefix))//".bx"
558 write (licz,'(bz,i3.3)') myparm
559 bxname = prefix(:ilen(prefix))//"_par"//licz//".bx"
562 if (.not.separate_parset) then
563 bxname = prefix(:ilen(prefix))//"_slice_"//licz2//".bx"
565 write (licz,'(bz,i3.3)') myparm
566 bxname = prefix(:ilen(prefix))//"par_"//licz//
567 & "_slice_"//licz2//".bx"
570 open (ientout,file=bxname,status="unknown",
571 & form="unformatted",access="direct",recl=lenrec1)
572 write (iout,*) "Master is creating binary database ",
573 & bxname(:ilen(bxname))
576 if (nslice.eq.1) then
577 if (.not.separate_parset) then
578 cxname = prefix(:ilen(prefix))//".cx"
580 cxname = prefix(:ilen(prefix))//"_par"//licz//".cx"
583 if (.not.separate_parset) then
584 cxname = prefix(:ilen(prefix))//
585 & "_slice_"//licz2//".cx"
587 cxname = prefix(:ilen(prefix))//"_par"//licz//
588 & "_slice_"//licz2//".cx"
591 #if (defined(AIX) && !defined(JUBL))
592 call xdrfopen_(ixdrf,cxname, "w", iret)
594 call xdrfopen(ixdrf,cxname, "w", iret)
597 write (iout,*) "Error opening cxfile ",cxname(:ilen(cxname))
602 write (liczba,'(bz,i3.3)') j
603 if (separate_parset) then
604 write (licz,'(bz,i3.3)') myparm
605 bxname = prefix(:ilen(prefix))//liczba//"_par"//licz//".bx"
607 bxname = prefix(:ilen(prefix))//liczba//".bx"
609 open (ientin,file=bxname,status="unknown",
610 & form="unformatted",access="direct",recl=lenrec1)
611 write (iout,*) "Master is reading conformations from ",
612 & bxname(:ilen(bxname))
614 c write (iout,*) "j",j," indstart",indstart(j)," indend",indend(j)
616 do i=indstart(j),indend(j)
618 read(ientin,rec=iii,err=101)
619 & ((csingle(l,k),l=1,3),k=1,nres),
620 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
621 & nss,(ihpb(k),jhpb(k),k=1,nss),
622 & eini,efree,rmsdev,iscor
623 if (bxfile .or. ensembles.gt.0) then
624 write (ientout,rec=i)
625 & ((csingle(l,k),l=1,3),k=1,nres),
626 & ((csingle(l,k+nres),l=1,3),k=nnt,nct),
627 & nss,(ihpb(k),jhpb(k),k=1,nss),
628 & eini,efree,rmsdev,iscor
630 if(cxfile)call cxwrite(ixdrf,csingle,eini,efree,rmsdev,iscor)
637 call int_from_cart1(.false.)
638 write (iout,'(2i5,3e15.5)') i,iii,eini,efree
639 write (iout,*) "The Cartesian geometry is:"
640 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
641 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
642 write (iout,*) "The internal geometry is:"
643 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
644 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
645 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
646 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
647 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
648 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
649 write (iout,'(16i5)') nss,(ihpb(k),jhpb(k),k=1,nss)
650 write (iout,'(f10.5,i5)') rmsdev,iscor
653 write (iout,*) iii," conformations (from",indstart(j)," to",
654 & indend(j),") read from ",
655 & bxname(:ilen(bxname))
656 close (ientin,status="delete")
658 if (bxfile .or. cxfile .or. ensembles.gt.0) close (ientout)
659 #if (defined(AIX) && !defined(JUBL))
660 if (cxfile) call xdrfclose_(ixdrf,cxname,iret)
662 if (cxfile) call xdrfclose(ixdrf,cxname,iret)
666 101 write (iout,*) "Error in scratchfile."
670 c-------------------------------------------------------------------------------
671 subroutine cxwrite(ixdrf,csingle,eini,efree,rmsdev,iscor)
674 include "DIMENSIONS.ZSCOPT"
675 include "DIMENSIONS.FREE"
676 include "DIMENSIONS.COMPAR"
679 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
682 include "COMMON.CONTROL"
683 include "COMMON.CHAIN"
684 include "COMMON.IOUNITS"
685 include "COMMON.PROTFILES"
686 include "COMMON.NAMES"
688 include "COMMON.SBRIDGE"
690 include "COMMON.FFIELD"
691 include "COMMON.ENEPS"
692 include "COMMON.LOCAL"
693 include "COMMON.WEIGHTS"
694 include "COMMON.INTERACT"
695 include "COMMON.FREE"
696 include "COMMON.ENERGIES"
697 include "COMMON.COMPAR"
698 include "COMMON.PROT"
699 integer i,j,itmp,iscor,iret,ixdrf
700 double precision rmsdev,efree,eini
701 real*4 csingle(3,maxres2),xoord(3,maxres2+2)
704 c write (iout,*) "cxwrite"
709 xoord(j,i)=csingle(j,i)
714 xoord(j,nres+i-nnt+1)=csingle(j,i+nres)
720 c write (iout,*) "itmp",itmp
722 #if (defined(AIX) && !defined(JUBL))
723 call xdrf3dfcoord_(ixdrf, xoord, itmp, prec, iret)
725 c write (iout,*) "xdrf3dfcoord"
727 call xdrfint_(ixdrf, nss, iret)
730 call xdrfint(ixdrf, idssb(j)+nres, iret)
731 call xdrfint(ixdrf, jdssb(j)+nres, iret)
733 call xdrfint_(ixdrf, ihpb(j), iret)
734 call xdrfint_(ixdrf, jhpb(j), iret)
737 call xdrffloat_(ixdrf,real(eini),iret)
738 call xdrffloat_(ixdrf,real(efree),iret)
739 call xdrffloat_(ixdrf,real(rmsdev),iret)
740 call xdrfint_(ixdrf,iscor,iret)
742 call xdrf3dfcoord(ixdrf, xoord, itmp, prec, iret)
744 call xdrfint(ixdrf, nss, iret)
747 call xdrfint(ixdrf, idssb(j)+nres, iret)
748 call xdrfint(ixdrf, jdssb(j)+nres, iret)
750 call xdrfint(ixdrf, ihpb(j), iret)
751 call xdrfint(ixdrf, jhpb(j), iret)
754 call xdrffloat(ixdrf,real(eini),iret)
755 call xdrffloat(ixdrf,real(efree),iret)
756 call xdrffloat(ixdrf,real(rmsdev),iret)
757 call xdrfint(ixdrf,iscor,iret)
762 c------------------------------------------------------------------------------
763 logical function conf_check(ii,iprint)
766 include "DIMENSIONS.ZSCOPT"
767 include "DIMENSIONS.FREE"
770 integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
773 include "COMMON.CHAIN"
774 include "COMMON.IOUNITS"
775 include "COMMON.PROTFILES"
776 include "COMMON.NAMES"
778 include "COMMON.SBRIDGE"
780 include "COMMON.FFIELD"
781 include "COMMON.ENEPS"
782 include "COMMON.LOCAL"
783 include "COMMON.WEIGHTS"
784 include "COMMON.INTERACT"
785 include "COMMON.FREE"
786 include "COMMON.ENERGIES"
787 include "COMMON.CONTROL"
788 include "COMMON.TORCNSTR"
789 integer j,k,l,ii,itj,iprint
790 c if (.not.check_conf) then
794 call int_from_cart1(.false.)
796 if (itype(j-1).ne.ntyp1 .and. itype(j).ne.ntyp1 .and.
797 & (vbld(j).lt.2.0d0 .or. vbld(j).gt.6.5d0)) then
799 & write (iout,*) "Bad CA-CA bond length",j," ",vbld(j),
800 & " for conformation",ii
801 if (iprint.gt.1) then
802 write (iout,*) "The Cartesian geometry is:"
803 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
804 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
805 write (iout,*) "The internal geometry is:"
806 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
807 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
808 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
809 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
810 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
811 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
813 if (iprint.gt.0) write (iout,*)
814 & "This conformation WILL NOT be added to the database."
821 if (itype(j).ne.10 .and.itype(j).ne.ntyp1 .and.
822 & (vbld(nres+j)-dsc(iabs(itj))).gt.2.0d0) then
824 & write (iout,*) "Bad CA-SC bond length",j," ",vbld(nres+j),
825 & restyp(itj),itj,dsc(iabs(itj))," for conformation",ii
826 if (iprint.gt.1) then
827 write (iout,*) "The Cartesian geometry is:"
828 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
829 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
830 write (iout,*) "The internal geometry is:"
831 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
832 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
833 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
834 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
835 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
836 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
838 if (iprint.gt.0) write (iout,*)
839 & "This conformation WILL NOT be added to the database."
845 if (theta(j).le.0.0d0) then
847 & write (iout,*) "Zero theta angle(s) in conformation",ii
848 if (iprint.gt.1) then
849 write (iout,*) "The Cartesian geometry is:"
850 write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres)
851 write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct)
852 write (iout,*) "The internal geometry is:"
853 write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct)
854 write (iout,'(8f10.4)') (vbld(k),k=nres+nnt,nres+nct)
855 write (iout,'(8f10.4)') (rad2deg*theta(k),k=3,nres)
856 write (iout,'(8f10.4)') (rad2deg*phi(k),k=4,nres)
857 write (iout,'(8f10.4)') (rad2deg*alph(k),k=2,nres-1)
858 write (iout,'(8f10.4)') (rad2deg*omeg(k),k=2,nres-1)
860 if (iprint.gt.0) write (iout,*)
861 & "This conformation WILL NOT be added to the database."
865 if (theta(j).gt.179.97*deg2rad) theta(j)=179.97*deg2rad
868 c write (iout,*) "conf_check passed",ii