X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Fcluster%2Fwham%2Fsrc-M%2Fprobabl.F;h=a40d7d8343e72f46a429cb1c3df95f5811036bdf;hb=15cbe2fc81082e6828fa504b3b22499600134b54;hp=293fb8fb2c10320a3470aafa95c2ba6f373776e2;hpb=478a9d9a1c99eb3f4bc4ca676ff3162bdd01d633;p=unres.git diff --git a/source/cluster/wham/src-M/probabl.F b/source/cluster/wham/src-M/probabl.F index 293fb8f..a40d7d8 100644 --- a/source/cluster/wham/src-M/probabl.F +++ b/source/cluster/wham/src-M/probabl.F @@ -8,6 +8,7 @@ include "COMMON.MPI" integer ierror,errcode,status(MPI_STATUS_SIZE) #endif + include "COMMON.CONTROL" include "COMMON.IOUNITS" include "COMMON.FREE" include "COMMON.FFIELD" @@ -27,10 +28,13 @@ character*80 bxname character*2 licz1 character*5 ctemper - integer ilen + integer ilen,ijk external ilen - real*4 Fdimless(maxconf) - double precision energia(0:max_ene) + character*80 structure/'Structure'/ + real*4 Fdimless(maxconf), Fdimless_buf(maxconf) + double precision energia(0:max_ene), totfree_buf(0:maxconf), + & entfac_buf(maxconf) + double precision buffer(maxconf) do i=1,ncon list_conf(i)=i enddo @@ -41,7 +45,8 @@ c enddo write (iout,*) me," indstart",indstart(me)," indend",indend(me) call daread_ccoords(indstart(me),indend(me)) #endif -c write (iout,*) "ncon",ncon +C write (iout,*) "ncon",ncon +C call flush(iout) temper=1.0d0/(beta_h(ib)*1.987D-3) c write (iout,*) "ib",ib," beta_h",beta_h(ib)," temper",temper c quot=1.0d0/(T0*beta_h(ib)*1.987D-3) @@ -53,6 +58,7 @@ c quotl=quotl*quot c kfacl=kfacl*kfac c fT(l)=kfacl/(kfacl-1.0d0+quotl) c enddo +C#define DEBUG if (rescale_mode.eq.1) then quot=1.0d0/(T0*beta_h(ib)*1.987D-3) quotl=1.0d0 @@ -113,19 +119,25 @@ c call flush(iout) do i=1,ncon ii=i #endif -c write (iout,*) "i",i," ii",ii +C write (iout,*) "i",i," ii",ii,"ib",ib,scount(me) c call flush(iout) - if (ib.eq.1) then +c if (ib.eq.1) then do j=1,nres do k=1,3 c(k,j)=allcart(k,j,i) c(k,j+nres)=allcart(k,j+nres,i) +C write(iout,*) "coord",i,j,k,allcart(k,j,i),c(k,j), +C & c(k,j+nres),allcart(k,j+nres,i) enddo enddo +C write(iout,*) "out of j loop" +C call flush(iout) do k=1,3 c(k,nres+1)=c(k,1) c(k,nres+nres)=c(k,nres) enddo +C write(iout,*) "after nres+nres",nss_all(i) +C call flush(iout) nss=nss_all(i) do j=1,nss ihpb(j)=ihpb_all(j,i) @@ -133,20 +145,31 @@ c call flush(iout) enddo call int_from_cart1(.false.) call etotal(energia(0),fT) + if (refstr) then +c write (structure(9:),'(bz,i6.6)') i + call TMscore_sub(rmsdev,gdt_ts_tb(i), + & gdt_ha_tb(i),tmscore_tb(i),Structure,.false.) +#ifdef DEBUG + write (iout,*) i,rmsdev,gdt_ts_tb(i),gdt_ha_tb(i), + & tmscore_tb(i) +#endif + endif totfree(i)=energia(0) + totfree_buf(i)=totfree(i) c write (iout,'(8f10.5)') ((c(l,k),l=1,3),k=1,nres) c write (iout,'(8f10.5)') ((c(l,k+nres),l=1,3),k=nnt,nct) -c call enerprint(energia(0),fT) c call pdbout(totfree(i),16,i) +c call flush(iout) +c#define DEBUG #ifdef DEBUG - write (iout,*) i," energia",(energia(j),j=0,19) - write (iout,*) "etot", etot - write (iout,*) "ft(6)", ft(6) + write (iout,*) "conformation", i + call enerprint(energia(0),fT) #endif +c#undef DEBUG do k=1,max_ene enetb(k,i)=energia(k) enddo - endif +c endif evdw=enetb(1,i) c write (iout,*) evdw etot=energia(0) @@ -205,44 +228,91 @@ c#endif write (iout,*) "evdw2", wscp, evdw2 write (iout,*) "welec", ft(1),welec,ees write (iout,*) "evdw1", wvdwpp,evdw1 - write (iout,*) "ebe" ebe,wang + write (iout,*) "ebe", ebe,wang #endif Fdimless(i)=beta_h(ib)*etot+entfac(ii) + Fdimless_buf(i)=Fdimless(i) totfree(i)=etot + totfree_buf(i)=totfree(i) #ifdef DEBUG write (iout,*) "fdim calc", i,ii,ib, & 1.0d0/(1.987d-3*beta_h(ib)),totfree(i), & entfac(ii),Fdimless(i) #endif enddo ! i + + do ijk=1,maxconf + entfac_buf(ijk)=entfac(ijk) + Fdimless_buf(ijk)=Fdimless(ijk) + enddo + do ijk=0,maxconf + totfree_buf(ijk)=totfree(ijk) + enddo + + +c scount_buf=scount(me) +c scount_buf2=scount(0) + +c entfac_buf(indstart(me)+1)=entfac(indstart(me)+1) + #ifdef MPI - call MPI_Gatherv(Fdimless(1),scount(me), +c WRITE (iout,*) "Wchodze do call MPI_Gatherv1 (Propabl)" + call MPI_Gatherv(Fdimless_buf(1),scount(me), & MPI_REAL,Fdimless(1), & scount(0),idispl(0),MPI_REAL,Master, & MPI_COMM_WORLD, IERROR) - call MPI_Gatherv(totfree(1),scount(me), +c WRITE (iout,*) "Wchodze do call MPI_Gatherv2 (Propabl)" + call MPI_Gatherv(totfree_buf(1),scount(me), & MPI_DOUBLE_PRECISION,totfree(1), & scount(0),idispl(0),MPI_DOUBLE_PRECISION,Master, & MPI_COMM_WORLD, IERROR) - call MPI_Gatherv(entfac(indstart(me)+1),scount(me), +c WRITE (iout,*) "Wchodze do call MPI_Gatherv3 (Propabl)" + call MPI_Gatherv(entfac_buf(indstart(me)+1),scount(me), & MPI_DOUBLE_PRECISION,entfac(1), & scount(0),idispl(0),MPI_DOUBLE_PRECISION,Master, & MPI_COMM_WORLD, IERROR) +c WRITE (iout,*) "Wychodze z call MPI_Gatherv (Propabl)" + if (refstr) then + do i=1,scount(me) + buffer(i)=gdt_ts_tb(i) + enddo + call MPI_Gatherv(buffer(1),scount(me),MPI_DOUBLE_PRECISION, + & gdt_ts_tb(1),scount(0),idispl(0),MPI_DOUBLE_PRECISION,Master, + & MPI_COMM_WORLD,IERROR) + do i=1,scount(me) + buffer(i)=gdt_ha_tb(i) + enddo + call MPI_Gatherv(buffer(1),scount(me),MPI_DOUBLE_PRECISION, + & gdt_ha_tb(1),scount(0),idispl(0),MPI_DOUBLE_PRECISION,Master, + & MPI_COMM_WORLD,IERROR) + do i=1,scount(me) + buffer(i)=tmscore_tb(i) + enddo + call MPI_Gatherv(buffer(1),scount(me),MPI_DOUBLE_PRECISION, + & tmscore_tb(1),scount(0),idispl(0),MPI_DOUBLE_PRECISION,Master, + & MPI_COMM_WORLD,IERROR) + endif if (me.eq.Master) then +c WRITE (iout,*) "me.eq.Master" #endif #ifdef DEBUG write (iout,*) "The FDIMLESS array before sorting" do i=1,ncon -c write (iout,*) i,fdimless(i) + write (iout,'(2i5,4f10.5)') i,list_conf(i),fdimless(i), + & gdt_ts_tb(i),gdt_ha_tb(i),tmscore_tb(i) enddo #endif +c WRITE (iout,*) "Wchodze do call mysort1" call mysort1(ncon,Fdimless,list_conf) +c WRITE (iout,*) "Wychodze z call mysort1" #ifdef DEBUG write (iout,*) "The FDIMLESS array after sorting" do i=1,ncon - write (iout,*) i,list_conf(i),fdimless(i) + write (iout,'(2i5,4f10.5)') i,list_conf(i),fdimless(i), + & gdt_ts_tb(i),gdt_ha_tb(i),tmscore_tb(i) enddo #endif +c WRITE (iout,*) "Wchodze do petli i=1,ncon totfree(i)=fdimless(i)" do i=1,ncon totfree(i)=fdimless(i) enddo