+++ /dev/null
-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<sigma).
-> 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<i'
----
-> ggg(1)=xj*fac
-> ggg(2)=yj*fac
-> ggg(3)=zj*fac
-> if (j.lt.i) then
-> cd write (iout,*) 'j<i'
-2343c3217
-< c do k=1,3
----
-> 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<i'
----
-> 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<i'
-2459c3310
-< c do k=1,3
----
-> 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
->
projects / unres.git / blobdiff