X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fsrc-HCD-5D%2Fenergy_p_new_barrier.F;h=ef198093918823fa0b772d2a791c0e4f9cd301b9;hb=b8a8a950fcfe48a76002af386e3f4de3b510760c;hp=2a588bdab2630f8ae5e8c30dd3b51de03726a50d;hpb=b6b1679cfe492bd5b73e03410f82917bd9c3aa7b;p=unres.git diff --git a/source/unres/src-HCD-5D/energy_p_new_barrier.F b/source/unres/src-HCD-5D/energy_p_new_barrier.F index 2a588bd..ef19809 100644 --- a/source/unres/src-HCD-5D/energy_p_new_barrier.F +++ b/source/unres/src-HCD-5D/energy_p_new_barrier.F @@ -30,6 +30,7 @@ c include 'COMMON.MD' include 'COMMON.SPLITELE' include 'COMMON.TORCNSTR' include 'COMMON.SAXS' + include 'COMMON.MD' double precision evdw,evdw1,evdw2,evdw2_14,ees,eel_loc, & eello_turn3,eello_turn4,edfadis,estr,ehpb,ebe,ethetacnstr, & escloc,etors,edihcnstr,etors_d,esccor,ecorr,ecorr5,ecorr6,eturn6, @@ -117,6 +118,12 @@ c call chainbuild_cart edfanei=0.0d0 edfabet=0.0d0 #endif + if (nfgtasks.gt.1) then + call MPI_Bcast(itime_mat,1,MPI_INT,king,FG_COMM,IERROR) + endif + if (mod(itime_mat,imatupdate).eq.0) call make_SCp_inter_list + if (mod(itime_mat,imatupdate).eq.0) call make_SCSC_inter_list + if (mod(itime_mat,imatupdate).eq.0) call make_pp_inter_list c print *,'Processor',myrank,' calling etotal ipot=',ipot c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct #else @@ -1460,14 +1467,17 @@ C #endif double precision gg(3) double precision evdw,evdwij - integer i,j,k,itypi,itypj,itypi1,num_conti,iint + integer i,j,k,itypi,itypj,itypi1,num_conti,iint,icont double precision xi,yi,zi,xj,yj,zj,rij,eps0ij,fac,e1,e2,rrij, & sigij,r0ij,rcut,sqrij,sss1,sssgrad1 double precision fcont,fprimcont double precision sscale,sscagrad c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 - do i=iatsc_s,iatsc_e +c do i=iatsc_s,iatsc_e + do icont=g_listscsc_start,g_listscsc_end + i=newcontlisti(icont) + j=newcontlistj(icont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -1479,10 +1489,10 @@ C Change 12/1/95 C C Calculate SC interaction energy. C - do iint=1,nint_gr(i) +c do iint=1,nint_gr(i) cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), cd & 'iend=',iend(i,iint) - do j=istart(i,iint),iend(i,iint) +c do j=istart(i,iint),iend(i,iint) itypj=iabs(itype(j)) if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi @@ -1587,8 +1597,8 @@ cd & i,j,(gacont(kk,num_conti,i),kk=1,3) endif endif #endif - enddo ! j - enddo ! iint +c enddo ! j +c enddo ! iint C Change 12/1/95 #ifdef FOURBODY num_cont(i)=num_conti @@ -1630,14 +1640,17 @@ C include 'COMMON.SPLITELE' double precision gg(3) double precision evdw,evdwij - integer i,j,k,itypi,itypj,itypi1,iint + integer i,j,k,itypi,itypj,itypi1,iint,icont double precision xi,yi,zi,xj,yj,zj,rij,eps0ij,fac,e1,e2,rrij, & fac_augm,e_augm,r_inv_ij,r_shift_inv,sss1,sssgrad1 logical scheck double precision sscale,sscagrad c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 - do i=iatsc_s,iatsc_e +c do i=iatsc_s,iatsc_e + do icont=g_listscsc_start,g_listscsc_end + i=newcontlisti(icont) + j=newcontlistj(icont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -1647,8 +1660,8 @@ c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon C C Calculate SC interaction energy. C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) +c do iint=1,nint_gr(i) +c do j=istart(i,iint),iend(i,iint) itypj=iabs(itype(j)) if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi @@ -1695,8 +1708,8 @@ cgrad do l=1,3 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) cgrad enddo cgrad enddo - enddo ! j - enddo ! iint +c enddo ! j +c enddo ! iint enddo ! i do i=1,nct do j=1,3 @@ -1727,7 +1740,7 @@ C integer icall common /srutu/ icall double precision evdw - integer itypi,itypj,itypi1,iint,ind + integer itypi,itypj,itypi1,iint,ind,icont double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,xi,yi,zi, & sss1,sssgrad1 double precision sscale,sscagrad @@ -1742,7 +1755,10 @@ c else lprn=.false. c endif ind=0 - do i=iatsc_s,iatsc_e +c do i=iatsc_s,iatsc_e + do icont=g_listscsc_start,g_listscsc_end + i=newcontlisti(icont) + j=newcontlistj(icont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -1757,8 +1773,8 @@ c dsci_inv=dsc_inv(itypi) C C Calculate SC interaction energy. C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) +c do iint=1,nint_gr(i) +c do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=iabs(itype(j)) if (itypj.eq.ntyp1) cycle @@ -1835,8 +1851,8 @@ C Calculate radial part of the gradient C Calculate the angular part of the gradient and sum add the contributions C to the appropriate components of the Cartesian gradient. call sc_grad - enddo ! j - enddo ! iint +! enddo ! j +! enddo ! iint enddo ! i c stop return @@ -1864,7 +1880,7 @@ C logical lprn integer xshift,yshift,zshift,subchap double precision evdw - integer itypi,itypj,itypi1,iint,ind + integer itypi,itypj,itypi1,iint,ind,icont double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,xi,yi,zi double precision fracinbuf,sslipi,evdwij_przed_tri,sig0ij, & sslipj,ssgradlipj,ssgradlipi,dist_init,xj_safe,yj_safe,zj_safe, @@ -1882,7 +1898,10 @@ C we have the original box) C do xshift=-1,1 C do yshift=-1,1 C do zshift=-1,1 - do i=iatsc_s,iatsc_e +c do i=iatsc_s,iatsc_e + do icont=g_listscsc_start,g_listscsc_end + i=newcontlisti(icont) + j=newcontlistj(icont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -1963,8 +1982,8 @@ c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi C C Calculate SC interaction energy. C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) +c do iint=1,nint_gr(i) +c do j=istart(i,iint),iend(i,iint) IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN c write(iout,*) "PRZED ZWYKLE", evdwij @@ -2211,8 +2230,8 @@ C Calculate angular part of the gradient. c call sc_grad_scale(sss) call sc_grad ENDIF ! dyn_ss - enddo ! j - enddo ! iint +c enddo ! j +c enddo ! iint enddo ! i C enddo ! zshift C enddo ! yshift @@ -2244,7 +2263,7 @@ C common /srutu/ icall logical lprn double precision evdw - integer itypi,itypj,itypi1,iint,ind + integer itypi,itypj,itypi1,iint,ind,icont double precision eps0ij,epsi,sigm,fac,e1,e2,rrij,r0ij, & xi,yi,zi,fac_augm,e_augm double precision fracinbuf,sslipi,evdwij_przed_tri,sig0ij, @@ -2257,7 +2276,10 @@ c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon lprn=.false. c if (icall.eq.0) lprn=.true. ind=0 - do i=iatsc_s,iatsc_e +c do i=iatsc_s,iatsc_e + do icont=g_listscsc_start,g_listscsc_end + i=newcontlisti(icont) + j=newcontlistj(icont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -2307,8 +2329,8 @@ c dsci_inv=dsc_inv(itypi) C C Calculate SC interaction energy. C - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) +c do iint=1,nint_gr(i) +c do j=istart(i,iint),iend(i,iint) ind=ind+1 itypj=iabs(itype(j)) if (itypj.eq.ntyp1) cycle @@ -2460,8 +2482,8 @@ C Calculate the radial part of the gradient C Calculate angular part of the gradient. c call sc_grad_scale(sss) call sc_grad - enddo ! j - enddo ! iint +c enddo ! j +c enddo ! iint enddo ! i end C----------------------------------------------------------------------------- @@ -2612,7 +2634,10 @@ c include 'COMMON.CONTACTS' dimension gg(3) cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct evdw=0.0D0 - do i=iatsc_s,iatsc_e +c do i=iatsc_s,iatsc_e + do icont=g_listscsc_start,g_listscsc_end + i=newcontlisti(icont) + j=newcontlistj(icont) itypi=iabs(itype(i)) if (itypi.eq.ntyp1) cycle itypi1=iabs(itype(i+1)) @@ -2622,10 +2647,10 @@ cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct C C Calculate SC interaction energy. C - do iint=1,nint_gr(i) +c do iint=1,nint_gr(i) cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), cd & 'iend=',iend(i,iint) - do j=istart(i,iint),iend(i,iint) +c do j=istart(i,iint),iend(i,iint) itypj=iabs(itype(j)) if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi @@ -2661,8 +2686,8 @@ cgrad do l=1,3 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l) cgrad enddo cgrad enddo - enddo ! j - enddo ! iint +c enddo ! j +c enddo ! iint enddo ! i return end @@ -3843,7 +3868,10 @@ c c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 c CTU KURWA - do i=iatel_s,iatel_e +c do i=iatel_s,iatel_e + do icont=g_listpp_start,g_listpp_end + i=newcontlistppi(icont) + j=newcontlistppj(icont) C do i=75,75 c if (i.le.1) cycle if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 @@ -3904,7 +3932,7 @@ c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) num_conti=num_cont_hb(i) #endif C I TU KURWA - do j=ielstart(i),ielend(i) +c do j=ielstart(i),ielend(i) C do j=16,17 C write (iout,*) i,j C if (j.le.1) cycle @@ -3917,7 +3945,7 @@ c & .or.itype(j+2).eq.ntyp1 c & .or.itype(j-1).eq.ntyp1 &) cycle call eelecij(i,j,ees,evdw1,eel_loc) - enddo ! j +c enddo ! j #ifdef FOURBODY num_cont_hb(i)=num_conti #endif @@ -5546,7 +5574,10 @@ cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e C do xshift=-1,1 C do yshift=-1,1 C do zshift=-1,1 - do i=iatscp_s,iatscp_e +c do i=iatscp_s,iatscp_e + do icont=g_listscp_start,g_listscp_end + i=newcontlistscpi(icont) + j=newcontlistscpj(icont) if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle iteli=itel(i) xi=0.5D0*(c(1,i)+c(1,i+1)) @@ -5586,9 +5617,9 @@ c endif C xi=xi+xshift*boxxsize C yi=yi+yshift*boxysize C zi=zi+zshift*boxzsize - do iint=1,nscp_gr(i) +c do iint=1,nscp_gr(i) - do j=iscpstart(i,iint),iscpend(i,iint) +c do j=iscpstart(i,iint),iscpend(i,iint) if (itype(j).eq.ntyp1) cycle itypj=iabs(itype(j)) C Uncomment following three lines for SC-p interactions @@ -5711,9 +5742,9 @@ cgrad enddo gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k) gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) enddo - enddo +c enddo - enddo ! iint +c enddo ! iint enddo ! i C enddo !zshift C enddo !yshift @@ -5741,7 +5772,7 @@ C include 'COMMON.SPLITELE' integer xshift,yshift,zshift double precision ggg(3) - integer i,iint,j,k,iteli,itypj,subchap + integer i,iint,j,k,iteli,itypj,subchap,icont double precision xi,yi,zi,xj,yj,zj,rrij,sss1,sssgrad1, & fac,e1,e2,rij double precision evdw2,evdw2_14,evdwij @@ -5757,7 +5788,10 @@ C do xshift=-1,1 C do yshift=-1,1 C do zshift=-1,1 if (energy_dec) write (iout,*) "escp:",r_cut_int,rlamb - do i=iatscp_s,iatscp_e +c do i=iatscp_s,iatscp_e + do icont=g_listscp_start,g_listscp_end + i=newcontlistscpi(icont) + j=newcontlistscpj(icont) if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle iteli=itel(i) xi=0.5D0*(c(1,i)+c(1,i+1)) @@ -5800,9 +5834,9 @@ c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or. c & (zi.lt.((zshift-0.5d0)*boxzsize))) then c go to 136 c endif - do iint=1,nscp_gr(i) +c do iint=1,nscp_gr(i) - do j=iscpstart(i,iint),iscpend(i,iint) +c do j=iscpstart(i,iint),iscpend(i,iint) itypj=iabs(itype(j)) if (itypj.eq.ntyp1) cycle C Uncomment following three lines for SC-p interactions @@ -5937,9 +5971,9 @@ cgrad enddo gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k) enddo c endif !endif for sscale cutoff - enddo ! j +c enddo ! j - enddo ! iint +c enddo ! iint enddo ! i c enddo !zshift c enddo !yshift