X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Fwham%2Fsrc%2Fenecalc1.F;h=397e0f3b697599683c05a423571de906f2cd2301;hb=e26610dc1d9f408822f8530f2dca7a04fc36c637;hp=c4311533637a0a69d74435b0f9408c8139963cd7;hpb=478a9d9a1c99eb3f4bc4ca676ff3162bdd01d633;p=unres.git diff --git a/source/wham/src/enecalc1.F b/source/wham/src/enecalc1.F index c431153..397e0f3 100644 --- a/source/wham/src/enecalc1.F +++ b/source/wham/src/enecalc1.F @@ -33,7 +33,8 @@ double precision rmsnat,gyrate external rmsnat,gyrate double precision tole /1.0d-1/ - integer i,itj,ii,iii,j,k,l,licz + integer i,itj,ii,iii,j,k,l,licz,scme,itmp + integer ires integer ir,ib,ipar,iparm integer iscor,islice real*4 csingle(3,maxres2) @@ -45,7 +46,8 @@ double precision tt integer snk_p(MaxR,MaxT_h,Max_parm) logical lerr - character*64 bprotfile_temp + character*128 bprotfile_temp + integer scount_t(0:maxprocs-1) call opentmp(islice,ientout,bprotfile_temp) iii=0 ii=0 @@ -75,6 +77,16 @@ & ((csingle(l,k+nres),l=1,3),k=nnt,nct), & nss,(ihpb(k),jhpb(k),k=1,nss), & eini,efree,rmsdev,(q(j,iii+1),j=1,nQ),iR,ib,ipar +#ifdef DEBUG + write (iout,*) "homol_nset",homol_nset, + & " i",i," iR",iR," ib",ib," iset",iset +#endif + if (homol_nset.gt.1) iset=iR +#ifdef DEBUG + write (iout,*) "homol_nset",homol_nset, + & " i",i," iR",iR," ib",ib," iset",iset +#endif +cc write(iout,*), 'NAWEJ',i,eini if (indpdb.gt.0) then do k=1,nres do l=1,3 @@ -153,14 +165,25 @@ c & " kfac",kfac,"quot",quot," fT",fT & wtor_d,wsccor,wbond #endif call etotal(energia(0),fT) + if (constr_homology.gt.0) energia(0)=energia(0)+ + & waga_homology(iset)*energia(22) +c write (iout,*) "constr_homology",constr_homology," iset",iset, +c & " waga_homology",waga_homology(iset) #ifdef DEBUG write (iout,*) "Conformation",i call enerprint(energia(0),fT) c write (iout,'(2i5,21f8.2)') i,iparm,(energia(k),k=1,21) c write (iout,*) "ftors",ftors -c call intout +c write (iout,'(a,3(3x,a5),5x,3(3x,a5))') +c & "Residue","X(CA)","Y(CA)","Z(CA)","X(SC)","Y(SC)","Z(SC)" +c do ires=1,nres +c write (iout,'(a3,1x,i3,3f8.3,5x,3f8.3)') +c & restyp(itype(ires)),ires,(c(j,ires),j=1,3), +c & (c(j,ires+nres),j=1,3) +c enddo + call intout #endif - if (energia(0).ge.1.0d20) then + if (energia(0).ge.1.0d6) then write (iout,*) "NaNs detected in some of the energy", & " components for conformation",ii+1 write (iout,*) "The Cartesian geometry is:" @@ -194,6 +217,25 @@ c call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev) & " the value read in: ",energia(0),eini," point", & iii+1,indstart(me1)+iii," T", & 1.0d0/(1.987D-3*beta_h(ib,ipar)) +#define DEBUG +#ifdef DEBUG + call enerprint(energia(0),fT) +#endif +#undef DEBUG +#ifdef DEBUG + write (iout,'(4f10.5,2i5)') 0.0,energia(0),0.0, + & 1.0d0/(beta_h(ib,ipar)*1.987D-3), + & 0,0 + write(iout,'(8f10.5)') + & ((c(l,k),l=1,3),k=1,nres), + & ((c(l,k+nres),l=1,3),k=nnt,nct) + itmp=ipdb + ipdb=iout + call pdbout(iii+1,beta_h(ib,ipar), + & eini,energia(0),0.0d0,rmsdev) + write (iout,*) + ipdb=itmp +#endif errmsg_count=errmsg_count+1 if (errmsg_count.gt.maxerrmsg_count) & write (iout,*) "Too many warning messages" @@ -209,15 +251,15 @@ c call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev) endif endif potE(iii+1,iparm)=energia(0) - do k=1,21 + do k=1,max_ene enetb(k,iii+1,iparm)=energia(k) enddo +c write(iout,*) "iCHUJ TU STRZELI",i,iii,entfac(i) +c call enerprint(energia(0),fT) #ifdef DEBUG write (iout,'(2i5,f10.1,3e15.5)') i,iii, & 1.0d0/(beta_h(ib,ipar)*1.987D-3),energia(0),eini,efree -c call enerprint(energia(0),fT) -#endif -#ifdef DEBUG + call enerprint(energia(0),fT) write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres) write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct) write (iout,'(8f10.4)') (vbld(k),k=nnt+1,nct) @@ -230,7 +272,12 @@ c call enerprint(energia(0),fT) write (iout,'(8f10.5)') (q(k,iii+1),k=1,nQ) write (iout,'(f10.5,i10)') rmsdev,iscor call enerprint(energia(0),fT) + write(liczba,'(bz,i3.3)') me + nazwa="test"//liczba//".pdb" + write (iout,*) "pdb file",nazwa + open (ipdb,file=nazwa,position="append") call pdbout(ii+1,beta_h(ib,ipar),efree,energia(0),0.0d0,rmsdev) + close(ipdb) #endif endif @@ -262,8 +309,12 @@ c & " snk",snk_p(iR,ib,ipar) write (iout,*) "Me",me," scount",scount(me) call flush(iout) c Master gathers updated numbers of conformations written by all procs. - call MPI_AllGather( scount(me), 1, MPI_INTEGER, scount(0), 1, + scme = scount(me) + call MPI_AllGather( scount(me), 1, MPI_INTEGER, scount_t(0), 1, & MPI_INTEGER, WHAM_COMM, IERROR) + do k=0,nprocs-1 + scount(k) = scount_t(k) + enddo indstart(0)=1 indend(0)=scount(0) do i=1, Nprocs-1 @@ -337,7 +388,7 @@ c------------------------------------------------------------------------------ include "COMMON.PROT" character*64 nazwa character*80 bxname,cxname - character*64 bprotfile_temp + character*128 bprotfile_temp character*3 liczba,licz character*2 licz2 integer i,itj,ii,iii,j,k,l @@ -432,12 +483,22 @@ c------------------------------------------------------------------------------ #else do i=1,ntot(islice) #endif +cc if (dyn_ss) then +cc read(ientout,rec=i,err=101) +cc & ((csingle(l,k),l=1,3),k=1,nres), +cc & ((csingle(l,k+nres),l=1,3),k=nnt,nct), +cc & nss,(idssb(k),jdssb(k),k=1,nss), +cc & eini,efree,rmsdev,(q(k,i),k=1,nQ),iR,ib,iparm +cc idssb(k)=idssb(k)-nres +cc jdssb(k)=jdssb(k)-nres +cc else read(ientout,rec=i,err=101) & ((csingle(l,k),l=1,3),k=1,nres), & ((csingle(l,k+nres),l=1,3),k=nnt,nct), & nss,(ihpb(k),jhpb(k),k=1,nss), & eini,efree,rmsdev,(q(k,i),k=1,nQ),iR,ib,iparm -c write (iout,*) iR,ib,iparm,eini,efree +cc endif +cc write (iout,*) 'CC', iR,ib,iparm,eini,efree do j=1,2*nres do k=1,3 c(k,j)=csingle(k,j) @@ -447,13 +508,23 @@ c write (iout,*) iR,ib,iparm,eini,efree iscore=0 if (indpdb.gt.0) then call conf_compar(i,.false.,.true.) - endif + endif +c if (dyn_ss) then if (bxfile .or.cxfile .or. ensembles.gt.0) write (ientin,rec=i) & ((csingle(l,k),l=1,3),k=1,nres), & ((csingle(l,k+nres),l=1,3),k=nnt,nct), & nss,(ihpb(k),jhpb(k),k=1,nss), c & potE(i,iparm),-entfac(i),rms_nat,iscore & potE(i,nparmset),-entfac(i),rms_nat,iscore +c else + if (bxfile .or.cxfile .or. ensembles.gt.0) write + & (ientin,rec=i) + & ((csingle(l,k),l=1,3),k=1,nres), + & ((csingle(l,k+nres),l=1,3),k=nnt,nct), + & nss,(ihpb(k),jhpb(k),k=1,nss), +c & potE(i,iparm),-entfac(i),rms_nat,iscore + & potE(i,nparmset),-entfac(i),rms_nat,iscore +c endif c write (iout,'(2i5,3e15.5)') i,me,potE(i,iparm),-entfac(i) #ifndef MPI if (cxfile) call cxwrite(ixdrf,csingle,potE(i,nparmset), @@ -533,17 +604,37 @@ c write (iout,*) "j",j," indstart",indstart(j)," indend",indend(j) c call flush(iout) do i=indstart(j),indend(j) iii = iii+1 +cc if (dyn_ss) then +cc read(ientin,rec=iii,err=101) +cc & ((csingle(l,k),l=1,3),k=1,nres), +cc & ((csingle(l,k+nres),l=1,3),k=nnt,nct), +cc & nss,(idssb(k),jdssb(k),k=1,nss), +cc & eini,efree,rmsdev,iscor +cc idssb(k)=idssb(k)-nres +cc jdssb(k)=jdssb(k)-nres +cc else read(ientin,rec=iii,err=101) & ((csingle(l,k),l=1,3),k=1,nres), & ((csingle(l,k+nres),l=1,3),k=nnt,nct), & nss,(ihpb(k),jhpb(k),k=1,nss), & eini,efree,rmsdev,iscor +cc endif if (bxfile .or. ensembles.gt.0) then - write (ientout,rec=i) +cc if (dyn_ss) then +cc write (ientout,rec=i) +cc & ((csingle(l,k),l=1,3),k=1,nres), +cc & ((csingle(l,k+nres),l=1,3),k=nnt,nct), +cc & nss,(idssb(k)+nres,jdssb(k)+nres,k=1,nss), +cc & eini,efree,rmsdev,iscor +cc else + write (ientout,rec=i) & ((csingle(l,k),l=1,3),k=1,nres), & ((csingle(l,k+nres),l=1,3),k=nnt,nct), & nss,(ihpb(k),jhpb(k),k=1,nss), & eini,efree,rmsdev,iscor +cc write(iout,*) "W poszukiwaniu zlotych galotow" +cc write(iout,*) "efree=",efree,iii +cc endif endif if(cxfile)call cxwrite(ixdrf,csingle,eini,efree,rmsdev,iscor) #ifdef DEBUG @@ -637,6 +728,7 @@ c call flush(iout) c write (iout,*) "itmp",itmp c call flush(iout) +c write (iout,*) "CNZ",eini,dyn_ss #if (defined(AIX) && !defined(JUBL)) call xdrf3dfcoord_(ixdrf, xoord, itmp, prec, iret) @@ -644,8 +736,13 @@ c write (iout,*) "xdrf3dfcoord" c call flush(iout) call xdrfint_(ixdrf, nss, iret) do j=1,nss +cc if (dyn_ss) then +cc call xdrfint_(ixdrf, idssb(j)+nres, iret) +cc call xdrfint_(ixdrf, jdssb(j)+nres, iret) +cc else call xdrfint_(ixdrf, ihpb(j), iret) call xdrfint_(ixdrf, jhpb(j), iret) +cc endif enddo call xdrffloat_(ixdrf,real(eini),iret) call xdrffloat_(ixdrf,real(efree),iret) @@ -656,11 +753,18 @@ c call flush(iout) call xdrfint(ixdrf, nss, iret) do j=1,nss +cc if (dyn_ss) then +cc call xdrfint(ixdrf, idssb(j), iret) +cc call xdrfint(ixdrf, jdssb(j), iret) +cc idssb(j)=idssb(j)-nres +cc jdssb(j)=jdssb(j)-nres +cc else call xdrfint(ixdrf, ihpb(j), iret) call xdrfint(ixdrf, jhpb(j), iret) +cc endif enddo call xdrffloat(ixdrf,real(eini),iret) - call xdrffloat(ixdrf,real(efree),iret) + call xdrffloat(ixdrf,real(efree),iret) call xdrffloat(ixdrf,real(rmsdev),iret) call xdrfint(ixdrf,iscor,iret) #endif