1,9c1,149 < C----------------------------------------------------------------------- < double precision function sscale(r) < double precision r,gamm < include "COMMON.SPLITELE" < if(r.lt.r_cut-rlamb) then < sscale=1.0d0 < else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then < gamm=(r-(r_cut-rlamb))/rlamb < sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0) --- > subroutine etotal(energia) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > #ifndef ISNAN > external proc_proc > #ifdef WINPGI > cMS$ATTRIBUTES C :: proc_proc > #endif > #endif > #ifdef MPI > include "mpif.h" > double precision weights_(n_ene) > #endif > include 'COMMON.SETUP' > include 'COMMON.IOUNITS' > double precision energia(0:n_ene) > include 'COMMON.LOCAL' > include 'COMMON.FFIELD' > include 'COMMON.DERIV' > include 'COMMON.INTERACT' > include 'COMMON.SBRIDGE' > include 'COMMON.CHAIN' > include 'COMMON.VAR' > include 'COMMON.MD' > include 'COMMON.CONTROL' > include 'COMMON.TIME1' > if (modecalc.eq.12.or.modecalc.eq.14) then > #ifdef MPI > if (fg_rank.eq.0) call int_from_cart1(.false.) > #else > call int_from_cart1(.false.) > #endif > endif > #ifdef MPI > c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank, > c & " nfgtasks",nfgtasks > if (nfgtasks.gt.1) then > time00=MPI_Wtime() > C FG slaves call the following matching MPI_Bcast in ERGASTULUM > if (fg_rank.eq.0) then > call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR) > c print *,"Processor",myrank," BROADCAST iorder" > C FG master sets up the WEIGHTS_ array which will be broadcast to the > C FG slaves as WEIGHTS array. > weights_(1)=wsc > weights_(2)=wscp > weights_(3)=welec > weights_(4)=wcorr > weights_(5)=wcorr5 > weights_(6)=wcorr6 > weights_(7)=wel_loc > weights_(8)=wturn3 > weights_(9)=wturn4 > weights_(10)=wturn6 > weights_(11)=wang > weights_(12)=wscloc > weights_(13)=wtor > weights_(14)=wtor_d > weights_(15)=wstrain > weights_(16)=wvdwpp > weights_(17)=wbond > weights_(18)=scal14 > weights_(21)=wsccor > C FG Master broadcasts the WEIGHTS_ array > call MPI_Bcast(weights_(1),n_ene, > & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) > else > C FG slaves receive the WEIGHTS array > call MPI_Bcast(weights(1),n_ene, > & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) > endif > c print *,"Processor",myrank," BROADCAST weights" > call MPI_Bcast(c(1,1),maxres6,MPI_DOUBLE_PRECISION, > & king,FG_COMM,IERR) > c print *,"Processor",myrank," BROADCAST c" > call MPI_Bcast(dc(1,1),maxres6,MPI_DOUBLE_PRECISION, > & king,FG_COMM,IERR) > c print *,"Processor",myrank," BROADCAST dc" > call MPI_Bcast(dc_norm(1,1),maxres6,MPI_DOUBLE_PRECISION, > & king,FG_COMM,IERR) > c print *,"Processor",myrank," BROADCAST dc_norm" > call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION, > & king,FG_COMM,IERR) > c print *,"Processor",myrank," BROADCAST theta" > call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION, > & king,FG_COMM,IERR) > c print *,"Processor",myrank," BROADCAST phi" > call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION, > & king,FG_COMM,IERR) > c print *,"Processor",myrank," BROADCAST alph" > call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION, > & king,FG_COMM,IERR) > c print *,"Processor",myrank," BROADCAST omeg" > call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION, > & king,FG_COMM,IERR) > c print *,"Processor",myrank," BROADCAST vbld" > call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION, > & king,FG_COMM,IERR) > time_Bcast=time_Bcast+MPI_Wtime()-time00 > c print *,"Processor",myrank," BROADCAST vbld_inv" > endif > c print *,'Processor',myrank,' calling etotal ipot=',ipot > c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct > #endif > C > C Compute the side-chain and electrostatic interaction energy > C > goto (101,102,103,104,105,106) ipot > C Lennard-Jones potential. > 101 call elj(evdw) > cd print '(a)','Exit ELJ' > goto 107 > C Lennard-Jones-Kihara potential (shifted). > 102 call eljk(evdw) > goto 107 > C Berne-Pechukas potential (dilated LJ, angular dependence). > 103 call ebp(evdw) > goto 107 > C Gay-Berne potential (shifted LJ, angular dependence). > 104 call egb(evdw) > goto 107 > C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). > 105 call egbv(evdw) > goto 107 > C Soft-sphere potential > 106 call e_softsphere(evdw) > C > C Calculate electrostatic (H-bonding) energy of the main chain. > C > 107 continue > c print *,"Processor",myrank," computed USCSC" > call vec_and_deriv > c print *,"Processor",myrank," left VEC_AND_DERIV" > if (ipot.lt.6) then > #ifdef SPLITELE > if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. > & wturn3.gt.0d0.or.wturn4.gt.0d0) then > #else > if (welec.gt.0d0.or.wel_loc.gt.0d0.or. > & wturn3.gt.0d0.or.wturn4.gt.0d0) then > #endif > call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) > else > ees=0 > evdw1=0 > eel_loc=0 > eello_turn3=0 > eello_turn4=0 > endif 11c151,153 < sscale=0d0 --- > c write (iout,*) "Soft-spheer ELEC potential" > call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, > & eello_turn4) 13,16c155 < return < end < C----------------------------------------------------------------------- < subroutine elj_long(evdw) --- > c print *,"Processor",myrank," computed UELEC" 18,19c157,261 < C This subroutine calculates the interaction energy of nonbonded side chains < C assuming the LJ potential of interaction. --- > C Calculate excluded-volume interaction energy between peptide groups > C and side chains. > C > if (ipot.lt.6) then > if(wscp.gt.0d0) then > call escp(evdw2,evdw2_14) > else > evdw2=0 > evdw2_14=0 > endif > else > c write (iout,*) "Soft-sphere SCP potential" > call escp_soft_sphere(evdw2,evdw2_14) > endif > c > c Calculate the bond-stretching energy > c > call ebond(estr) > C > C Calculate the disulfide-bridge and other energy and the contributions > C from other distance constraints. > cd print *,'Calling EHPB' > call edis(ehpb) > cd print *,'EHPB exitted succesfully.' > C > C Calculate the virtual-bond-angle energy. > C > if (wang.gt.0d0) then > call ebend(ebe) > else > ebe=0 > endif > c print *,"Processor",myrank," computed UB" > C > C Calculate the SC local energy. > C > call esc(escloc) > c print *,"Processor",myrank," computed USC" > C > C Calculate the virtual-bond torsional energy. > C > cd print *,'nterm=',nterm > if (wtor.gt.0) then > call etor(etors,edihcnstr) > else > etors=0 > edihcnstr=0 > endif > c print *,"Processor",myrank," computed Utor" > C > C 6/23/01 Calculate double-torsional energy > C > if (wtor_d.gt.0) then > call etor_d(etors_d) > else > etors_d=0 > endif > c print *,"Processor",myrank," computed Utord" > C > C 21/5/07 Calculate local sicdechain correlation energy > C > if (wsccor.gt.0.0d0) then > call eback_sc_corr(esccor) > else > esccor=0.0d0 > endif > c print *,"Processor",myrank," computed Usccorr" > C > C 12/1/95 Multi-body terms > C > n_corr=0 > n_corr1=0 > if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 > & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then > call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1) > c write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1, > c &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6 > else > ecorr=0 > ecorr5=0 > ecorr6=0 > eturn6=0 > endif > if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then > call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) > else > ecorr=0 > ecorr5=0 > ecorr6=0 > eturn6=0 > endif > c print *,"Processor",myrank," computed Ucorr" > C > C If performing constraint dynamics, call the constraint energy > C after the equilibration time > if(usampl.and.totT.gt.eq_time) then > call EconstrQ > call Econstr_back > else > Uconst=0.0d0 > Uconst_back=0.0d0 > endif > c print *,"Processor",myrank," computed Uconstr" > c > C Sum the energies 20a263,300 > energia(1)=evdw > #ifdef SCP14 > energia(2)=evdw2-evdw2_14 > energia(18)=evdw2_14 > #else > energia(2)=evdw2 > energia(18)=0.0d0 > #endif > #ifdef SPLITELE > energia(3)=ees > energia(16)=evdw1 > #else > energia(3)=ees+evdw1 > energia(16)=0.0d0 > #endif > energia(4)=ecorr > energia(5)=ecorr5 > energia(6)=ecorr6 > energia(7)=eel_loc > energia(8)=eello_turn3 > energia(9)=eello_turn4 > energia(10)=eturn6 > energia(11)=ebe > energia(12)=escloc > energia(13)=etors > energia(14)=etors_d > energia(15)=ehpb > energia(19)=edihcnstr > energia(17)=estr > energia(20)=Uconst+Uconst_back > energia(21)=esccor > c print *," Processor",myrank," calls SUM_ENERGY" > call sum_energy(energia,.true.) > c print *," Processor",myrank," left SUM_ENERGY" > return > end > c------------------------------------------------------------------------------- > subroutine sum_energy(energia,reduce) 23,27c303,315 < parameter (accur=1.0d-10) < include 'COMMON.GEO' < include 'COMMON.VAR' < include 'COMMON.LOCAL' < include 'COMMON.CHAIN' --- > #ifndef ISNAN > external proc_proc > #ifdef WINPGI > cMS$ATTRIBUTES C :: proc_proc > #endif > #endif > #ifdef MPI > include "mpif.h" > #endif > include 'COMMON.SETUP' > include 'COMMON.IOUNITS' > double precision energia(0:n_ene),enebuff(0:n_ene+1) > include 'COMMON.FFIELD' 30d317 < include 'COMMON.TORSION' 32c319,428 < include 'COMMON.NAMES' --- > include 'COMMON.CHAIN' > include 'COMMON.VAR' > include 'COMMON.CONTROL' > include 'COMMON.TIME1' > logical reduce > #ifdef MPI > if (nfgtasks.gt.1 .and. reduce) then > #ifdef DEBUG > write (iout,*) "energies before REDUCE" > call enerprint(energia) > call flush(iout) > #endif > do i=0,n_ene > enebuff(i)=energia(i) > enddo > time00=MPI_Wtime() > call MPI_Reduce(enebuff(0),energia(0),n_ene+1, > & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) > #ifdef DEBUG > write (iout,*) "energies after REDUCE" > call enerprint(energia) > call flush(iout) > #endif > time_Reduce=time_Reduce+MPI_Wtime()-time00 > endif > if (fg_rank.eq.0) then > #endif > evdw=energia(1) > #ifdef SCP14 > evdw2=energia(2)+energia(18) > evdw2_14=energia(18) > #else > evdw2=energia(2) > #endif > #ifdef SPLITELE > ees=energia(3) > evdw1=energia(16) > #else > ees=energia(3) > evdw1=0.0d0 > #endif > ecorr=energia(4) > ecorr5=energia(5) > ecorr6=energia(6) > eel_loc=energia(7) > eello_turn3=energia(8) > eello_turn4=energia(9) > eturn6=energia(10) > ebe=energia(11) > escloc=energia(12) > etors=energia(13) > etors_d=energia(14) > ehpb=energia(15) > edihcnstr=energia(19) > estr=energia(17) > Uconst=energia(20) > esccor=energia(21) > #ifdef SPLITELE > etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 > & +wang*ebe+wtor*etors+wscloc*escloc > & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5 > & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 > & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d > & +wbond*estr+Uconst+wsccor*esccor > #else > etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) > & +wang*ebe+wtor*etors+wscloc*escloc > & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5 > & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 > & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d > & +wbond*estr+Uconst+wsccor*esccor > #endif > energia(0)=etot > c detecting NaNQ > #ifdef ISNAN > #ifdef AIX > if (isnan(etot).ne.0) energia(0)=1.0d+99 > #else > if (isnan(etot)) energia(0)=1.0d+99 > #endif > #else > i=0 > #ifdef WINPGI > idumm=proc_proc(etot,i) > #else > call proc_proc(etot,i) > #endif > if(i.eq.1)energia(0)=1.0d+99 > #endif > #ifdef MPI > endif > #endif > return > end > c------------------------------------------------------------------------------- > subroutine sum_gradient > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > #ifndef ISNAN > external proc_proc > #ifdef WINPGI > cMS$ATTRIBUTES C :: proc_proc > #endif > #endif > #ifdef MPI > include 'mpif.h' > double precision gradbufc(3,maxres),gradbufx(3,maxres), > & glocbuf(4*maxres) > #endif > include 'COMMON.SETUP' 34,45c430,438 < include 'COMMON.CONTACTS' < dimension gg(3) < c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon < evdw=0.0D0 < do i=iatsc_s,iatsc_e < itypi=itype(i) < itypi1=itype(i+1) < xi=c(1,nres+i) < yi=c(2,nres+i) < zi=c(3,nres+i) < C < C Calculate SC interaction energy. --- > include 'COMMON.FFIELD' > include 'COMMON.DERIV' > include 'COMMON.INTERACT' > include 'COMMON.SBRIDGE' > include 'COMMON.CHAIN' > include 'COMMON.VAR' > include 'COMMON.CONTROL' > include 'COMMON.TIME1' > include 'COMMON.MAXGRAD' 47,65c440 < 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) < itypj=itype(j) < xj=c(1,nres+j)-xi < yj=c(2,nres+j)-yi < zj=c(3,nres+j)-zi < rij=xj*xj+yj*yj+zj*zj < sss=sscale(dsqrt(rij)/sigma(itypi,itypj)) < if (sss.lt.1.0d0) then < rrij=1.0D0/rij < fac=rrij**expon2 < e1=fac*fac*aa(itypi,itypj) < e2=fac*bb(itypi,itypj) < evdwij=e1+e2 < evdw=evdw+(1.0d0-sss)*evdwij < C < C Calculate the components of the gradient in DC and X --- > C Sum up the components of the Cartesian gradient. 67,83c442 < fac=-rrij*(e1+evdwij)*(1.0d0-sss) < gg(1)=xj*fac < gg(2)=yj*fac < gg(3)=zj*fac < do k=1,3 < gvdwx(k,i)=gvdwx(k,i)-gg(k) < gvdwx(k,j)=gvdwx(k,j)+gg(k) < enddo < do k=i,j-1 < do l=1,3 < gvdwc(l,k)=gvdwc(l,k)+gg(l) < enddo < enddo < endif < enddo ! j < enddo ! iint < enddo ! i --- > #ifdef SPLITELE 86,87c445,484 < gvdwc(j,i)=expon*gvdwc(j,i) < gvdwx(j,i)=expon*gvdwx(j,i) --- > gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+ > & welec*gelc(j,i)+wvdwpp*gvdwpp(j,i)+ > & wbond*gradb(j,i)+ > & wstrain*ghpbc(j,i)+ > & wcorr*gradcorr(j,i)+ > & wel_loc*gel_loc(j,i)+ > & wturn3*gcorr3_turn(j,i)+ > & wturn4*gcorr4_turn(j,i)+ > & wcorr5*gradcorr5(j,i)+ > & wcorr6*gradcorr6(j,i)+ > & wturn6*gcorr6_turn(j,i)+ > & wsccor*gsccorc(j,i) > & +wscloc*gscloc(j,i) > gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ > & wbond*gradbx(j,i)+ > & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ > & wsccor*gsccorx(j,i) > & +wscloc*gsclocx(j,i) > enddo > enddo > #else > do i=1,nct > do j=1,3 > gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+ > & welec*gelc(j,i)+wstrain*ghpbc(j,i)+ > & wbond*gradb(j,i)+ > & wcorr*gradcorr(j,i)+ > & wel_loc*gel_loc(j,i)+ > & wturn3*gcorr3_turn(j,i)+ > & wturn4*gcorr4_turn(j,i)+ > & wcorr5*gradcorr5(j,i)+ > & wcorr6*gradcorr6(j,i)+ > & wturn6*gcorr6_turn(j,i)+ > & wsccor*gsccorc(j,i) > & +wscloc*gscloc(j,i) > gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ > & wbond*gradbx(j,i)+ > & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ > & wsccor*gsccorx(j,i) > & +wscloc*gsclocx(j,i) 88a486,496 > enddo > #endif > do i=1,nres-3 > gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) > & +wcorr5*g_corr5_loc(i) > & +wcorr6*g_corr6_loc(i) > & +wturn4*gel_loc_turn4(i) > & +wturn3*gel_loc_turn3(i) > & +wturn6*gel_loc_turn6(i) > & +wel_loc*gel_loc_loc(i) > & +wsccor*gsccor_loc(i) 90,98c498,790 < C****************************************************************************** < C < C N O T E !!! < C < C To save time, the factor of EXPON has been extracted from ALL components < C of GVDWC and GRADX. Remember to multiply them by this factor before further < C use! < C < C****************************************************************************** --- > #ifdef MPI > if (nfgtasks.gt.1) then > do j=1,3 > do i=1,nres > gradbufc(j,i)=gradc(j,i,icg) > gradbufx(j,i)=gradx(j,i,icg) > enddo > enddo > do i=1,4*nres > glocbuf(i)=gloc(i,icg) > enddo > C FG slaves call the following matching MPI_Bcast in ERGASTULUM > if (fg_rank.eq.0) call MPI_Bcast(1,1,MPI_INTEGER, > & king,FG_COMM,IERROR) > time00=MPI_Wtime() > call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres, > & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) > call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres, > & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) > call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres, > & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) > time_reduce=time_reduce+MPI_Wtime()-time00 > endif > #endif > if (gnorm_check) then > c > c Compute the maximum elements of the gradient > c > gvdwc_max=0.0d0 > gvdwc_scp_max=0.0d0 > gelc_max=0.0d0 > gvdwpp_max=0.0d0 > gradb_max=0.0d0 > ghpbc_max=0.0d0 > gradcorr_max=0.0d0 > gel_loc_max=0.0d0 > gcorr3_turn_max=0.0d0 > gcorr4_turn_max=0.0d0 > gradcorr5_max=0.0d0 > gradcorr6_max=0.0d0 > gcorr6_turn_max=0.0d0 > gsccorc_max=0.0d0 > gscloc_max=0.0d0 > gvdwx_max=0.0d0 > gradx_scp_max=0.0d0 > ghpbx_max=0.0d0 > gradxorr_max=0.0d0 > gsccorx_max=0.0d0 > gsclocx_max=0.0d0 > do i=1,nct > gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i))) > if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm > gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i))) > if (gvdwc_scp_norm.gt.gvdwc_scp_max) > & gvdwc_scp_max=gvdwc_scp_norm > gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i))) > if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm > gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i))) > if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm > gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i))) > if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm > ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i))) > if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm > gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i))) > if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm > gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i))) > if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm > gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i), > & gcorr3_turn(1,i))) > if (gcorr3_turn_norm.gt.gcorr3_turn_max) > & gcorr3_turn_max=gcorr3_turn_norm > gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i), > & gcorr4_turn(1,i))) > if (gcorr4_turn_norm.gt.gcorr4_turn_max) > & gcorr4_turn_max=gcorr4_turn_norm > gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i))) > if (gradcorr5_norm.gt.gradcorr5_max) > & gradcorr5_max=gradcorr5_norm > gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i))) > if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm > gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i), > & gcorr6_turn(1,i))) > if (gcorr6_turn_norm.gt.gcorr6_turn_max) > & gcorr6_turn_max=gcorr6_turn_norm > gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i))) > if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm > gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i))) > if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm > gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i))) > if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm > gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i))) > if (gradx_scp_norm.gt.gradx_scp_max) > & gradx_scp_max=gradx_scp_norm > ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i))) > if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm > gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i))) > if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm > gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i))) > if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm > gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i))) > if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm > enddo > if (gradout) then > #ifdef AIX > open(istat,file=statname,position="append") > #else > open(istat,file=statname,access="append") > #endif > write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max, > & gelc_max,gvdwpp_max,gradb_max,ghpbc_max, > & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max, > & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max, > & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max, > & gsccorx_max,gsclocx_max > close(istat) > if (gvdwc_max.gt.1.0d4) then > write (iout,*) "gvdwc gvdwx gradb gradbx" > do i=nnt,nct > write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i), > & gradb(j,i),gradbx(j,i),j=1,3) > enddo > call pdbout(0.0d0,'cipiszcze',iout) > call flush(iout) > endif > endif > endif > #ifdef DEBUG > write (iout,*) "gradc gradx gloc" > do i=1,nres > write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') > & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg) > enddo > #endif > return > end > c------------------------------------------------------------------------------- > subroutine rescale_weights(t_bath) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.IOUNITS' > include 'COMMON.FFIELD' > include 'COMMON.SBRIDGE' > double precision kfac /2.4d0/ > double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/ > c facT=temp0/t_bath > c facT=2*temp0/(t_bath+temp0) > if (rescale_mode.eq.0) then > facT=1.0d0 > facT2=1.0d0 > facT3=1.0d0 > facT4=1.0d0 > facT5=1.0d0 > else if (rescale_mode.eq.1) then > facT=kfac/(kfac-1.0d0+t_bath/temp0) > facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2) > facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3) > facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4) > facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5) > else if (rescale_mode.eq.2) then > x=t_bath/temp0 > x2=x*x > x3=x2*x > x4=x3*x > x5=x4*x > facT=licznik/dlog(dexp(x)+dexp(-x)) > facT2=licznik/dlog(dexp(x2)+dexp(-x2)) > facT3=licznik/dlog(dexp(x3)+dexp(-x3)) > facT4=licznik/dlog(dexp(x4)+dexp(-x4)) > facT5=licznik/dlog(dexp(x5)+dexp(-x5)) > else > write (iout,*) "Wrong RESCALE_MODE",rescale_mode > write (*,*) "Wrong RESCALE_MODE",rescale_mode > #ifdef MPI > call MPI_Finalize(MPI_COMM_WORLD,IERROR) > #endif > stop 555 > endif > welec=weights(3)*fact > wcorr=weights(4)*fact3 > wcorr5=weights(5)*fact4 > wcorr6=weights(6)*fact5 > wel_loc=weights(7)*fact2 > wturn3=weights(8)*fact2 > wturn4=weights(9)*fact3 > wturn6=weights(10)*fact5 > wtor=weights(13)*fact > wtor_d=weights(14)*fact2 > wsccor=weights(21)*fact > > return > end > C------------------------------------------------------------------------ > subroutine enerprint(energia) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.IOUNITS' > include 'COMMON.FFIELD' > include 'COMMON.SBRIDGE' > include 'COMMON.MD' > double precision energia(0:n_ene) > etot=energia(0) > evdw=energia(1) > evdw2=energia(2) > #ifdef SCP14 > evdw2=energia(2)+energia(18) > #else > evdw2=energia(2) > #endif > ees=energia(3) > #ifdef SPLITELE > evdw1=energia(16) > #endif > ecorr=energia(4) > ecorr5=energia(5) > ecorr6=energia(6) > eel_loc=energia(7) > eello_turn3=energia(8) > eello_turn4=energia(9) > eello_turn6=energia(10) > ebe=energia(11) > escloc=energia(12) > etors=energia(13) > etors_d=energia(14) > ehpb=energia(15) > edihcnstr=energia(19) > estr=energia(17) > Uconst=energia(20) > esccor=energia(21) > #ifdef SPLITELE > write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp, > & estr,wbond,ebe,wang, > & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, > & ecorr,wcorr, > & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, > & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor, > & edihcnstr,ebr*nss, > & Uconst,etot > 10 format (/'Virtual-chain energies:'// > & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ > & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ > & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ > & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ > & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ > & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ > & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ > & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ > & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ > & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, > & ' (SS bridges & dist. cnstr.)'/ > & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ > & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ > & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ > & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ > & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ > & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ > & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ > & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ > & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ > & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ > & 'UCONST= ',1pE16.6,' (Constraint energy)'/ > & 'ETOT= ',1pE16.6,' (total)') > #else > write (iout,10) evdw,wsc,evdw2,wscp,ees,welec, > & estr,wbond,ebe,wang, > & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain, > & ecorr,wcorr, > & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3, > & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr, > & ebr*nss,Uconst,etot > 10 format (/'Virtual-chain energies:'// > & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ > & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ > & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ > & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ > & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ > & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ > & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ > & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ > & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, > & ' (SS bridges & dist. cnstr.)'/ > & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ > & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ > & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ > & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ > & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ > & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ > & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ > & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ > & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ > & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ > & 'UCONST=',1pE16.6,' (Constraint energy)'/ > & 'ETOT= ',1pE16.6,' (total)') > #endif 102c794 < subroutine elj_short(evdw) --- > subroutine elj(evdw) 129a822,823 > C Change 12/1/95 > num_conti=0 140a835 > C Change 12/1/95 to calculate four-body interactions 142,149c837,850 < sss=sscale(dsqrt(rij)/sigma(itypi,itypj)) < if (sss.gt.0.0d0) then < rrij=1.0D0/rij < fac=rrij**expon2 < e1=fac*fac*aa(itypi,itypj) < e2=fac*bb(itypi,itypj) < evdwij=e1+e2 < evdw=evdw+sss*evdwij --- > rrij=1.0D0/rij > c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj > eps0ij=eps(itypi,itypj) > fac=rrij**expon2 > e1=fac*fac*aa(itypi,itypj) > e2=fac*bb(itypi,itypj) > evdwij=e1+e2 > cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) > cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) > cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)') > cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), > cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm, > cd & (c(k,i),k=1,3),(c(k,j),k=1,3) > evdw=evdw+evdwij 153,164c854,864 < fac=-rrij*(e1+evdwij)*sss < gg(1)=xj*fac < gg(2)=yj*fac < gg(3)=zj*fac < do k=1,3 < gvdwx(k,i)=gvdwx(k,i)-gg(k) < gvdwx(k,j)=gvdwx(k,j)+gg(k) < enddo < do k=i,j-1 < do l=1,3 < gvdwc(l,k)=gvdwc(l,k)+gg(l) < enddo --- > fac=-rrij*(e1+evdwij) > gg(1)=xj*fac > gg(2)=yj*fac > gg(3)=zj*fac > do k=1,3 > gvdwx(k,i)=gvdwx(k,i)-gg(k) > gvdwx(k,j)=gvdwx(k,j)+gg(k) > enddo > do k=i,j-1 > do l=1,3 > gvdwc(l,k)=gvdwc(l,k)+gg(l) 165a866,921 > enddo > C > C 12/1/95, revised on 5/20/97 > C > C Calculate the contact function. The ith column of the array JCONT will > C contain the numbers of atoms that make contacts with the atom I (of numbers > C greater than I). The arrays FACONT and GACONT will contain the values of > C the contact function and its derivative. > C > C Uncomment next line, if the correlation interactions include EVDW explicitly. > c if (j.gt.i+1 .and. evdwij.le.0.0D0) then > C Uncomment next line, if the correlation interactions are contact function only > if (j.gt.i+1.and. eps0ij.gt.0.0D0) then > rij=dsqrt(rij) > sigij=sigma(itypi,itypj) > r0ij=rs0(itypi,itypj) > C > C Check whether the SC's are not too far to make a contact. > C > rcut=1.5d0*r0ij > call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont) > C Add a new contact, if the SC's are close enough, but not too close (r C > if (fcont.gt.0.0D0) then > C If the SC-SC distance if close to sigma, apply spline. > cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0, > cAdam & fcont1,fprimcont1) > cAdam fcont1=1.0d0-fcont1 > cAdam if (fcont1.gt.0.0d0) then > cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1 > cAdam fcont=fcont*fcont1 > cAdam endif > C Uncomment following 4 lines to have the geometric average of the epsilon0's > cga eps0ij=1.0d0/dsqrt(eps0ij) > cga do k=1,3 > cga gg(k)=gg(k)*eps0ij > cga enddo > cga eps0ij=-evdwij*eps0ij > C Uncomment for AL's type of SC correlation interactions. > cadam eps0ij=-evdwij > num_conti=num_conti+1 > jcont(num_conti,i)=j > facont(num_conti,i)=fcont*eps0ij > fprimcont=eps0ij*fprimcont/rij > fcont=expon*fcont > cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1) > cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2) > cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3) > C Uncomment following 3 lines for Skolnick's type of SC correlation. > gacont(1,num_conti,i)=-fprimcont*xj > gacont(2,num_conti,i)=-fprimcont*yj > gacont(3,num_conti,i)=-fprimcont*zj > cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i) > cd write (iout,'(2i3,3f10.5)') > cd & i,j,(gacont(kk,num_conti,i),kk=1,3) > endif 168a925,926 > C Change 12/1/95 > num_cont(i)=num_conti 188c946 < subroutine eljk_long(evdw) --- > subroutine eljk(evdw) 227,243c985,997 < sss=sscale(rij/sigma(itypi,itypj)) < < if (sss.lt.1.0d0) then < < r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj)) < fac=r_shift_inv**expon < e1=fac*fac*aa(itypi,itypj) < e2=fac*bb(itypi,itypj) < evdwij=e_augm+e1+e2 < cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) < cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) < cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)') < cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), < cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm, < cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij, < cd & (c(k,i),k=1,3),(c(k,j),k=1,3) < evdw=evdw+evdwij*(1.0d0-sss) --- > r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj)) > fac=r_shift_inv**expon > e1=fac*fac*aa(itypi,itypj) > e2=fac*bb(itypi,itypj) > evdwij=e_augm+e1+e2 > cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) > cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) > cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)') > cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), > cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm, > cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij, > cd & (c(k,i),k=1,3),(c(k,j),k=1,3) > evdw=evdw+evdwij 247,259c1001,1011 < fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2) < fac=fac*(1.0d0-sss) < gg(1)=xj*fac < gg(2)=yj*fac < gg(3)=zj*fac < do k=1,3 < gvdwx(k,i)=gvdwx(k,i)-gg(k) < gvdwx(k,j)=gvdwx(k,j)+gg(k) < enddo < do k=i,j-1 < do l=1,3 < gvdwc(l,k)=gvdwc(l,k)+gg(l) < enddo --- > fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2) > gg(1)=xj*fac > gg(2)=yj*fac > gg(3)=zj*fac > do k=1,3 > gvdwx(k,i)=gvdwx(k,i)-gg(k) > gvdwx(k,j)=gvdwx(k,j)+gg(k) > enddo > do k=i,j-1 > do l=1,3 > gvdwc(l,k)=gvdwc(l,k)+gg(l) 261,263c1013 < < endif < --- > enddo 276c1026 < subroutine eljk_short(evdw) --- > subroutine ebp(evdw) 279c1029 < C assuming the LJK potential of interaction. --- > C assuming the Berne-Pechukas potential of interaction. 287a1038 > include 'COMMON.NAMES' 290,382c1041,1044 < include 'COMMON.NAMES' < dimension gg(3) < logical scheck < c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon < evdw=0.0D0 < do i=iatsc_s,iatsc_e < itypi=itype(i) < itypi1=itype(i+1) < xi=c(1,nres+i) < yi=c(2,nres+i) < zi=c(3,nres+i) < C < C Calculate SC interaction energy. < C < do iint=1,nint_gr(i) < do j=istart(i,iint),iend(i,iint) < itypj=itype(j) < xj=c(1,nres+j)-xi < yj=c(2,nres+j)-yi < zj=c(3,nres+j)-zi < rrij=1.0D0/(xj*xj+yj*yj+zj*zj) < fac_augm=rrij**expon < e_augm=augm(itypi,itypj)*fac_augm < r_inv_ij=dsqrt(rrij) < rij=1.0D0/r_inv_ij < sss=sscale(rij/sigma(itypi,itypj)) < < if (sss.gt.0.0d0) then < < r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj)) < fac=r_shift_inv**expon < e1=fac*fac*aa(itypi,itypj) < e2=fac*bb(itypi,itypj) < evdwij=e_augm+e1+e2 < cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) < cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj) < cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)') < cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), < cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm, < cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij, < cd & (c(k,i),k=1,3),(c(k,j),k=1,3) < evdw=evdw+evdwij*sss < C < C Calculate the components of the gradient in DC and X < C < fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2) < fac=fac*sss < gg(1)=xj*fac < gg(2)=yj*fac < gg(3)=zj*fac < do k=1,3 < gvdwx(k,i)=gvdwx(k,i)-gg(k) < gvdwx(k,j)=gvdwx(k,j)+gg(k) < enddo < do k=i,j-1 < do l=1,3 < gvdwc(l,k)=gvdwc(l,k)+gg(l) < enddo < enddo < < endif < < enddo ! j < enddo ! iint < enddo ! i < do i=1,nct < do j=1,3 < gvdwc(j,i)=expon*gvdwc(j,i) < gvdwx(j,i)=expon*gvdwx(j,i) < enddo < enddo < return < end < C----------------------------------------------------------------------------- < subroutine ebp_long(evdw) < C < C This subroutine calculates the interaction energy of nonbonded side chains < C assuming the Berne-Pechukas potential of interaction. < C < implicit real*8 (a-h,o-z) < include 'DIMENSIONS' < include 'COMMON.GEO' < include 'COMMON.VAR' < include 'COMMON.LOCAL' < include 'COMMON.CHAIN' < include 'COMMON.DERIV' < include 'COMMON.NAMES' < include 'COMMON.INTERACT' < include 'COMMON.IOUNITS' < include 'COMMON.CALC' < common /srutu/ icall < c double precision rrsave(maxdim) < logical lprn --- > include 'COMMON.CALC' > common /srutu/ icall > c double precision rrsave(maxdim) > logical lprn 444,447d1105 < sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) < < if (sss.lt.1.0d0) then < 449c1107 < call sc_angular --- > call sc_angular 452,462c1110,1120 < fac=(rrij*sigsq)**expon2 < e1=fac*fac*aa(itypi,itypj) < e2=fac*bb(itypi,itypj) < evdwij=eps1*eps2rt*eps3rt*(e1+e2) < eps2der=evdwij*eps3rt < eps3der=evdwij*eps2rt < evdwij=evdwij*eps2rt*eps3rt < evdw=evdw+evdwij*(1.0d0-sss) < if (lprn) then < sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) < epsi=bb(itypi,itypj)**2/aa(itypi,itypj) --- > fac=(rrij*sigsq)**expon2 > e1=fac*fac*aa(itypi,itypj) > e2=fac*bb(itypi,itypj) > evdwij=eps1*eps2rt*eps3rt*(e1+e2) > eps2der=evdwij*eps3rt > eps3der=evdwij*eps2rt > evdwij=evdwij*eps2rt*eps3rt > evdw=evdw+evdwij > if (lprn) then > sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) > epsi=bb(itypi,itypj)**2/aa(itypi,itypj) 469,482d1126 < endif < C Calculate gradient components. < e1=e1*eps1*eps2rt**2*eps3rt**2 < fac=-expon*(e1+evdwij) < sigder=fac/sigsq < fac=rrij*fac < C Calculate radial part of the gradient < gg(1)=xj*fac < gg(2)=yj*fac < gg(3)=zj*fac < 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_scale(1.0d0-sss) < 484,597d1127 < < enddo ! j < enddo ! iint < enddo ! i < c stop < return < end < C----------------------------------------------------------------------------- < subroutine ebp_short(evdw) < C < C This subroutine calculates the interaction energy of nonbonded side chains < C assuming the Berne-Pechukas potential of interaction. < C < implicit real*8 (a-h,o-z) < include 'DIMENSIONS' < include 'COMMON.GEO' < include 'COMMON.VAR' < include 'COMMON.LOCAL' < include 'COMMON.CHAIN' < include 'COMMON.DERIV' < include 'COMMON.NAMES' < include 'COMMON.INTERACT' < include 'COMMON.IOUNITS' < include 'COMMON.CALC' < common /srutu/ icall < c double precision rrsave(maxdim) < logical lprn < evdw=0.0D0 < c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon < evdw=0.0D0 < c if (icall.eq.0) then < c lprn=.true. < c else < lprn=.false. < c endif < ind=0 < do i=iatsc_s,iatsc_e < itypi=itype(i) < itypi1=itype(i+1) < xi=c(1,nres+i) < yi=c(2,nres+i) < zi=c(3,nres+i) < dxi=dc_norm(1,nres+i) < dyi=dc_norm(2,nres+i) < dzi=dc_norm(3,nres+i) < c dsci_inv=dsc_inv(itypi) < dsci_inv=vbld_inv(i+nres) < C < C Calculate SC interaction energy. < C < do iint=1,nint_gr(i) < do j=istart(i,iint),iend(i,iint) < ind=ind+1 < itypj=itype(j) < c dscj_inv=dsc_inv(itypj) < dscj_inv=vbld_inv(j+nres) < chi1=chi(itypi,itypj) < chi2=chi(itypj,itypi) < chi12=chi1*chi2 < chip1=chip(itypi) < chip2=chip(itypj) < chip12=chip1*chip2 < alf1=alp(itypi) < alf2=alp(itypj) < alf12=0.5D0*(alf1+alf2) < C For diagnostics only!!! < c chi1=0.0D0 < c chi2=0.0D0 < c chi12=0.0D0 < c chip1=0.0D0 < c chip2=0.0D0 < c chip12=0.0D0 < c alf1=0.0D0 < c alf2=0.0D0 < c alf12=0.0D0 < xj=c(1,nres+j)-xi < yj=c(2,nres+j)-yi < zj=c(3,nres+j)-zi < dxj=dc_norm(1,nres+j) < dyj=dc_norm(2,nres+j) < dzj=dc_norm(3,nres+j) < rrij=1.0D0/(xj*xj+yj*yj+zj*zj) < cd if (icall.eq.0) then < cd rrsave(ind)=rrij < cd else < cd rrij=rrsave(ind) < cd endif < rij=dsqrt(rrij) < sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) < < if (sss.gt.0.0d0) then < < C Calculate the angle-dependent terms of energy & contributions to derivatives. < call sc_angular < C Calculate whole angle-dependent part of epsilon and contributions < C to its derivatives < fac=(rrij*sigsq)**expon2 < e1=fac*fac*aa(itypi,itypj) < e2=fac*bb(itypi,itypj) < evdwij=eps1*eps2rt*eps3rt*(e1+e2) < eps2der=evdwij*eps3rt < eps3der=evdwij*eps2rt < evdwij=evdwij*eps2rt*eps3rt < evdw=evdw+evdwij*sss < if (lprn) then < sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) < epsi=bb(itypi,itypj)**2/aa(itypi,itypj) < cd write (iout,'(2(a3,i3,2x),15(0pf7.3))') < cd & restyp(itypi),i,restyp(itypj),j, < cd & epsi,sigm,chi1,chi2,chip1,chip2, < cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq), < cd & om1,om2,om12,1.0D0/dsqrt(rrij), < cd & evdwij < endif 599,602c1129,1132 < e1=e1*eps1*eps2rt**2*eps3rt**2 < fac=-expon*(e1+evdwij) < sigder=fac/sigsq < fac=rrij*fac --- > e1=e1*eps1*eps2rt**2*eps3rt**2 > fac=-expon*(e1+evdwij) > sigder=fac/sigsq > fac=rrij*fac 604,606c1134,1136 < gg(1)=xj*fac < gg(2)=yj*fac < gg(3)=zj*fac --- > gg(1)=xj*fac > gg(2)=yj*fac > gg(3)=zj*fac 609,612c1139 < call sc_grad_scale(sss) < < endif < --- > call sc_grad 620c1147 < subroutine egb_long(evdw) --- > subroutine egb(evdw) 701,706d1227 < sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) < c write(iout,*) "long",i,itypi,j,itypj," rij",1.0d0/rij, < c & " sigmaii",sigmaii(itypi,itypj)," sss",sss < < if (sss.lt.1.0d0) then < 709,712c1230,1233 < call sc_angular < sigsq=1.0D0/sigsq < sig=sig0ij*dsqrt(sigsq) < rij_shift=1.0D0/rij-sig+sig0ij --- > call sc_angular > sigsq=1.0D0/sigsq > sig=sig0ij*dsqrt(sigsq) > rij_shift=1.0D0/rij-sig+sig0ij 714c1235 < c rij_shift=1.2*sig0ij --- > c rij_shift=1.2*sig0ij 716,723c1237,1244 < if (rij_shift.le.0.0D0) then < evdw=1.0D20 < cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') < cd & restyp(itypi),i,restyp(itypj),j, < cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) < return < endif < sigder=-sig*sigsq --- > if (rij_shift.le.0.0D0) then > evdw=1.0D20 > cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') > cd & restyp(itypi),i,restyp(itypj),j, > cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) > return > endif > sigder=-sig*sigsq 725,732c1246,1253 < rij_shift=1.0D0/rij_shift < fac=rij_shift**expon < e1=fac*fac*aa(itypi,itypj) < e2=fac*bb(itypi,itypj) < evdwij=eps1*eps2rt*eps3rt*(e1+e2) < eps2der=evdwij*eps3rt < eps3der=evdwij*eps2rt < c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, --- > rij_shift=1.0D0/rij_shift > fac=rij_shift**expon > e1=fac*fac*aa(itypi,itypj) > e2=fac*bb(itypi,itypj) > evdwij=eps1*eps2rt*eps3rt*(e1+e2) > eps2der=evdwij*eps3rt > eps3der=evdwij*eps2rt > c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, 734,746c1255,1266 < evdwij=evdwij*eps2rt*eps3rt < evdw=evdw+evdwij*(1.0d0-sss) < c write (iout,*) "evdwij",evdwij," evdw",evdw < if (lprn) then < sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) < epsi=bb(itypi,itypj)**2/aa(itypi,itypj) < write (iout,'(2(a3,i3,2x),17(0pf7.3))') < & restyp(itypi),i,restyp(itypj),j, < & epsi,sigm,chi1,chi2,chip1,chip2, < & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, < & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, < & evdwij < endif --- > evdwij=evdwij*eps2rt*eps3rt > evdw=evdw+evdwij > if (lprn) then > sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) > epsi=bb(itypi,itypj)**2/aa(itypi,itypj) > write (iout,'(2(a3,i3,2x),17(0pf7.3))') > & restyp(itypi),i,restyp(itypj),j, > & epsi,sigm,chi1,chi2,chip1,chip2, > & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, > & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, > & evdwij > endif 748c1268 < if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') --- > if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') 752,756c1272,1276 < e1=e1*eps1*eps2rt**2*eps3rt**2 < fac=-expon*(e1+evdwij)*rij_shift < sigder=fac*sigder < fac=rij*fac < c fac=0.0d0 --- > e1=e1*eps1*eps2rt**2*eps3rt**2 > fac=-expon*(e1+evdwij)*rij_shift > sigder=fac*sigder > fac=rij*fac > c fac=0.0d0 758,760c1278,1280 < gg(1)=xj*fac < gg(2)=yj*fac < gg(3)=zj*fac --- > gg(1)=xj*fac > gg(2)=yj*fac > gg(3)=zj*fac 762,765c1282 < call sc_grad_scale(1.0d0-sss) < < endif < --- > call sc_grad 773c1290 < subroutine egb_short(evdw) --- > subroutine egbv(evdw) 776c1293 < C assuming the Gay-Berne potential of interaction. --- > C assuming the Gay-Berne-Vorobjev potential of interaction. 789c1306 < include 'COMMON.CONTROL' --- > common /srutu/ icall 792d1308 < ccccc energy_dec=.false. 796c1312 < c if (icall.eq.0) lprn=.false. --- > c if (icall.eq.0) lprn=.true. 809,810d1324 < c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) < c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi 820,822d1333 < c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, < c & 1.0d0/vbld(j+nres) < c write (iout,*) "i",i," j", j," itype",itype(i),itype(j) 823a1335 > r0ij=r0(itypi,itypj) 849,851d1360 < c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi < c write (iout,*) "j",j," dc_norm", < c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) 854,858d1362 < sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) < c write(iout,*) "short",i,itypi,j,itypj," rij",1.0d0/rij, < c & " sigmaii",sigmaii(itypi,itypj)," sss",sss < if (sss.gt.0.0d0) then < 861,866c1365,1368 < call sc_angular < sigsq=1.0D0/sigsq < sig=sig0ij*dsqrt(sigsq) < rij_shift=1.0D0/rij-sig+sig0ij < c for diagnostics; uncomment < c rij_shift=1.2*sig0ij --- > call sc_angular > sigsq=1.0D0/sigsq > sig=sig0ij*dsqrt(sigsq) > rij_shift=1.0D0/rij-sig+r0ij 868,875c1370,1374 < if (rij_shift.le.0.0D0) then < evdw=1.0D20 < cd write (iout,'(2(a3,i3,2x),17(0pf7.3))') < cd & restyp(itypi),i,restyp(itypj),j, < cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) < return < endif < sigder=-sig*sigsq --- > if (rij_shift.le.0.0D0) then > evdw=1.0D20 > return > endif > sigder=-sig*sigsq 877,902c1376,1397 < rij_shift=1.0D0/rij_shift < fac=rij_shift**expon < e1=fac*fac*aa(itypi,itypj) < e2=fac*bb(itypi,itypj) < evdwij=eps1*eps2rt*eps3rt*(e1+e2) < eps2der=evdwij*eps3rt < eps3der=evdwij*eps2rt < c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, < c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 < evdwij=evdwij*eps2rt*eps3rt < evdw=evdw+evdwij*sss < c write (iout,*) "evdwij",evdwij," evdw",evdw < if (lprn) then < sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) < epsi=bb(itypi,itypj)**2/aa(itypi,itypj) < write (iout,'(2(a3,i3,2x),17(0pf7.3))') < & restyp(itypi),i,restyp(itypj),j, < & epsi,sigm,chi1,chi2,chip1,chip2, < & eps1,eps2rt**2,eps3rt**2,sig,sig0ij, < & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, < & evdwij < endif < < if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') < & 'evdw',i,j,evdwij < --- > rij_shift=1.0D0/rij_shift > fac=rij_shift**expon > e1=fac*fac*aa(itypi,itypj) > e2=fac*bb(itypi,itypj) > evdwij=eps1*eps2rt*eps3rt*(e1+e2) > eps2der=evdwij*eps3rt > eps3der=evdwij*eps2rt > fac_augm=rrij**expon > e_augm=augm(itypi,itypj)*fac_augm > evdwij=evdwij*eps2rt*eps3rt > evdw=evdw+evdwij+e_augm > if (lprn) then > sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) > epsi=bb(itypi,itypj)**2/aa(itypi,itypj) > write (iout,'(2(a3,i3,2x),17(0pf7.3))') > & restyp(itypi),i,restyp(itypj),j, > & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0), > & chi1,chi2,chip1,chip2, > & eps1,eps2rt**2,eps3rt**2, > & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, > & evdwij+e_augm > endif 904,908c1399,1402 < e1=e1*eps1*eps2rt**2*eps3rt**2 < fac=-expon*(e1+evdwij)*rij_shift < sigder=fac*sigder < fac=rij*fac < c fac=0.0d0 --- > e1=e1*eps1*eps2rt**2*eps3rt**2 > fac=-expon*(e1+evdwij)*rij_shift > sigder=fac*sigder > fac=rij*fac-2*expon*rrij*e_augm 910,912c1404,1406 < gg(1)=xj*fac < gg(2)=yj*fac < gg(3)=zj*fac --- > gg(1)=xj*fac > gg(2)=yj*fac > gg(3)=zj*fac 914,917c1408 < call sc_grad_scale(sss) < < endif < --- > call sc_grad 921,922d1411 < cccc energy_dec=.false. < return 925,1189c1414,1482 < subroutine egbv_long(evdw) < C < C This subroutine calculates the interaction energy of nonbonded side chains < C assuming the Gay-Berne-Vorobjev potential of interaction. < C < implicit real*8 (a-h,o-z) < include 'DIMENSIONS' < include 'COMMON.GEO' < include 'COMMON.VAR' < include 'COMMON.LOCAL' < include 'COMMON.CHAIN' < include 'COMMON.DERIV' < include 'COMMON.NAMES' < include 'COMMON.INTERACT' < include 'COMMON.IOUNITS' < include 'COMMON.CALC' < common /srutu/ icall < logical lprn < evdw=0.0D0 < c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon < evdw=0.0D0 < lprn=.false. < c if (icall.eq.0) lprn=.true. < ind=0 < do i=iatsc_s,iatsc_e < itypi=itype(i) < itypi1=itype(i+1) < xi=c(1,nres+i) < yi=c(2,nres+i) < zi=c(3,nres+i) < dxi=dc_norm(1,nres+i) < dyi=dc_norm(2,nres+i) < dzi=dc_norm(3,nres+i) < c dsci_inv=dsc_inv(itypi) < dsci_inv=vbld_inv(i+nres) < C < C Calculate SC interaction energy. < C < do iint=1,nint_gr(i) < do j=istart(i,iint),iend(i,iint) < ind=ind+1 < itypj=itype(j) < c dscj_inv=dsc_inv(itypj) < dscj_inv=vbld_inv(j+nres) < sig0ij=sigma(itypi,itypj) < r0ij=r0(itypi,itypj) < chi1=chi(itypi,itypj) < chi2=chi(itypj,itypi) < chi12=chi1*chi2 < chip1=chip(itypi) < chip2=chip(itypj) < chip12=chip1*chip2 < alf1=alp(itypi) < alf2=alp(itypj) < alf12=0.5D0*(alf1+alf2) < C For diagnostics only!!! < c chi1=0.0D0 < c chi2=0.0D0 < c chi12=0.0D0 < c chip1=0.0D0 < c chip2=0.0D0 < c chip12=0.0D0 < c alf1=0.0D0 < c alf2=0.0D0 < c alf12=0.0D0 < xj=c(1,nres+j)-xi < yj=c(2,nres+j)-yi < zj=c(3,nres+j)-zi < dxj=dc_norm(1,nres+j) < dyj=dc_norm(2,nres+j) < dzj=dc_norm(3,nres+j) < rrij=1.0D0/(xj*xj+yj*yj+zj*zj) < rij=dsqrt(rrij) < < sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) < < if (sss.lt.1.0d0) then < < C Calculate angle-dependent terms of energy and contributions to their < C derivatives. < call sc_angular < sigsq=1.0D0/sigsq < sig=sig0ij*dsqrt(sigsq) < rij_shift=1.0D0/rij-sig+r0ij < C I hate to put IF's in the loops, but here don't have another choice!!!! < if (rij_shift.le.0.0D0) then < evdw=1.0D20 < return < endif < sigder=-sig*sigsq < c--------------------------------------------------------------- < rij_shift=1.0D0/rij_shift < fac=rij_shift**expon < e1=fac*fac*aa(itypi,itypj) < e2=fac*bb(itypi,itypj) < evdwij=eps1*eps2rt*eps3rt*(e1+e2) < eps2der=evdwij*eps3rt < eps3der=evdwij*eps2rt < fac_augm=rrij**expon < e_augm=augm(itypi,itypj)*fac_augm < evdwij=evdwij*eps2rt*eps3rt < evdw=evdw+(evdwij+e_augm)*(1.0d0-sss) < if (lprn) then < sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) < epsi=bb(itypi,itypj)**2/aa(itypi,itypj) < write (iout,'(2(a3,i3,2x),17(0pf7.3))') < & restyp(itypi),i,restyp(itypj),j, < & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0), < & chi1,chi2,chip1,chip2, < & eps1,eps2rt**2,eps3rt**2, < & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, < & evdwij+e_augm < endif < C Calculate gradient components. < e1=e1*eps1*eps2rt**2*eps3rt**2 < fac=-expon*(e1+evdwij)*rij_shift < sigder=fac*sigder < fac=rij*fac-2*expon*rrij*e_augm < C Calculate the radial part of the gradient < gg(1)=xj*fac < gg(2)=yj*fac < gg(3)=zj*fac < C Calculate angular part of the gradient. < call sc_grad_scale(1.0d0-sss) < < endif < < enddo ! j < enddo ! iint < enddo ! i < end < C----------------------------------------------------------------------------- < subroutine egbv_short(evdw) < C < C This subroutine calculates the interaction energy of nonbonded side chains < C assuming the Gay-Berne-Vorobjev potential of interaction. < C < implicit real*8 (a-h,o-z) < include 'DIMENSIONS' < include 'COMMON.GEO' < include 'COMMON.VAR' < include 'COMMON.LOCAL' < include 'COMMON.CHAIN' < include 'COMMON.DERIV' < include 'COMMON.NAMES' < include 'COMMON.INTERACT' < include 'COMMON.IOUNITS' < include 'COMMON.CALC' < common /srutu/ icall < logical lprn < evdw=0.0D0 < c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon < evdw=0.0D0 < lprn=.false. < c if (icall.eq.0) lprn=.true. < ind=0 < do i=iatsc_s,iatsc_e < itypi=itype(i) < itypi1=itype(i+1) < xi=c(1,nres+i) < yi=c(2,nres+i) < zi=c(3,nres+i) < dxi=dc_norm(1,nres+i) < dyi=dc_norm(2,nres+i) < dzi=dc_norm(3,nres+i) < c dsci_inv=dsc_inv(itypi) < dsci_inv=vbld_inv(i+nres) < C < C Calculate SC interaction energy. < C < do iint=1,nint_gr(i) < do j=istart(i,iint),iend(i,iint) < ind=ind+1 < itypj=itype(j) < c dscj_inv=dsc_inv(itypj) < dscj_inv=vbld_inv(j+nres) < sig0ij=sigma(itypi,itypj) < r0ij=r0(itypi,itypj) < chi1=chi(itypi,itypj) < chi2=chi(itypj,itypi) < chi12=chi1*chi2 < chip1=chip(itypi) < chip2=chip(itypj) < chip12=chip1*chip2 < alf1=alp(itypi) < alf2=alp(itypj) < alf12=0.5D0*(alf1+alf2) < C For diagnostics only!!! < c chi1=0.0D0 < c chi2=0.0D0 < c chi12=0.0D0 < c chip1=0.0D0 < c chip2=0.0D0 < c chip12=0.0D0 < c alf1=0.0D0 < c alf2=0.0D0 < c alf12=0.0D0 < xj=c(1,nres+j)-xi < yj=c(2,nres+j)-yi < zj=c(3,nres+j)-zi < dxj=dc_norm(1,nres+j) < dyj=dc_norm(2,nres+j) < dzj=dc_norm(3,nres+j) < rrij=1.0D0/(xj*xj+yj*yj+zj*zj) < rij=dsqrt(rrij) < < sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj))) < < if (sss.gt.0.0d0) then < < C Calculate angle-dependent terms of energy and contributions to their < C derivatives. < call sc_angular < sigsq=1.0D0/sigsq < sig=sig0ij*dsqrt(sigsq) < rij_shift=1.0D0/rij-sig+r0ij < C I hate to put IF's in the loops, but here don't have another choice!!!! < if (rij_shift.le.0.0D0) then < evdw=1.0D20 < return < endif < sigder=-sig*sigsq < c--------------------------------------------------------------- < rij_shift=1.0D0/rij_shift < fac=rij_shift**expon < e1=fac*fac*aa(itypi,itypj) < e2=fac*bb(itypi,itypj) < evdwij=eps1*eps2rt*eps3rt*(e1+e2) < eps2der=evdwij*eps3rt < eps3der=evdwij*eps2rt < fac_augm=rrij**expon < e_augm=augm(itypi,itypj)*fac_augm < evdwij=evdwij*eps2rt*eps3rt < evdw=evdw+(evdwij+e_augm)*sss < if (lprn) then < sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) < epsi=bb(itypi,itypj)**2/aa(itypi,itypj) < write (iout,'(2(a3,i3,2x),17(0pf7.3))') < & restyp(itypi),i,restyp(itypj),j, < & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0), < & chi1,chi2,chip1,chip2, < & eps1,eps2rt**2,eps3rt**2, < & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, < & evdwij+e_augm < endif < C Calculate gradient components. < e1=e1*eps1*eps2rt**2*eps3rt**2 < fac=-expon*(e1+evdwij)*rij_shift < sigder=fac*sigder < fac=rij*fac-2*expon*rrij*e_augm < C Calculate the radial part of the gradient < gg(1)=xj*fac < gg(2)=yj*fac < gg(3)=zj*fac < C Calculate angular part of the gradient. < call sc_grad_scale(sss) < < endif < < enddo ! j < enddo ! iint < enddo ! i < end < C---------------------------------------------------------------------------- < subroutine sc_grad_scale(scalfac) --- > subroutine sc_angular > C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2, > C om12. Called by ebp, egb, and egbv. > implicit none > include 'COMMON.CALC' > include 'COMMON.IOUNITS' > erij(1)=xj*rij > erij(2)=yj*rij > erij(3)=zj*rij > om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3) > om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3) > om12=dxi*dxj+dyi*dyj+dzi*dzj > chiom12=chi12*om12 > C Calculate eps1(om12) and its derivative in om12 > faceps1=1.0D0-om12*chiom12 > faceps1_inv=1.0D0/faceps1 > eps1=dsqrt(faceps1_inv) > C Following variable is eps1*deps1/dom12 > eps1_om12=faceps1_inv*chiom12 > c diagnostics only > c faceps1_inv=om12 > c eps1=om12 > c eps1_om12=1.0d0 > c write (iout,*) "om12",om12," eps1",eps1 > C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2, > C and om12. > om1om2=om1*om2 > chiom1=chi1*om1 > chiom2=chi2*om2 > facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12 > sigsq=1.0D0-facsig*faceps1_inv > sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv > sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv > sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2 > c diagnostics only > c sigsq=1.0d0 > c sigsq_om1=0.0d0 > c sigsq_om2=0.0d0 > c sigsq_om12=0.0d0 > c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12 > c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv, > c & " eps1",eps1 > C Calculate eps2 and its derivatives in om1, om2, and om12. > chipom1=chip1*om1 > chipom2=chip2*om2 > chipom12=chip12*om12 > facp=1.0D0-om12*chipom12 > facp_inv=1.0D0/facp > facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12 > c write (iout,*) "chipom1",chipom1," chipom2",chipom2, > c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv > C Following variable is the square root of eps2 > eps2rt=1.0D0-facp1*facp_inv > C Following three variables are the derivatives of the square root of eps > C in om1, om2, and om12. > eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv > eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv > eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2 > C Evaluate the "asymmetric" factor in the VDW constant, eps3 > eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12 > c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt > c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2, > c & " eps2rt_om12",eps2rt_om12 > C Calculate whole angle-dependent part of epsilon and contributions > C to its derivatives > return > end > C---------------------------------------------------------------------------- > subroutine sc_grad 1197d1489 < double precision scalfac 1216c1508 < gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac --- > gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k) 1221,1222c1513,1514 < & +((eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) < & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv)*scalfac --- > & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) > & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv 1224,1225c1516,1517 < & +((eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) < & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv)*scalfac --- > & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) > & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv 1240a1533,1605 > C----------------------------------------------------------------------- > subroutine e_softsphere(evdw) > C > C This subroutine calculates the interaction energy of nonbonded side chains > C assuming the LJ potential of interaction. > C > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > parameter (accur=1.0d-10) > include 'COMMON.GEO' > include 'COMMON.VAR' > include 'COMMON.LOCAL' > include 'COMMON.CHAIN' > include 'COMMON.DERIV' > include 'COMMON.INTERACT' > include 'COMMON.TORSION' > include 'COMMON.SBRIDGE' > include 'COMMON.NAMES' > include 'COMMON.IOUNITS' > include 'COMMON.CONTACTS' > dimension gg(3) > cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct > evdw=0.0D0 > do i=iatsc_s,iatsc_e > itypi=itype(i) > itypi1=itype(i+1) > xi=c(1,nres+i) > yi=c(2,nres+i) > zi=c(3,nres+i) > C > C Calculate SC interaction energy. > 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) > itypj=itype(j) > xj=c(1,nres+j)-xi > yj=c(2,nres+j)-yi > zj=c(3,nres+j)-zi > rij=xj*xj+yj*yj+zj*zj > c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj > r0ij=r0(itypi,itypj) > r0ijsq=r0ij*r0ij > c print *,i,j,r0ij,dsqrt(rij) > if (rij.lt.r0ijsq) then > evdwij=0.25d0*(rij-r0ijsq)**2 > fac=rij-r0ijsq > else > evdwij=0.0d0 > fac=0.0d0 > endif > evdw=evdw+evdwij > C > C Calculate the components of the gradient in DC and X > C > gg(1)=xj*fac > gg(2)=yj*fac > gg(3)=zj*fac > do k=1,3 > gvdwx(k,i)=gvdwx(k,i)-gg(k) > gvdwx(k,j)=gvdwx(k,j)+gg(k) > enddo > do k=i,j-1 > do l=1,3 > gvdwc(l,k)=gvdwc(l,k)+gg(l) > enddo > enddo > enddo ! j > enddo ! iint > enddo ! i > return > end 1242c1607,1608 < subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4) --- > subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3, > & eello_turn4) 1244,1248c1610 < C This subroutine calculates the average interaction energy and its gradient < C in the virtual-bond vectors between non-adjacent peptide groups, based on < C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715. < C The potential depends both on the distance of peptide-group centers and on < C the orientation of the CA-CA virtual bonds. --- > C Soft-sphere potential of p-p interaction 1264,1315c1626,1627 < dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3), < & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3) < double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4), < & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4) < common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2 < c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions < #ifdef MOMENT < double precision scal_el /1.0d0/ < #else < double precision scal_el /0.5d0/ < #endif < C 12/13/98 < C 13-go grudnia roku pamietnego... < double precision unmat(3,3) /1.0d0,0.0d0,0.0d0, < & 0.0d0,1.0d0,0.0d0, < & 0.0d0,0.0d0,1.0d0/ < cd write(iout,*) 'In EELEC' < cd do i=1,nloctyp < cd write(iout,*) 'Type',i < cd write(iout,*) 'B1',B1(:,i) < cd write(iout,*) 'B2',B2(:,i) < cd write(iout,*) 'CC',CC(:,:,i) < cd write(iout,*) 'DD',DD(:,:,i) < cd write(iout,*) 'EE',EE(:,:,i) < cd enddo < cd call check_vecgrad < cd stop < if (icheckgrad.eq.1) then < do i=1,nres-1 < fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i))) < do k=1,3 < dc_norm(k,i)=dc(k,i)*fac < enddo < c write (iout,*) 'i',i,' fac',fac < enddo < endif < if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 < & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. < & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then < c call vec_and_deriv < call set_matrices < endif < cd do i=1,nres-1 < cd write (iout,*) 'i=',i < cd do k=1,3 < cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i) < cd enddo < cd do k=1,3 < cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)') < cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3) < cd enddo < cd enddo --- > dimension ggg(3) > cd write(iout,*) 'In EELEC_soft_sphere' 1323,1373d1634 < do i=1,nres < num_cont_hb(i)=0 < enddo < cd print '(a)','Enter EELEC' < cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e < do i=1,nres < gel_loc_loc(i)=0.0d0 < gcorr_loc(i)=0.0d0 < enddo < cd do i=1,nres < cd write (iout,'(i3,3f10.5,5x,3f10.5)') < cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i) < cd enddo < c < c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms < C < C Loop over i,i+2 and i,i+3 pairs of the peptide groups < C < do i=iturn3_start,iturn3_end < dxi=dc(1,i) < dyi=dc(2,i) < dzi=dc(3,i) < dx_normi=dc_norm(1,i) < dy_normi=dc_norm(2,i) < dz_normi=dc_norm(3,i) < xmedi=c(1,i)+0.5d0*dxi < ymedi=c(2,i)+0.5d0*dyi < zmedi=c(3,i)+0.5d0*dzi < num_conti=0 < call eelecij_scale(i,i+2,ees,evdw1,eel_loc) < if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3) < num_cont_hb(i)=num_conti < enddo < do i=iturn4_start,iturn4_end < dxi=dc(1,i) < dyi=dc(2,i) < dzi=dc(3,i) < dx_normi=dc_norm(1,i) < dy_normi=dc_norm(2,i) < dz_normi=dc_norm(3,i) < xmedi=c(1,i)+0.5d0*dxi < ymedi=c(2,i)+0.5d0*dyi < zmedi=c(3,i)+0.5d0*dzi < num_conti=0 < call eelecij_scale(i,i+3,ees,evdw1,eel_loc) < if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4) < num_cont_hb(i)=num_cont_hb(i)+num_conti < enddo ! i < c < c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 < c 1378,1380d1638 < dx_normi=dc_norm(1,i) < dy_normi=dc_norm(2,i) < dz_normi=dc_norm(3,i) 1387c1645,1684 < call eelecij_scale(i,j,ees,evdw1,eel_loc) --- > ind=ind+1 > iteli=itel(i) > itelj=itel(j) > if (j.eq.i+2 .and. itelj.eq.2) iteli=2 > r0ij=rpp(iteli,itelj) > r0ijsq=r0ij*r0ij > dxj=dc(1,j) > dyj=dc(2,j) > dzj=dc(3,j) > xj=c(1,j)+0.5D0*dxj-xmedi > yj=c(2,j)+0.5D0*dyj-ymedi > zj=c(3,j)+0.5D0*dzj-zmedi > rij=xj*xj+yj*yj+zj*zj > if (rij.lt.r0ijsq) then > evdw1ij=0.25d0*(rij-r0ijsq)**2 > fac=rij-r0ijsq > else > evdw1ij=0.0d0 > fac=0.0d0 > endif > evdw1=evdw1+evdw1ij > C > C Calculate contributions to the Cartesian gradient. > C > ggg(1)=fac*xj > ggg(2)=fac*yj > ggg(3)=fac*zj > do k=1,3 > ghalf=0.5D0*ggg(k) > gelc(k,i)=gelc(k,i)+ghalf > gelc(k,j)=gelc(k,j)+ghalf > enddo > * > * Loop over residues i+1 thru j-1. > * > do k=i+1,j-1 > do l=1,3 > gelc(l,k)=gelc(l,k)+ggg(l) > enddo > enddo 1389d1685 < num_cont_hb(i)=num_cont_hb(i)+num_conti 1393,1394c1689,2133 < C------------------------------------------------------------------------------- < subroutine eelecij_scale(i,j,ees,evdw1,eel_loc) --- > c------------------------------------------------------------------------------ > subroutine vec_and_deriv > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > #ifdef MPI > include 'mpif.h' > #endif > include 'COMMON.IOUNITS' > include 'COMMON.GEO' > include 'COMMON.VAR' > include 'COMMON.LOCAL' > include 'COMMON.CHAIN' > include 'COMMON.VECTORS' > include 'COMMON.SETUP' > include 'COMMON.TIME1' > dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2) > C Compute the local reference systems. For reference system (i), the > C X-axis points from CA(i) to CA(i+1), the Y axis is in the > C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane. > c do i=1,nres-1 > do i=ivec_start,ivec_end > if (i.eq.nres-1) then > C Case of the last full residue > C Compute the Z-axis > call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i)) > costh=dcos(pi-theta(nres)) > fac=1.0d0/dsqrt(1.0d0-costh*costh) > do k=1,3 > uz(k,i)=fac*uz(k,i) > enddo > C Compute the derivatives of uz > uzder(1,1,1)= 0.0d0 > uzder(2,1,1)=-dc_norm(3,i-1) > uzder(3,1,1)= dc_norm(2,i-1) > uzder(1,2,1)= dc_norm(3,i-1) > uzder(2,2,1)= 0.0d0 > uzder(3,2,1)=-dc_norm(1,i-1) > uzder(1,3,1)=-dc_norm(2,i-1) > uzder(2,3,1)= dc_norm(1,i-1) > uzder(3,3,1)= 0.0d0 > uzder(1,1,2)= 0.0d0 > uzder(2,1,2)= dc_norm(3,i) > uzder(3,1,2)=-dc_norm(2,i) > uzder(1,2,2)=-dc_norm(3,i) > uzder(2,2,2)= 0.0d0 > uzder(3,2,2)= dc_norm(1,i) > uzder(1,3,2)= dc_norm(2,i) > uzder(2,3,2)=-dc_norm(1,i) > uzder(3,3,2)= 0.0d0 > C Compute the Y-axis > facy=fac > do k=1,3 > uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i)) > enddo > C Compute the derivatives of uy > do j=1,3 > do k=1,3 > uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) > & -dc_norm(k,i)*dc_norm(j,i-1) > uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i) > enddo > uyder(j,j,1)=uyder(j,j,1)-costh > uyder(j,j,2)=1.0d0+uyder(j,j,2) > enddo > do j=1,2 > do k=1,3 > do l=1,3 > uygrad(l,k,j,i)=uyder(l,k,j) > uzgrad(l,k,j,i)=uzder(l,k,j) > enddo > enddo > enddo > call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i)) > call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i)) > call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i)) > call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i)) > else > C Other residues > C Compute the Z-axis > call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i)) > costh=dcos(pi-theta(i+2)) > fac=1.0d0/dsqrt(1.0d0-costh*costh) > do k=1,3 > uz(k,i)=fac*uz(k,i) > enddo > C Compute the derivatives of uz > uzder(1,1,1)= 0.0d0 > uzder(2,1,1)=-dc_norm(3,i+1) > uzder(3,1,1)= dc_norm(2,i+1) > uzder(1,2,1)= dc_norm(3,i+1) > uzder(2,2,1)= 0.0d0 > uzder(3,2,1)=-dc_norm(1,i+1) > uzder(1,3,1)=-dc_norm(2,i+1) > uzder(2,3,1)= dc_norm(1,i+1) > uzder(3,3,1)= 0.0d0 > uzder(1,1,2)= 0.0d0 > uzder(2,1,2)= dc_norm(3,i) > uzder(3,1,2)=-dc_norm(2,i) > uzder(1,2,2)=-dc_norm(3,i) > uzder(2,2,2)= 0.0d0 > uzder(3,2,2)= dc_norm(1,i) > uzder(1,3,2)= dc_norm(2,i) > uzder(2,3,2)=-dc_norm(1,i) > uzder(3,3,2)= 0.0d0 > C Compute the Y-axis > facy=fac > do k=1,3 > uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i)) > enddo > C Compute the derivatives of uy > do j=1,3 > do k=1,3 > uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) > & -dc_norm(k,i)*dc_norm(j,i+1) > uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i) > enddo > uyder(j,j,1)=uyder(j,j,1)-costh > uyder(j,j,2)=1.0d0+uyder(j,j,2) > enddo > do j=1,2 > do k=1,3 > do l=1,3 > uygrad(l,k,j,i)=uyder(l,k,j) > uzgrad(l,k,j,i)=uzder(l,k,j) > enddo > enddo > enddo > call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i)) > call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i)) > call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i)) > call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i)) > endif > enddo > do i=1,nres-1 > vbld_inv_temp(1)=vbld_inv(i+1) > if (i.lt.nres-1) then > vbld_inv_temp(2)=vbld_inv(i+2) > else > vbld_inv_temp(2)=vbld_inv(i) > endif > do j=1,2 > do k=1,3 > do l=1,3 > uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i) > uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i) > enddo > enddo > enddo > enddo > #ifdef MPI > if (nfgtasks.gt.1) then > time00=MPI_Wtime() > c print *,"Processor",fg_rank,kolor," ivec_start",ivec_start, > c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1), > c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1) > call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank), > & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ, > & FG_COMM,IERR) > call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank), > & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ, > & FG_COMM,IERR) > call MPI_Allgatherv(uygrad(1,1,1,ivec_start), > & ivec_count(fg_rank),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0), > & ivec_displ(0),MPI_UYZGRAD,FG_COMM,IERR) > call MPI_Allgatherv(uzgrad(1,1,1,ivec_start), > & ivec_count(fg_rank),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0), > & ivec_displ(0),MPI_UYZGRAD,FG_COMM,IERR) > endif > time_gather=time_gather+MPI_Wtime()-time00 > c if (fg_rank.eq.0) then > c write (iout,*) "Arrays UY and UZ" > c do i=1,nres-1 > c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3), > c & (uz(k,i),k=1,3) > c enddo > c endif > #endif > return > end > C----------------------------------------------------------------------------- > subroutine check_vecgrad > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.IOUNITS' > include 'COMMON.GEO' > include 'COMMON.VAR' > include 'COMMON.LOCAL' > include 'COMMON.CHAIN' > include 'COMMON.VECTORS' > dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres) > dimension uyt(3,maxres),uzt(3,maxres) > dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3) > double precision delta /1.0d-7/ > call vec_and_deriv > cd do i=1,nres > crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i) > crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i) > crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i) > cd write(iout,'(2i5,2(3f10.5,5x))') i,1, > cd & (dc_norm(if90,i),if90=1,3) > cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3) > cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3) > cd write(iout,'(a)') > cd enddo > do i=1,nres > do j=1,2 > do k=1,3 > do l=1,3 > uygradt(l,k,j,i)=uygrad(l,k,j,i) > uzgradt(l,k,j,i)=uzgrad(l,k,j,i) > enddo > enddo > enddo > enddo > call vec_and_deriv > do i=1,nres > do j=1,3 > uyt(j,i)=uy(j,i) > uzt(j,i)=uz(j,i) > enddo > enddo > do i=1,nres > cd write (iout,*) 'i=',i > do k=1,3 > erij(k)=dc_norm(k,i) > enddo > do j=1,3 > do k=1,3 > dc_norm(k,i)=erij(k) > enddo > dc_norm(j,i)=dc_norm(j,i)+delta > c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i))) > c do k=1,3 > c dc_norm(k,i)=dc_norm(k,i)/fac > c enddo > c write (iout,*) (dc_norm(k,i),k=1,3) > c write (iout,*) (erij(k),k=1,3) > call vec_and_deriv > do k=1,3 > uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta > uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta > uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta > uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta > enddo > c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)') > c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3), > c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3) > enddo > do k=1,3 > dc_norm(k,i)=erij(k) > enddo > cd do k=1,3 > cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)') > cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3), > cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3) > cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)') > cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3), > cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3) > cd write (iout,'(a)') > cd enddo > enddo > return > end > C-------------------------------------------------------------------------- > subroutine set_matrices > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.IOUNITS' > include 'COMMON.GEO' > include 'COMMON.VAR' > include 'COMMON.LOCAL' > include 'COMMON.CHAIN' > include 'COMMON.DERIV' > include 'COMMON.INTERACT' > include 'COMMON.CONTACTS' > include 'COMMON.TORSION' > include 'COMMON.VECTORS' > include 'COMMON.FFIELD' > double precision auxvec(2),auxmat(2,2) > C > C Compute the virtual-bond-torsional-angle dependent quantities needed > C to calculate the el-loc multibody terms of various order. > C > do i=3,nres+1 > if (i .lt. nres+1) then > sin1=dsin(phi(i)) > cos1=dcos(phi(i)) > sintab(i-2)=sin1 > costab(i-2)=cos1 > obrot(1,i-2)=cos1 > obrot(2,i-2)=sin1 > sin2=dsin(2*phi(i)) > cos2=dcos(2*phi(i)) > sintab2(i-2)=sin2 > costab2(i-2)=cos2 > obrot2(1,i-2)=cos2 > obrot2(2,i-2)=sin2 > Ug(1,1,i-2)=-cos1 > Ug(1,2,i-2)=-sin1 > Ug(2,1,i-2)=-sin1 > Ug(2,2,i-2)= cos1 > Ug2(1,1,i-2)=-cos2 > Ug2(1,2,i-2)=-sin2 > Ug2(2,1,i-2)=-sin2 > Ug2(2,2,i-2)= cos2 > else > costab(i-2)=1.0d0 > sintab(i-2)=0.0d0 > obrot(1,i-2)=1.0d0 > obrot(2,i-2)=0.0d0 > obrot2(1,i-2)=0.0d0 > obrot2(2,i-2)=0.0d0 > Ug(1,1,i-2)=1.0d0 > Ug(1,2,i-2)=0.0d0 > Ug(2,1,i-2)=0.0d0 > Ug(2,2,i-2)=1.0d0 > Ug2(1,1,i-2)=0.0d0 > Ug2(1,2,i-2)=0.0d0 > Ug2(2,1,i-2)=0.0d0 > Ug2(2,2,i-2)=0.0d0 > endif > if (i .gt. 3 .and. i .lt. nres+1) then > obrot_der(1,i-2)=-sin1 > obrot_der(2,i-2)= cos1 > Ugder(1,1,i-2)= sin1 > Ugder(1,2,i-2)=-cos1 > Ugder(2,1,i-2)=-cos1 > Ugder(2,2,i-2)=-sin1 > dwacos2=cos2+cos2 > dwasin2=sin2+sin2 > obrot2_der(1,i-2)=-dwasin2 > obrot2_der(2,i-2)= dwacos2 > Ug2der(1,1,i-2)= dwasin2 > Ug2der(1,2,i-2)=-dwacos2 > Ug2der(2,1,i-2)=-dwacos2 > Ug2der(2,2,i-2)=-dwasin2 > else > obrot_der(1,i-2)=0.0d0 > obrot_der(2,i-2)=0.0d0 > Ugder(1,1,i-2)=0.0d0 > Ugder(1,2,i-2)=0.0d0 > Ugder(2,1,i-2)=0.0d0 > Ugder(2,2,i-2)=0.0d0 > obrot2_der(1,i-2)=0.0d0 > obrot2_der(2,i-2)=0.0d0 > Ug2der(1,1,i-2)=0.0d0 > Ug2der(1,2,i-2)=0.0d0 > Ug2der(2,1,i-2)=0.0d0 > Ug2der(2,2,i-2)=0.0d0 > endif > c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then > if (i.gt. nnt+2 .and. i.lt.nct+2) then > iti = itortyp(itype(i-2)) > else > iti=ntortyp+1 > endif > c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then > if (i.gt. nnt+1 .and. i.lt.nct+1) then > iti1 = itortyp(itype(i-1)) > else > iti1=ntortyp+1 > endif > cd write (iout,*) '*******i',i,' iti1',iti > cd write (iout,*) 'b1',b1(:,iti) > cd write (iout,*) 'b2',b2(:,iti) > cd write (iout,*) 'Ug',Ug(:,:,i-2) > c if (i .gt. iatel_s+2) then > if (i .gt. nnt+2) then > call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2)) > call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2)) > call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2)) > call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2)) > call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2)) > call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2)) > call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2)) > else > do k=1,2 > Ub2(k,i-2)=0.0d0 > Ctobr(k,i-2)=0.0d0 > Dtobr2(k,i-2)=0.0d0 > do l=1,2 > EUg(l,k,i-2)=0.0d0 > CUg(l,k,i-2)=0.0d0 > DUg(l,k,i-2)=0.0d0 > DtUg2(l,k,i-2)=0.0d0 > enddo > enddo > endif > call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2)) > call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2)) > call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2)) > call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2)) > call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2)) > call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2)) > call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2)) > do k=1,2 > muder(k,i-2)=Ub2der(k,i-2) > enddo > c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then > if (i.gt. nnt+1 .and. i.lt.nct+1) then > iti1 = itortyp(itype(i-1)) > else > iti1=ntortyp+1 > endif > do k=1,2 > mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1) > enddo > C Vectors and matrices dependent on a single virtual-bond dihedral. > call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1)) > call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2)) > call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2)) > call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2)) > call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2)) > call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2)) > call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2)) > call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2)) > call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2)) > cd write (iout,*) 'mu ',mu(:,i-2) > cd write (iout,*) 'mu1',mu1(:,i-2) > cd write (iout,*) 'mu2',mu2(:,i-2) > enddo > C Matrices dependent on two consecutive virtual-bond dihedrals. > C The order of matrices is from left to right. > do i=2,nres-1 > call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i)) > call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i)) > call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i)) > call transpose2(DtUg2(1,1,i-1),auxmat(1,1)) > call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i)) > call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i)) > call transpose2(DtUg2der(1,1,i-1),auxmat(1,1)) > call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i)) > enddo > cd do i=1,nres > cd iti = itortyp(itype(i)) > cd write (iout,*) i > cd do j=1,2 > cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)') > cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2) > cd enddo > cd enddo > return > end > C-------------------------------------------------------------------------- > subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) 1420,1422c2159 < common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33, < & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi, < & num_conti,j1,j2 --- > common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2 1434,1485c2171,2284 < ind=ind+1 < iteli=itel(i) < itelj=itel(j) < if (j.eq.i+2 .and. itelj.eq.2) iteli=2 < aaa=app(iteli,itelj) < bbb=bpp(iteli,itelj) < ael6i=ael6(iteli,itelj) < ael3i=ael3(iteli,itelj) < C Diagnostics only!!! < c aaa=0.0D0 < c bbb=0.0D0 < c ael6i=0.0D0 < c ael3i=0.0D0 < C End diagnostics < dxj=dc(1,j) < dyj=dc(2,j) < dzj=dc(3,j) < dx_normj=dc_norm(1,j) < dy_normj=dc_norm(2,j) < dz_normj=dc_norm(3,j) < xj=c(1,j)+0.5D0*dxj-xmedi < yj=c(2,j)+0.5D0*dyj-ymedi < zj=c(3,j)+0.5D0*dzj-zmedi < rij=xj*xj+yj*yj+zj*zj < rrmij=1.0D0/rij < rij=dsqrt(rij) < rmij=1.0D0/rij < c For extracting the short-range part of Evdwpp < sss=sscale(rij/rpp(iteli,itelj)) < c < r3ij=rrmij*rmij < r6ij=r3ij*r3ij < cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj < cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij < cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij < fac=cosa-3.0D0*cosb*cosg < ev1=aaa*r6ij*r6ij < c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions < if (j.eq.i+2) ev1=scal_el*ev1 < ev2=bbb*r6ij < fac3=ael6i*r6ij < fac4=ael3i*r3ij < evdwij=ev1+ev2 < el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)) < el2=fac4*fac < eesij=el1+el2 < C 12/26/95 - for the evaluation of multi-body H-bonding interactions < ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg) < ees=ees+eesij < evdw1=evdw1+evdwij*(1.0d0-sss) < cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)') < cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i, --- > cd write(iout,*) 'In EELEC' > cd do i=1,nloctyp > cd write(iout,*) 'Type',i > cd write(iout,*) 'B1',B1(:,i) > cd write(iout,*) 'B2',B2(:,i) > cd write(iout,*) 'CC',CC(:,:,i) > cd write(iout,*) 'DD',DD(:,:,i) > cd write(iout,*) 'EE',EE(:,:,i) > cd enddo > cd call check_vecgrad > cd stop > if (icheckgrad.eq.1) then > do i=1,nres-1 > fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i))) > do k=1,3 > dc_norm(k,i)=dc(k,i)*fac > enddo > c write (iout,*) 'i',i,' fac',fac > enddo > endif > if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 > & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. > & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then > c call vec_and_deriv > call set_matrices > endif > cd do i=1,nres-1 > cd write (iout,*) 'i=',i > cd do k=1,3 > cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i) > cd enddo > cd do k=1,3 > cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)') > cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3) > cd enddo > cd enddo > num_conti_hb=0 > ees=0.0D0 > evdw1=0.0D0 > eel_loc=0.0d0 > eello_turn3=0.0d0 > eello_turn4=0.0d0 > ind=0 > do i=1,nres > num_cont_hb(i)=0 > enddo > cd print '(a)','Enter EELEC' > cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e > do i=1,nres > gel_loc_loc(i)=0.0d0 > gcorr_loc(i)=0.0d0 > enddo > do i=iatel_s,iatel_e > dxi=dc(1,i) > dyi=dc(2,i) > dzi=dc(3,i) > dx_normi=dc_norm(1,i) > dy_normi=dc_norm(2,i) > dz_normi=dc_norm(3,i) > xmedi=c(1,i)+0.5d0*dxi > ymedi=c(2,i)+0.5d0*dyi > zmedi=c(3,i)+0.5d0*dzi > num_conti=0 > c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) > do j=ielstart(i),ielend(i) > ind=ind+1 > iteli=itel(i) > itelj=itel(j) > if (j.eq.i+2 .and. itelj.eq.2) iteli=2 > aaa=app(iteli,itelj) > bbb=bpp(iteli,itelj) > ael6i=ael6(iteli,itelj) > ael3i=ael3(iteli,itelj) > C Diagnostics only!!! > c aaa=0.0D0 > c bbb=0.0D0 > c ael6i=0.0D0 > c ael3i=0.0D0 > C End diagnostics > dxj=dc(1,j) > dyj=dc(2,j) > dzj=dc(3,j) > dx_normj=dc_norm(1,j) > dy_normj=dc_norm(2,j) > dz_normj=dc_norm(3,j) > xj=c(1,j)+0.5D0*dxj-xmedi > yj=c(2,j)+0.5D0*dyj-ymedi > zj=c(3,j)+0.5D0*dzj-zmedi > rij=xj*xj+yj*yj+zj*zj > rrmij=1.0D0/rij > rij=dsqrt(rij) > rmij=1.0D0/rij > r3ij=rrmij*rmij > r6ij=r3ij*r3ij > cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj > cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij > cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij > fac=cosa-3.0D0*cosb*cosg > ev1=aaa*r6ij*r6ij > c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions > if (j.eq.i+2) ev1=scal_el*ev1 > ev2=bbb*r6ij > fac3=ael6i*r6ij > fac4=ael3i*r3ij > evdwij=ev1+ev2 > el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)) > el2=fac4*fac > eesij=el1+el2 > C 12/26/95 - for the evaluation of multi-body H-bonding interactions > ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg) > ees=ees+eesij > evdw1=evdw1+evdwij > cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)') > cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i, 1498c2297 < facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss) --- > facvdw=-6*rrmij*(ev1+evdwij) 1540c2339 < facvdw=(ev1+evdwij)*(1.0d0-sss) --- > facvdw=ev1+evdwij 1876a2676,2683 > if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then > C Contributions from turns > a_temp(1,1)=a22 > a_temp(1,2)=a23 > a_temp(2,1)=a32 > a_temp(2,2)=a33 > call eturn34(i,j,eello_turn3,eello_turn4) > endif 2073a2881,2889 > enddo ! j > num_cont_hb(i)=num_conti > enddo ! i > cd do i=1,nres > cd write (iout,'(i3,3f10.5,5x,3f10.5)') > cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i) > cd enddo > c 12/7/99 Adam eello_turn3 will be considered as a separate energy term > ccc eel_loc=eel_loc+eello_turn3 2076,2080c2892,2894 < C----------------------------------------------------------------------- < subroutine evdwpp_long(evdw1) < C < C Compute Evdwpp < C --- > C----------------------------------------------------------------------------- > subroutine eturn34(i,j,eello_turn3,eello_turn4) > C Third- and fourth-order contributions from turns 2083d2896 < include 'COMMON.CONTROL' 2094a2908 > include 'COMMON.CONTROL' 2096,2148c2910,2917 < c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions < #ifdef MOMENT < double precision scal_el /1.0d0/ < #else < double precision scal_el /0.5d0/ < #endif < evdw1=0.0D0 < do i=iatel_s,iatel_e < dxi=dc(1,i) < dyi=dc(2,i) < dzi=dc(3,i) < dx_normi=dc_norm(1,i) < dy_normi=dc_norm(2,i) < dz_normi=dc_norm(3,i) < xmedi=c(1,i)+0.5d0*dxi < ymedi=c(2,i)+0.5d0*dyi < zmedi=c(3,i)+0.5d0*dzi < num_conti=0 < c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) < do j=ielstart(i),ielend(i) < ind=ind+1 < iteli=itel(i) < itelj=itel(j) < if (j.eq.i+2 .and. itelj.eq.2) iteli=2 < aaa=app(iteli,itelj) < bbb=bpp(iteli,itelj) < dxj=dc(1,j) < dyj=dc(2,j) < dzj=dc(3,j) < dx_normj=dc_norm(1,j) < dy_normj=dc_norm(2,j) < dz_normj=dc_norm(3,j) < xj=c(1,j)+0.5D0*dxj-xmedi < yj=c(2,j)+0.5D0*dyj-ymedi < zj=c(3,j)+0.5D0*dzj-zmedi < rij=xj*xj+yj*yj+zj*zj < rrmij=1.0D0/rij < rij=dsqrt(rij) < sss=sscale(rij/rpp(iteli,itelj)) < if (sss.lt.1.0d0) then < rmij=1.0D0/rij < r3ij=rrmij*rmij < r6ij=r3ij*r3ij < ev1=aaa*r6ij*r6ij < c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions < if (j.eq.i+2) ev1=scal_el*ev1 < ev2=bbb*r6ij < evdwij=ev1+ev2 < if (energy_dec) then < write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij < write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij < endif < evdw1=evdw1+evdwij*(1.0d0-sss) --- > double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2), > & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2), > & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2) > double precision agg(3,4),aggi(3,4),aggi1(3,4), > & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2) > common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2 > if (j.eq.i+2) then > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2150c2919,2980 < C Calculate contributions to the Cartesian gradient. --- > C Third-order contributions > C > C (i+2)o----(i+3) > C | | > C | | > C (i+1)o----i > C > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC > cd call checkint_turn3(i,a_temp,eello_turn3_num) > call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1)) > call transpose2(auxmat(1,1),auxmat1(1,1)) > call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) > eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) > if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') > & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2)) > cd write (2,*) 'i,',i,' j',j,'eello_turn3', > cd & 0.5d0*(pizda(1,1)+pizda(2,2)), > cd & ' eello_turn3_num',4*eello_turn3_num > C Derivatives in gamma(i) > call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1)) > call transpose2(auxmat2(1,1),auxmat3(1,1)) > call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1)) > gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2)) > C Derivatives in gamma(i+1) > call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1)) > call transpose2(auxmat2(1,1),auxmat3(1,1)) > call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1)) > gel_loc_turn3(i+1)=gel_loc_turn3(i+1) > & +0.5d0*(pizda(1,1)+pizda(2,2)) > C Cartesian derivatives > do l=1,3 > a_temp(1,1)=aggi(l,1) > a_temp(1,2)=aggi(l,2) > a_temp(2,1)=aggi(l,3) > a_temp(2,2)=aggi(l,4) > call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) > gcorr3_turn(l,i)=gcorr3_turn(l,i) > & +0.5d0*(pizda(1,1)+pizda(2,2)) > a_temp(1,1)=aggi1(l,1) > a_temp(1,2)=aggi1(l,2) > a_temp(2,1)=aggi1(l,3) > a_temp(2,2)=aggi1(l,4) > call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) > gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) > & +0.5d0*(pizda(1,1)+pizda(2,2)) > a_temp(1,1)=aggj(l,1) > a_temp(1,2)=aggj(l,2) > a_temp(2,1)=aggj(l,3) > a_temp(2,2)=aggj(l,4) > call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) > gcorr3_turn(l,j)=gcorr3_turn(l,j) > & +0.5d0*(pizda(1,1)+pizda(2,2)) > a_temp(1,1)=aggj1(l,1) > a_temp(1,2)=aggj1(l,2) > a_temp(2,1)=aggj1(l,3) > a_temp(2,2)=aggj1(l,4) > call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1)) > gcorr3_turn(l,j1)=gcorr3_turn(l,j1) > & +0.5d0*(pizda(1,1)+pizda(2,2)) > enddo > else if (j.eq.i+3) then > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2152,2172c2982,3119 < facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss) < ggg(1)=facvdw*xj < ggg(2)=facvdw*yj < ggg(3)=facvdw*zj < < do k=1,3 < ghalf=0.5D0*ggg(k) < gvdwpp(k,i)=gvdwpp(k,i)+ghalf < gvdwpp(k,j)=gvdwpp(k,j)+ghalf < enddo < * < * Loop over residues i+1 thru j-1. < * < do k=i+1,j-1 < do l=1,3 < gvdwpp(l,k)=gvdwpp(l,k)+ggg(l) < enddo < enddo < endif < enddo ! j < enddo ! i --- > C Fourth-order contributions > C > C (i+3)o----(i+4) > C / | > C (i+2)o | > C \ | > C (i+1)o----i > C > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC > cd call checkint_turn4(i,a_temp,eello_turn4_num) > iti1=itortyp(itype(i+1)) > iti2=itortyp(itype(i+2)) > iti3=itortyp(itype(i+3)) > call transpose2(EUg(1,1,i+1),e1t(1,1)) > call transpose2(Eug(1,1,i+2),e2t(1,1)) > call transpose2(Eug(1,1,i+3),e3t(1,1)) > call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) > call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) > s1=scalar2(b1(1,iti2),auxvec(1)) > call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) > call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) > s2=scalar2(b1(1,iti1),auxvec(1)) > call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) > call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) > s3=0.5d0*(pizda(1,1)+pizda(2,2)) > eello_turn4=eello_turn4-(s1+s2+s3) > if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') > & 'eturn4',i,j,-(s1+s2+s3) > cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3), > cd & ' eello_turn4_num',8*eello_turn4_num > C Derivatives in gamma(i) > call transpose2(EUgder(1,1,i+1),e1tder(1,1)) > call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1)) > call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1)) > s1=scalar2(b1(1,iti2),auxvec(1)) > call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1)) > s3=0.5d0*(pizda(1,1)+pizda(2,2)) > gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) > C Derivatives in gamma(i+1) > call transpose2(EUgder(1,1,i+2),e2tder(1,1)) > call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1)) > s2=scalar2(b1(1,iti1),auxvec(1)) > call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1)) > call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1)) > s3=0.5d0*(pizda(1,1)+pizda(2,2)) > gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) > C Derivatives in gamma(i+2) > call transpose2(EUgder(1,1,i+3),e3tder(1,1)) > call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1)) > s1=scalar2(b1(1,iti2),auxvec(1)) > call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1)) > call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1)) > s2=scalar2(b1(1,iti1),auxvec(1)) > call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1)) > call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1)) > s3=0.5d0*(pizda(1,1)+pizda(2,2)) > gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) > C Cartesian derivatives > C Derivatives of this turn contributions in DC(i+2) > if (j.lt.nres-1) then > do l=1,3 > a_temp(1,1)=agg(l,1) > a_temp(1,2)=agg(l,2) > a_temp(2,1)=agg(l,3) > a_temp(2,2)=agg(l,4) > call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) > call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) > s1=scalar2(b1(1,iti2),auxvec(1)) > call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) > call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) > s2=scalar2(b1(1,iti1),auxvec(1)) > call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) > call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) > s3=0.5d0*(pizda(1,1)+pizda(2,2)) > ggg(l)=-(s1+s2+s3) > gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3) > enddo > endif > C Remaining derivatives of this turn contribution > do l=1,3 > a_temp(1,1)=aggi(l,1) > a_temp(1,2)=aggi(l,2) > a_temp(2,1)=aggi(l,3) > a_temp(2,2)=aggi(l,4) > call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) > call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) > s1=scalar2(b1(1,iti2),auxvec(1)) > call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) > call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) > s2=scalar2(b1(1,iti1),auxvec(1)) > call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) > call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) > s3=0.5d0*(pizda(1,1)+pizda(2,2)) > gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) > a_temp(1,1)=aggi1(l,1) > a_temp(1,2)=aggi1(l,2) > a_temp(2,1)=aggi1(l,3) > a_temp(2,2)=aggi1(l,4) > call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) > call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) > s1=scalar2(b1(1,iti2),auxvec(1)) > call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) > call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) > s2=scalar2(b1(1,iti1),auxvec(1)) > call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) > call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) > s3=0.5d0*(pizda(1,1)+pizda(2,2)) > gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) > a_temp(1,1)=aggj(l,1) > a_temp(1,2)=aggj(l,2) > a_temp(2,1)=aggj(l,3) > a_temp(2,2)=aggj(l,4) > call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) > call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) > s1=scalar2(b1(1,iti2),auxvec(1)) > call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) > call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) > s2=scalar2(b1(1,iti1),auxvec(1)) > call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) > call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) > s3=0.5d0*(pizda(1,1)+pizda(2,2)) > gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) > a_temp(1,1)=aggj1(l,1) > a_temp(1,2)=aggj1(l,2) > a_temp(2,1)=aggj1(l,3) > a_temp(2,2)=aggj1(l,4) > call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1)) > call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1)) > s1=scalar2(b1(1,iti2),auxvec(1)) > call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1)) > call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1)) > s2=scalar2(b1(1,iti1),auxvec(1)) > call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1)) > call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) > s3=0.5d0*(pizda(1,1)+pizda(2,2)) > gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) > enddo > endif 2175,2176c3122,3160 < C----------------------------------------------------------------------- < subroutine evdwpp_short(evdw1) --- > C----------------------------------------------------------------------------- > subroutine vecpr(u,v,w) > implicit real*8(a-h,o-z) > dimension u(3),v(3),w(3) > w(1)=u(2)*v(3)-u(3)*v(2) > w(2)=-u(1)*v(3)+u(3)*v(1) > w(3)=u(1)*v(2)-u(2)*v(1) > return > end > C----------------------------------------------------------------------------- > subroutine unormderiv(u,ugrad,unorm,ungrad) > C This subroutine computes the derivatives of a normalized vector u, given > C the derivatives computed without normalization conditions, ugrad. Returns > C ungrad. > implicit none > double precision u(3),ugrad(3,3),unorm,ungrad(3,3) > double precision vec(3) > double precision scalar > integer i,j > c write (2,*) 'ugrad',ugrad > c write (2,*) 'u',u > do i=1,3 > vec(i)=scalar(ugrad(1,i),u(1)) > enddo > c write (2,*) 'vec',vec > do i=1,3 > do j=1,3 > ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm > enddo > enddo > c write (2,*) 'ungrad',ungrad > return > end > C----------------------------------------------------------------------------- > subroutine escp_soft_sphere(evdw2,evdw2_14) > C > C This subroutine calculates the excluded-volume interaction energy between > C peptide-group centers and side chains and its gradient in virtual-bond and > C side-chain vectors. 2178,2179d3161 < C Compute Evdwpp < C 2182,2183d3163 < include 'COMMON.CONTROL' < include 'COMMON.IOUNITS' 2190,2192d3169 < include 'COMMON.CONTACTS' < include 'COMMON.TORSION' < include 'COMMON.VECTORS' 2194,2291c3171,3172 < dimension ggg(3) < c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions < #ifdef MOMENT < double precision scal_el /1.0d0/ < #else < double precision scal_el /0.5d0/ < #endif < evdw1=0.0D0 < do i=iatel_s,iatel_e < dxi=dc(1,i) < dyi=dc(2,i) < dzi=dc(3,i) < dx_normi=dc_norm(1,i) < dy_normi=dc_norm(2,i) < dz_normi=dc_norm(3,i) < xmedi=c(1,i)+0.5d0*dxi < ymedi=c(2,i)+0.5d0*dyi < zmedi=c(3,i)+0.5d0*dzi < num_conti=0 < c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) < do j=ielstart(i),ielend(i) < ind=ind+1 < iteli=itel(i) < itelj=itel(j) < if (j.eq.i+2 .and. itelj.eq.2) iteli=2 < aaa=app(iteli,itelj) < bbb=bpp(iteli,itelj) < dxj=dc(1,j) < dyj=dc(2,j) < dzj=dc(3,j) < dx_normj=dc_norm(1,j) < dy_normj=dc_norm(2,j) < dz_normj=dc_norm(3,j) < xj=c(1,j)+0.5D0*dxj-xmedi < yj=c(2,j)+0.5D0*dyj-ymedi < zj=c(3,j)+0.5D0*dzj-zmedi < rij=xj*xj+yj*yj+zj*zj < rrmij=1.0D0/rij < rij=dsqrt(rij) < sss=sscale(rij/rpp(iteli,itelj)) < if (sss.gt.0.0d0) then < rmij=1.0D0/rij < r3ij=rrmij*rmij < r6ij=r3ij*r3ij < ev1=aaa*r6ij*r6ij < c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions < if (j.eq.i+2) ev1=scal_el*ev1 < ev2=bbb*r6ij < evdwij=ev1+ev2 < if (energy_dec) then < write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij < write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij < endif < evdw1=evdw1+evdwij*sss < C < C Calculate contributions to the Cartesian gradient. < C < facvdw=-6*rrmij*(ev1+evdwij)*sss < ggg(1)=facvdw*xj < ggg(2)=facvdw*yj < ggg(3)=facvdw*zj < < do k=1,3 < ghalf=0.5D0*ggg(k) < gvdwpp(k,i)=gvdwpp(k,i)+ghalf < gvdwpp(k,j)=gvdwpp(k,j)+ghalf < enddo < * < * Loop over residues i+1 thru j-1. < * < do k=i+1,j-1 < do l=1,3 < gvdwpp(l,k)=gvdwpp(l,k)+ggg(l) < enddo < enddo < endif < enddo ! j < enddo ! i < return < end < C----------------------------------------------------------------------------- < subroutine escp_long(evdw2,evdw2_14) < C < C This subroutine calculates the excluded-volume interaction energy between < C peptide-group centers and side chains and its gradient in virtual-bond and < C side-chain vectors. < C < implicit real*8 (a-h,o-z) < include 'DIMENSIONS' < include 'COMMON.GEO' < include 'COMMON.VAR' < include 'COMMON.LOCAL' < include 'COMMON.CHAIN' < include 'COMMON.DERIV' < include 'COMMON.INTERACT' < include 'COMMON.FFIELD' < include 'COMMON.IOUNITS' < include 'COMMON.CONTROL' --- > include 'COMMON.IOUNITS' > include 'COMMON.CONTROL' 2294a3176 > r0_scp=4.5d0 2315,2332c3197,3207 < rrij=1.0D0/(xj*xj+yj*yj+zj*zj) < < sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli))) < < if (sss.lt.1.0d0) then < < fac=rrij**expon2 < e1=fac*fac*aad(itypj,iteli) < e2=fac*bad(itypj,iteli) < if (iabs(j-i) .le. 2) then < e1=scal14*e1 < e2=scal14*e2 < evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss) < endif < evdwij=e1+e2 < evdw2=evdw2+evdwij*(1.0d0-sss) < if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') < & 'evdw2',i,j,evdwij --- > rij=xj*xj+yj*yj+zj*zj > r0ij=r0_scp > r0ijsq=r0ij*r0ij > if (rij.lt.r0ijsq) then > evdwij=0.25d0*(rij-r0ijsq)**2 > fac=rij-r0ijsq > else > evdwij=0.0d0 > fac=0.0d0 > endif > evdw2=evdw2+evdwij 2336,2341c3211,3215 < fac=-(evdwij+e1)*rrij*(1.0d0-sss) < ggg(1)=xj*fac < ggg(2)=yj*fac < ggg(3)=zj*fac < if (j.lt.i) then < cd write (iout,*) 'j ggg(1)=xj*fac > ggg(2)=yj*fac > ggg(3)=zj*fac > if (j.lt.i) then > cd write (iout,*) 'j c do k=1,3 2345,2353c3219,3221 < c enddo < else < cd write (iout,*) 'j>i' < do k=1,3 < ggg(k)=-ggg(k) < C Uncomment following line for SC-p interactions < c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) < enddo < endif --- > c enddo > else > cd write (iout,*) 'j>i' 2355c3223,3225 < gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) --- > ggg(k)=-ggg(k) > C Uncomment following line for SC-p interactions > c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) 2357,2358c3227,3232 < kstart=min0(i+1,j) < kend=max0(i-1,j-1) --- > endif > do k=1,3 > gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) > enddo > kstart=min0(i+1,j) > kend=max0(i-1,j-1) 2361,2364c3235,3237 < do k=kstart,kend < do l=1,3 < gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) < enddo --- > do k=kstart,kend > do l=1,3 > gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) 2366,2368c3239 < < endif < --- > enddo 2373,2387d3243 < do i=1,nct < do j=1,3 < gvdwc_scp(j,i)=expon*gvdwc_scp(j,i) < gradx_scp(j,i)=expon*gradx_scp(j,i) < enddo < enddo < C****************************************************************************** < C < C N O T E !!! < C < C To save time the factor EXPON has been extracted from ALL components < C of GVDWC and GRADX. Remember to multiply them by this factor before further < C use! < C < C****************************************************************************** 2391c3247 < subroutine escp_short(evdw2,evdw2_14) --- > subroutine escp(evdw2,evdw2_14) 2432,2448c3288,3299 < < sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli))) < < if (sss.gt.0.0d0) then < < fac=rrij**expon2 < e1=fac*fac*aad(itypj,iteli) < e2=fac*bad(itypj,iteli) < if (iabs(j-i) .le. 2) then < e1=scal14*e1 < e2=scal14*e2 < evdw2_14=evdw2_14+(e1+e2)*sss < endif < evdwij=e1+e2 < evdw2=evdw2+evdwij*sss < if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') < & 'evdw2',i,j,evdwij --- > fac=rrij**expon2 > e1=fac*fac*aad(itypj,iteli) > e2=fac*bad(itypj,iteli) > if (iabs(j-i) .le. 2) then > e1=scal14*e1 > e2=scal14*e2 > evdw2_14=evdw2_14+e1+e2 > endif > evdwij=e1+e2 > evdw2=evdw2+evdwij > if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') > & 'evdw2',i,j,evdwij 2452,2457c3303,3308 < fac=-(evdwij+e1)*rrij*sss < ggg(1)=xj*fac < ggg(2)=yj*fac < ggg(3)=zj*fac < if (j.lt.i) then < cd write (iout,*) 'j fac=-(evdwij+e1)*rrij > ggg(1)=xj*fac > ggg(2)=yj*fac > ggg(3)=zj*fac > if (j.lt.i) then > cd write (iout,*) 'j c do k=1,3 2461,2469c3312,3314 < c enddo < else < cd write (iout,*) 'j>i' < do k=1,3 < ggg(k)=-ggg(k) < C Uncomment following line for SC-p interactions < c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) < enddo < endif --- > c enddo > else > cd write (iout,*) 'j>i' 2471c3316,3318 < gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) --- > ggg(k)=-ggg(k) > C Uncomment following line for SC-p interactions > c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k) 2473,2474c3320,3325 < kstart=min0(i+1,j) < kend=max0(i-1,j-1) --- > endif > do k=1,3 > gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k) > enddo > kstart=min0(i+1,j) > kend=max0(i-1,j-1) 2477,2480c3328,3330 < do k=kstart,kend < do l=1,3 < gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) < enddo --- > do k=kstart,kend > do l=1,3 > gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l) 2482,2484c3332 < < endif < --- > enddo 2505a3354,7899 > C-------------------------------------------------------------------------- > subroutine edis(ehpb) > C > C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors. > C > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.SBRIDGE' > include 'COMMON.CHAIN' > include 'COMMON.DERIV' > include 'COMMON.VAR' > include 'COMMON.INTERACT' > dimension ggg(3) > ehpb=0.0D0 > cd print *,'edis: nhpb=',nhpb,' fbr=',fbr > cd print *,'link_start=',link_start,' link_end=',link_end > if (link_end.eq.0) return > do i=link_start,link_end > C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a > C CA-CA distance used in regularization of structure. > ii=ihpb(i) > jj=jhpb(i) > C iii and jjj point to the residues for which the distance is assigned. > if (ii.gt.nres) then > iii=ii-nres > jjj=jj-nres > else > iii=ii > jjj=jj > endif > C 24/11/03 AL: SS bridges handled separately because of introducing a specific > C distance and angle dependent SS bond potential. > if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then > call ssbond_ene(iii,jjj,eij) > ehpb=ehpb+2*eij > else > C Calculate the distance between the two points and its difference from the > C target distance. > dd=dist(ii,jj) > rdis=dd-dhpb(i) > C Get the force constant corresponding to this distance. > waga=forcon(i) > C Calculate the contribution to energy. > ehpb=ehpb+waga*rdis*rdis > C > C Evaluate gradient. > C > fac=waga*rdis/dd > cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd, > cd & ' waga=',waga,' fac=',fac > do j=1,3 > ggg(j)=fac*(c(j,jj)-c(j,ii)) > enddo > cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3) > C If this is a SC-SC distance, we need to calculate the contributions to the > C Cartesian gradient in the SC vectors (ghpbx). > if (iii.lt.ii) then > do j=1,3 > ghpbx(j,iii)=ghpbx(j,iii)-ggg(j) > ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j) > enddo > endif > do j=iii,jjj-1 > do k=1,3 > ghpbc(k,j)=ghpbc(k,j)+ggg(k) > enddo > enddo > endif > enddo > ehpb=0.5D0*ehpb > return > end > C-------------------------------------------------------------------------- > subroutine ssbond_ene(i,j,eij) > C > C Calculate the distance and angle dependent SS-bond potential energy > C using a free-energy function derived based on RHF/6-31G** ab initio > C calculations of diethyl disulfide. > C > C A. Liwo and U. Kozlowska, 11/24/03 > C > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.SBRIDGE' > include 'COMMON.CHAIN' > include 'COMMON.DERIV' > include 'COMMON.LOCAL' > include 'COMMON.INTERACT' > include 'COMMON.VAR' > include 'COMMON.IOUNITS' > double precision erij(3),dcosom1(3),dcosom2(3),gg(3) > itypi=itype(i) > xi=c(1,nres+i) > yi=c(2,nres+i) > zi=c(3,nres+i) > dxi=dc_norm(1,nres+i) > dyi=dc_norm(2,nres+i) > dzi=dc_norm(3,nres+i) > dsci_inv=dsc_inv(itypi) > itypj=itype(j) > dscj_inv=dsc_inv(itypj) > xj=c(1,nres+j)-xi > yj=c(2,nres+j)-yi > zj=c(3,nres+j)-zi > dxj=dc_norm(1,nres+j) > dyj=dc_norm(2,nres+j) > dzj=dc_norm(3,nres+j) > rrij=1.0D0/(xj*xj+yj*yj+zj*zj) > rij=dsqrt(rrij) > erij(1)=xj*rij > erij(2)=yj*rij > erij(3)=zj*rij > om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3) > om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3) > om12=dxi*dxj+dyi*dyj+dzi*dzj > do k=1,3 > dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k)) > dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k)) > enddo > rij=1.0d0/rij > deltad=rij-d0cm > deltat1=1.0d0-om1 > deltat2=1.0d0+om2 > deltat12=om2-om1+2.0d0 > cosphi=om12-om1*om2 > eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) > & +akct*deltad*deltat12 > & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi > c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth, > c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2, > c & " deltat12",deltat12," eij",eij > ed=2*akcm*deltad+akct*deltat12 > pom1=akct*deltad > pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi > eom1=-2*akth*deltat1-pom1-om2*pom2 > eom2= 2*akth*deltat2+pom1-om1*pom2 > eom12=pom2 > do k=1,3 > gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k) > enddo > do k=1,3 > ghpbx(k,i)=ghpbx(k,i)-gg(k) > & +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv > ghpbx(k,j)=ghpbx(k,j)+gg(k) > & +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv > enddo > C > C Calculate the components of the gradient in DC and X > C > do k=i,j-1 > do l=1,3 > ghpbc(l,k)=ghpbc(l,k)+gg(l) > enddo > enddo > return > end > C-------------------------------------------------------------------------- > subroutine ebond(estr) > c > c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds > c > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.LOCAL' > include 'COMMON.GEO' > include 'COMMON.INTERACT' > include 'COMMON.DERIV' > include 'COMMON.VAR' > include 'COMMON.CHAIN' > include 'COMMON.IOUNITS' > include 'COMMON.NAMES' > include 'COMMON.FFIELD' > include 'COMMON.CONTROL' > include 'COMMON.SETUP' > double precision u(3),ud(3) > estr=0.0d0 > do i=ibondp_start,ibondp_end > diff = vbld(i)-vbldp0 > c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff > estr=estr+diff*diff > do j=1,3 > gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i) > enddo > c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3) > enddo > estr=0.5d0*AKP*estr > c > c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included > c > do i=ibond_start,ibond_end > iti=itype(i) > if (iti.ne.10) then > nbi=nbondterm(iti) > if (nbi.eq.1) then > diff=vbld(i+nres)-vbldsc0(1,iti) > c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff, > c & AKSC(1,iti),AKSC(1,iti)*diff*diff > estr=estr+0.5d0*AKSC(1,iti)*diff*diff > do j=1,3 > gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres) > enddo > else > do j=1,nbi > diff=vbld(i+nres)-vbldsc0(j,iti) > ud(j)=aksc(j,iti)*diff > u(j)=abond0(j,iti)+0.5d0*ud(j)*diff > enddo > uprod=u(1) > do j=2,nbi > uprod=uprod*u(j) > enddo > usum=0.0d0 > usumsqder=0.0d0 > do j=1,nbi > uprod1=1.0d0 > uprod2=1.0d0 > do k=1,nbi > if (k.ne.j) then > uprod1=uprod1*u(k) > uprod2=uprod2*u(k)*u(k) > endif > enddo > usum=usum+uprod1 > usumsqder=usumsqder+ud(j)*uprod2 > enddo > estr=estr+uprod/usum > do j=1,3 > gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres) > enddo > endif > endif > enddo > return > end > #ifdef CRYST_THETA > C-------------------------------------------------------------------------- > subroutine ebend(etheta) > C > C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral > C angles gamma and its derivatives in consecutive thetas and gammas. > C > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.LOCAL' > include 'COMMON.GEO' > include 'COMMON.INTERACT' > include 'COMMON.DERIV' > include 'COMMON.VAR' > include 'COMMON.CHAIN' > include 'COMMON.IOUNITS' > include 'COMMON.NAMES' > include 'COMMON.FFIELD' > include 'COMMON.CONTROL' > common /calcthet/ term1,term2,termm,diffak,ratak, > & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, > & delthe0,sig0inv,sigtc,sigsqtc,delthec,it > double precision y(2),z(2) > delta=0.02d0*pi > c time11=dexp(-2*time) > c time12=1.0d0 > etheta=0.0D0 > c write (*,'(a,i2)') 'EBEND ICG=',icg > do i=ithet_start,ithet_end > C Zero the energy function and its derivative at 0 or pi. > call splinthet(theta(i),0.5d0*delta,ss,ssd) > it=itype(i-1) > if (i.gt.3) then > #ifdef OSF > phii=phi(i) > if (phii.ne.phii) phii=150.0 > #else > phii=phi(i) > #endif > y(1)=dcos(phii) > y(2)=dsin(phii) > else > y(1)=0.0D0 > y(2)=0.0D0 > endif > if (i.lt.nres) then > #ifdef OSF > phii1=phi(i+1) > if (phii1.ne.phii1) phii1=150.0 > phii1=pinorm(phii1) > z(1)=cos(phii1) > #else > phii1=phi(i+1) > z(1)=dcos(phii1) > #endif > z(2)=dsin(phii1) > else > z(1)=0.0D0 > z(2)=0.0D0 > endif > C Calculate the "mean" value of theta from the part of the distribution > C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2). > C In following comments this theta will be referred to as t_c. > thet_pred_mean=0.0d0 > do k=1,2 > athetk=athet(k,it) > bthetk=bthet(k,it) > thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k) > enddo > dthett=thet_pred_mean*ssd > thet_pred_mean=thet_pred_mean*ss+a0thet(it) > C Derivatives of the "mean" values in gamma1 and gamma2. > dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss > dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss > if (theta(i).gt.pi-delta) then > call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0, > & E_tc0) > call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0) > call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1) > call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai, > & E_theta) > call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0, > & E_tc) > else if (theta(i).lt.delta) then > call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0) > call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1) > call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai, > & E_theta) > call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0) > call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0, > & E_tc) > else > call theteng(theta(i),thet_pred_mean,theta0(it),ethetai, > & E_theta,E_tc) > endif > etheta=etheta+ethetai > if (energy_dec) write (iout,'(a6,i5,0pf7.3)') > & 'ebend',i,ethetai > if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1 > if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2 > gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett) > enddo > C Ufff.... We've done all this!!! > return > end > C--------------------------------------------------------------------------- > subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta, > & E_tc) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.LOCAL' > include 'COMMON.IOUNITS' > common /calcthet/ term1,term2,termm,diffak,ratak, > & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, > & delthe0,sig0inv,sigtc,sigsqtc,delthec,it > C Calculate the contributions to both Gaussian lobes. > C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time) > C The "polynomial part" of the "standard deviation" of this part of > C the distribution. > sig=polthet(3,it) > do j=2,0,-1 > sig=sig*thet_pred_mean+polthet(j,it) > enddo > C Derivative of the "interior part" of the "standard deviation of the" > C gamma-dependent Gaussian lobe in t_c. > sigtc=3*polthet(3,it) > do j=2,1,-1 > sigtc=sigtc*thet_pred_mean+j*polthet(j,it) > enddo > sigtc=sig*sigtc > C Set the parameters of both Gaussian lobes of the distribution. > C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc) > fac=sig*sig+sigc0(it) > sigcsq=fac+fac > sigc=1.0D0/sigcsq > C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c > sigsqtc=-4.0D0*sigcsq*sigtc > c print *,i,sig,sigtc,sigsqtc > C Following variable (sigtc) is d[sigma(t_c)]/dt_c > sigtc=-sigtc/(fac*fac) > C Following variable is sigma(t_c)**(-2) > sigcsq=sigcsq*sigcsq > sig0i=sig0(it) > sig0inv=1.0D0/sig0i**2 > delthec=thetai-thet_pred_mean > delthe0=thetai-theta0i > term1=-0.5D0*sigcsq*delthec*delthec > term2=-0.5D0*sig0inv*delthe0*delthe0 > C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and > C NaNs in taking the logarithm. We extract the largest exponent which is added > C to the energy (this being the log of the distribution) at the end of energy > C term evaluation for this virtual-bond angle. > if (term1.gt.term2) then > termm=term1 > term2=dexp(term2-termm) > term1=1.0d0 > else > termm=term2 > term1=dexp(term1-termm) > term2=1.0d0 > endif > C The ratio between the gamma-independent and gamma-dependent lobes of > C the distribution is a Gaussian function of thet_pred_mean too. > diffak=gthet(2,it)-thet_pred_mean > ratak=diffak/gthet(3,it)**2 > ak=dexp(gthet(1,it)-0.5D0*diffak*ratak) > C Let's differentiate it in thet_pred_mean NOW. > aktc=ak*ratak > C Now put together the distribution terms to make complete distribution. > termexp=term1+ak*term2 > termpre=sigc+ak*sig0i > C Contribution of the bending energy from this theta is just the -log of > C the sum of the contributions from the two lobes and the pre-exponential > C factor. Simple enough, isn't it? > ethetai=(-dlog(termexp)-termm+dlog(termpre)) > C NOW the derivatives!!! > C 6/6/97 Take into account the deformation. > E_theta=(delthec*sigcsq*term1 > & +ak*delthe0*sig0inv*term2)/termexp > E_tc=((sigtc+aktc*sig0i)/termpre > & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ > & aktc*term2)/termexp) > return > end > c----------------------------------------------------------------------------- > subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.LOCAL' > include 'COMMON.IOUNITS' > common /calcthet/ term1,term2,termm,diffak,ratak, > & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq, > & delthe0,sig0inv,sigtc,sigsqtc,delthec,it > delthec=thetai-thet_pred_mean > delthe0=thetai-theta0i > C "Thank you" to MAPLE (probably spared one day of hand-differentiation). > t3 = thetai-thet_pred_mean > t6 = t3**2 > t9 = term1 > t12 = t3*sigcsq > t14 = t12+t6*sigsqtc > t16 = 1.0d0 > t21 = thetai-theta0i > t23 = t21**2 > t26 = term2 > t27 = t21*t26 > t32 = termexp > t40 = t32**2 > E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 > & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 > & *(-t12*t9-ak*sig0inv*t27) > return > end > #else > C-------------------------------------------------------------------------- > subroutine ebend(etheta) > C > C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral > C angles gamma and its derivatives in consecutive thetas and gammas. > C ab initio-derived potentials from > c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 > C > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.LOCAL' > include 'COMMON.GEO' > include 'COMMON.INTERACT' > include 'COMMON.DERIV' > include 'COMMON.VAR' > include 'COMMON.CHAIN' > include 'COMMON.IOUNITS' > include 'COMMON.NAMES' > include 'COMMON.FFIELD' > include 'COMMON.CONTROL' > double precision coskt(mmaxtheterm),sinkt(mmaxtheterm), > & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle), > & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble), > & sinph1ph2(maxdouble,maxdouble) > logical lprn /.false./, lprn1 /.false./ > etheta=0.0D0 > do i=ithet_start,ithet_end > dethetai=0.0d0 > dephii=0.0d0 > dephii1=0.0d0 > theti2=0.5d0*theta(i) > ityp2=ithetyp(itype(i-1)) > do k=1,nntheterm > coskt(k)=dcos(k*theti2) > sinkt(k)=dsin(k*theti2) > enddo > if (i.gt.3) then > #ifdef OSF > phii=phi(i) > if (phii.ne.phii) phii=150.0 > #else > phii=phi(i) > #endif > ityp1=ithetyp(itype(i-2)) > do k=1,nsingle > cosph1(k)=dcos(k*phii) > sinph1(k)=dsin(k*phii) > enddo > else > phii=0.0d0 > ityp1=nthetyp+1 > do k=1,nsingle > cosph1(k)=0.0d0 > sinph1(k)=0.0d0 > enddo > endif > if (i.lt.nres) then > #ifdef OSF > phii1=phi(i+1) > if (phii1.ne.phii1) phii1=150.0 > phii1=pinorm(phii1) > #else > phii1=phi(i+1) > #endif > ityp3=ithetyp(itype(i)) > do k=1,nsingle > cosph2(k)=dcos(k*phii1) > sinph2(k)=dsin(k*phii1) > enddo > else > phii1=0.0d0 > ityp3=nthetyp+1 > do k=1,nsingle > cosph2(k)=0.0d0 > sinph2(k)=0.0d0 > enddo > endif > ethetai=aa0thet(ityp1,ityp2,ityp3) > do k=1,ndouble > do l=1,k-1 > ccl=cosph1(l)*cosph2(k-l) > ssl=sinph1(l)*sinph2(k-l) > scl=sinph1(l)*cosph2(k-l) > csl=cosph1(l)*sinph2(k-l) > cosph1ph2(l,k)=ccl-ssl > cosph1ph2(k,l)=ccl+ssl > sinph1ph2(l,k)=scl+csl > sinph1ph2(k,l)=scl-csl > enddo > enddo > if (lprn) then > write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2, > & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1 > write (iout,*) "coskt and sinkt" > do k=1,nntheterm > write (iout,*) k,coskt(k),sinkt(k) > enddo > endif > do k=1,ntheterm > ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k) > dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3) > & *coskt(k) > if (lprn) > & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3), > & " ethetai",ethetai > enddo > if (lprn) then > write (iout,*) "cosph and sinph" > do k=1,nsingle > write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k) > enddo > write (iout,*) "cosph1ph2 and sinph2ph2" > do k=2,ndouble > do l=1,k-1 > write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l), > & sinph1ph2(l,k),sinph1ph2(k,l) > enddo > enddo > write(iout,*) "ethetai",ethetai > endif > do m=1,ntheterm2 > do k=1,nsingle > aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k) > & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k) > & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k) > & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k) > ethetai=ethetai+sinkt(m)*aux > dethetai=dethetai+0.5d0*m*aux*coskt(m) > dephii=dephii+k*sinkt(m)*( > & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)- > & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)) > dephii1=dephii1+k*sinkt(m)*( > & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)- > & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k)) > if (lprn) > & write (iout,*) "m",m," k",k," bbthet", > & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet", > & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet", > & ddthet(k,m,ityp1,ityp2,ityp3)," eethet", > & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai > enddo > enddo > if (lprn) > & write(iout,*) "ethetai",ethetai > do m=1,ntheterm3 > do k=2,ndouble > do l=1,k-1 > aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ > & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+ > & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ > & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l) > ethetai=ethetai+sinkt(m)*aux > dethetai=dethetai+0.5d0*m*coskt(m)*aux > dephii=dephii+l*sinkt(m)*( > & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)- > & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ > & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+ > & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) > dephii1=dephii1+(k-l)*sinkt(m)*( > & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+ > & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+ > & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)- > & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) > if (lprn) then > write (iout,*) "m",m," k",k," l",l," ffthet", > & ffthet(l,k,m,ityp1,ityp2,ityp3), > & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet", > & ggthet(l,k,m,ityp1,ityp2,ityp3), > & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai > write (iout,*) cosph1ph2(l,k)*sinkt(m), > & cosph1ph2(k,l)*sinkt(m), > & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m) > endif > enddo > enddo > enddo > 10 continue > if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') > & i,theta(i)*rad2deg,phii*rad2deg, > & phii1*rad2deg,ethetai > etheta=etheta+ethetai > if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii > if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1 > gloc(nphi+i-2,icg)=wang*dethetai > enddo > return > end > #endif > #ifdef CRYST_SC > c----------------------------------------------------------------------------- > subroutine esc(escloc) > C Calculate the local energy of a side chain and its derivatives in the > C corresponding virtual-bond valence angles THETA and the spherical angles > C ALPHA and OMEGA. > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.GEO' > include 'COMMON.LOCAL' > include 'COMMON.VAR' > include 'COMMON.INTERACT' > include 'COMMON.DERIV' > include 'COMMON.CHAIN' > include 'COMMON.IOUNITS' > include 'COMMON.NAMES' > include 'COMMON.FFIELD' > include 'COMMON.CONTROL' > double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3), > & ddersc0(3),ddummy(3),xtemp(3),temp(3) > common /sccalc/ time11,time12,time112,theti,it,nlobit > delta=0.02d0*pi > escloc=0.0D0 > c write (iout,'(a)') 'ESC' > do i=loc_start,loc_end > it=itype(i) > if (it.eq.10) goto 1 > nlobit=nlob(it) > c print *,'i=',i,' it=',it,' nlobit=',nlobit > c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad > theti=theta(i+1)-pipol > x(1)=dtan(theti) > x(2)=alph(i) > x(3)=omeg(i) > > if (x(2).gt.pi-delta) then > xtemp(1)=x(1) > xtemp(2)=pi-delta > xtemp(3)=x(3) > call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) > xtemp(2)=pi > call enesc(xtemp,escloci1,dersc1,ddummy,.false.) > call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2), > & escloci,dersc(2)) > call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), > & ddersc0(1),dersc(1)) > call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3), > & ddersc0(3),dersc(3)) > xtemp(2)=pi-delta > call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) > xtemp(2)=pi > call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) > call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1, > & dersc0(2),esclocbi,dersc02) > call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1), > & dersc12,dersc01) > call splinthet(x(2),0.5d0*delta,ss,ssd) > dersc0(1)=dersc01 > dersc0(2)=dersc02 > dersc0(3)=0.0d0 > do k=1,3 > dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) > enddo > dersc(2)=dersc(2)+ssd*(escloci-esclocbi) > c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, > c & esclocbi,ss,ssd > escloci=ss*escloci+(1.0d0-ss)*esclocbi > c escloci=esclocbi > c write (iout,*) escloci > else if (x(2).lt.delta) then > xtemp(1)=x(1) > xtemp(2)=delta > xtemp(3)=x(3) > call enesc(xtemp,escloci0,dersc0,ddersc0,.true.) > xtemp(2)=0.0d0 > call enesc(xtemp,escloci1,dersc1,ddummy,.false.) > call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2), > & escloci,dersc(2)) > call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), > & ddersc0(1),dersc(1)) > call spline2(x(2),delta,-delta,dersc0(3),dersc1(3), > & ddersc0(3),dersc(3)) > xtemp(2)=delta > call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.) > xtemp(2)=0.0d0 > call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.) > call spline1(x(2),delta,-delta,esclocbi0,esclocbi1, > & dersc0(2),esclocbi,dersc02) > call spline2(x(2),delta,-delta,dersc0(1),dersc1(1), > & dersc12,dersc01) > dersc0(1)=dersc01 > dersc0(2)=dersc02 > dersc0(3)=0.0d0 > call splinthet(x(2),0.5d0*delta,ss,ssd) > do k=1,3 > dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k) > enddo > dersc(2)=dersc(2)+ssd*(escloci-esclocbi) > c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci, > c & esclocbi,ss,ssd > escloci=ss*escloci+(1.0d0-ss)*esclocbi > c write (iout,*) escloci > else > call enesc(x,escloci,dersc,ddummy,.false.) > endif > > escloc=escloc+escloci > if (energy_dec) write (iout,'(a6,i5,0pf7.3)') > & 'escloc',i,escloci > c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc > > gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ > & wscloc*dersc(1) > gloc(ialph(i,1),icg)=wscloc*dersc(2) > gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3) > 1 continue > enddo > return > end > C--------------------------------------------------------------------------- > subroutine enesc(x,escloci,dersc,ddersc,mixed) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.GEO' > include 'COMMON.LOCAL' > include 'COMMON.IOUNITS' > common /sccalc/ time11,time12,time112,theti,it,nlobit > double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3) > double precision contr(maxlob,-1:1) > logical mixed > c write (iout,*) 'it=',it,' nlobit=',nlobit > escloc_i=0.0D0 > do j=1,3 > dersc(j)=0.0D0 > if (mixed) ddersc(j)=0.0d0 > enddo > x3=x(3) > > C Because of periodicity of the dependence of the SC energy in omega we have > C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi). > C To avoid underflows, first compute & store the exponents. > > do iii=-1,1 > > x(3)=x3+iii*dwapi > > do j=1,nlobit > do k=1,3 > z(k)=x(k)-censc(k,j,it) > enddo > do k=1,3 > Axk=0.0D0 > do l=1,3 > Axk=Axk+gaussc(l,k,j,it)*z(l) > enddo > Ax(k,j,iii)=Axk > enddo > expfac=0.0D0 > do k=1,3 > expfac=expfac+Ax(k,j,iii)*z(k) > enddo > contr(j,iii)=expfac > enddo ! j > > enddo ! iii > > x(3)=x3 > C As in the case of ebend, we want to avoid underflows in exponentiation and > C subsequent NaNs and INFs in energy calculation. > C Find the largest exponent > emin=contr(1,-1) > do iii=-1,1 > do j=1,nlobit > if (emin.gt.contr(j,iii)) emin=contr(j,iii) > enddo > enddo > emin=0.5D0*emin > cd print *,'it=',it,' emin=',emin > > C Compute the contribution to SC energy and derivatives > do iii=-1,1 > > do j=1,nlobit > #ifdef OSF > adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin > if(adexp.ne.adexp) adexp=1.0 > expfac=dexp(adexp) > #else > expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin) > #endif > cd print *,'j=',j,' expfac=',expfac > escloc_i=escloc_i+expfac > do k=1,3 > dersc(k)=dersc(k)+Ax(k,j,iii)*expfac > enddo > if (mixed) then > do k=1,3,2 > ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) > & +gaussc(k,2,j,it))*expfac > enddo > endif > enddo > > enddo ! iii > > dersc(1)=dersc(1)/cos(theti)**2 > ddersc(1)=ddersc(1)/cos(theti)**2 > ddersc(3)=ddersc(3) > > escloci=-(dlog(escloc_i)-emin) > do j=1,3 > dersc(j)=dersc(j)/escloc_i > enddo > if (mixed) then > do j=1,3,2 > ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j)) > enddo > endif > return > end > C------------------------------------------------------------------------------ > subroutine enesc_bound(x,escloci,dersc,dersc12,mixed) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.GEO' > include 'COMMON.LOCAL' > include 'COMMON.IOUNITS' > common /sccalc/ time11,time12,time112,theti,it,nlobit > double precision x(3),z(3),Ax(3,maxlob),dersc(3) > double precision contr(maxlob) > logical mixed > > escloc_i=0.0D0 > > do j=1,3 > dersc(j)=0.0D0 > enddo > > do j=1,nlobit > do k=1,2 > z(k)=x(k)-censc(k,j,it) > enddo > z(3)=dwapi > do k=1,3 > Axk=0.0D0 > do l=1,3 > Axk=Axk+gaussc(l,k,j,it)*z(l) > enddo > Ax(k,j)=Axk > enddo > expfac=0.0D0 > do k=1,3 > expfac=expfac+Ax(k,j)*z(k) > enddo > contr(j)=expfac > enddo ! j > > C As in the case of ebend, we want to avoid underflows in exponentiation and > C subsequent NaNs and INFs in energy calculation. > C Find the largest exponent > emin=contr(1) > do j=1,nlobit > if (emin.gt.contr(j)) emin=contr(j) > enddo > emin=0.5D0*emin > > C Compute the contribution to SC energy and derivatives > > dersc12=0.0d0 > do j=1,nlobit > expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin) > escloc_i=escloc_i+expfac > do k=1,2 > dersc(k)=dersc(k)+Ax(k,j)*expfac > enddo > if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) > & +gaussc(1,2,j,it))*expfac > dersc(3)=0.0d0 > enddo > > dersc(1)=dersc(1)/cos(theti)**2 > dersc12=dersc12/cos(theti)**2 > escloci=-(dlog(escloc_i)-emin) > do j=1,2 > dersc(j)=dersc(j)/escloc_i > enddo > if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1)) > return > end > #else > c---------------------------------------------------------------------------------- > subroutine esc(escloc) > C Calculate the local energy of a side chain and its derivatives in the > C corresponding virtual-bond valence angles THETA and the spherical angles > C ALPHA and OMEGA derived from AM1 all-atom calculations. > C added by Urszula Kozlowska. 07/11/2007 > C > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.GEO' > include 'COMMON.LOCAL' > include 'COMMON.VAR' > include 'COMMON.SCROT' > include 'COMMON.INTERACT' > include 'COMMON.DERIV' > include 'COMMON.CHAIN' > include 'COMMON.IOUNITS' > include 'COMMON.NAMES' > include 'COMMON.FFIELD' > include 'COMMON.CONTROL' > include 'COMMON.VECTORS' > double precision x_prime(3),y_prime(3),z_prime(3) > & , sumene,dsc_i,dp2_i,x(65), > & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6, > & de_dxx,de_dyy,de_dzz,de_dt > double precision s1_t,s1_6_t,s2_t,s2_6_t > double precision > & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3), > & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3), > & dt_dCi(3),dt_dCi1(3) > common /sccalc/ time11,time12,time112,theti,it,nlobit > delta=0.02d0*pi > escloc=0.0D0 > do i=loc_start,loc_end > costtab(i+1) =dcos(theta(i+1)) > sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1)) > cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1))) > sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1))) > cosfac2=0.5d0/(1.0d0+costtab(i+1)) > cosfac=dsqrt(cosfac2) > sinfac2=0.5d0/(1.0d0-costtab(i+1)) > sinfac=dsqrt(sinfac2) > it=itype(i) > if (it.eq.10) goto 1 > c > C Compute the axes of tghe local cartesian coordinates system; store in > c x_prime, y_prime and z_prime > c > do j=1,3 > x_prime(j) = 0.00 > y_prime(j) = 0.00 > z_prime(j) = 0.00 > enddo > C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres), > C & dc_norm(3,i+nres) > do j = 1,3 > x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac > y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac > enddo > do j = 1,3 > z_prime(j) = -uz(j,i-1) > enddo > c write (2,*) "i",i > c write (2,*) "x_prime",(x_prime(j),j=1,3) > c write (2,*) "y_prime",(y_prime(j),j=1,3) > c write (2,*) "z_prime",(z_prime(j),j=1,3) > c write (2,*) "xx",scalar(x_prime(1),x_prime(1)), > c & " xy",scalar(x_prime(1),y_prime(1)), > c & " xz",scalar(x_prime(1),z_prime(1)), > c & " yy",scalar(y_prime(1),y_prime(1)), > c & " yz",scalar(y_prime(1),z_prime(1)), > c & " zz",scalar(z_prime(1),z_prime(1)) > c > C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i), > C to local coordinate system. Store in xx, yy, zz. > c > xx=0.0d0 > yy=0.0d0 > zz=0.0d0 > do j = 1,3 > xx = xx + x_prime(j)*dc_norm(j,i+nres) > yy = yy + y_prime(j)*dc_norm(j,i+nres) > zz = zz + z_prime(j)*dc_norm(j,i+nres) > enddo > > xxtab(i)=xx > yytab(i)=yy > zztab(i)=zz > C > C Compute the energy of the ith side cbain > C > c write (2,*) "xx",xx," yy",yy," zz",zz > it=itype(i) > do j = 1,65 > x(j) = sc_parmin(j,it) > enddo > #ifdef CHECK_COORD > Cc diagnostics - remove later > xx1 = dcos(alph(2)) > yy1 = dsin(alph(2))*dcos(omeg(2)) > zz1 = -dsin(alph(2))*dsin(omeg(2)) > write(2,'(3f8.1,3f9.3,1x,3f9.3)') > & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz, > & xx1,yy1,zz1 > C," --- ", xx_w,yy_w,zz_w > c end diagnostics > #endif > sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 > & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy > & + x(10)*yy*zz > sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 > & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy > & + x(20)*yy*zz > sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 > & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy > & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 > & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx > & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy > & +x(40)*xx*yy*zz > sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 > & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy > & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 > & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx > & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy > & +x(60)*xx*yy*zz > dsc_i = 0.743d0+x(61) > dp2_i = 1.9d0+x(62) > dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i > & *(xx*cost2tab(i+1)+yy*sint2tab(i+1))) > dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i > & *(xx*cost2tab(i+1)-yy*sint2tab(i+1))) > s1=(1+x(63))/(0.1d0 + dscp1) > s1_6=(1+x(64))/(0.1d0 + dscp1**6) > s2=(1+x(65))/(0.1d0 + dscp2) > s2_6=(1+x(65))/(0.1d0 + dscp2**6) > sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) > & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6) > c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3, > c & sumene4, > c & dscp1,dscp2,sumene > c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) > escloc = escloc + sumene > c write (2,*) "i",i," escloc",sumene,escloc > #ifdef DEBUG > C > C This section to check the numerical derivatives of the energy of ith side > C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert > C #define DEBUG in the code to turn it on. > C > write (2,*) "sumene =",sumene > aincr=1.0d-7 > xxsave=xx > xx=xx+aincr > write (2,*) xx,yy,zz > sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) > de_dxx_num=(sumenep-sumene)/aincr > xx=xxsave > write (2,*) "xx+ sumene from enesc=",sumenep > yysave=yy > yy=yy+aincr > write (2,*) xx,yy,zz > sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) > de_dyy_num=(sumenep-sumene)/aincr > yy=yysave > write (2,*) "yy+ sumene from enesc=",sumenep > zzsave=zz > zz=zz+aincr > write (2,*) xx,yy,zz > sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) > de_dzz_num=(sumenep-sumene)/aincr > zz=zzsave > write (2,*) "zz+ sumene from enesc=",sumenep > costsave=cost2tab(i+1) > sintsave=sint2tab(i+1) > cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr)) > sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr)) > sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) > de_dt_num=(sumenep-sumene)/aincr > write (2,*) " t+ sumene from enesc=",sumenep > cost2tab(i+1)=costsave > sint2tab(i+1)=sintsave > C End of diagnostics section. > #endif > C > C Compute the gradient of esc > C > pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2 > pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2 > pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2 > pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2 > pom_dx=dsc_i*dp2_i*cost2tab(i+1) > pom_dy=dsc_i*dp2_i*sint2tab(i+1) > pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1)) > pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1)) > pom1=(sumene3*sint2tab(i+1)+sumene1) > & *(pom_s1/dscp1+pom_s16*dscp1**4) > pom2=(sumene4*cost2tab(i+1)+sumene2) > & *(pom_s2/dscp2+pom_s26*dscp2**4) > sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy > sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 > & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) > & +x(40)*yy*zz > sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy > sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 > & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) > & +x(60)*yy*zz > de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) > & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) > & +(pom1+pom2)*pom_dx > #ifdef DEBUG > write(2,*), "de_dxx = ", de_dxx,de_dxx_num > #endif > C > sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz > sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 > & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) > & +x(40)*xx*zz > sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz > sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz > & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz > & +x(59)*zz**2 +x(60)*xx*zz > de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) > & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) > & +(pom1-pom2)*pom_dy > #ifdef DEBUG > write(2,*), "de_dyy = ", de_dyy,de_dyy_num > #endif > C > de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy > & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx > & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) > & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) > & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 > & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy > & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) > & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6) > #ifdef DEBUG > write(2,*), "de_dzz = ", de_dzz,de_dzz_num > #endif > C > de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) > & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) > & +pom1*pom_dt1+pom2*pom_dt2 > #ifdef DEBUG > write(2,*), "de_dt = ", de_dt,de_dt_num > #endif > c > C > cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres)) > cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres)) > cosfac2xx=cosfac2*xx > sinfac2yy=sinfac2*yy > do k = 1,3 > dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* > & vbld_inv(i+1) > dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* > & vbld_inv(i) > pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1) > pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i) > c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1, > c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k) > c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3), > c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i) > dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx > dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx > dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy > dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy > dZZ_Ci1(k)=0.0d0 > dZZ_Ci(k)=0.0d0 > do j=1,3 > dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres) > dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres) > enddo > > dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres)) > dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres)) > dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres)) > c > dt_dCi(k) = -dt_dCi(k)/sinttab(i+1) > dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1) > enddo > > do k=1,3 > dXX_Ctab(k,i)=dXX_Ci(k) > dXX_C1tab(k,i)=dXX_Ci1(k) > dYY_Ctab(k,i)=dYY_Ci(k) > dYY_C1tab(k,i)=dYY_Ci1(k) > dZZ_Ctab(k,i)=dZZ_Ci(k) > dZZ_C1tab(k,i)=dZZ_Ci1(k) > dXX_XYZtab(k,i)=dXX_XYZ(k) > dYY_XYZtab(k,i)=dYY_XYZ(k) > dZZ_XYZtab(k,i)=dZZ_XYZ(k) > enddo > > do k = 1,3 > c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1", > c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k) > c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci", > c & dyy_ci(k)," dzz_ci",dzz_ci(k) > c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci", > c & dt_dci(k) > c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ", > c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k) > gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) > & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k) > gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) > & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k) > gsclocx(k,i)= de_dxx*dxx_XYZ(k) > & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k) > enddo > c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3), > c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3) > > C to check gradient call subroutine check_grad > > 1 continue > enddo > return > end > c------------------------------------------------------------------------------ > double precision function enesc(x,xx,yy,zz,cost2,sint2) > implicit none > double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2, > & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6 > sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 > & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy > & + x(10)*yy*zz > sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 > & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy > & + x(20)*yy*zz > sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 > & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy > & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 > & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx > & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy > & +x(40)*xx*yy*zz > sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 > & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy > & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 > & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx > & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy > & +x(60)*xx*yy*zz > dsc_i = 0.743d0+x(61) > dp2_i = 1.9d0+x(62) > dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i > & *(xx*cost2+yy*sint2)) > dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i > & *(xx*cost2-yy*sint2)) > s1=(1+x(63))/(0.1d0 + dscp1) > s1_6=(1+x(64))/(0.1d0 + dscp1**6) > s2=(1+x(65))/(0.1d0 + dscp2) > s2_6=(1+x(65))/(0.1d0 + dscp2**6) > sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) > & + (sumene4*cost2 +sumene2)*(s2+s2_6) > enesc=sumene > return > end > #endif > c------------------------------------------------------------------------------ > subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont) > C > C This procedure calculates two-body contact function g(rij) and its derivative: > C > C eps0ij ! x < -1 > C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1 > C 0 ! x > 1 > C > C where x=(rij-r0ij)/delta > C > C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy > C > implicit none > double precision rij,r0ij,eps0ij,fcont,fprimcont > double precision x,x2,x4,delta > c delta=0.02D0*r0ij > c delta=0.2D0*r0ij > x=(rij-r0ij)/delta > if (x.lt.-1.0D0) then > fcont=eps0ij > fprimcont=0.0D0 > else if (x.le.1.0D0) then > x2=x*x > x4=x2*x2 > fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0) > fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta > else > fcont=0.0D0 > fprimcont=0.0D0 > endif > return > end > c------------------------------------------------------------------------------ > subroutine splinthet(theti,delta,ss,ssder) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.VAR' > include 'COMMON.GEO' > thetup=pi-delta > thetlow=delta > if (theti.gt.pipol) then > call gcont(theti,thetup,1.0d0,delta,ss,ssder) > else > call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder) > ssder=-ssder > endif > return > end > c------------------------------------------------------------------------------ > subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim) > implicit none > double precision x,x0,delta,f0,f1,fprim0,f,fprim > double precision ksi,ksi2,ksi3,a1,a2,a3 > a1=fprim0*delta/(f1-f0) > a2=3.0d0-2.0d0*a1 > a3=a1-2.0d0 > ksi=(x-x0)/delta > ksi2=ksi*ksi > ksi3=ksi2*ksi > f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi)) > fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3)) > return > end > c------------------------------------------------------------------------------ > subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx) > implicit none > double precision x,x0,delta,f0x,f1x,fprim0x,fx > double precision ksi,ksi2,ksi3,a1,a2,a3 > ksi=(x-x0)/delta > ksi2=ksi*ksi > ksi3=ksi2*ksi > a1=fprim0x*delta > a2=3*(f1x-f0x)-2*fprim0x*delta > a3=fprim0x*delta-2*(f1x-f0x) > fx=f0x+a1*ksi+a2*ksi2+a3*ksi3 > return > end > C----------------------------------------------------------------------------- > #ifdef CRYST_TOR > C----------------------------------------------------------------------------- > subroutine etor(etors,edihcnstr) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.VAR' > include 'COMMON.GEO' > include 'COMMON.LOCAL' > include 'COMMON.TORSION' > include 'COMMON.INTERACT' > include 'COMMON.DERIV' > include 'COMMON.CHAIN' > include 'COMMON.NAMES' > include 'COMMON.IOUNITS' > include 'COMMON.FFIELD' > include 'COMMON.TORCNSTR' > include 'COMMON.CONTROL' > logical lprn > C Set lprn=.true. for debugging > lprn=.false. > c lprn=.true. > etors=0.0D0 > do i=iphi_start,iphi_end > etors_ii=0.0D0 > itori=itortyp(itype(i-2)) > itori1=itortyp(itype(i-1)) > phii=phi(i) > gloci=0.0D0 > C Proline-Proline pair is a special case... > if (itori.eq.3 .and. itori1.eq.3) then > if (phii.gt.-dwapi3) then > cosphi=dcos(3*phii) > fac=1.0D0/(1.0D0-cosphi) > etorsi=v1(1,3,3)*fac > etorsi=etorsi+etorsi > etors=etors+etorsi-v1(1,3,3) > if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3) > gloci=gloci-3*fac*etorsi*dsin(3*phii) > endif > do j=1,3 > v1ij=v1(j+1,itori,itori1) > v2ij=v2(j+1,itori,itori1) > cosphi=dcos(j*phii) > sinphi=dsin(j*phii) > etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) > if (energy_dec) etors_ii=etors_ii+ > & v2ij*sinphi+dabs(v1ij)+dabs(v2ij) > gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) > enddo > else > do j=1,nterm_old > v1ij=v1(j,itori,itori1) > v2ij=v2(j,itori,itori1) > cosphi=dcos(j*phii) > sinphi=dsin(j*phii) > etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) > if (energy_dec) etors_ii=etors_ii+ > & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij) > gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) > enddo > endif > if (energy_dec) write (iout,'(a6,i5,0pf7.3)') > 'etor',i,etors_ii > if (lprn) > & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') > & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, > & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6) > gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci > c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) > enddo > ! 6/20/98 - dihedral angle constraints > edihcnstr=0.0d0 > do i=1,ndih_constr > itori=idih_constr(i) > phii=phi(itori) > difi=phii-phi0(i) > if (difi.gt.drange(i)) then > difi=difi-drange(i) > edihcnstr=edihcnstr+0.25d0*ftors*difi**4 > gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 > else if (difi.lt.-drange(i)) then > difi=difi+drange(i) > edihcnstr=edihcnstr+0.25d0*ftors*difi**4 > gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 > endif > ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii, > ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) > enddo > ! write (iout,*) 'edihcnstr',edihcnstr > return > end > c------------------------------------------------------------------------------ > subroutine etor_d(etors_d) > etors_d=0.0d0 > return > end > c---------------------------------------------------------------------------- > #else > subroutine etor(etors,edihcnstr) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.VAR' > include 'COMMON.GEO' > include 'COMMON.LOCAL' > include 'COMMON.TORSION' > include 'COMMON.INTERACT' > include 'COMMON.DERIV' > include 'COMMON.CHAIN' > include 'COMMON.NAMES' > include 'COMMON.IOUNITS' > include 'COMMON.FFIELD' > include 'COMMON.TORCNSTR' > include 'COMMON.CONTROL' > logical lprn > C Set lprn=.true. for debugging > lprn=.false. > c lprn=.true. > etors=0.0D0 > do i=iphi_start,iphi_end > etors_ii=0.0D0 > itori=itortyp(itype(i-2)) > itori1=itortyp(itype(i-1)) > phii=phi(i) > gloci=0.0D0 > C Regular cosine and sine terms > do j=1,nterm(itori,itori1) > v1ij=v1(j,itori,itori1) > v2ij=v2(j,itori,itori1) > cosphi=dcos(j*phii) > sinphi=dsin(j*phii) > etors=etors+v1ij*cosphi+v2ij*sinphi > if (energy_dec) etors_ii=etors_ii+ > & v1ij*cosphi+v2ij*sinphi > gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) > enddo > C Lorentz terms > C v1 > C E = SUM ----------------------------------- - v1 > C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1 > C > cosphi=dcos(0.5d0*phii) > sinphi=dsin(0.5d0*phii) > do j=1,nlor(itori,itori1) > vl1ij=vlor1(j,itori,itori1) > vl2ij=vlor2(j,itori,itori1) > vl3ij=vlor3(j,itori,itori1) > pom=vl2ij*cosphi+vl3ij*sinphi > pom1=1.0d0/(pom*pom+1.0d0) > etors=etors+vl1ij*pom1 > if (energy_dec) etors_ii=etors_ii+ > & vl1ij*pom1 > pom=-pom*pom1*pom1 > gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom > enddo > C Subtract the constant term > etors=etors-v0(itori,itori1) > if (energy_dec) write (iout,'(a6,i5,0pf7.3)') > & 'etor',i,etors_ii-v0(itori,itori1) > if (lprn) > & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') > & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, > & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6) > gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci > c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) > enddo > ! 6/20/98 - dihedral angle constraints > edihcnstr=0.0d0 > c do i=1,ndih_constr > do i=idihconstr_start,idihconstr_end > itori=idih_constr(i) > phii=phi(itori) > difi=pinorm(phii-phi0(i)) > if (difi.gt.drange(i)) then > difi=difi-drange(i) > edihcnstr=edihcnstr+0.25d0*ftors*difi**4 > gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 > else if (difi.lt.-drange(i)) then > difi=difi+drange(i) > edihcnstr=edihcnstr+0.25d0*ftors*difi**4 > gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3 > else > difi=0.0 > endif > cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii, > cd & rad2deg*phi0(i), rad2deg*drange(i), > cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg) > enddo > cd write (iout,*) 'edihcnstr',edihcnstr > return > end > c---------------------------------------------------------------------------- > subroutine etor_d(etors_d) > C 6/23/01 Compute double torsional energy > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.VAR' > include 'COMMON.GEO' > include 'COMMON.LOCAL' > include 'COMMON.TORSION' > include 'COMMON.INTERACT' > include 'COMMON.DERIV' > include 'COMMON.CHAIN' > include 'COMMON.NAMES' > include 'COMMON.IOUNITS' > include 'COMMON.FFIELD' > include 'COMMON.TORCNSTR' > logical lprn > C Set lprn=.true. for debugging > lprn=.false. > c lprn=.true. > etors_d=0.0D0 > do i=iphid_start,iphid_end > itori=itortyp(itype(i-2)) > itori1=itortyp(itype(i-1)) > itori2=itortyp(itype(i)) > phii=phi(i) > phii1=phi(i+1) > gloci1=0.0D0 > gloci2=0.0D0 > C Regular cosine and sine terms > do j=1,ntermd_1(itori,itori1,itori2) > v1cij=v1c(1,j,itori,itori1,itori2) > v1sij=v1s(1,j,itori,itori1,itori2) > v2cij=v1c(2,j,itori,itori1,itori2) > v2sij=v1s(2,j,itori,itori1,itori2) > cosphi1=dcos(j*phii) > sinphi1=dsin(j*phii) > cosphi2=dcos(j*phii1) > sinphi2=dsin(j*phii1) > etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ > & v2cij*cosphi2+v2sij*sinphi2 > gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1) > gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2) > enddo > do k=2,ntermd_2(itori,itori1,itori2) > do l=1,k-1 > v1cdij = v2c(k,l,itori,itori1,itori2) > v2cdij = v2c(l,k,itori,itori1,itori2) > v1sdij = v2s(k,l,itori,itori1,itori2) > v2sdij = v2s(l,k,itori,itori1,itori2) > cosphi1p2=dcos(l*phii+(k-l)*phii1) > cosphi1m2=dcos(l*phii-(k-l)*phii1) > sinphi1p2=dsin(l*phii+(k-l)*phii1) > sinphi1m2=dsin(l*phii-(k-l)*phii1) > etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ > & v1sdij*sinphi1p2+v2sdij*sinphi1m2 > gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 > & -v1cdij*sinphi1p2-v2cdij*sinphi1m2) > gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 > & -v1cdij*sinphi1p2+v2cdij*sinphi1m2) > enddo > enddo > gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1 > gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2 > enddo > return > end > #endif > c------------------------------------------------------------------------------ > subroutine eback_sc_corr(esccor) > c 7/21/2007 Correlations between the backbone-local and side-chain-local > c conformational states; temporarily implemented as differences > c between UNRES torsional potentials (dependent on three types of > c residues) and the torsional potentials dependent on all 20 types > c of residues computed from AM1 energy surfaces of terminally-blocked > c amino-acid residues. > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.VAR' > include 'COMMON.GEO' > include 'COMMON.LOCAL' > include 'COMMON.TORSION' > include 'COMMON.SCCOR' > include 'COMMON.INTERACT' > include 'COMMON.DERIV' > include 'COMMON.CHAIN' > include 'COMMON.NAMES' > include 'COMMON.IOUNITS' > include 'COMMON.FFIELD' > include 'COMMON.CONTROL' > logical lprn > C Set lprn=.true. for debugging > lprn=.false. > c lprn=.true. > c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor > esccor=0.0D0 > do i=iphi_start,iphi_end > esccor_ii=0.0D0 > itori=itype(i-2) > itori1=itype(i-1) > phii=phi(i) > gloci=0.0D0 > do j=1,nterm_sccor > v1ij=v1sccor(j,itori,itori1) > v2ij=v2sccor(j,itori,itori1) > cosphi=dcos(j*phii) > sinphi=dsin(j*phii) > esccor=esccor+v1ij*cosphi+v2ij*sinphi > gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) > enddo > if (lprn) > & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') > & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1, > & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6) > gsccor_loc(i-3)=gsccor_loc(i-3)+gloci > enddo > return > end > c---------------------------------------------------------------------------- > subroutine multibody(ecorr) > C This subroutine calculates multi-body contributions to energy following > C the idea of Skolnick et al. If side chains I and J make a contact and > C at the same time side chains I+1 and J+1 make a contact, an extra > C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added. > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.IOUNITS' > include 'COMMON.DERIV' > include 'COMMON.INTERACT' > include 'COMMON.CONTACTS' > double precision gx(3),gx1(3) > logical lprn > > C Set lprn=.true. for debugging > lprn=.false. > > if (lprn) then > write (iout,'(a)') 'Contact function values:' > do i=nnt,nct-2 > write (iout,'(i2,20(1x,i2,f10.5))') > & i,(jcont(j,i),facont(j,i),j=1,num_cont(i)) > enddo > endif > ecorr=0.0D0 > do i=nnt,nct > do j=1,3 > gradcorr(j,i)=0.0D0 > gradxorr(j,i)=0.0D0 > enddo > enddo > do i=nnt,nct-2 > > DO ISHIFT = 3,4 > > i1=i+ishift > num_conti=num_cont(i) > num_conti1=num_cont(i1) > do jj=1,num_conti > j=jcont(jj,i) > do kk=1,num_conti1 > j1=jcont(kk,i1) > if (j1.eq.j+ishift .or. j1.eq.j-ishift) then > cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1, > cd & ' ishift=',ishift > C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously. > C The system gains extra energy. > ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk) > endif ! j1==j+-ishift > enddo ! kk > enddo ! jj > > ENDDO ! ISHIFT > > enddo ! i > return > end > c------------------------------------------------------------------------------ > double precision function esccorr(i,j,k,l,jj,kk) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.IOUNITS' > include 'COMMON.DERIV' > include 'COMMON.INTERACT' > include 'COMMON.CONTACTS' > double precision gx(3),gx1(3) > logical lprn > lprn=.false. > eij=facont(jj,i) > ekl=facont(kk,k) > cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl > C Calculate the multi-body contribution to energy. > C Calculate multi-body contributions to the gradient. > cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3), > cd & k,l,(gacont(m,kk,k),m=1,3) > do m=1,3 > gx(m) =ekl*gacont(m,jj,i) > gx1(m)=eij*gacont(m,kk,k) > gradxorr(m,i)=gradxorr(m,i)-gx(m) > gradxorr(m,j)=gradxorr(m,j)+gx(m) > gradxorr(m,k)=gradxorr(m,k)-gx1(m) > gradxorr(m,l)=gradxorr(m,l)+gx1(m) > enddo > do m=i,j-1 > do ll=1,3 > gradcorr(ll,m)=gradcorr(ll,m)+gx(ll) > enddo > enddo > do m=k,l-1 > do ll=1,3 > gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll) > enddo > enddo > esccorr=-eij*ekl > return > end > c------------------------------------------------------------------------------ > #ifdef MPI > subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > integer dimen1,dimen2,atom,indx > double precision buffer(dimen1,dimen2) > double precision zapas > common /contacts_hb/ zapas(3,maxconts,maxres,8), > & facont_hb(maxconts,maxres),ees0p(maxconts,maxres), > & ees0m(maxconts,maxres),d_cont(maxconts,maxres), > & num_cont_hb(maxres),jcont_hb(maxconts,maxres) > num_kont=num_cont_hb(atom) > do i=1,num_kont > do k=1,8 > do j=1,3 > buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k) > enddo ! j > enddo ! k > buffer(i,indx+25)=facont_hb(i,atom) > buffer(i,indx+26)=ees0p(i,atom) > buffer(i,indx+27)=ees0m(i,atom) > buffer(i,indx+28)=d_cont(i,atom) > buffer(i,indx+29)=dfloat(jcont_hb(i,atom)) > enddo ! i > buffer(1,indx+30)=dfloat(num_kont) > return > end > c------------------------------------------------------------------------------ > subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > integer dimen1,dimen2,atom,indx > double precision buffer(dimen1,dimen2) > double precision zapas > common /contacts_hb/ zapas(3,maxconts,maxres,8), > & facont_hb(maxconts,maxres),ees0p(maxconts,maxres), > & ees0m(maxconts,maxres),d_cont(maxconts,maxres), > & num_cont_hb(maxres),jcont_hb(maxconts,maxres) > num_kont=buffer(1,indx+30) > num_kont_old=num_cont_hb(atom) > num_cont_hb(atom)=num_kont+num_kont_old > do i=1,num_kont > ii=i+num_kont_old > do k=1,8 > do j=1,3 > zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j) > enddo ! j > enddo ! k > facont_hb(ii,atom)=buffer(i,indx+25) > ees0p(ii,atom)=buffer(i,indx+26) > ees0m(ii,atom)=buffer(i,indx+27) > d_cont(i,atom)=buffer(i,indx+28) > jcont_hb(ii,atom)=buffer(i,indx+29) > enddo ! i > return > end > c------------------------------------------------------------------------------ > #endif > subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) > C This subroutine calculates multi-body contributions to hydrogen-bonding > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.IOUNITS' > #ifdef MPI > include "mpif.h" > parameter (max_cont=maxconts) > parameter (max_dim=2*(8*3+6)) > parameter (msglen1=max_cont*max_dim) > parameter (msglen2=2*msglen1) > integer source,CorrelType,CorrelID,Error > double precision buffer(max_cont,max_dim) > integer status(MPI_STATUS_SIZE) > #endif > include 'COMMON.SETUP' > include 'COMMON.FFIELD' > include 'COMMON.DERIV' > include 'COMMON.INTERACT' > include 'COMMON.CONTACTS' > include 'COMMON.CONTROL' > double precision gx(3),gx1(3),time00 > logical lprn,ldone > > C Set lprn=.true. for debugging > lprn=.false. > #ifdef MPI > n_corr=0 > n_corr1=0 > if (nfgtasks.le.1) goto 30 > if (lprn) then > write (iout,'(a)') 'Contact function values:' > do i=nnt,nct-2 > write (iout,'(2i3,50(1x,i2,f5.2))') > & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), > & j=1,num_cont_hb(i)) > enddo > endif > C Caution! Following code assumes that electrostatic interactions concerning > C a given atom are split among at most two processors! > CorrelType=477 > CorrelID=fg_rank+1 > ldone=.false. > do i=1,max_cont > do j=1,max_dim > buffer(i,j)=0.0D0 > enddo > enddo > mm=mod(fg_rank,2) > c write (*,*) 'MyRank',MyRank,' mm',mm > if (mm) 20,20,10 > 10 continue > c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone > if (fg_rank.gt.0) then > C Send correlation contributions to the preceding processor > msglen=msglen1 > nn=num_cont_hb(iatel_s) > call pack_buffer(max_cont,max_dim,iatel_s,0,buffer) > c write (*,*) 'The BUFFER array:' > c do i=1,nn > c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30) > c enddo > if (ielstart(iatel_s).gt.iatel_s+ispp) then > msglen=msglen2 > call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer) > C Clear the contacts of the atom passed to the neighboring processor > nn=num_cont_hb(iatel_s+1) > c do i=1,nn > c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30) > c enddo > num_cont_hb(iatel_s)=0 > endif > cd write (iout,*) 'Processor ',fg_rank,MyRank, > cd & ' is sending correlation contribution to processor',fg_rank-1, > cd & ' msglen=',msglen > c write (*,*) 'Processor ',fg_rank,MyRank, > c & ' is sending correlation contribution to processor',fg_rank-1, > c & ' msglen=',msglen,' CorrelType=',CorrelType > time00=MPI_Wtime() > call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, > & CorrelType,FG_COMM,IERROR) > time_sendrecv=time_sendrecv+MPI_Wtime()-time00 > cd write (iout,*) 'Processor ',fg_rank, > cd & ' has sent correlation contribution to processor',fg_rank-1, > cd & ' msglen=',msglen,' CorrelID=',CorrelID > c write (*,*) 'Processor ',fg_rank, > c & ' has sent correlation contribution to processor',fg_rank-1, > c & ' msglen=',msglen,' CorrelID=',CorrelID > c msglen=msglen1 > endif ! (fg_rank.gt.0) > if (ldone) goto 30 > ldone=.true. > 20 continue > c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone > if (fg_rank.lt.nfgtasks-1) then > C Receive correlation contributions from the next processor > msglen=msglen1 > if (ielend(iatel_e).lt.nct-1) msglen=msglen2 > cd write (iout,*) 'Processor',fg_rank, > cd & ' is receiving correlation contribution from processor',fg_rank+1, > cd & ' msglen=',msglen,' CorrelType=',CorrelType > c write (*,*) 'Processor',fg_rank, > c &' is receiving correlation contribution from processor',fg_rank+1, > c & ' msglen=',msglen,' CorrelType=',CorrelType > time00=MPI_Wtime() > nbytes=-1 > do while (nbytes.le.0) > call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR) > call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR) > enddo > c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes > call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, > & fg_rank+1,CorrelType,FG_COMM,status,IERROR) > time_sendrecv=time_sendrecv+MPI_Wtime()-time00 > c write (*,*) 'Processor',fg_rank, > c &' has received correlation contribution from processor',fg_rank+1, > c & ' msglen=',msglen,' nbytes=',nbytes > c write (*,*) 'The received BUFFER array:' > c do i=1,max_cont > c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60) > c enddo > if (msglen.eq.msglen1) then > call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer) > else if (msglen.eq.msglen2) then > call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer) > call unpack_buffer(max_cont,max_dim,iatel_e+1,30,buffer) > else > write (iout,*) > & 'ERROR!!!! message length changed while processing correlations.' > write (*,*) > & 'ERROR!!!! message length changed while processing correlations.' > call MPI_Abort(MPI_COMM_WORLD,Error,IERROR) > endif ! msglen.eq.msglen1 > endif ! fg_rank.lt.nfgtasks-1 > if (ldone) goto 30 > ldone=.true. > goto 10 > 30 continue > #endif > if (lprn) then > write (iout,'(a)') 'Contact function values:' > do i=nnt,nct-2 > write (iout,'(2i3,50(1x,i2,f5.2))') > & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), > & j=1,num_cont_hb(i)) > enddo > endif > ecorr=0.0D0 > C Remove the loop below after debugging !!! > do i=nnt,nct > do j=1,3 > gradcorr(j,i)=0.0D0 > gradxorr(j,i)=0.0D0 > enddo > enddo > C Calculate the local-electrostatic correlation terms > do i=iatel_s,iatel_e+1 > i1=i+1 > num_conti=num_cont_hb(i) > num_conti1=num_cont_hb(i+1) > do jj=1,num_conti > j=jcont_hb(jj,i) > do kk=1,num_conti1 > j1=jcont_hb(kk,i1) > c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, > c & ' jj=',jj,' kk=',kk > if (j1.eq.j+1 .or. j1.eq.j-1) then > C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. > C The system gains extra energy. > ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0) > if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') > & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0) > n_corr=n_corr+1 > else if (j1.eq.j) then > C Contacts I-J and I-(J+1) occur simultaneously. > C The system loses extra energy. > c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0) > endif > enddo ! kk > do kk=1,num_conti > j1=jcont_hb(kk,i) > c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, > c & ' jj=',jj,' kk=',kk > if (j1.eq.j+1) then > C Contacts I-J and (I+1)-J occur simultaneously. > C The system loses extra energy. > c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0) > endif ! j1==j+1 > enddo ! kk > enddo ! jj > enddo ! i > return > end > c------------------------------------------------------------------------------ > subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr, > & n_corr1) > C This subroutine calculates multi-body contributions to hydrogen-bonding > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.IOUNITS' > #ifdef MPI > include 'mpif.h' > parameter (max_cont=maxconts) > parameter (max_dim=2*(8*3+6)) > c parameter (msglen1=max_cont*max_dim*4) > parameter (msglen1=max_cont*max_dim/2) > parameter (msglen2=2*msglen1) > integer source,CorrelType,CorrelID,Error > double precision buffer(max_cont,max_dim) > integer status(MPI_STATUS_SIZE) > #endif > include 'COMMON.SETUP' > include 'COMMON.FFIELD' > include 'COMMON.DERIV' > include 'COMMON.INTERACT' > include 'COMMON.CONTACTS' > include 'COMMON.CONTROL' > double precision gx(3),gx1(3) > logical lprn,ldone > C Set lprn=.true. for debugging > lprn=.false. > eturn6=0.0d0 > #ifdef MPI > n_corr=0 > n_corr1=0 > if (fgProcs.le.1) goto 30 > if (lprn) then > write (iout,'(a)') 'Contact function values:' > do i=nnt,nct-2 > write (iout,'(2i3,50(1x,i2,f5.2))') > & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), > & j=1,num_cont_hb(i)) > enddo > endif > C Caution! Following code assumes that electrostatic interactions concerning > C a given atom are split among at most two processors! > CorrelType=477 > CorrelID=MyID+1 > ldone=.false. > do i=1,max_cont > do j=1,max_dim > buffer(i,j)=0.0D0 > enddo > enddo > mm=mod(MyRank,2) > cd write (iout,*) 'MyRank',MyRank,' mm',mm > if (mm) 20,20,10 > 10 continue > cd write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone > if (MyRank.gt.0) then > C Send correlation contributions to the preceding processor > msglen=msglen1 > nn=num_cont_hb(iatel_s) > call pack_buffer(max_cont,max_dim,iatel_s,0,buffer) > cd write (iout,*) 'The BUFFER array:' > cd do i=1,nn > cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30) > cd enddo > if (ielstart(iatel_s).gt.iatel_s+ispp) then > msglen=msglen2 > call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer) > C Clear the contacts of the atom passed to the neighboring processor > nn=num_cont_hb(iatel_s+1) > cd do i=1,nn > cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30) > cd enddo > num_cont_hb(iatel_s)=0 > endif > cd write (*,*) 'Processor ',fg_rank,MyRank, > cd & ' is sending correlation contribution to processor',fg_rank-1, > cd & ' msglen=',msglen > cd write (*,*) 'Processor ',MyID,MyRank, > cd & ' is sending correlation contribution to processor',fg_rank-1, > cd & ' msglen=',msglen,' CorrelType=',CorrelType > time00=MPI_Wtime() > call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, > & CorrelType,FG_COMM,IERROR) > time_sendrecv=time_sendrecv+MPI_Wtime()-time00 > cd write (*,*) 'Processor ',fg_rank,MyRank, > cd & ' has sent correlation contribution to processor',fg_rank-1, > cd & ' msglen=',msglen,' CorrelID=',CorrelID > cd write (*,*) 'Processor ',fg_rank, > cd & ' has sent correlation contribution to processor',fg_rank-1, > cd & ' msglen=',msglen,' CorrelID=',CorrelID > msglen=msglen1 > endif ! (MyRank.gt.0) > if (ldone) goto 30 > ldone=.true. > 20 continue > cd write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone > if (fg_rank.lt.nfgtasks-1) then > C Receive correlation contributions from the next processor > msglen=msglen1 > if (ielend(iatel_e).lt.nct-1) msglen=msglen2 > cd write (iout,*) 'Processor',fg_rank, > cd & ' is receiving correlation contribution from processor',fg_rank+1, > cd & ' msglen=',msglen,' CorrelType=',CorrelType > cd write (*,*) 'Processor',fg_rank, > cd & ' is receiving correlation contribution from processor',fg_rank+1, > cd & ' msglen=',msglen,' CorrelType=',CorrelType > time00=MPI_Wtime() > nbytes=-1 > do while (nbytes.le.0) > call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR) > call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR) > enddo > cd print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes > call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, > & fg_rank+1,CorrelType,status,IERROR) > time_sendrecv=time_sendrecv+MPI_Wtime()-time00 > cd write (iout,*) 'Processor',fg_rank, > cd & ' has received correlation contribution from processor',fg_rank+1, > cd & ' msglen=',msglen,' nbytes=',nbytes > cd write (iout,*) 'The received BUFFER array:' > cd do i=1,max_cont > cd write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52) > cd enddo > if (msglen.eq.msglen1) then > call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer) > else if (msglen.eq.msglen2) then > call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer) > call unpack_buffer(max_cont,max_dim,iatel_e+1,30,buffer) > else > write (iout,*) > & 'ERROR!!!! message length changed while processing correlations.' > write (*,*) > & 'ERROR!!!! message length changed while processing correlations.' > call MPI_Abort(MPI_COMM_WORLD,Error,IERROR) > endif ! msglen.eq.msglen1 > endif ! fg_rank.lt.nfgtasks-1 > if (ldone) goto 30 > ldone=.true. > goto 10 > 30 continue > #endif > if (lprn) then > write (iout,'(a)') 'Contact function values:' > do i=nnt,nct-2 > write (iout,'(2i3,50(1x,i2,f5.2))') > & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), > & j=1,num_cont_hb(i)) > enddo > endif > ecorr=0.0D0 > ecorr5=0.0d0 > ecorr6=0.0d0 > C Remove the loop below after debugging !!! > do i=nnt,nct > do j=1,3 > gradcorr(j,i)=0.0D0 > gradxorr(j,i)=0.0D0 > enddo > enddo > C Calculate the dipole-dipole interaction energies > if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then > do i=iatel_s,iatel_e+1 > num_conti=num_cont_hb(i) > do jj=1,num_conti > j=jcont_hb(jj,i) > call dipole(i,j,jj) > enddo > enddo > endif > C Calculate the local-electrostatic correlation terms > do i=iatel_s,iatel_e+1 > i1=i+1 > num_conti=num_cont_hb(i) > num_conti1=num_cont_hb(i+1) > do jj=1,num_conti > j=jcont_hb(jj,i) > do kk=1,num_conti1 > j1=jcont_hb(kk,i1) > c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, > c & ' jj=',jj,' kk=',kk > if (j1.eq.j+1 .or. j1.eq.j-1) then > C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. > C The system gains extra energy. > n_corr=n_corr+1 > sqd1=dsqrt(d_cont(jj,i)) > sqd2=dsqrt(d_cont(kk,i1)) > sred_geom = sqd1*sqd2 > IF (sred_geom.lt.cutoff_corr) THEN > call gcont(sred_geom,r0_corr,1.0D0,delt_corr, > & ekont,fprimcont) > cd write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, > cd & ' jj=',jj,' kk=',kk > fac_prim1=0.5d0*sqd2/sqd1*fprimcont > fac_prim2=0.5d0*sqd1/sqd2*fprimcont > do l=1,3 > g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i) > g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1) > enddo > n_corr1=n_corr1+1 > cd write (iout,*) 'sred_geom=',sred_geom, > cd & ' ekont=',ekont,' fprim=',fprimcont > call calc_eello(i,j,i+1,j1,jj,kk) > if (wcorr4.gt.0.0d0) > & ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk) > if (energy_dec.and.wcorr4.gt.0.0d0) > 1 write (iout,'(a6,2i5,0pf7.3)') > 2 'ecorr4',i,j,eello4(i,j,i+1,j1,jj,kk) > if (wcorr5.gt.0.0d0) > & ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk) > if (energy_dec.and.wcorr5.gt.0.0d0) > 1 write (iout,'(a6,2i5,0pf7.3)') > 2 'ecorr5',i,j,eello5(i,j,i+1,j1,jj,kk) > cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6 > cd write(2,*)'ijkl',i,j,i+1,j1 > if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3 > & .or. wturn6.eq.0.0d0))then > cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1 > ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk) > if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') > 1 'ecorr6',i,j,eello6(i,j,i+1,j1,jj,kk) > cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5, > cd & 'ecorr6=',ecorr6 > cd write (iout,'(4e15.5)') sred_geom, > cd & dabs(eello4(i,j,i+1,j1,jj,kk)), > cd & dabs(eello5(i,j,i+1,j1,jj,kk)), > cd & dabs(eello6(i,j,i+1,j1,jj,kk)) > else if (wturn6.gt.0.0d0 > & .and. (j.eq.i+4 .and. j1.eq.i+3)) then > cd write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1 > eturn6=eturn6+eello_turn6(i,jj,kk) > if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') > 1 'eturn6',i,j,eello_turn6(i,jj,kk) > cd write (2,*) 'multibody_eello:eturn6',eturn6 > endif > ENDIF > 1111 continue > else if (j1.eq.j) then > C Contacts I-J and I-(J+1) occur simultaneously. > C The system loses extra energy. > c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0) > endif > enddo ! kk > do kk=1,num_conti > j1=jcont_hb(kk,i) > c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1, > c & ' jj=',jj,' kk=',kk > if (j1.eq.j+1) then > C Contacts I-J and (I+1)-J occur simultaneously. > C The system loses extra energy. > c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0) > endif ! j1==j+1 > enddo ! kk > enddo ! jj > enddo ! i > return > end > c------------------------------------------------------------------------------ > double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.IOUNITS' > include 'COMMON.DERIV' > include 'COMMON.INTERACT' > include 'COMMON.CONTACTS' > double precision gx(3),gx1(3) > logical lprn > lprn=.false. > eij=facont_hb(jj,i) > ekl=facont_hb(kk,k) > ees0pij=ees0p(jj,i) > ees0pkl=ees0p(kk,k) > ees0mij=ees0m(jj,i) > ees0mkl=ees0m(kk,k) > ekont=eij*ekl > ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl) > cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl) > C Following 4 lines for diagnostics. > cd ees0pkl=0.0D0 > cd ees0pij=1.0D0 > cd ees0mkl=0.0D0 > cd ees0mij=1.0D0 > c write (iout,*)'Contacts have occurred for peptide groups',i,j, > c & ' and',k,l > c write (iout,*)'Contacts have occurred for peptide groups', > c & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l > c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees > C Calculate the multi-body contribution to energy. > ecorr=ecorr+ekont*ees > C Calculate multi-body contributions to the gradient. > do ll=1,3 > ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i) > gradcorr(ll,i)=gradcorr(ll,i)+ghalf > & -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+ > & coeffm*ees0mkl*gacontm_hb1(ll,jj,i)) > gradcorr(ll,j)=gradcorr(ll,j)+ghalf > & -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+ > & coeffm*ees0mkl*gacontm_hb2(ll,jj,i)) > ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k) > gradcorr(ll,k)=gradcorr(ll,k)+ghalf > & -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+ > & coeffm*ees0mij*gacontm_hb1(ll,kk,k)) > gradcorr(ll,l)=gradcorr(ll,l)+ghalf > & -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+ > & coeffm*ees0mij*gacontm_hb2(ll,kk,k)) > enddo > do m=i+1,j-1 > do ll=1,3 > gradcorr(ll,m)=gradcorr(ll,m)+ > & ees*ekl*gacont_hbr(ll,jj,i)- > & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+ > & coeffm*ees0mkl*gacontm_hb3(ll,jj,i)) > enddo > enddo > do m=k+1,l-1 > do ll=1,3 > gradcorr(ll,m)=gradcorr(ll,m)+ > & ees*eij*gacont_hbr(ll,kk,k)- > & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+ > & coeffm*ees0mij*gacontm_hb3(ll,kk,k)) > enddo > enddo > ehbcorr=ekont*ees > return > end > C--------------------------------------------------------------------------- > subroutine dipole(i,j,jj) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.IOUNITS' > include 'COMMON.CHAIN' > include 'COMMON.FFIELD' > include 'COMMON.DERIV' > include 'COMMON.INTERACT' > include 'COMMON.CONTACTS' > include 'COMMON.TORSION' > include 'COMMON.VAR' > include 'COMMON.GEO' > dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2), > & auxmat(2,2) > iti1 = itortyp(itype(i+1)) > if (j.lt.nres-1) then > itj1 = itortyp(itype(j+1)) > else > itj1=ntortyp+1 > endif > do iii=1,2 > dipi(iii,1)=Ub2(iii,i) > dipderi(iii)=Ub2der(iii,i) > dipi(iii,2)=b1(iii,iti1) > dipj(iii,1)=Ub2(iii,j) > dipderj(iii)=Ub2der(iii,j) > dipj(iii,2)=b1(iii,itj1) > enddo > kkk=0 > do iii=1,2 > call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1)) > do jjj=1,2 > kkk=kkk+1 > dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1)) > enddo > enddo > do kkk=1,5 > do lll=1,3 > mmm=0 > do iii=1,2 > call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii), > & auxvec(1)) > do jjj=1,2 > mmm=mmm+1 > dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1)) > enddo > enddo > enddo > enddo > call transpose2(a_chuj(1,1,jj,i),auxmat(1,1)) > call matvec2(auxmat(1,1),dipderi(1),auxvec(1)) > do iii=1,2 > dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii)) > enddo > call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1)) > do iii=1,2 > dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii)) > enddo > return > end > C--------------------------------------------------------------------------- > subroutine calc_eello(i,j,k,l,jj,kk) > C > C This subroutine computes matrices and vectors needed to calculate > C the fourth-, fifth-, and sixth-order local-electrostatic terms. > C > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.IOUNITS' > include 'COMMON.CHAIN' > include 'COMMON.DERIV' > include 'COMMON.INTERACT' > include 'COMMON.CONTACTS' > include 'COMMON.TORSION' > include 'COMMON.VAR' > include 'COMMON.GEO' > include 'COMMON.FFIELD' > double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2), > & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2) > logical lprn > common /kutas/ lprn > cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l, > cd & ' jj=',jj,' kk=',kk > cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return > do iii=1,2 > do jjj=1,2 > aa1(iii,jjj)=a_chuj(iii,jjj,jj,i) > aa2(iii,jjj)=a_chuj(iii,jjj,kk,k) > enddo > enddo > call transpose2(aa1(1,1),aa1t(1,1)) > call transpose2(aa2(1,1),aa2t(1,1)) > do kkk=1,5 > do lll=1,3 > call transpose2(a_chuj_der(1,1,lll,kkk,jj,i), > & aa1tder(1,1,lll,kkk)) > call transpose2(a_chuj_der(1,1,lll,kkk,kk,k), > & aa2tder(1,1,lll,kkk)) > enddo > enddo > if (l.eq.j+1) then > C parallel orientation of the two CA-CA-CA frames. > if (i.gt.1) then > iti=itortyp(itype(i)) > else > iti=ntortyp+1 > endif > itk1=itortyp(itype(k+1)) > itj=itortyp(itype(j)) > if (l.lt.nres-1) then > itl1=itortyp(itype(l+1)) > else > itl1=ntortyp+1 > endif > C A1 kernel(j+1) A2T > cd do iii=1,2 > cd write (iout,'(3f10.5,5x,3f10.5)') > cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2) > cd enddo > call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), > & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l), > & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1)) > C Following matrices are needed only for 6-th order cumulants > IF (wcorr6.gt.0.0d0) THEN > call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), > & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l), > & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1)) > call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), > & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l), > & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1), > & ADtEAderx(1,1,1,1,1,1)) > lprn=.false. > call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), > & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l), > & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1), > & ADtEA1derx(1,1,1,1,1,1)) > ENDIF > C End 6-th order cumulants > cd lprn=.false. > cd if (lprn) then > cd write (2,*) 'In calc_eello6' > cd do iii=1,2 > cd write (2,*) 'iii=',iii > cd do kkk=1,5 > cd write (2,*) 'kkk=',kkk > cd do jjj=1,2 > cd write (2,'(3(2f10.5),5x)') > cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3) > cd enddo > cd enddo > cd enddo > cd endif > call transpose2(EUgder(1,1,k),auxmat(1,1)) > call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1)) > call transpose2(EUg(1,1,k),auxmat(1,1)) > call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1)) > call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1)) > do iii=1,2 > do kkk=1,5 > do lll=1,3 > call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), > & EAEAderx(1,1,lll,kkk,iii,1)) > enddo > enddo > enddo > C A1T kernel(i+1) A2 > call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), > & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k), > & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2)) > C Following matrices are needed only for 6-th order cumulants > IF (wcorr6.gt.0.0d0) THEN > call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), > & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k), > & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2)) > call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), > & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k), > & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2), > & ADtEAderx(1,1,1,1,1,2)) > call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1), > & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k), > & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2), > & ADtEA1derx(1,1,1,1,1,2)) > ENDIF > C End 6-th order cumulants > call transpose2(EUgder(1,1,l),auxmat(1,1)) > call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2)) > call transpose2(EUg(1,1,l),auxmat(1,1)) > call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2)) > call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2)) > do iii=1,2 > do kkk=1,5 > do lll=1,3 > call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), > & EAEAderx(1,1,lll,kkk,iii,2)) > enddo > enddo > enddo > C AEAb1 and AEAb2 > C Calculate the vectors and their derivatives in virtual-bond dihedral angles. > C They are needed only when the fifth- or the sixth-order cumulants are > C indluded. > IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN > call transpose2(AEA(1,1,1),auxmat(1,1)) > call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) > call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) > call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) > call transpose2(AEAderg(1,1,1),auxmat(1,1)) > call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) > call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) > call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) > call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) > call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) > call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) > call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) > call transpose2(AEA(1,1,2),auxmat(1,1)) > call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2)) > call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2)) > call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2)) > call transpose2(AEAderg(1,1,2),auxmat(1,1)) > call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2)) > call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2)) > call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2)) > call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2)) > call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2)) > call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2)) > call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2)) > C Calculate the Cartesian derivatives of the vectors. > do iii=1,2 > do kkk=1,5 > do lll=1,3 > call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) > call matvec2(auxmat(1,1),b1(1,iti), > & AEAb1derx(1,lll,kkk,iii,1,1)) > call matvec2(auxmat(1,1),Ub2(1,i), > & AEAb2derx(1,lll,kkk,iii,1,1)) > call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), > & AEAb1derx(1,lll,kkk,iii,2,1)) > call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), > & AEAb2derx(1,lll,kkk,iii,2,1)) > call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) > call matvec2(auxmat(1,1),b1(1,itj), > & AEAb1derx(1,lll,kkk,iii,1,2)) > call matvec2(auxmat(1,1),Ub2(1,j), > & AEAb2derx(1,lll,kkk,iii,1,2)) > call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1), > & AEAb1derx(1,lll,kkk,iii,2,2)) > call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1), > & AEAb2derx(1,lll,kkk,iii,2,2)) > enddo > enddo > enddo > ENDIF > C End vectors > else > C Antiparallel orientation of the two CA-CA-CA frames. > if (i.gt.1) then > iti=itortyp(itype(i)) > else > iti=ntortyp+1 > endif > itk1=itortyp(itype(k+1)) > itl=itortyp(itype(l)) > itj=itortyp(itype(j)) > if (j.lt.nres-1) then > itj1=itortyp(itype(j+1)) > else > itj1=ntortyp+1 > endif > C A2 kernel(j-1)T A1T > call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), > & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j), > & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1)) > C Following matrices are needed only for 6-th order cumulants > IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. > & j.eq.i+4 .and. l.eq.i+3)) THEN > call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), > & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j), > & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1)) > call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), > & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j), > & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1), > & ADtEAderx(1,1,1,1,1,1)) > call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i), > & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j), > & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1), > & ADtEA1derx(1,1,1,1,1,1)) > ENDIF > C End 6-th order cumulants > call transpose2(EUgder(1,1,k),auxmat(1,1)) > call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1)) > call transpose2(EUg(1,1,k),auxmat(1,1)) > call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1)) > call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1)) > do iii=1,2 > do kkk=1,5 > do lll=1,3 > call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), > & EAEAderx(1,1,lll,kkk,iii,1)) > enddo > enddo > enddo > C A2T kernel(i+1)T A1 > call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), > & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k), > & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2)) > C Following matrices are needed only for 6-th order cumulants > IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. > & j.eq.i+4 .and. l.eq.i+3)) THEN > call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), > & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k), > & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2)) > call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), > & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k), > & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2), > & ADtEAderx(1,1,1,1,1,2)) > call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1), > & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k), > & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2), > & ADtEA1derx(1,1,1,1,1,2)) > ENDIF > C End 6-th order cumulants > call transpose2(EUgder(1,1,j),auxmat(1,1)) > call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2)) > call transpose2(EUg(1,1,j),auxmat(1,1)) > call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2)) > call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2)) > do iii=1,2 > do kkk=1,5 > do lll=1,3 > call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), > & EAEAderx(1,1,lll,kkk,iii,2)) > enddo > enddo > enddo > C AEAb1 and AEAb2 > C Calculate the vectors and their derivatives in virtual-bond dihedral angles. > C They are needed only when the fifth- or the sixth-order cumulants are > C indluded. > IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. > & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN > call transpose2(AEA(1,1,1),auxmat(1,1)) > call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1)) > call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1)) > call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1)) > call transpose2(AEAderg(1,1,1),auxmat(1,1)) > call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1)) > call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1)) > call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1)) > call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1)) > call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1)) > call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1)) > call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1)) > call transpose2(AEA(1,1,2),auxmat(1,1)) > call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2)) > call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2)) > call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2)) > call transpose2(AEAderg(1,1,2),auxmat(1,1)) > call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2)) > call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2)) > call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2)) > call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2)) > call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2)) > call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2)) > call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2)) > C Calculate the Cartesian derivatives of the vectors. > do iii=1,2 > do kkk=1,5 > do lll=1,3 > call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1)) > call matvec2(auxmat(1,1),b1(1,iti), > & AEAb1derx(1,lll,kkk,iii,1,1)) > call matvec2(auxmat(1,1),Ub2(1,i), > & AEAb2derx(1,lll,kkk,iii,1,1)) > call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1), > & AEAb1derx(1,lll,kkk,iii,2,1)) > call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1), > & AEAb2derx(1,lll,kkk,iii,2,1)) > call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1)) > call matvec2(auxmat(1,1),b1(1,itl), > & AEAb1derx(1,lll,kkk,iii,1,2)) > call matvec2(auxmat(1,1),Ub2(1,l), > & AEAb2derx(1,lll,kkk,iii,1,2)) > call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1), > & AEAb1derx(1,lll,kkk,iii,2,2)) > call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j), > & AEAb2derx(1,lll,kkk,iii,2,2)) > enddo > enddo > enddo > ENDIF > C End vectors > endif > return > end > C--------------------------------------------------------------------------- > subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp, > & KK,KKderg,AKA,AKAderg,AKAderx) > implicit none > integer nderg > logical transp > double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5), > & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2), > & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2) > integer iii,kkk,lll > integer jjj,mmm > logical lprn > common /kutas/ lprn > call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1)) > do iii=1,nderg > call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp, > & AKAderg(1,1,iii)) > enddo > cd if (lprn) write (2,*) 'In kernel' > do kkk=1,5 > cd if (lprn) write (2,*) 'kkk=',kkk > do lll=1,3 > call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1), > & KK(1,1),transp,AKAderx(1,1,lll,kkk,1)) > cd if (lprn) then > cd write (2,*) 'lll=',lll > cd write (2,*) 'iii=1' > cd do jjj=1,2 > cd write (2,'(3(2f10.5),5x)') > cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2) > cd enddo > cd endif > call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk), > & KK(1,1),transp,AKAderx(1,1,lll,kkk,2)) > cd if (lprn) then > cd write (2,*) 'lll=',lll > cd write (2,*) 'iii=2' > cd do jjj=1,2 > cd write (2,'(3(2f10.5),5x)') > cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2) > cd enddo > cd endif > enddo > enddo > return > end > C--------------------------------------------------------------------------- > double precision function eello4(i,j,k,l,jj,kk) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.IOUNITS' > include 'COMMON.CHAIN' > include 'COMMON.DERIV' > include 'COMMON.INTERACT' > include 'COMMON.CONTACTS' > include 'COMMON.TORSION' > include 'COMMON.VAR' > include 'COMMON.GEO' > double precision pizda(2,2),ggg1(3),ggg2(3) > cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then > cd eello4=0.0d0 > cd return > cd endif > cd print *,'eello4:',i,j,k,l,jj,kk > cd write (2,*) 'i',i,' j',j,' k',k,' l',l > cd call checkint4(i,j,k,l,jj,kk,eel4_num) > cold eij=facont_hb(jj,i) > cold ekl=facont_hb(kk,k) > cold ekont=eij*ekl > eel4=-EAEA(1,1,1)-EAEA(2,2,1) > cd eel41=-EAEA(1,1,2)-EAEA(2,2,2) > gcorr_loc(k-1)=gcorr_loc(k-1) > & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1)) > if (l.eq.j+1) then > gcorr_loc(l-1)=gcorr_loc(l-1) > & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1)) > else > gcorr_loc(j-1)=gcorr_loc(j-1) > & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1)) > endif > do iii=1,2 > do kkk=1,5 > do lll=1,3 > derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) > & -EAEAderx(2,2,lll,kkk,iii,1) > cd derx(lll,kkk,iii)=0.0d0 > enddo > enddo > enddo > cd gcorr_loc(l-1)=0.0d0 > cd gcorr_loc(j-1)=0.0d0 > cd gcorr_loc(k-1)=0.0d0 > cd eel4=1.0d0 > cd write (iout,*)'Contacts have occurred for peptide groups', > cd & i,j,' fcont:',eij,' eij',' and ',k,l, > cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num > if (j.lt.nres-1) then > j1=j+1 > j2=j-1 > else > j1=j-1 > j2=j-2 > endif > if (l.lt.nres-1) then > l1=l+1 > l2=l-1 > else > l1=l-1 > l2=l-2 > endif > do ll=1,3 > cold ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i) > ggg1(ll)=eel4*g_contij(ll,1) > ggg2(ll)=eel4*g_contij(ll,2) > ghalf=0.5d0*ggg1(ll) > cd ghalf=0.0d0 > gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1) > gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1) > gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1) > gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1) > cold ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k) > ghalf=0.5d0*ggg2(ll) > cd ghalf=0.0d0 > gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2) > gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2) > gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2) > gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2) > enddo > cd goto 1112 > do m=i+1,j-1 > do ll=1,3 > cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i) > gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll) > enddo > enddo > do m=k+1,l-1 > do ll=1,3 > cold gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k) > gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll) > enddo > enddo > 1112 continue > do m=i+2,j2 > do ll=1,3 > gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1) > enddo > enddo > do m=k+2,l2 > do ll=1,3 > gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2) > enddo > enddo > cd do iii=1,nres-3 > cd write (2,*) iii,gcorr_loc(iii) > cd enddo > eello4=ekont*eel4 > cd write (2,*) 'ekont',ekont > cd write (iout,*) 'eello4',ekont*eel4 > return > end > C--------------------------------------------------------------------------- > double precision function eello5(i,j,k,l,jj,kk) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.IOUNITS' > include 'COMMON.CHAIN' > include 'COMMON.DERIV' > include 'COMMON.INTERACT' > include 'COMMON.CONTACTS' > include 'COMMON.TORSION' > include 'COMMON.VAR' > include 'COMMON.GEO' > double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2) > double precision ggg1(3),ggg2(3) > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC > C C > C Parallel chains C > C C > C o o o o C > C /l\ / \ \ / \ / \ / C > C / \ / \ \ / \ / \ / C > C j| o |l1 | o | o| o | | o |o C > C \ |/k\| |/ \| / |/ \| |/ \| C > C \i/ \ / \ / / \ / \ C > C o k1 o C > C (I) (II) (III) (IV) C > C C > C eello5_1 eello5_2 eello5_3 eello5_4 C > C C > C Antiparallel chains C > C C > C o o o o C > C /j\ / \ \ / \ / \ / C > C / \ / \ \ / \ / \ / C > C j1| o |l | o | o| o | | o |o C > C \ |/k\| |/ \| / |/ \| |/ \| C > C \i/ \ / \ / / \ / \ C > C o k1 o C > C (I) (II) (III) (IV) C > C C > C eello5_1 eello5_2 eello5_3 eello5_4 C > C C > C o denotes a local interaction, vertical lines an electrostatic interaction. C > C C > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC > cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then > cd eello5=0.0d0 > cd return > cd endif > cd write (iout,*) > cd & 'EELLO5: Contacts have occurred for peptide groups',i,j, > cd & ' and',k,l > itk=itortyp(itype(k)) > itl=itortyp(itype(l)) > itj=itortyp(itype(j)) > eello5_1=0.0d0 > eello5_2=0.0d0 > eello5_3=0.0d0 > eello5_4=0.0d0 > cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num, > cd & eel5_3_num,eel5_4_num) > do iii=1,2 > do kkk=1,5 > do lll=1,3 > derx(lll,kkk,iii)=0.0d0 > enddo > enddo > enddo > cd eij=facont_hb(jj,i) > cd ekl=facont_hb(kk,k) > cd ekont=eij*ekl > cd write (iout,*)'Contacts have occurred for peptide groups', > cd & i,j,' fcont:',eij,' eij',' and ',k,l > cd goto 1111 > C Contribution from the graph I. > cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1) > cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1) > call transpose2(EUg(1,1,k),auxmat(1,1)) > call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(1,2)+pizda(2,1) > eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) > & +0.5d0*scalar2(vv(1),Dtobr2(1,i)) > C Explicit gradient in virtual-dihedral angles. > if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) > & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) > & +0.5d0*scalar2(vv(1),Dtobr2der(1,i))) > call transpose2(EUgder(1,1,k),auxmat1(1,1)) > call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(1,2)+pizda(2,1) > g_corr5_loc(k-1)=g_corr5_loc(k-1) > & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) > & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) > call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(1,2)+pizda(2,1) > if (l.eq.j+1) then > if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) > & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) > & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) > else > if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) > & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) > & +0.5d0*scalar2(vv(1),Dtobr2(1,i))) > endif > C Cartesian gradient > do iii=1,2 > do kkk=1,5 > do lll=1,3 > call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1), > & pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(1,2)+pizda(2,1) > derx(lll,kkk,iii)=derx(lll,kkk,iii) > & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) > & +0.5d0*scalar2(vv(1),Dtobr2(1,i)) > enddo > enddo > enddo > c goto 1112 > c1111 continue > C Contribution from graph II > call transpose2(EE(1,1,itk),auxmat(1,1)) > call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1)) > vv(1)=pizda(1,1)+pizda(2,2) > vv(2)=pizda(2,1)-pizda(1,2) > eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) > & -0.5d0*scalar2(vv(1),Ctobr(1,k)) > C Explicit gradient in virtual-dihedral angles. > g_corr5_loc(k-1)=g_corr5_loc(k-1) > & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k)) > call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1)) > vv(1)=pizda(1,1)+pizda(2,2) > vv(2)=pizda(2,1)-pizda(1,2) > if (l.eq.j+1) then > g_corr5_loc(l-1)=g_corr5_loc(l-1) > & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) > & -0.5d0*scalar2(vv(1),Ctobr(1,k))) > else > g_corr5_loc(j-1)=g_corr5_loc(j-1) > & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) > & -0.5d0*scalar2(vv(1),Ctobr(1,k))) > endif > C Cartesian gradient > do iii=1,2 > do kkk=1,5 > do lll=1,3 > call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1), > & pizda(1,1)) > vv(1)=pizda(1,1)+pizda(2,2) > vv(2)=pizda(2,1)-pizda(1,2) > derx(lll,kkk,iii)=derx(lll,kkk,iii) > & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) > & -0.5d0*scalar2(vv(1),Ctobr(1,k)) > enddo > enddo > enddo > cd goto 1112 > cd1111 continue > if (l.eq.j+1) then > cd goto 1110 > C Parallel orientation > C Contribution from graph III > call transpose2(EUg(1,1,l),auxmat(1,1)) > call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(1,2)+pizda(2,1) > eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) > & +0.5d0*scalar2(vv(1),Dtobr2(1,j)) > C Explicit gradient in virtual-dihedral angles. > g_corr5_loc(j-1)=g_corr5_loc(j-1) > & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) > & +0.5d0*scalar2(vv(1),Dtobr2der(1,j))) > call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(1,2)+pizda(2,1) > g_corr5_loc(k-1)=g_corr5_loc(k-1) > & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) > & +0.5d0*scalar2(vv(1),Dtobr2(1,j))) > call transpose2(EUgder(1,1,l),auxmat1(1,1)) > call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(1,2)+pizda(2,1) > g_corr5_loc(l-1)=g_corr5_loc(l-1) > & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) > & +0.5d0*scalar2(vv(1),Dtobr2(1,j))) > C Cartesian gradient > do iii=1,2 > do kkk=1,5 > do lll=1,3 > call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1), > & pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(1,2)+pizda(2,1) > derx(lll,kkk,iii)=derx(lll,kkk,iii) > & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) > & +0.5d0*scalar2(vv(1),Dtobr2(1,j)) > enddo > enddo > enddo > cd goto 1112 > C Contribution from graph IV > cd1110 continue > call transpose2(EE(1,1,itl),auxmat(1,1)) > call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) > vv(1)=pizda(1,1)+pizda(2,2) > vv(2)=pizda(2,1)-pizda(1,2) > eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) > & -0.5d0*scalar2(vv(1),Ctobr(1,l)) > C Explicit gradient in virtual-dihedral angles. > g_corr5_loc(l-1)=g_corr5_loc(l-1) > & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l)) > call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1)) > vv(1)=pizda(1,1)+pizda(2,2) > vv(2)=pizda(2,1)-pizda(1,2) > g_corr5_loc(k-1)=g_corr5_loc(k-1) > & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) > & -0.5d0*scalar2(vv(1),Ctobr(1,l))) > C Cartesian gradient > do iii=1,2 > do kkk=1,5 > do lll=1,3 > call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), > & pizda(1,1)) > vv(1)=pizda(1,1)+pizda(2,2) > vv(2)=pizda(2,1)-pizda(1,2) > derx(lll,kkk,iii)=derx(lll,kkk,iii) > & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) > & -0.5d0*scalar2(vv(1),Ctobr(1,l)) > enddo > enddo > enddo > else > C Antiparallel orientation > C Contribution from graph III > c goto 1110 > call transpose2(EUg(1,1,j),auxmat(1,1)) > call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(1,2)+pizda(2,1) > eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) > & +0.5d0*scalar2(vv(1),Dtobr2(1,l)) > C Explicit gradient in virtual-dihedral angles. > g_corr5_loc(l-1)=g_corr5_loc(l-1) > & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) > & +0.5d0*scalar2(vv(1),Dtobr2der(1,l))) > call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(1,2)+pizda(2,1) > g_corr5_loc(k-1)=g_corr5_loc(k-1) > & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) > & +0.5d0*scalar2(vv(1),Dtobr2(1,l))) > call transpose2(EUgder(1,1,j),auxmat1(1,1)) > call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(1,2)+pizda(2,1) > g_corr5_loc(j-1)=g_corr5_loc(j-1) > & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) > & +0.5d0*scalar2(vv(1),Dtobr2(1,l))) > C Cartesian gradient > do iii=1,2 > do kkk=1,5 > do lll=1,3 > call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1), > & pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(1,2)+pizda(2,1) > derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) > & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) > & +0.5d0*scalar2(vv(1),Dtobr2(1,l)) > enddo > enddo > enddo > cd goto 1112 > C Contribution from graph IV > 1110 continue > call transpose2(EE(1,1,itj),auxmat(1,1)) > call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1)) > vv(1)=pizda(1,1)+pizda(2,2) > vv(2)=pizda(2,1)-pizda(1,2) > eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) > & -0.5d0*scalar2(vv(1),Ctobr(1,j)) > C Explicit gradient in virtual-dihedral angles. > g_corr5_loc(j-1)=g_corr5_loc(j-1) > & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j)) > call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1)) > vv(1)=pizda(1,1)+pizda(2,2) > vv(2)=pizda(2,1)-pizda(1,2) > g_corr5_loc(k-1)=g_corr5_loc(k-1) > & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) > & -0.5d0*scalar2(vv(1),Ctobr(1,j))) > C Cartesian gradient > do iii=1,2 > do kkk=1,5 > do lll=1,3 > call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2), > & pizda(1,1)) > vv(1)=pizda(1,1)+pizda(2,2) > vv(2)=pizda(2,1)-pizda(1,2) > derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) > & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) > & -0.5d0*scalar2(vv(1),Ctobr(1,j)) > enddo > enddo > enddo > endif > 1112 continue > eel5=eello5_1+eello5_2+eello5_3+eello5_4 > cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then > cd write (2,*) 'ijkl',i,j,k,l > cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2, > cd & ' eello5_3',eello5_3,' eello5_4',eello5_4 > cd endif > cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num > cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num > cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num > cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num > if (j.lt.nres-1) then > j1=j+1 > j2=j-1 > else > j1=j-1 > j2=j-2 > endif > if (l.lt.nres-1) then > l1=l+1 > l2=l-1 > else > l1=l-1 > l2=l-2 > endif > cd eij=1.0d0 > cd ekl=1.0d0 > cd ekont=1.0d0 > cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont > do ll=1,3 > ggg1(ll)=eel5*g_contij(ll,1) > ggg2(ll)=eel5*g_contij(ll,2) > cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i) > ghalf=0.5d0*ggg1(ll) > cd ghalf=0.0d0 > gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1) > gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1) > gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1) > gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1) > cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k) > ghalf=0.5d0*ggg2(ll) > cd ghalf=0.0d0 > gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2) > gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2) > gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2) > gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2) > enddo > cd goto 1112 > do m=i+1,j-1 > do ll=1,3 > cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i) > gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll) > enddo > enddo > do m=k+1,l-1 > do ll=1,3 > cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k) > gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll) > enddo > enddo > c1112 continue > do m=i+2,j2 > do ll=1,3 > gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1) > enddo > enddo > do m=k+2,l2 > do ll=1,3 > gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2) > enddo > enddo > cd do iii=1,nres-3 > cd write (2,*) iii,g_corr5_loc(iii) > cd enddo > eello5=ekont*eel5 > cd write (2,*) 'ekont',ekont > cd write (iout,*) 'eello5',ekont*eel5 > return > end > c-------------------------------------------------------------------------- > double precision function eello6(i,j,k,l,jj,kk) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.IOUNITS' > include 'COMMON.CHAIN' > include 'COMMON.DERIV' > include 'COMMON.INTERACT' > include 'COMMON.CONTACTS' > include 'COMMON.TORSION' > include 'COMMON.VAR' > include 'COMMON.GEO' > include 'COMMON.FFIELD' > double precision ggg1(3),ggg2(3) > cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then > cd eello6=0.0d0 > cd return > cd endif > cd write (iout,*) > cd & 'EELLO6: Contacts have occurred for peptide groups',i,j, > cd & ' and',k,l > eello6_1=0.0d0 > eello6_2=0.0d0 > eello6_3=0.0d0 > eello6_4=0.0d0 > eello6_5=0.0d0 > eello6_6=0.0d0 > cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num, > cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num) > do iii=1,2 > do kkk=1,5 > do lll=1,3 > derx(lll,kkk,iii)=0.0d0 > enddo > enddo > enddo > cd eij=facont_hb(jj,i) > cd ekl=facont_hb(kk,k) > cd ekont=eij*ekl > cd eij=1.0d0 > cd ekl=1.0d0 > cd ekont=1.0d0 > if (l.eq.j+1) then > eello6_1=eello6_graph1(i,j,k,l,1,.false.) > eello6_2=eello6_graph1(j,i,l,k,2,.false.) > eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.) > eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.) > eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.) > eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.) > else > eello6_1=eello6_graph1(i,j,k,l,1,.false.) > eello6_2=eello6_graph1(l,k,j,i,2,.true.) > eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.) > eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.) > if (wturn6.eq.0.0d0 .or. j.ne.i+4) then > eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.) > else > eello6_5=0.0d0 > endif > eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.) > endif > C If turn contributions are considered, they will be handled separately. > eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6 > cd write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num > cd write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num > cd write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num > cd write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num > cd write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num > cd write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num > cd goto 1112 > if (j.lt.nres-1) then > j1=j+1 > j2=j-1 > else > j1=j-1 > j2=j-2 > endif > if (l.lt.nres-1) then > l1=l+1 > l2=l-1 > else > l1=l-1 > l2=l-2 > endif > do ll=1,3 > ggg1(ll)=eel6*g_contij(ll,1) > ggg2(ll)=eel6*g_contij(ll,2) > cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i) > ghalf=0.5d0*ggg1(ll) > cd ghalf=0.0d0 > gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1) > gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1) > gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1) > gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1) > ghalf=0.5d0*ggg2(ll) > cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k) > cd ghalf=0.0d0 > gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2) > gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2) > gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2) > gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2) > enddo > cd goto 1112 > do m=i+1,j-1 > do ll=1,3 > cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i) > gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll) > enddo > enddo > do m=k+1,l-1 > do ll=1,3 > cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k) > gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll) > enddo > enddo > 1112 continue > do m=i+2,j2 > do ll=1,3 > gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1) > enddo > enddo > do m=k+2,l2 > do ll=1,3 > gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2) > enddo > enddo > cd do iii=1,nres-3 > cd write (2,*) iii,g_corr6_loc(iii) > cd enddo > eello6=ekont*eel6 > cd write (2,*) 'ekont',ekont > cd write (iout,*) 'eello6',ekont*eel6 > return > end > c-------------------------------------------------------------------------- > double precision function eello6_graph1(i,j,k,l,imat,swap) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.IOUNITS' > include 'COMMON.CHAIN' > include 'COMMON.DERIV' > include 'COMMON.INTERACT' > include 'COMMON.CONTACTS' > include 'COMMON.TORSION' > include 'COMMON.VAR' > include 'COMMON.GEO' > double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2) > logical swap > logical lprn > common /kutas/ lprn > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC > C > C Parallel Antiparallel > C > C o o > C /l\ /j\ > C / \ / \ > C /| o | | o |\ > C \ j|/k\| / \ |/k\|l / > C \ / \ / \ / \ / > C o o o o > C i i > C > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC > itk=itortyp(itype(k)) > s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i)) > s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k)) > s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k)) > call transpose2(EUgC(1,1,k),auxmat(1,1)) > call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1)) > vv1(1)=pizda1(1,1)-pizda1(2,2) > vv1(2)=pizda1(1,2)+pizda1(2,1) > s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) > vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk) > vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk) > s5=scalar2(vv(1),Dtobr2(1,i)) > cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5 > eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5) > if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) > & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) > & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) > & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) > & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) > & +scalar2(vv(1),Dtobr2der(1,i))) > call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1)) > vv1(1)=pizda1(1,1)-pizda1(2,2) > vv1(2)=pizda1(1,2)+pizda1(2,1) > vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk) > vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk) > if (l.eq.j+1) then > g_corr6_loc(l-1)=g_corr6_loc(l-1) > & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) > & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) > & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) > & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i)))) > else > g_corr6_loc(j-1)=g_corr6_loc(j-1) > & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) > & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) > & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) > & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i)))) > endif > call transpose2(EUgCder(1,1,k),auxmat(1,1)) > call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1)) > vv1(1)=pizda1(1,1)-pizda1(2,2) > vv1(2)=pizda1(1,2)+pizda1(2,1) > if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) > & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) > & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) > & +0.5d0*scalar2(vv1(1),Dtobr2(1,i)))) > do iii=1,2 > if (swap) then > ind=3-iii > else > ind=iii > endif > do kkk=1,5 > do lll=1,3 > s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i)) > s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k)) > s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k)) > call transpose2(EUgC(1,1,k),auxmat(1,1)) > call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), > & pizda1(1,1)) > vv1(1)=pizda1(1,1)-pizda1(2,2) > vv1(2)=pizda1(1,2)+pizda1(2,1) > s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i)) > vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) > & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk) > vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) > & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk) > s5=scalar2(vv(1),Dtobr2(1,i)) > derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5) > enddo > enddo > enddo > return > end > c---------------------------------------------------------------------------- > double precision function eello6_graph2(i,j,k,l,jj,kk,swap) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.IOUNITS' > include 'COMMON.CHAIN' > include 'COMMON.DERIV' > include 'COMMON.INTERACT' > include 'COMMON.CONTACTS' > include 'COMMON.TORSION' > include 'COMMON.VAR' > include 'COMMON.GEO' > logical swap > double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), > & auxvec1(2),auxvec2(1),auxmat1(2,2) > logical lprn > common /kutas/ lprn > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC > C > C Parallel Antiparallel > C > C o o > C \ /l\ /j\ / > C \ / \ / \ / > C o| o | | o |o > C \ j|/k\| \ |/k\|l > C \ / \ \ / \ > C o o > C i i > C > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC > cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l > C AL 7/4/01 s1 would occur in the sixth-order moment, > C but not in a cluster cumulant > #ifdef MOMENT > s1=dip(1,jj,i)*dip(1,kk,k) > #endif > call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1)) > s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1)) > call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1)) > s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1)) > call transpose2(EUg(1,1,k),auxmat(1,1)) > call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(1,2)+pizda(2,1) > s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) > cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4 > #ifdef MOMENT > eello6_graph2=-(s1+s2+s3+s4) > #else > eello6_graph2=-(s2+s3+s4) > #endif > c eello6_graph2=-s3 > C Derivatives in gamma(i-1) > if (i.gt.1) then > #ifdef MOMENT > s1=dipderg(1,jj,i)*dip(1,kk,k) > #endif > s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1)) > call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1)) > s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) > s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i)) > #ifdef MOMENT > g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4) > #else > g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4) > #endif > c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3 > endif > C Derivatives in gamma(k-1) > #ifdef MOMENT > s1=dip(1,jj,i)*dipderg(1,kk,k) > #endif > call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1)) > s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) > call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1)) > s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) > call transpose2(EUgder(1,1,k),auxmat1(1,1)) > call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(1,2)+pizda(2,1) > s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) > #ifdef MOMENT > g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4) > #else > g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4) > #endif > c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3 > C Derivatives in gamma(j-1) or gamma(l-1) > if (j.gt.1) then > #ifdef MOMENT > s1=dipderg(3,jj,i)*dip(1,kk,k) > #endif > call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1)) > s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) > s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1)) > call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(1,2)+pizda(2,1) > s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) > #ifdef MOMENT > if (swap) then > g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1 > else > g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1 > endif > #endif > g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4) > c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3 > endif > C Derivatives in gamma(l-1) or gamma(j-1) > if (l.gt.1) then > #ifdef MOMENT > s1=dip(1,jj,i)*dipderg(3,kk,k) > #endif > call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1)) > s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1)) > call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1)) > s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1)) > call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(1,2)+pizda(2,1) > s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) > #ifdef MOMENT > if (swap) then > g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1 > else > g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1 > endif > #endif > g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4) > c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3 > endif > C Cartesian derivatives. > if (lprn) then > write (2,*) 'In eello6_graph2' > do iii=1,2 > write (2,*) 'iii=',iii > do kkk=1,5 > write (2,*) 'kkk=',kkk > do jjj=1,2 > write (2,'(3(2f10.5),5x)') > & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3) > enddo > enddo > enddo > endif > do iii=1,2 > do kkk=1,5 > do lll=1,3 > #ifdef MOMENT > if (iii.eq.1) then > s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k) > else > s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k) > endif > #endif > call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k), > & auxvec(1)) > s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1)) > call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l), > & auxvec(1)) > s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1)) > call transpose2(EUg(1,1,k),auxmat(1,1)) > call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1), > & pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(1,2)+pizda(2,1) > s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i)) > cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4 > #ifdef MOMENT > derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) > #else > derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) > #endif > if (swap) then > derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 > else > derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 > endif > enddo > enddo > enddo > return > end > c---------------------------------------------------------------------------- > double precision function eello6_graph3(i,j,k,l,jj,kk,swap) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.IOUNITS' > include 'COMMON.CHAIN' > include 'COMMON.DERIV' > include 'COMMON.INTERACT' > include 'COMMON.CONTACTS' > include 'COMMON.TORSION' > include 'COMMON.VAR' > include 'COMMON.GEO' > double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2) > logical swap > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC > C > C Parallel Antiparallel > C > C o o > C /l\ / \ /j\ > C / \ / \ / \ > C /| o |o o| o |\ > C j|/k\| / |/k\|l / > C / \ / / \ / > C / o / o > C i i > C > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC > C > C 4/7/01 AL Component s1 was removed, because it pertains to the respective > C energy moment and not to the cluster cumulant. > iti=itortyp(itype(i)) > if (j.lt.nres-1) then > itj1=itortyp(itype(j+1)) > else > itj1=ntortyp+1 > endif > itk=itortyp(itype(k)) > itk1=itortyp(itype(k+1)) > if (l.lt.nres-1) then > itl1=itortyp(itype(l+1)) > else > itl1=ntortyp+1 > endif > #ifdef MOMENT > s1=dip(4,jj,i)*dip(4,kk,k) > #endif > call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1)) > s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) > call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1)) > s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) > call transpose2(EE(1,1,itk),auxmat(1,1)) > call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1)) > vv(1)=pizda(1,1)+pizda(2,2) > vv(2)=pizda(2,1)-pizda(1,2) > s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) > cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4 > #ifdef MOMENT > eello6_graph3=-(s1+s2+s3+s4) > #else > eello6_graph3=-(s2+s3+s4) > #endif > c eello6_graph3=-s4 > C Derivatives in gamma(k-1) > call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1)) > s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) > s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k)) > g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4) > C Derivatives in gamma(l-1) > call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1)) > s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) > call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1)) > vv(1)=pizda(1,1)+pizda(2,2) > vv(2)=pizda(2,1)-pizda(1,2) > s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) > g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4) > C Cartesian derivatives. > do iii=1,2 > do kkk=1,5 > do lll=1,3 > #ifdef MOMENT > if (iii.eq.1) then > s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k) > else > s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k) > endif > #endif > call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1), > & auxvec(1)) > s2=0.5d0*scalar2(b1(1,itk),auxvec(1)) > call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1), > & auxvec(1)) > s3=0.5d0*scalar2(b1(1,itj1),auxvec(1)) > call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1), > & pizda(1,1)) > vv(1)=pizda(1,1)+pizda(2,2) > vv(2)=pizda(2,1)-pizda(1,2) > s4=-0.25d0*scalar2(vv(1),Ctobr(1,k)) > #ifdef MOMENT > derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) > #else > derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) > #endif > if (swap) then > derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 > else > derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 > endif > c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4 > enddo > enddo > enddo > return > end > c---------------------------------------------------------------------------- > double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.IOUNITS' > include 'COMMON.CHAIN' > include 'COMMON.DERIV' > include 'COMMON.INTERACT' > include 'COMMON.CONTACTS' > include 'COMMON.TORSION' > include 'COMMON.VAR' > include 'COMMON.GEO' > include 'COMMON.FFIELD' > double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2), > & auxvec1(2),auxmat1(2,2) > logical swap > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC > C > C Parallel Antiparallel > C > C o o > C /l\ / \ /j\ > C / \ / \ / \ > C /| o |o o| o |\ > C \ j|/k\| \ |/k\|l > C \ / \ \ / \ > C o \ o \ > C i i > C > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC > C > C 4/7/01 AL Component s1 was removed, because it pertains to the respective > C energy moment and not to the cluster cumulant. > cd write (2,*) 'eello_graph4: wturn6',wturn6 > iti=itortyp(itype(i)) > itj=itortyp(itype(j)) > if (j.lt.nres-1) then > itj1=itortyp(itype(j+1)) > else > itj1=ntortyp+1 > endif > itk=itortyp(itype(k)) > if (k.lt.nres-1) then > itk1=itortyp(itype(k+1)) > else > itk1=ntortyp+1 > endif > itl=itortyp(itype(l)) > if (l.lt.nres-1) then > itl1=itortyp(itype(l+1)) > else > itl1=ntortyp+1 > endif > cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l > cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk, > cd & ' itl',itl,' itl1',itl1 > #ifdef MOMENT > if (imat.eq.1) then > s1=dip(3,jj,i)*dip(3,kk,k) > else > s1=dip(2,jj,j)*dip(2,kk,l) > endif > #endif > call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1)) > s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) > if (j.eq.l+1) then > call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1)) > s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) > else > call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1)) > s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) > endif > call transpose2(EUg(1,1,k),auxmat(1,1)) > call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(2,1)+pizda(1,2) > s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) > cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4 > #ifdef MOMENT > eello6_graph4=-(s1+s2+s3+s4) > #else > eello6_graph4=-(s2+s3+s4) > #endif > C Derivatives in gamma(i-1) > if (i.gt.1) then > #ifdef MOMENT > if (imat.eq.1) then > s1=dipderg(2,jj,i)*dip(3,kk,k) > else > s1=dipderg(4,jj,j)*dip(2,kk,l) > endif > #endif > s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1)) > if (j.eq.l+1) then > call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1)) > s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) > else > call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1)) > s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) > endif > s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i)) > if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then > cd write (2,*) 'turn6 derivatives' > #ifdef MOMENT > gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4) > #else > gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4) > #endif > else > #ifdef MOMENT > g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4) > #else > g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4) > #endif > endif > endif > C Derivatives in gamma(k-1) > #ifdef MOMENT > if (imat.eq.1) then > s1=dip(3,jj,i)*dipderg(2,kk,k) > else > s1=dip(2,jj,j)*dipderg(4,kk,l) > endif > #endif > call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1)) > s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1)) > if (j.eq.l+1) then > call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1)) > s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1)) > else > call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1)) > s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1)) > endif > call transpose2(EUgder(1,1,k),auxmat1(1,1)) > call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(2,1)+pizda(1,2) > s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) > if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then > #ifdef MOMENT > gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4) > #else > gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4) > #endif > else > #ifdef MOMENT > g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4) > #else > g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4) > #endif > endif > C Derivatives in gamma(j-1) or gamma(l-1) > if (l.eq.j+1 .and. l.gt.1) then > call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1)) > s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) > call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(2,1)+pizda(1,2) > s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) > g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4) > else if (j.gt.1) then > call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1)) > s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) > call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(2,1)+pizda(1,2) > s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) > if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then > gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4) > else > g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4) > endif > endif > C Cartesian derivatives. > do iii=1,2 > do kkk=1,5 > do lll=1,3 > #ifdef MOMENT > if (iii.eq.1) then > if (imat.eq.1) then > s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k) > else > s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l) > endif > else > if (imat.eq.1) then > s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k) > else > s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l) > endif > endif > #endif > call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k), > & auxvec(1)) > s2=0.5d0*scalar2(Ub2(1,i),auxvec(1)) > if (j.eq.l+1) then > call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), > & b1(1,itj1),auxvec(1)) > s3=-0.5d0*scalar2(b1(1,itj),auxvec(1)) > else > call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat), > & b1(1,itl1),auxvec(1)) > s3=-0.5d0*scalar2(b1(1,itl),auxvec(1)) > endif > call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1), > & pizda(1,1)) > vv(1)=pizda(1,1)-pizda(2,2) > vv(2)=pizda(2,1)+pizda(1,2) > s4=0.25d0*scalar2(vv(1),Dtobr2(1,i)) > if (swap) then > if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then > #ifdef MOMENT > derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) > & -(s1+s2+s4) > #else > derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) > & -(s2+s4) > #endif > derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3 > else > #ifdef MOMENT > derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4) > #else > derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4) > #endif > derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 > endif > else > #ifdef MOMENT > derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4) > #else > derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4) > #endif > if (l.eq.j+1) then > derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3 > else > derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3 > endif > endif > enddo > enddo > enddo > return > end > c---------------------------------------------------------------------------- > double precision function eello_turn6(i,jj,kk) > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > include 'COMMON.IOUNITS' > include 'COMMON.CHAIN' > include 'COMMON.DERIV' > include 'COMMON.INTERACT' > include 'COMMON.CONTACTS' > include 'COMMON.TORSION' > include 'COMMON.VAR' > include 'COMMON.GEO' > double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2), > & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2), > & ggg1(3),ggg2(3) > double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2), > & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2) > C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to > C the respective energy moment and not to the cluster cumulant. > s1=0.0d0 > s8=0.0d0 > s13=0.0d0 > c > eello_turn6=0.0d0 > j=i+4 > k=i+1 > l=i+3 > iti=itortyp(itype(i)) > itk=itortyp(itype(k)) > itk1=itortyp(itype(k+1)) > itl=itortyp(itype(l)) > itj=itortyp(itype(j)) > cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj > cd write (2,*) 'i',i,' k',k,' j',j,' l',l > cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then > cd eello6=0.0d0 > cd return > cd endif > cd write (iout,*) > cd & 'EELLO6: Contacts have occurred for peptide groups',i,j, > cd & ' and',k,l > cd call checkint_turn6(i,jj,kk,eel_turn6_num) > do iii=1,2 > do kkk=1,5 > do lll=1,3 > derx_turn(lll,kkk,iii)=0.0d0 > enddo > enddo > enddo > cd eij=1.0d0 > cd ekl=1.0d0 > cd ekont=1.0d0 > eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.) > cd eello6_5=0.0d0 > cd write (2,*) 'eello6_5',eello6_5 > #ifdef MOMENT > call transpose2(AEA(1,1,1),auxmat(1,1)) > call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1)) > ss1=scalar2(Ub2(1,i+2),b1(1,itl)) > s1 = (auxmat(1,1)+auxmat(2,2))*ss1 > #endif > call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) > call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1)) > s2 = scalar2(b1(1,itk),vtemp1(1)) > #ifdef MOMENT > call transpose2(AEA(1,1,2),atemp(1,1)) > call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1)) > call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1)) > s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) > #endif > call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1)) > call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1)) > s12 = scalar2(Ub2(1,i+2),vtemp3(1)) > #ifdef MOMENT > call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1)) > call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1)) > call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1)) > call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1)) > ss13 = scalar2(b1(1,itk),vtemp4(1)) > s13 = (gtemp(1,1)+gtemp(2,2))*ss13 > #endif > c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13 > c s1=0.0d0 > c s2=0.0d0 > c s8=0.0d0 > c s12=0.0d0 > c s13=0.0d0 > eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13) > C Derivatives in gamma(i+2) > s1d =0.0d0 > s8d =0.0d0 > #ifdef MOMENT > call transpose2(AEA(1,1,1),auxmatd(1,1)) > call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) > s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 > call transpose2(AEAderg(1,1,2),atempd(1,1)) > call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) > s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) > #endif > call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1)) > call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) > s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) > c s1d=0.0d0 > c s2d=0.0d0 > c s8d=0.0d0 > c s12d=0.0d0 > c s13d=0.0d0 > gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d) > C Derivatives in gamma(i+3) > #ifdef MOMENT > call transpose2(AEA(1,1,1),auxmatd(1,1)) > call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) > ss1d=scalar2(Ub2der(1,i+2),b1(1,itl)) > s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d > #endif > call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1)) > call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1)) > s2d = scalar2(b1(1,itk),vtemp1d(1)) > #ifdef MOMENT > call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1)) > s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1)) > #endif > s12d = scalar2(Ub2der(1,i+2),vtemp3(1)) > #ifdef MOMENT > call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1)) > call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) > s13d = (gtempd(1,1)+gtempd(2,2))*ss13 > #endif > c s1d=0.0d0 > c s2d=0.0d0 > c s8d=0.0d0 > c s12d=0.0d0 > c s13d=0.0d0 > #ifdef MOMENT > gel_loc_turn6(i+1)=gel_loc_turn6(i+1) > & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d) > #else > gel_loc_turn6(i+1)=gel_loc_turn6(i+1) > & -0.5d0*ekont*(s2d+s12d) > #endif > C Derivatives in gamma(i+4) > call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1)) > call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) > s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) > #ifdef MOMENT > call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1)) > call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1)) > s13d = (gtempd(1,1)+gtempd(2,2))*ss13 > #endif > c s1d=0.0d0 > c s2d=0.0d0 > c s8d=0.0d0 > C s12d=0.0d0 > c s13d=0.0d0 > #ifdef MOMENT > gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d) > #else > gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d) > #endif > C Derivatives in gamma(i+5) > #ifdef MOMENT > call transpose2(AEAderg(1,1,1),auxmatd(1,1)) > call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) > s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 > #endif > call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1)) > call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1)) > s2d = scalar2(b1(1,itk),vtemp1d(1)) > #ifdef MOMENT > call transpose2(AEA(1,1,2),atempd(1,1)) > call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1)) > s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1)) > #endif > call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1)) > s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) > #ifdef MOMENT > call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1)) > ss13d = scalar2(b1(1,itk),vtemp4d(1)) > s13d = (gtemp(1,1)+gtemp(2,2))*ss13d > #endif > c s1d=0.0d0 > c s2d=0.0d0 > c s8d=0.0d0 > c s12d=0.0d0 > c s13d=0.0d0 > #ifdef MOMENT > gel_loc_turn6(i+3)=gel_loc_turn6(i+3) > & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d) > #else > gel_loc_turn6(i+3)=gel_loc_turn6(i+3) > & -0.5d0*ekont*(s2d+s12d) > #endif > C Cartesian derivatives > do iii=1,2 > do kkk=1,5 > do lll=1,3 > #ifdef MOMENT > call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1)) > call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1)) > s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1 > #endif > call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1)) > call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1), > & vtemp1d(1)) > s2d = scalar2(b1(1,itk),vtemp1d(1)) > #ifdef MOMENT > call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1)) > call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1)) > s8d = -(atempd(1,1)+atempd(2,2))* > & scalar2(cc(1,1,itl),vtemp2(1)) > #endif > call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2), > & auxmatd(1,1)) > call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1)) > s12d = scalar2(Ub2(1,i+2),vtemp3d(1)) > c s1d=0.0d0 > c s2d=0.0d0 > c s8d=0.0d0 > c s12d=0.0d0 > c s13d=0.0d0 > #ifdef MOMENT > derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) > & - 0.5d0*(s1d+s2d) > #else > derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) > & - 0.5d0*s2d > #endif > #ifdef MOMENT > derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) > & - 0.5d0*(s8d+s12d) > #else > derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) > & - 0.5d0*s12d > #endif > enddo > enddo > enddo > #ifdef MOMENT > do kkk=1,5 > do lll=1,3 > call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1), > & achuj_tempd(1,1)) > call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1)) > call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1)) > s13d=(gtempd(1,1)+gtempd(2,2))*ss13 > derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d > call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4), > & vtemp4d(1)) > ss13d = scalar2(b1(1,itk),vtemp4d(1)) > s13d = (gtemp(1,1)+gtemp(2,2))*ss13d > derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d > enddo > enddo > #endif > cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num', > cd & 16*eel_turn6_num > cd goto 1112 > if (j.lt.nres-1) then > j1=j+1 > j2=j-1 > else > j1=j-1 > j2=j-2 > endif > if (l.lt.nres-1) then > l1=l+1 > l2=l-1 > else > l1=l-1 > l2=l-2 > endif > do ll=1,3 > ggg1(ll)=eel_turn6*g_contij(ll,1) > ggg2(ll)=eel_turn6*g_contij(ll,2) > ghalf=0.5d0*ggg1(ll) > cd ghalf=0.0d0 > gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf > & +ekont*derx_turn(ll,2,1) > gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1) > gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf > & +ekont*derx_turn(ll,4,1) > gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1) > ghalf=0.5d0*ggg2(ll) > cd ghalf=0.0d0 > gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf > & +ekont*derx_turn(ll,2,2) > gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2) > gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf > & +ekont*derx_turn(ll,4,2) > gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2) > enddo > cd goto 1112 > do m=i+1,j-1 > do ll=1,3 > gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll) > enddo > enddo > do m=k+1,l-1 > do ll=1,3 > gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll) > enddo > enddo > 1112 continue > do m=i+2,j2 > do ll=1,3 > gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1) > enddo > enddo > do m=k+2,l2 > do ll=1,3 > gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2) > enddo > enddo > cd do iii=1,nres-3 > cd write (2,*) iii,g_corr6_loc(iii) > cd enddo > eello_turn6=ekont*eel_turn6 > cd write (2,*) 'ekont',ekont > cd write (2,*) 'eel_turn6',ekont*eel_turn6 > return > end > > C----------------------------------------------------------------------------- > double precision function scalar(u,v) > !DIR$ INLINEALWAYS scalar > #ifndef OSF > cDEC$ ATTRIBUTES FORCEINLINE::scalar > #endif > implicit none > double precision u(3),v(3) > cd double precision sc > cd integer i > cd sc=0.0d0 > cd do i=1,3 > cd sc=sc+u(i)*v(i) > cd enddo > cd scalar=sc > > scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3) > return > end > crc------------------------------------------------- > SUBROUTINE MATVEC2(A1,V1,V2) > !DIR$ INLINEALWAYS MATVEC2 > #ifndef OSF > cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2 > #endif > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > DIMENSION A1(2,2),V1(2),V2(2) > c DO 1 I=1,2 > c VI=0.0 > c DO 3 K=1,2 > c 3 VI=VI+A1(I,K)*V1(K) > c Vaux(I)=VI > c 1 CONTINUE > > vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2) > vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2) > > v2(1)=vaux1 > v2(2)=vaux2 > END > C--------------------------------------- > SUBROUTINE MATMAT2(A1,A2,A3) > #ifndef OSF > cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2 > #endif > implicit real*8 (a-h,o-z) > include 'DIMENSIONS' > DIMENSION A1(2,2),A2(2,2),A3(2,2) > c DIMENSION AI3(2,2) > c DO J=1,2 > c A3IJ=0.0 > c DO K=1,2 > c A3IJ=A3IJ+A1(I,K)*A2(K,J) > c enddo > c A3(I,J)=A3IJ > c enddo > c enddo > > ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1) > ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2) > ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1) > ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2) > > A3(1,1)=AI3_11 > A3(2,1)=AI3_21 > A3(1,2)=AI3_12 > A3(2,2)=AI3_22 > END > > c------------------------------------------------------------------------- > double precision function scalar2(u,v) > !DIR$ INLINEALWAYS scalar2 > implicit none > double precision u(2),v(2) > double precision sc > integer i > scalar2=u(1)*v(1)+u(2)*v(2) > return > end > > C----------------------------------------------------------------------------- > > subroutine transpose2(a,at) > !DIR$ INLINEALWAYS transpose2 > #ifndef OSF > cDEC$ ATTRIBUTES FORCEINLINE::transpose2 > #endif > implicit none > double precision a(2,2),at(2,2) > at(1,1)=a(1,1) > at(1,2)=a(2,1) > at(2,1)=a(1,2) > at(2,2)=a(2,2) > return > end > c-------------------------------------------------------------------------- > subroutine transpose(n,a,at) > implicit none > integer n,i,j > double precision a(n,n),at(n,n) > do i=1,n > do j=1,n > at(j,i)=a(i,j) > enddo > enddo > return > end > C--------------------------------------------------------------------------- > subroutine prodmat3(a1,a2,kk,transp,prod) > !DIR$ INLINEALWAYS prodmat3 > #ifndef OSF > cDEC$ ATTRIBUTES FORCEINLINE::prodmat3 > #endif > implicit none > integer i,j > double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2) > logical transp > crc double precision auxmat(2,2),prod_(2,2) > > if (transp) then > crc call transpose2(kk(1,1),auxmat(1,1)) > crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1)) > crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1)) > > prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) > & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1) > prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) > & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2) > prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) > & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1) > prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) > & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2) > > else > crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1)) > crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1)) > > prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) > & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1) > prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) > & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2) > prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) > & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1) > prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) > & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2) > > endif > c call transpose2(a2(1,1),a2t(1,1)) > > crc print *,transp > crc print *,((prod_(i,j),i=1,2),j=1,2) > crc print *,((prod(i,j),i=1,2),j=1,2) > > return > end >