--- /dev/null
+ subroutine probabl(ib,nlist,ncon,*)
+! construct the conformational ensembles at REMD temperatures
+ implicit none
+ include "DIMENSIONS"
+ include "sizesclu.dat"
+#ifdef MPI
+ include "mpif.h"
+ include "COMMON.MPI"
+ integer ierror,errcode,status(MPI_STATUS_SIZE)
+#endif
+ include "COMMON.IOUNITS"
+ include "COMMON.FREE"
+ include "COMMON.FFIELD"
+ include "COMMON.INTERACT"
+ include "COMMON.SBRIDGE"
+ include "COMMON.CHAIN"
+ include "COMMON.CLUSTER"
+ real*4 csingle(3,maxres2)
+ double precision fT(5),fTprim(5),fTbis(5),quot,quotl1,quotl,kfacl,
+ & eprim,ebis,temper,kfac/2.4d0/,T0/300.0d0/
+ double precision etot,evdw,evdw2,ees,evdw1,ebe,etors,escloc,
+ & ehpb,ecorr,ecorr5,ecorr6,eello_turn4,eello_turn3,
+ & eturn6,eel_loc,edihcnstr,etors_d,estr,evdw2_14,esccor
+ integer i,ii,ik,iproc,iscor,j,k,l,ib,nlist,ncon
+ double precision qfree,sumprob,eini,efree,rmsdev
+ character*80 bxname
+ character*2 licz1
+ character*5 ctemper
+ integer ilen
+ external ilen
+ real*4 Fdimless(maxconf)
+ double precision energia(0:max_ene)
+ do i=1,ncon
+ list_conf(i)=i
+ enddo
+c do i=1,ncon
+c write (iout,*) i,list_conf(i)
+c enddo
+#ifdef MPI
+ write (iout,*) me," indstart",indstart(me)," indend",indend(me)
+ call daread_ccoords(indstart(me),indend(me))
+#endif
+c write (iout,*) "ncon",ncon
+ 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)
+c quotl=1.0d0
+c kfacl=1.0d0
+c do l=1,5
+c quotl1=quotl
+c quotl=quotl*quot
+c kfacl=kfacl*kfac
+c fT(l)=kfacl/(kfacl-1.0d0+quotl)
+c enddo
+ if (rescale_mode.eq.1) then
+ quot=1.0d0/(T0*beta_h(ib)*1.987D-3)
+ quotl=1.0d0
+ kfacl=1.0d0
+ do l=1,5
+ quotl1=quotl
+ quotl=quotl*quot
+ kfacl=kfacl*kfac
+ fT(l)=kfacl/(kfacl-1.0d0+quotl)
+ enddo
+ else if (rescale_mode.eq.2) then
+ quot=1.0d0/(T0*beta_h(ib)*1.987D-3)
+ quotl=1.0d0
+ do l=1,5
+ quotl=quotl*quot
+ fT(l)=1.12692801104297249644d0/
+ & dlog(dexp(quotl)+dexp(-quotl))
+ enddo
+c write (iout,*) 1.0d0/(beta_h(ib)*1.987D-3),ft
+ call flush(iout)
+ endif
+
+#ifdef MPI
+ do i=1,scount(me)
+ ii=i+indstart(me)-1
+#else
+ do i=1,ncon
+ ii=i
+#endif
+c write (iout,*) "i",i," ii",ii
+ call flush(iout)
+ 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)
+ enddo
+ enddo
+ do k=1,3
+ c(k,nres+1)=c(k,1)
+ c(k,nres+nres)=c(k,nres)
+ enddo
+ nss=nss_all(i)
+ do j=1,nss
+ ihpb(j)=ihpb_all(j,i)
+ jhpb(j)=jhpb_all(j,i)
+ enddo
+ call int_from_cart1(.false.)
+ call etotal(energia(0),fT)
+ totfree(i)=energia(0)
+#define DEBUG
+#ifdef DEBUG
+c write (iout,*) i," energia",(energia(j),j=0,21)
+ call enerprint(energia(0),ft)
+ call flush(iout)
+#endif
+#undef DEBUG
+ do k=1,max_ene
+ enetb(k,i)=energia(k)
+ enddo
+ endif
+ evdw=enetb(1,i)
+#ifdef SCP14
+ evdw2_14=enetb(17,i)
+ evdw2=enetb(2,i)+evdw2_14
+#else
+ evdw2=enetb(2,i)
+ evdw2_14=0.0d0
+#endif
+#ifdef SPLITELE
+ ees=enetb(3,i)
+ evdw1=enetb(16,i)
+#else
+ ees=enetb(3,i)
+ evdw1=0.0d0
+#endif
+ ecorr=enetb(4,i)
+ ecorr5=enetb(5,i)
+ ecorr6=enetb(6,i)
+ eel_loc=enetb(7,i)
+ eello_turn3=enetb(8,i)
+ eello_turn4=enetb(9,i)
+ eturn6=enetb(10,i)
+ ebe=enetb(11,i)
+ escloc=enetb(12,i)
+ etors=enetb(13,i)
+ etors_d=enetb(14,i)
+ ehpb=enetb(15,i)
+ estr=enetb(18,i)
+ esccor=enetb(19,i)
+ edihcnstr=enetb(20,i)
+#ifdef SPLITELE
+ etot=wsc*evdw+wscp*evdw2+ft(1)*welec*ees+wvdwpp*evdw1
+ & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc
+ & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5
+ & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4
+ & +ft(2)*wturn3*eello_turn3
+ & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc
+ & +edihcnstr+ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor
+ & +wbond*estr
+#else
+ etot=wsc*evdw+wscp*evdw2+ft(1)*welec*(ees+evdw1)
+ & +wang*ebe+ft(1)*wtor*etors+wscloc*escloc
+ & +wstrain*ehpb+nss*ebr+ft(3)*wcorr*ecorr+ft(4)*wcorr5*ecorr5
+ & +ft(5)*wcorr6*ecorr6+ft(3)*wturn4*eello_turn4
+ & +ft(2)*wturn3*eello_turn3
+ & +ft(5)*wturn6*eturn6+ft(2)*wel_loc*eel_loc+edihcnstr
+ & +ft(2)*wtor_d*etors_d+ft(1)*wsccor*esccor
+ & +wbond*estr
+#endif
+ Fdimless(i)=beta_h(ib)*etot+entfac(ii)
+ totfree(i)=etot
+#ifdef DEBUG
+ write (iout,*) i,ii,ib,
+ & 1.0d0/(1.987d-3*beta_h(ib)),totfree(i),
+ & entfac(ii),Fdimless(i)
+#endif
+ enddo ! i
+#ifdef MPI
+ call MPI_Gatherv(Fdimless(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),
+ & 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),
+ & MPI_DOUBLE_PRECISION,entfac(1),
+ & scount(0),idispl(0),MPI_DOUBLE_PRECISION,Master,
+ & MPI_COMM_WORLD, IERROR)
+ if (me.eq.Master) then
+#endif
+#ifdef DEBUG
+ write (iout,*) "The FDIMLESS array before sorting"
+ do i=1,ncon
+ write (iout,*) i,fdimless(i)
+ enddo
+#endif
+ call mysort1(ncon,Fdimless,list_conf)
+#ifdef DEBUG
+ write (iout,*) "The FDIMLESS array after sorting"
+ do i=1,ncon
+ write (iout,*) i,list_conf(i),fdimless(i)
+ enddo
+#endif
+ do i=1,ncon
+ totfree(i)=fdimless(i)
+ enddo
+ qfree=0.0d0
+ do i=1,ncon
+ qfree=qfree+exp(-fdimless(i)+fdimless(1))
+ enddo
+c write (iout,*) "qfree",qfree
+ nlist=1
+ sumprob=0.0
+ do i=1,min0(ncon,maxstr_proc)-1
+ sumprob=sumprob+exp(-fdimless(i)+fdimless(1))/qfree
+#ifdef DEBUG
+ write (iout,*) i,ib,beta_h(ib),
+ & 1.0d0/(1.987d-3*beta_h(ib)),list_conf(i),
+ & totfree(list_conf(i)),
+ & -entfac(list_conf(i)),fdimless(i),sumprob
+#endif
+ if (sumprob.gt.prob_limit) goto 122
+c if (sumprob.gt.1.00d0) goto 122
+ nlist=nlist+1
+ enddo
+ 122 continue
+#ifdef MPI
+ endif
+ call MPI_Bcast(nlist, 1, MPI_INTEGER, Master, MPI_COMM_WORLD,
+ & IERROR)
+ call MPI_Bcast(list_conf,nlist,MPI_INTEGER,Master,MPI_COMM_WORLD,
+ & IERROR)
+c do iproc=0,nprocs
+c write (iout,*) "iproc",iproc," indstart",indstart(iproc),
+c & " indend",indend(iproc)
+c enddo
+ write (iout,*) "nlist",nlist
+#endif
+ return
+ end
+!--------------------------------------------------
+ subroutine mysort1(n, x, ipermut)
+ implicit none
+ integer i,j,imax,ipm,n
+ real x(n)
+ integer ipermut(n)
+ real xtemp
+ do i=1,n
+ xtemp=x(i)
+ imax=i
+ do j=i+1,n
+ if (x(j).lt.xtemp) then
+ imax=j
+ xtemp=x(j)
+ endif
+ enddo
+ x(imax)=x(i)
+ x(i)=xtemp
+ ipm=ipermut(imax)
+ ipermut(imax)=ipermut(i)
+ ipermut(i)=ipm
+ enddo
+ return
+ end
projects / unres.git / blobdiff