X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fenergy.f90;h=7d21f897cd2015227fd479ca133f45ecebc18609;hb=540f877fc0c1eaf1389f53eef08fe02d352e25a2;hp=59b09b7b31b594c9c205b6922b16ae1e6162e6ef;hpb=65b670d78bae7c2df18f3465fdad7b4f13490e33;p=unres4.git diff --git a/source/unres/energy.f90 b/source/unres/energy.f90 index 59b09b7..7d21f89 100644 --- a/source/unres/energy.f90 +++ b/source/unres/energy.f90 @@ -11,71 +11,89 @@ ! implicit none !----------------------------------------------------------------------------- +! Max. number of contacts per residue +! integer :: maxconts +!----------------------------------------------------------------------------- +! Max. number of derivatives of virtual-bond and side-chain vectors in theta +! or phi. +! integer :: maxdim +!----------------------------------------------------------------------------- +! Max. number of SC contacts +! integer :: maxcont +!----------------------------------------------------------------------------- ! Max. number of variables integer :: maxvar !----------------------------------------------------------------------------- -! Max number of torsional terms in SCCOR - integer,parameter :: maxterm_sccor=6 +! Max number of torsional terms in SCCOR in control_data +! integer,parameter :: maxterm_sccor=6 !----------------------------------------------------------------------------- ! Maximum number of SC local term fitting function coefficiants integer,parameter :: maxsccoef=65 +! Maximum number of local shielding effectors +! integer,parameter :: maxcontsshi=50 +!----------------------------------------------------------------------------- +! commom.calc common/calc/ !----------------------------------------------------------------------------- ! commom.contacts ! common /contacts/ ! Change 12/1/95 - common block CONTACTS1 included. ! common /contacts1/ - integer,dimension(:),allocatable :: num_cont !(maxres) - integer,dimension(:,:),allocatable :: jcont !(maxconts,maxres) - real(kind=8),dimension(:,:),allocatable :: facont !(maxconts,maxres) - real(kind=8),dimension(:,:,:),allocatable :: gacont !(3,maxconts,maxres) + + integer,dimension(:),allocatable :: num_cont !(maxres) + integer,dimension(:,:),allocatable :: jcont !(maxconts,maxres) + real(kind=8),dimension(:,:),allocatable :: facont,ees0plist !(maxconts,maxres) + real(kind=8),dimension(:,:,:),allocatable :: gacont !(3,maxconts,maxres) + integer,dimension(:),allocatable :: ishield_list + integer,dimension(:,:),allocatable :: shield_list + real(kind=8),dimension(:),allocatable :: enetube,enecavtube ! ! 12/26/95 - H-bonding contacts ! common /contacts_hb/ real(kind=8),dimension(:,:,:),allocatable :: gacontp_hb1,gacontp_hb2,& - gacontp_hb3,gacontm_hb1,gacontm_hb2,gacontm_hb3,gacont_hbr,grij_hb_cont !(3,maxconts,maxres) + gacontp_hb3,gacontm_hb1,gacontm_hb2,gacontm_hb3,gacont_hbr,grij_hb_cont !(3,maxconts,maxres) real(kind=8),dimension(:,:),allocatable :: facont_hb,ees0p,& - ees0m,d_cont !(maxconts,maxres) - integer,dimension(:),allocatable :: num_cont_hb !(maxres) - integer,dimension(:,:),allocatable :: jcont_hb !(maxconts,maxres) + ees0m,d_cont !(maxconts,maxres) + integer,dimension(:),allocatable :: num_cont_hb !(maxres) + integer,dimension(:,:),allocatable :: jcont_hb !(maxconts,maxres) ! 9/23/99 Added improper rotation matrices and matrices of dipole-dipole ! interactions ! 7/25/08 commented out; not needed when cumulants used ! Interactions of pseudo-dipoles generated by loc-el interactions. ! common /dipint/ real(kind=8),dimension(:,:,:),allocatable :: dip,& - dipderg !(4,maxconts,maxres) + dipderg !(4,maxconts,maxres) real(kind=8),dimension(:,:,:,:,:),allocatable :: dipderx !(3,5,4,maxconts,maxres) ! 10/30/99 Added other pre-computed vectors and matrices needed ! to calculate three - six-order el-loc correlation terms ! common /rotat/ - real(kind=8),dimension(:,:,:),allocatable :: Ug,Ugder,Ug2,Ug2der !(2,2,maxres) + real(kind=8),dimension(:,:,:),allocatable :: Ug,Ugder,Ug2,Ug2der !(2,2,maxres) real(kind=8),dimension(:,:),allocatable :: obrot,obrot2,obrot_der,& - obrot2_der !(2,maxres) + obrot2_der !(2,maxres) ! ! This common block contains vectors and matrices dependent on a single ! amino-acid residue. ! common /precomp1/ real(kind=8),dimension(:,:),allocatable :: mu,muder,Ub2,Ub2der,& - Ctobr,Ctobrder,Dtobr2,Dtobr2der !(2,maxres) + Ctobr,Ctobrder,Dtobr2,Dtobr2der !(2,maxres) real(kind=8),dimension(:,:,:),allocatable :: EUg,EUgder,CUg,& - CUgder,DUg,Dugder,DtUg2,DtUg2der !(2,2,maxres) + CUgder,DUg,Dugder,DtUg2,DtUg2der !(2,2,maxres) ! This common block contains vectors and matrices dependent on two ! consecutive amino-acid residues. ! common /precomp2/ real(kind=8),dimension(:,:),allocatable :: Ug2Db1t,Ug2Db1tder,& - CUgb2,CUgb2der !(2,maxres) + CUgb2,CUgb2der !(2,maxres) real(kind=8),dimension(:,:,:),allocatable :: EUgC,EUgCder,& - EUgD,EUgDder,DtUg2EUg,Ug2DtEUg !(2,2,maxres) + EUgD,EUgDder,DtUg2EUg,Ug2DtEUg !(2,2,maxres) real(kind=8),dimension(:,:,:,:),allocatable :: Ug2DtEUgder,& - DtUg2EUgder !(2,2,2,maxres) + DtUg2EUgder !(2,2,2,maxres) ! common /rotat_old/ real(kind=8),dimension(:),allocatable :: costab,sintab,& - costab2,sintab2 !(maxres) + costab2,sintab2 !(maxres) ! This common block contains dipole-interaction matrices and their ! Cartesian derivatives. ! common /dipmat/ - real(kind=8),dimension(:,:,:,:),allocatable :: a_chuj !(2,2,maxconts,maxres) - real(kind=8),dimension(:,:,:,:,:,:),allocatable :: a_chuj_der !(2,2,3,5,maxconts,maxres) + real(kind=8),dimension(:,:,:,:),allocatable :: a_chuj !(2,2,maxconts,maxres) + real(kind=8),dimension(:,:,:,:,:,:),allocatable :: a_chuj_der !(2,2,3,5,maxconts,maxres) ! common /diploc/ real(kind=8),dimension(2,2,2) :: AEA,AEAderg,EAEA,AECA,& AECAderg,ADtEA,ADtEA1,AEAb1,AEAb1derg,AEAb2 @@ -100,25 +118,48 @@ real(kind=8),dimension(:,:),allocatable :: gvdwc,gelc,gelc_long,& gvdwpp,gvdwc_scpp,gradx_scp,gvdwc_scp,ghpbx,ghpbc,& gradcorr,gradcorr_long,gradcorr5_long,gradcorr6_long,& - gcorr6_turn_long,gradxorr,gradcorr5,gradcorr6 !(3,maxres) + gcorr6_turn_long,gradxorr,gradcorr5,gradcorr6,gliptran,gliptranc,& + gliptranx, & + gshieldx,gshieldc,gshieldc_loc,gshieldx_ec,& + gshieldc_ec,gshieldc_loc_ec,gshieldx_t3, & + gshieldc_t3,gshieldc_loc_t3,gshieldx_t4,gshieldc_t4, & + gshieldc_loc_t4,gshieldx_ll,gshieldc_ll,gshieldc_loc_ll,& + grad_shield,gg_tube,gg_tube_sc,gradafm !(3,maxres) +!-----------------------------NUCLEIC GRADIENT + real(kind=8),dimension(:,:),allocatable ::gradb_nucl,gradbx_nucl, & + gvdwpsb1,gelpp,gvdwpsb,gelsbc,gelsbx,gvdwsbx,gvdwsbc,gsbloc,& + gsblocx,gradcorr_nucl,gradxorr_nucl,gradcorr3_nucl,gradxorr3_nucl,& + gvdwpp_nucl +!-----------------------------NUCLEIC-PROTEIN GRADIENT + real(kind=8),dimension(:,:),allocatable :: gvdwx_scbase,gvdwc_scbase,& + gvdwx_pepbase,gvdwc_pepbase,gvdwx_scpho,gvdwc_scpho,& + gvdwc_peppho +!------------------------------IONS GRADIENT + real(kind=8),dimension(:,:),allocatable :: gradcatcat, & + gradpepcat,gradpepcatx ! real(kind=8),dimension(:,:),allocatable :: gloc,gloc_x !(maxvar,2) + + real(kind=8),dimension(:,:),allocatable :: gel_loc,gel_loc_long,& gcorr3_turn,gcorr4_turn,gcorr6_turn,gradb,gradbx !(3,maxres) real(kind=8),dimension(:),allocatable :: gel_loc_loc,& gel_loc_turn3,gel_loc_turn4,gel_loc_turn6,gcorr_loc,g_corr5_loc,& - g_corr6_loc !(maxvar) + g_corr6_loc !(maxvar) real(kind=8),dimension(:,:),allocatable :: gsccorc,gsccorx !(3,maxres) - real(kind=8),dimension(:),allocatable :: gsccor_loc !(maxres) -! real(kind=8),dimension(:,:,:),allocatable :: dtheta !(3,2,maxres) + real(kind=8),dimension(:),allocatable :: gsccor_loc !(maxres) +! real(kind=8),dimension(:,:,:),allocatable :: dtheta !(3,2,maxres) real(kind=8),dimension(:,:),allocatable :: gscloc,gsclocx !(3,maxres) ! real(kind=8),dimension(:,:,:),allocatable :: dphi,dalpha,domega !(3,3,maxres) + real(kind=8),dimension(:,:,:),allocatable :: grad_shield_side, & + grad_shield_loc ! (3,maxcontsshileding,maxnres) ! integer :: nfl,icg ! common /deriv_loc/ + real(kind=8), dimension(:),allocatable :: fac_shield real(kind=8),dimension(3,5,2) :: derx,derx_turn ! common /deriv_scloc/ real(kind=8),dimension(:,:),allocatable :: dXX_C1tab,dYY_C1tab,& dZZ_C1tab,dXX_Ctab,dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,& - dZZ_XYZtab !(3,maxres) + dZZ_XYZtab !(3,maxres) !----------------------------------------------------------------------------- ! common.maxgrad ! common /maxgrad/ @@ -136,7 +177,7 @@ ! common /qmeas/ real(kind=8) :: Ucdfrag,Ucdpair real(kind=8),dimension(:,:),allocatable :: dUdconst,dUdxconst,& - dqwol,dxqwol !(3,0:MAXRES) + dqwol,dxqwol !(3,0:MAXRES) !----------------------------------------------------------------------------- ! common.sbridge ! common /dyn_ssbond/ @@ -146,7 +187,7 @@ ! Parameters of the SCCOR term ! common/sccor/ real(kind=8),dimension(:,:,:,:),allocatable :: dcostau,dsintau,& - dcosomicron,domicron !(3,3,3,maxres2) + dcosomicron,domicron !(3,3,3,maxres2) !----------------------------------------------------------------------------- ! common.vectors ! common /vectors/ @@ -154,7 +195,8 @@ real(kind=8),dimension(:,:,:,:),allocatable :: uygrad,uzgrad !(3,3,2,maxres) !----------------------------------------------------------------------------- ! common /przechowalnia/ - real(kind=8),dimension(:,:,:),allocatable :: zapas !(max_dim,maxconts,max_fg_procs) + real(kind=8),dimension(:,:,:),allocatable :: zapas + real(kind=8),dimension(:,:,:,:),allocatable ::zapas2 !(max_dim,maxconts,max_fg_procs) real(kind=8),dimension(:,:,:),allocatable :: fromto !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2) !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- @@ -168,7 +210,7 @@ subroutine etotal(energia) ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' - use MD_data, only: totT + use MD_data #ifndef ISNAN external proc_proc #ifdef WINPGI @@ -196,11 +238,28 @@ integer :: n_corr,n_corr1,ierror real(kind=8) :: etors,edihcnstr,etors_d,esccor,ehpb real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,escloc,ees,eel_loc - real(kind=8) :: eello_turn3,eello_turn4,estr,ebe + real(kind=8) :: eello_turn3,eello_turn4,estr,ebe,eliptran,etube, & + Eafmforce,ethetacnstr real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6 +! now energies for nulceic alone parameters + real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,& + ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,& + ecorr3_nucl +! energies for ions + real(kind=8) :: ecation_prot,ecationcation +! energies for protein nucleic acid interaction + real(kind=8) :: escbase,epepbase,escpho,epeppho #ifdef MPI real(kind=8) :: weights_(n_ene) !,time_Bcast,time_Bcastw +! shielding effect varibles for MPI + real(kind=8) fac_shieldbuf(nres), & + grad_shield_locbuf(3,maxcontsshi,-1:nres), & + grad_shield_sidebuf(3,maxcontsshi,-1:nres), & + grad_shieldbuf(3,-1:nres) + integer ishield_listbuf(nres), & + shield_listbuf(maxcontsshi,nres),k,j,i + ! print*,"ETOTAL Processor",fg_rank," absolute rank",myrank, ! & " nfgtasks",nfgtasks if (nfgtasks.gt.1) then @@ -230,6 +289,27 @@ weights_(17)=wbond weights_(18)=scal14 weights_(21)=wsccor + weights_(26)=wvdwpp_nucl + weights_(27)=welpp + weights_(28)=wvdwpsb + weights_(29)=welpsb + weights_(30)=wvdwsb + weights_(31)=welsb + weights_(32)=wbond_nucl + weights_(33)=wang_nucl + weights_(34)=wsbloc + weights_(35)=wtor_nucl + weights_(36)=wtor_d_nucl + weights_(37)=wcorr_nucl + weights_(38)=wcorr3_nucl + weights_(41)=wcatcat + weights_(42)=wcatprot + weights_(46)=wscbase + weights_(47)=wscpho + weights_(48)=wpeppho +! wcatcat= weights(41) +! wcatprot=weights(42) + ! FG Master broadcasts the WEIGHTS_ array call MPI_Bcast(weights_(1),n_ene,& MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR) @@ -256,6 +336,24 @@ wbond=weights(17) scal14=weights(18) wsccor=weights(21) + wvdwpp_nucl =weights(26) + welpp =weights(27) + wvdwpsb=weights(28) + welpsb =weights(29) + wvdwsb =weights(30) + welsb =weights(31) + wbond_nucl =weights(32) + wang_nucl =weights(33) + wsbloc =weights(34) + wtor_nucl =weights(35) + wtor_d_nucl =weights(36) + wcorr_nucl =weights(37) + wcorr3_nucl =weights(38) + wcatcat= weights(41) + wcatprot=weights(42) + wscbase=weights(46) + wscpho=weights(47) + wpeppho=weights(48) endif time_Bcast=time_Bcast+MPI_Wtime()-time00 time_Bcastw=time_Bcastw+MPI_Wtime()-time00 @@ -273,31 +371,110 @@ #endif ! ! Compute the side-chain and electrostatic interaction energy -! - goto (101,102,103,104,105,106) ipot +! print *, "Before EVDW" +! goto (101,102,103,104,105,106) ipot + select case(ipot) ! Lennard-Jones potential. - 101 call elj(evdw) +! 101 call elj(evdw) + case (1) + call elj(evdw) !d print '(a)','Exit ELJcall el' - goto 107 +! goto 107 ! Lennard-Jones-Kihara potential (shifted). - 102 call eljk(evdw) - goto 107 +! 102 call eljk(evdw) + case (2) + call eljk(evdw) +! goto 107 ! Berne-Pechukas potential (dilated LJ, angular dependence). - 103 call ebp(evdw) - goto 107 +! 103 call ebp(evdw) + case (3) + call ebp(evdw) +! goto 107 ! Gay-Berne potential (shifted LJ, angular dependence). - 104 call egb(evdw) - goto 107 +! 104 call egb(evdw) + case (4) +! print *,"MOMO",scelemode + if (scelemode.eq.0) then + call egb(evdw) + else + call emomo(evdw) + endif +! goto 107 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence). - 105 call egbv(evdw) - goto 107 +! 105 call egbv(evdw) + case (5) + call egbv(evdw) +! goto 107 ! Soft-sphere potential - 106 call e_softsphere(evdw) +! 106 call e_softsphere(evdw) + case (6) + call e_softsphere(evdw) ! ! Calculate electrostatic (H-bonding) energy of the main chain. ! - 107 continue +! 107 continue + case default + write(iout,*)"Wrong ipot" +! return +! 50 continue + end select +! continue +! print *,"after EGB" +! shielding effect + if (shield_mode.eq.2) then + call set_shield_fac2 + endif + if (nfgtasks.gt.1) then + call MPI_Allgatherv(fac_shield(ivec_start), & + ivec_count(fg_rank1), & + MPI_DOUBLE_PRECISION,fac_shieldbuf(1),ivec_count(0), & + ivec_displ(0), & + MPI_DOUBLE_PRECISION,FG_COMM,IERROR) + call MPI_Allgatherv(shield_list(1,ivec_start), & + ivec_count(fg_rank1), & + MPI_I50,shield_listbuf(1,1),ivec_count(0), & + ivec_displ(0), & + MPI_I50,FG_COMM,IERROR) + call MPI_Allgatherv(ishield_list(ivec_start), & + ivec_count(fg_rank1), & + MPI_INTEGER,ishield_listbuf(1),ivec_count(0), & + ivec_displ(0), & + MPI_INTEGER,FG_COMM,IERROR) + call MPI_Allgatherv(grad_shield(1,ivec_start), & + ivec_count(fg_rank1), & + MPI_UYZ,grad_shieldbuf(1,1),ivec_count(0), & + ivec_displ(0), & + MPI_UYZ,FG_COMM,IERROR) + call MPI_Allgatherv(grad_shield_side(1,1,ivec_start), & + ivec_count(fg_rank1), & + MPI_SHI,grad_shield_sidebuf(1,1,1),ivec_count(0), & + ivec_displ(0), & + MPI_SHI,FG_COMM,IERROR) + call MPI_Allgatherv(grad_shield_loc(1,1,ivec_start), & + ivec_count(fg_rank1), & + MPI_SHI,grad_shield_locbuf(1,1,1),ivec_count(0), & + ivec_displ(0), & + MPI_SHI,FG_COMM,IERROR) + do i=1,nres + fac_shield(i)=fac_shieldbuf(i) + ishield_list(i)=ishield_listbuf(i) + do j=1,3 + grad_shield(j,i)=grad_shieldbuf(j,i) + enddo !j + do j=1,ishield_list(i) + shield_list(j,i)=shield_listbuf(j,i) + do k=1,3 + grad_shield_loc(k,j,i)=grad_shield_locbuf(k,j,i) + grad_shield_side(k,j,i)=grad_shield_sidebuf(k,j,i) + enddo !k + enddo !j + enddo !i + endif + + + +! print *,"AFTER EGB",ipot,evdw !mc !mc Sep-06: egb takes care of dynamic ss bonds too !mc @@ -310,9 +487,14 @@ #ifdef TIMING time_vec=time_vec+MPI_Wtime()-time01 #endif -! print *,"Processor",myrank," left VEC_AND_DERIV" + + + + +! print *,"Processor",myrank," left VEC_AND_DERIV" if (ipot.lt.6) then #ifdef SPLITELE +! print *,"after ipot if", ipot if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 & @@ -323,7 +505,9 @@ .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then #endif +! print *,"just befor eelec call" call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) +! write (iout,*) "ELEC calc" else ees=0.0d0 evdw1=0.0d0 @@ -341,6 +525,7 @@ ! Calculate excluded-volume interaction energy between peptide groups ! and side chains. ! +!elwrite(iout,*) "in etotal calc exc;luded",ipot if (ipot.lt.6) then if(wscp.gt.0d0) then @@ -353,30 +538,37 @@ ! write (iout,*) "Soft-sphere SCP potential" call escp_soft_sphere(evdw2,evdw2_14) endif +! write(iout,*) "in etotal before ebond",ipot ! ! Calculate the bond-stretching energy ! call ebond(estr) +! print *,"EBOND",estr +! write(iout,*) "in etotal afer ebond",ipot + ! ! Calculate the disulfide-bridge and other energy and the contributions ! from other distance constraints. - print *,'Calling EHPB' +! print *,'Calling EHPB' call edis(ehpb) +!elwrite(iout,*) "in etotal afer edis",ipot ! print *,'EHPB exitted succesfully.' ! ! Calculate the virtual-bond-angle energy. ! if (wang.gt.0d0) then - call ebend(ebe) + call ebend(ebe,ethetacnstr) else ebe=0 + ethetacnstr=0 endif ! print *,"Processor",myrank," computed UB" ! ! Calculate the SC local energy. ! call esc(escloc) +!elwrite(iout,*) "in etotal afer esc",ipot ! print *,"Processor",myrank," computed USC" ! ! Calculate the virtual-bond torsional energy. @@ -392,6 +584,7 @@ ! ! 6/23/01 Calculate double-torsional energy ! +!elwrite(iout,*) "in etotal",ipot if (wtor_d.gt.0) then call etor_d(etors_d) else @@ -423,23 +616,93 @@ ecorr6=0.0d0 eturn6=0.0d0 endif +!elwrite(iout,*) "in etotal",ipot 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) !d write (iout,*) "multibody_hb ecorr",ecorr endif +!elwrite(iout,*) "afeter multibody hb" ! print *,"Processor",myrank," computed Ucorr" ! ! If performing constraint dynamics, call the constraint energy ! after the equilibration time if(usampl.and.totT.gt.eq_time) then +!elwrite(iout,*) "afeter multibody hb" call EconstrQ +!elwrite(iout,*) "afeter multibody hb" call Econstr_back +!elwrite(iout,*) "afeter multibody hb" else Uconst=0.0d0 Uconst_back=0.0d0 endif + call flush(iout) +! write(iout,*) "after Econstr" + if (wliptran.gt.0) then +! print *,"PRZED WYWOLANIEM" + call Eliptransfer(eliptran) + else + eliptran=0.0d0 + endif + if (fg_rank.eq.0) then + if (AFMlog.gt.0) then + call AFMforce(Eafmforce) + else if (selfguide.gt.0) then + call AFMvel(Eafmforce) + endif + endif + if (tubemode.eq.1) then + call calctube(etube) + else if (tubemode.eq.2) then + call calctube2(etube) + elseif (tubemode.eq.3) then + call calcnano(etube) + else + etube=0.0d0 + endif +!-------------------------------------------------------- +! write (iout,*) "NRES_MOLEC(2),",nres_molec(2) +! print *,"before",ees,evdw1,ecorr + if (nres_molec(2).gt.0) then + call ebond_nucl(estr_nucl) + call ebend_nucl(ebe_nucl) + call etor_nucl(etors_nucl) + call esb_gb(evdwsb,eelsb) + call epp_nucl_sub(evdwpp,eespp) + call epsb(evdwpsb,eelpsb) + call esb(esbloc) + call multibody_hb_nucl(ecorr_nucl,ecorr3_nucl,n_corr,n_corr1) + else + etors_nucl=0.0d0 + estr_nucl=0.0d0 + ebe_nucl=0.0d0 + evdwsb=0.0d0 + eelsb=0.0d0 + esbloc=0.0d0 + endif + if (nfgtasks.gt.1) then + if (fg_rank.eq.0) then + call ecatcat(ecationcation) + endif + else + call ecatcat(ecationcation) + endif + call ecat_prot(ecation_prot) + if (nres_molec(2).gt.0) then + call eprot_sc_base(escbase) + call epep_sc_base(epepbase) + call eprot_sc_phosphate(escpho) + call eprot_pep_phosphate(epeppho) + else + epepbase=0.0 + escbase=0.0 + escpho=0.0 + epeppho=0.0 + endif +! call ecatcat(ecationcation) +! print *,"after ebend", ebe_nucl #ifdef TIMING time_enecalc=time_enecalc+MPI_Wtime()-time00 #endif @@ -481,15 +744,42 @@ energia(17)=estr energia(20)=Uconst+Uconst_back energia(21)=esccor + energia(22)=eliptran + energia(23)=Eafmforce + energia(24)=ethetacnstr + energia(25)=etube +!--------------------------------------------------------------- + energia(26)=evdwpp + energia(27)=eespp + energia(28)=evdwpsb + energia(29)=eelpsb + energia(30)=evdwsb + energia(31)=eelsb + energia(32)=estr_nucl + energia(33)=ebe_nucl + energia(34)=esbloc + energia(35)=etors_nucl + energia(36)=etors_d_nucl + energia(37)=ecorr_nucl + energia(38)=ecorr3_nucl +!---------------------------------------------------------------------- ! Here are the energies showed per procesor if the are more processors ! per molecule then we sum it up in sum_energy subroutine ! print *," Processor",myrank," calls SUM_ENERGY" + energia(41)=ecation_prot + energia(42)=ecationcation + energia(46)=escbase + energia(47)=epepbase + energia(48)=escpho + energia(49)=epeppho call sum_energy(energia,.true.) if (dyn_ss) call dyn_set_nss ! print *," Processor",myrank," left SUM_ENERGY" #ifdef TIMING time_sumene=time_sumene+MPI_Wtime()-time00 #endif +!el call enerprint(energia) +!elwrite(iout,*)"finish etotal" return end subroutine etotal !----------------------------------------------------------------------------- @@ -519,13 +809,19 @@ logical :: reduce real(kind=8) :: evdw,evdw2,evdw2_14,ees,evdw1,ecorr,ecorr5,ecorr6 real(kind=8) :: eel_loc,eello_turn3,eello_turn4,eturn6,ebe,escloc - real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,esccor,etot + real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,esccor,etot, & + eliptran,etube, Eafmforce,ethetacnstr + real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,& + ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,& + ecorr3_nucl + real(kind=8) :: ecation_prot,ecationcation + real(kind=8) :: escbase,epepbase,escpho,epeppho integer :: i #ifdef MPI integer :: ierr real(kind=8) :: time00 if (nfgtasks.gt.1 .and. reduce) then -!el #define DEBUG + #ifdef DEBUG write (iout,*) "energies before REDUCE" call enerprint(energia) @@ -579,20 +875,61 @@ estr=energia(17) Uconst=energia(20) esccor=energia(21) + eliptran=energia(22) + Eafmforce=energia(23) + ethetacnstr=energia(24) + etube=energia(25) + evdwpp=energia(26) + eespp=energia(27) + evdwpsb=energia(28) + eelpsb=energia(29) + evdwsb=energia(30) + eelsb=energia(31) + estr_nucl=energia(32) + ebe_nucl=energia(33) + esbloc=energia(34) + etors_nucl=energia(35) + etors_d_nucl=energia(36) + ecorr_nucl=energia(37) + ecorr3_nucl=energia(38) + ecation_prot=energia(41) + ecationcation=energia(42) + escbase=energia(46) + epepbase=energia(47) + escpho=energia(48) + epeppho=energia(49) +! energia(41)=ecation_prot +! energia(42)=ecationcation + + #ifdef SPLITELE etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 & +wang*ebe+wtor*etors+wscloc*escloc & +wstrain*ehpb+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 + +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube& + +Eafmforce+ethetacnstr & + +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl& + +wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb& + +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl& + +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl& + +wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase& + +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho #else etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) & +wang*ebe+wtor*etors+wscloc*escloc & +wstrain*ehpb+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 + +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube& + +Eafmforce+ethetacnstr & + +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl& + +wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb& + +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl& + +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl& + +wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase& + +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho #endif energia(0)=etot ! detecting NaNQ @@ -614,7 +951,7 @@ #ifdef MPI endif #endif -!el #undef DUBUG +! call enerprint(energia) call flush(iout) return end subroutine sum_energy @@ -631,33 +968,56 @@ real(kind=8) :: kfac=2.4d0 real(kind=8) :: x,x2,x3,x4,x5,licznik=1.12692801104297249644 !el local variables - real(kind=8) :: t_bath,facT,facT2,facT3,facT4,facT5 + real(kind=8) :: t_bath,facT(6) !,facT2,facT3,facT4,facT5,facT6 + real(kind=8) :: T0=3.0d2 integer :: ierror ! facT=temp0/t_bath ! 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 + facT(1)=1.0d0 + facT(2)=1.0d0 + facT(3)=1.0d0 + facT(4)=1.0d0 + facT(5)=1.0d0 + facT(6)=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) + facT(1)=kfac/(kfac-1.0d0+t_bath/temp0) + facT(2)=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2) + facT(3)=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3) + facT(4)=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4) + facT(5)=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5) +#ifdef WHAM_RUN +!#if defined(WHAM_RUN) || defined(CLUSTER) +#if defined(FUNCTH) +! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3) + facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0 +#elif defined(FUNCT) + facT(6)=t_bath/T0 +#else + facT(6)=1.0d0 +#endif +#endif 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)) + facT(1)=licznik/dlog(dexp(x)+dexp(-x)) + facT(2)=licznik/dlog(dexp(x2)+dexp(-x2)) + facT(3)=licznik/dlog(dexp(x3)+dexp(-x3)) + facT(4)=licznik/dlog(dexp(x4)+dexp(-x4)) + facT(5)=licznik/dlog(dexp(x5)+dexp(-x5)) +#ifdef WHAM_RUN +!#if defined(WHAM_RUN) || defined(CLUSTER) +#if defined(FUNCTH) + facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0 +#elif defined(FUNCT) + facT(6)=t_bath/T0 +#else + facT(6)=1.0d0 +#endif +#endif else write (iout,*) "Wrong RESCALE_MODE",rescale_mode write (*,*) "Wrong RESCALE_MODE",rescale_mode @@ -666,17 +1026,17 @@ #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 + welec=weights(3)*fact(1) + wcorr=weights(4)*fact(3) + wcorr5=weights(5)*fact(4) + wcorr6=weights(6)*fact(5) + wel_loc=weights(7)*fact(2) + wturn3=weights(8)*fact(2) + wturn4=weights(9)*fact(3) + wturn6=weights(10)*fact(5) + wtor=weights(13)*fact(1) + wtor_d=weights(14)*fact(2) + wsccor=weights(21)*fact(1) return end subroutine rescale_weights @@ -692,7 +1052,13 @@ !el local variables real(kind=8) :: etot,evdw,evdw2,ees,evdw1,ecorr,ecorr5,ecorr6,eel_loc real(kind=8) :: eello_turn6,eello_turn3,eello_turn4,ebe,escloc - real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,Uconst,esccor + real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,Uconst,esccor,eliptran,& + etube,ethetacnstr,Eafmforce + real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,& + ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,& + ecorr3_nucl + real(kind=8) :: ecation_prot,ecationcation + real(kind=8) :: escbase,epepbase,escpho,epeppho etot=energia(0) evdw=energia(1) @@ -722,6 +1088,29 @@ estr=energia(17) Uconst=energia(20) esccor=energia(21) + eliptran=energia(22) + Eafmforce=energia(23) + ethetacnstr=energia(24) + etube=energia(25) + evdwpp=energia(26) + eespp=energia(27) + evdwpsb=energia(28) + eelpsb=energia(29) + evdwsb=energia(30) + eelsb=energia(31) + estr_nucl=energia(32) + ebe_nucl=energia(33) + esbloc=energia(34) + etors_nucl=energia(35) + etors_d_nucl=energia(36) + ecorr_nucl=energia(37) + ecorr3_nucl=energia(38) + ecation_prot=energia(41) + ecationcation=energia(42) + escbase=energia(46) + epepbase=energia(47) + escpho=energia(48) + epeppho=energia(49) #ifdef SPLITELE write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,& estr,wbond,ebe,wang,& @@ -729,8 +1118,15 @@ 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 + edihcnstr,ethetacnstr,ebr*nss,& + Uconst,eliptran,wliptran,Eafmforce,etube,wtube, & ! till now protein + estr_nucl,wbond_nucl,ebe_nucl,wang_nucl, & + evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb,& + evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl,& + etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,& + ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, & + escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,& + etot 10 format (/'Virtual-chain energies:'// & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ & @@ -752,8 +1148,31 @@ 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ & + 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ & 'UCONST= ',1pE16.6,' (Constraint energy)'/ & + 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/& + 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ & + 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ & + 'ESTR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ & + 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ & + 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ & + 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ & + 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ & + 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ & + 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ & + 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ & + 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ & + 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ & + 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ & + 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ & + 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ & + 'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ & + 'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ & + 'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ & + 'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ & + 'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/& + 'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/& 'ETOT= ',1pE16.6,' (total)') #else write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,& @@ -762,7 +1181,15 @@ 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 + ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc, & + etube,wtube, & + estr_nucl,wbond_nucl, ebe_nucl,wang_nucl,& + evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb& + evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl& + etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,& + ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, & + escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,& + etot 10 format (/'Virtual-chain energies:'// & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ & @@ -783,8 +1210,31 @@ 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ & + 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ & 'UCONST=',1pE16.6,' (Constraint energy)'/ & + 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ & + 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ & + 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ & + 'ESTR_nucl= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ & + 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ & + 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ & + 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ & + 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ & + 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ & + 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ & + 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ & + 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ & + 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ & + 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ & + 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ & + 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ & + 'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ & + 'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ & + 'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ & + 'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ & + 'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/& + 'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/& 'ETOT= ',1pE16.6,' (total)') #endif return @@ -809,7 +1259,7 @@ ! include 'COMMON.NAMES' ! include 'COMMON.IOUNITS' ! include 'COMMON.CONTACTS' - real(kind=8),dimension(3) :: gg + real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj integer :: num_conti !el local variables integer :: i,itypi,iint,j,itypi1,itypj,k @@ -821,13 +1271,13 @@ evdw=0.0D0 ! allocate(num_cont(iatsc_s:iatsc_e)) !(maxres) nnt,nct-2 ! allocate(jcont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres) (maxconts=maxres/4) -! allocate(facont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres) -! allocate(gacont(3,nres/4,iatsc_s:iatsc_e)) !(3,maxconts,maxres) +! allocate(facont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres) +! allocate(gacont(3,nres/4,iatsc_s:iatsc_e)) !(3,maxconts,maxres) do i=iatsc_s,iatsc_e - itypi=iabs(itype(i)) + itypi=iabs(itype(i,1)) if (itypi.eq.ntyp1) cycle - itypi1=iabs(itype(i+1)) + itypi1=iabs(itype(i+1,1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -840,7 +1290,7 @@ !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), !d & 'iend=',iend(i,iint) do j=istart(i,iint),iend(i,iint) - itypj=iabs(itype(j)) + itypj=iabs(itype(j,1)) if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi @@ -851,13 +1301,13 @@ ! 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) + e1=fac*fac*aa_aq(itypi,itypj) + e2=fac*bb_aq(itypi,itypj) evdwij=e1+e2 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj) !d write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)') -!d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), +!d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj), !d & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm, !d & (c(k,i),k=1,3),(c(k,j),k=1,3) evdw=evdw+evdwij @@ -973,7 +1423,7 @@ ! include 'COMMON.INTERACT' ! include 'COMMON.IOUNITS' ! include 'COMMON.NAMES' - real(kind=8),dimension(3) :: gg + real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj logical :: scheck !el local variables integer :: i,iint,j,itypi,itypi1,k,itypj @@ -983,9 +1433,9 @@ ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 do i=iatsc_s,iatsc_e - itypi=iabs(itype(i)) + itypi=iabs(itype(i,1)) if (itypi.eq.ntyp1) cycle - itypi1=iabs(itype(i+1)) + itypi1=iabs(itype(i+1,1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -994,7 +1444,7 @@ ! do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) - itypj=iabs(itype(j)) + itypj=iabs(itype(j,1)) if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi @@ -1006,13 +1456,13 @@ rij=1.0D0/r_inv_ij 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) + e1=fac*fac*aa_aq(itypi,itypj) + e2=fac*bb_aq(itypi,itypj) evdwij=e_augm+e1+e2 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj) !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)') -!d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), +!d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj), !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm, !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij, !d & (c(k,i),k=1,3),(c(k,j),k=1,3) @@ -1084,9 +1534,9 @@ ! endif !el ind=0 do i=iatsc_s,iatsc_e - itypi=iabs(itype(i)) + itypi=iabs(itype(i,1)) if (itypi.eq.ntyp1) cycle - itypi1=iabs(itype(i+1)) + itypi1=iabs(itype(i+1,1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -1101,7 +1551,7 @@ do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) !el ind=ind+1 - itypj=iabs(itype(j)) + itypj=iabs(itype(j,1)) if (itypj.eq.ntyp1) cycle ! dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) @@ -1142,18 +1592,18 @@ ! Calculate whole angle-dependent part of epsilon and contributions ! to its derivatives fac=(rrij*sigsq)**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa_aq(itypi,itypj) + e2=fac*bb_aq(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) + sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0) + epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj) !d write (iout,'(2(a3,i3,2x),15(0pf7.3))') -!d & restyp(itypi),i,restyp(itypj),j, +!d & restyp(itypi,1),i,restyp(itypj,1),j, !d & epsi,sigm,chi1,chi2,chip1,chip2, !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq), !d & om1,om2,om12,1.0D0/dsqrt(rrij), @@ -1199,9 +1649,14 @@ ! include 'COMMON.SBRIDGE' logical :: lprn !el local variables - integer :: iint,itypi,itypi1,itypj + integer :: iint,itypi,itypi1,itypj,subchap real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi real(kind=8) :: evdw,sig0ij + real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,& + dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, & + sslipi,sslipj,faclip + integer :: ii + real(kind=8) :: fracinbuf !cccc energy_dec=.false. ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon @@ -1210,12 +1665,44 @@ ! if (icall.eq.0) lprn=.false. !el ind=0 do i=iatsc_s,iatsc_e - itypi=iabs(itype(i)) +!C print *,"I am in EVDW",i + itypi=iabs(itype(i,1)) +! if (i.ne.47) cycle if (itypi.eq.ntyp1) cycle - itypi1=iabs(itype(i+1)) + itypi1=iabs(itype(i+1,1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + xi=dmod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=dmod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=dmod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize + + if ((zi.gt.bordlipbot) & + .and.(zi.lt.bordliptop)) then +!C the energy transfer exist + if (zi.lt.buflipbot) then +!C what fraction I am in + fracinbuf=1.0d0- & + ((zi-bordlipbot)/lipbufthick) +!C lipbufthick is thickenes of lipid buffore + sslipi=sscalelip(fracinbuf) + ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick + elseif (zi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick) + sslipi=sscalelip(fracinbuf) + ssgradlipi=sscagradlip(fracinbuf)/lipbufthick + else + sslipi=1.0d0 + ssgradlipi=0.0 + endif + else + sslipi=0.0d0 + ssgradlipi=0.0 + endif +! print *, sslipi,ssgradlipi dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -1233,15 +1720,39 @@ evdw=evdw+evdwij if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') & 'evdw',i,j,evdwij,' ss' +! if (energy_dec) write (iout,*) & +! 'evdw',i,j,evdwij,' ss' + do k=j+1,iend(i,iint) +!C search over all next residues + if (dyn_ss_mask(k)) then +!C check if they are cysteins +!C write(iout,*) 'k=',k + +!c write(iout,*) "PRZED TRI", evdwij +! evdwij_przed_tri=evdwij + call triple_ssbond_ene(i,j,k,evdwij) +!c if(evdwij_przed_tri.ne.evdwij) then +!c write (iout,*) "TRI:", evdwij, evdwij_przed_tri +!c endif + +!c write(iout,*) "PO TRI", evdwij +!C call the energy function that removes the artifical triple disulfide +!C bond the soubroutine is located in ssMD.F + evdw=evdw+evdwij + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') & + 'evdw',i,j,evdwij,'tss' + endif!dyn_ss_mask(k) + enddo! k ELSE !el ind=ind+1 - itypj=iabs(itype(j)) + itypj=iabs(itype(j,1)) if (itypj.eq.ntyp1) cycle +! if (j.ne.78) cycle ! dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) -! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, -! & 1.0d0/vbld(j+nres) -! write (iout,*) "i",i," j", j," itype",itype(i),itype(j) +! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,& +! 1.0d0/vbld(j+nres) !d +! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1) sig0ij=sigma(itypi,itypj) chi1=chi(itypi,itypj) chi2=chi(itypj,itypi) @@ -1262,30 +1773,108 @@ ! alf1=0.0D0 ! alf2=0.0D0 ! alf12=0.0D0 - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + xj=dmod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=dmod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=dmod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize +! print *,"tu",xi,yi,zi,xj,yj,zj +! print *,"tu2",j,j+nres,c(1,j),c(1,j+nres) +! this fragment set correct epsilon for lipid phase + if ((zj.gt.bordlipbot) & + .and.(zj.lt.bordliptop)) then +!C the energy transfer exist + if (zj.lt.buflipbot) then +!C what fraction I am in + fracinbuf=1.0d0- & + ((zj-bordlipbot)/lipbufthick) +!C lipbufthick is thickenes of lipid buffore + sslipj=sscalelip(fracinbuf) + ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick + elseif (zj.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick) + sslipj=sscalelip(fracinbuf) + ssgradlipj=sscagradlip(fracinbuf)/lipbufthick + else + sslipj=1.0d0 + ssgradlipj=0.0 + endif + else + sslipj=0.0d0 + ssgradlipj=0.0 + endif + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 & + +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 & + +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 +!------------------------------------------------ + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) ! write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi -! write (iout,*) "j",j," dc_norm", -! & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) +! write (iout,*) "j",j," dc_norm",& !d +! dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j) +! write(iout,*)"rrij ",rrij +! write(iout,*)"xj yj zj ", xj, yj, zj +! write(iout,*)"xi yi zi ", xi, yi, zi +! write(iout,*)"c ", c(1,:), c(2,:), c(3,:) rrij=1.0D0/(xj*xj+yj*yj+zj*zj) rij=dsqrt(rrij) + sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj))) + sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj))) +! print *,sss_ele_cut,sss_ele_grad,& +! 1.0d0/(rij),r_cut_ele,rlamb_ele + if (sss_ele_cut.le.0.0) cycle ! Calculate angle-dependent terms of energy and contributions to their ! derivatives. call sc_angular sigsq=1.0D0/sigsq sig=sig0ij*dsqrt(sigsq) rij_shift=1.0D0/rij-sig+sig0ij +! write(iout,*)" rij_shift",rij_shift," rij",rij," sig",sig,& +! "sig0ij",sig0ij ! for diagnostics; uncomment ! rij_shift=1.2*sig0ij ! 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 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))') -!d & restyp(itypi),i,restyp(itypj),j, +!d & restyp(itypi,1),i,restyp(itypj,1),j, !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) return endif @@ -1293,45 +1882,67 @@ !--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + faclip=fac + e1=fac*fac*aa!(itypi,itypj) + e2=fac*bb!(itypi,itypj) evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt -! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,& -! " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 +! write(iout,*)"aa, bb ",aa(:,:),bb(:,:) +! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,& !d +! " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2," fac",fac !d evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+evdwij + evdw=evdw+evdwij*sss_ele_cut if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) + sigm=dabs(aa/bb)**(1.0D0/6.0D0) + epsi=bb**2/aa!(itypi,itypj) write (iout,'(2(a3,i3,2x),17(0pf7.3))') & - restyp(itypi),i,restyp(itypj),j, & + restyp(itypi,1),i,restyp(itypj,1),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 + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2e10.2,e11.3)')& + 'evdw',i,j,evdwij,xi,xj,rij !,"egb" +!C print *,i,j,c(1,i),c(1,j),c(2,i),c(2,j),c(3,i),c(3,j) +! if (energy_dec) write (iout,*) & +! 'evdw',i,j,evdwij +! print *,"ZALAMKA", evdw ! Calculate gradient components. e1=e1*eps1*eps2rt**2*eps3rt**2 fac=-expon*(e1+evdwij)*rij_shift sigder=fac*sigder fac=rij*fac +! print *,'before fac',fac,rij,evdwij + fac=fac+evdwij*sss_ele_grad/sss_ele_cut& + /sigma(itypi,itypj)*rij +! print *,'grad part scale',fac, & +! evdwij*sss_ele_grad/sss_ele_cut & +! /sigma(itypi,itypj)*rij ! fac=0.0d0 ! Calculate the radial part of the gradient gg(1)=xj*fac gg(2)=yj*fac gg(3)=zj*fac +!C Calculate the radial part of the gradient + gg_lipi(3)=eps1*(eps2rt*eps2rt)& + *(eps3rt*eps3rt)*sss_ele_cut/2.0d0*(faclip*faclip*& + (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))& + +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj))) + gg_lipj(3)=ssgradlipj*gg_lipi(3) + gg_lipi(3)=gg_lipi(3)*ssgradlipi + +! print *,'before sc_grad', gg(1),gg(2),gg(3) ! Calculate angular part of the gradient. call sc_grad ENDIF ! dyn_ss enddo ! j enddo ! iint enddo ! i +! print *,"ZALAMKA", evdw ! write (iout,*) "Number of loop steps in EGB:",ind !ccc energy_dec=.false. return @@ -1370,9 +1981,9 @@ ! if (icall.eq.0) lprn=.true. !el ind=0 do i=iatsc_s,iatsc_e - itypi=iabs(itype(i)) + itypi=iabs(itype(i,1)) if (itypi.eq.ntyp1) cycle - itypi1=iabs(itype(i+1)) + itypi1=iabs(itype(i+1,1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -1387,7 +1998,7 @@ do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) !el ind=ind+1 - itypj=iabs(itype(j)) + itypj=iabs(itype(j,1)) if (itypj.eq.ntyp1) cycle ! dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) @@ -1435,8 +2046,8 @@ !--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa_aq(itypi,itypj) + e2=fac*bb_aq(itypi,itypj) evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt @@ -1445,10 +2056,11 @@ 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) + sigm=dabs(aa_aq(itypi,itypj)/& + bb_aq(itypi,itypj))**(1.0D0/6.0D0) + epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj) write (iout,'(2(a3,i3,2x),17(0pf7.3))') & - restyp(itypi),i,restyp(itypj),j,& + restyp(itypi,1),i,restyp(itypj,1),j,& epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),& chi1,chi2,chip1,chip2,& eps1,eps2rt**2,eps3rt**2,& @@ -1492,7 +2104,7 @@ ! include 'COMMON.NAMES' ! include 'COMMON.IOUNITS' ! include 'COMMON.CONTACTS' - real(kind=8),dimension(3) :: gg + real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj !d print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct !el local variables integer :: i,iint,j,itypi,itypi1,itypj,k @@ -1501,9 +2113,9 @@ evdw=0.0D0 do i=iatsc_s,iatsc_e - itypi=iabs(itype(i)) + itypi=iabs(itype(i,1)) if (itypi.eq.ntyp1) cycle - itypi1=iabs(itype(i+1)) + itypi1=iabs(itype(i+1,1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -1514,7 +2126,7 @@ !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), !d & 'iend=',iend(i,iint) do j=istart(i,iint),iend(i,iint) - itypj=iabs(itype(j)) + itypj=iabs(itype(j,1)) if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi @@ -1588,7 +2200,7 @@ eello_turn4=0.0d0 !el ind=0 do i=iatel_s,iatel_e - if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle + if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -1598,7 +2210,7 @@ num_conti=0 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) do j=ielstart(i),ielend(i) - if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle + if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle !el ind=ind+1 iteli=itel(i) itelj=itel(j) @@ -1849,8 +2461,8 @@ ! include 'COMMON.LOCAL' ! include 'COMMON.CHAIN' ! include 'COMMON.VECTORS' - real(kind=8),dimension(3,3,2,nres) :: uygradt,uzgradt !(3,3,2,maxres) - real(kind=8),dimension(3,nres) :: uyt,uzt !(3,maxres) + real(kind=8),dimension(3,3,2,nres) :: uygradt,uzgradt !(3,3,2,maxres) + real(kind=8),dimension(3,nres) :: uyt,uzt !(3,maxres) real(kind=8),dimension(3,3,2) :: uygradn,uzgradn real(kind=8),dimension(3) :: erij real(kind=8) :: delta=1.0d-7 @@ -1951,62 +2563,18 @@ real(kind=8) :: auxvec(2),auxmat(2,2) integer :: i,iti1,iti,k,l real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2 - -! allocate(Ug(2,2,nres)) !(2,2,maxres) -! allocate(Ug2(2,2,nres)) !(2,2,maxres) -! allocate(Ugder(2,2,nres)) !(2,2,maxres) -! allocate(Ug2der(2,2,nres)) !(2,2,maxres) -! allocate(obrot(2,nres)) !(2,maxres) -! allocate(obrot2(2,nres)) !(2,maxres) -! allocate(obrot_der(2,nres)) !(2,maxres) -! allocate(obrot2_der(2,nres)) !(2,maxres) -! allocate(costab2(nres)) !(maxres) -! allocate(sintab2(nres)) !(maxres) -! allocate(costab(nres)) !(maxres) -! allocate(sintab(nres)) !(maxres) - -! allocate(Ub2(2,nres)) !(2,maxres) -! allocate(Ctobr(2,nres)) !(2,maxres) -! allocate(Dtobr2(2,nres)) !(2,maxres) -! allocate(mu(2,nres)) !(2,maxres) -! allocate(muder(2,nres)) !(2,maxres) -! allocate(Ub2der(2,nres)) !(2,maxres) -! allocate(Ctobrder(2,nres)) !(2,maxres) -! allocate(Dtobr2der(2,nres)) !(2,maxres) - -! allocate(EUg(2,2,nres)) !(2,2,maxres) -! allocate(CUg(2,2,nres)) !(2,2,maxres) -! allocate(DUg(2,2,nres)) !(2,2,maxres) -! allocate(DtUg2(2,2,nres)) !(2,2,maxres) -! allocate(EUgder(2,2,nres)) !(2,2,maxres) -! allocate(CUgder(2,2,nres)) !(2,2,maxres) -! allocate(DUgder(2,2,nres)) !(2,2,maxres) -! allocate(Dtug2der(2,2,nres)) !(2,2,maxres) - -! allocate(Ug2Db1t(2,nres)) !(2,maxres) -! allocate(Ug2Db1tder(2,nres)) !(2,maxres) -! allocate(CUgb2(2,nres)) !(2,maxres) -! allocate(CUgb2der(2,nres)) !(2,maxres) - -! allocate(EUgC(2,2,nres)) !(2,2,maxres) -! allocate(EUgCder(2,2,nres)) !(2,2,maxres) -! allocate(EUgD(2,2,nres)) !(2,2,maxres) -! allocate(EUgDder(2,2,nres)) !(2,2,maxres) -! allocate(DtUg2EUg(2,2,nres)) !(2,2,maxres) -! allocate(Ug2DtEUg(2,2,nres)) !(2,2,maxres) - -! allocate(Ug2DtEUgder(2,2,2,nres)) !(2,2,2,maxres) -! allocate(DtUg2EUgder(2,2,2,nres)) !(2,2,2,maxres) - +! print *,"in set matrices" ! ! Compute the virtual-bond-torsional-angle dependent quantities needed ! to calculate the el-loc multibody terms of various order. ! +!AL el mu=0.0d0 #ifdef PARMAT do i=ivec_start+2,ivec_end+2 #else do i=3,nres+1 #endif +! print *,i,"i" if (i .lt. nres+1) then sin1=dsin(phi(i)) cos1=dcos(phi(i)) @@ -2075,16 +2643,25 @@ endif ! 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)) + if (itype(i-2,1).eq.0) then + iti=ntortyp+1 + else + iti = itortyp(itype(i-2,1)) + endif else iti=ntortyp+1 endif ! 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)) + if (itype(i-1,1).eq.0) then + iti1=ntortyp+1 + else + iti1 = itortyp(itype(i-1,1)) + endif else iti1=ntortyp+1 endif +! print *,iti,i,"iti",iti1,itype(i-1,1),itype(i-2,1) !d write (iout,*) '*******i',i,' iti1',iti !d write (iout,*) 'b1',b1(:,iti) !d write (iout,*) 'b2',b2(:,iti) @@ -2121,8 +2698,10 @@ enddo ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then if (i.gt. nnt+1 .and. i.lt.nct+1) then - if (itype(i-1).le.ntyp) then - iti1 = itortyp(itype(i-1)) + if (itype(i-1,1).eq.0) then + iti1=ntortyp+1 + elseif (itype(i-1,1).le.ntyp) then + iti1 = itortyp(itype(i-1,1)) else iti1=ntortyp+1 endif @@ -2132,7 +2711,9 @@ do k=1,2 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1) enddo -!d write (iout,*) 'mu ',mu(:,i-2) +! if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2) +! if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,iti1) +! if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2) !d write (iout,*) 'mu1',mu1(:,i-2) !d write (iout,*) 'mu2',mu2(:,i-2) if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) & @@ -2171,7 +2752,6 @@ enddo endif #if defined(MPI) && defined(PARMAT) -!el #define DUBUG #ifdef DEBUG ! if (fg_rank.eq.0) then write (iout,*) "Arrays UG and UGDER before GATHER" @@ -2420,7 +3000,7 @@ #endif #endif !d do i=1,nres -!d iti = itortyp(itype(i)) +!d iti = itortyp(itype(i,1)) !d write (iout,*) i !d do j=1,2 !d write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)') @@ -2428,7 +3008,6 @@ !d enddo !d enddo return -!el #undef DUBUG end subroutine set_matrices !----------------------------------------------------------------------------- subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4) @@ -2486,10 +3065,11 @@ !el local variables integer :: i,k,j real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4 - real(kind=8) :: fac,t_eelecij + real(kind=8) :: fac,t_eelecij,fracinbuf !d write(iout,*) 'In EELEC' +! print *,"IN EELEC" !d do i=1,nloctyp !d write(iout,*) 'Type',i !d write(iout,*) 'B1',B1(:,i) @@ -2500,7 +3080,26 @@ !d enddo !d call check_vecgrad !d stop +! ees=0.0d0 !AS +! evdw1=0.0d0 +! eel_loc=0.0d0 +! eello_turn3=0.0d0 +! eello_turn4=0.0d0 + t_eelecij=0.0d0 + ees=0.0D0 + evdw1=0.0D0 + eel_loc=0.0d0 + eello_turn3=0.0d0 + eello_turn4=0.0d0 +! + if (icheckgrad.eq.1) then +!el +! do i=0,2*nres+2 +! dc_norm(1,i)=0.0d0 +! dc_norm(2,i)=0.0d0 +! dc_norm(3,i)=0.0d0 +! enddo do i=1,nres-1 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i))) do k=1,3 @@ -2509,6 +3108,8 @@ ! write (iout,*) 'i',i,' fac',fac enddo endif +! print *,wel_loc,"wel_loc",wcorr4,wcorr5,wcorr6,wturn3,wturn4, & +! wturn6 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 @@ -2516,11 +3117,15 @@ #ifdef TIMING time01=MPI_Wtime() #endif +! print *, "before set matrices" call set_matrices +! print *, "after set matrices" + #ifdef TIMING time_mat=time_mat+MPI_Wtime()-time01 #endif endif +! print *, "after set matrices" !d do i=1,nres-1 !d write (iout,*) 'i=',i !d do k=1,3 @@ -2557,10 +3162,10 @@ ! - +! print *,"before iturn3 loop" do i=iturn3_start,iturn3_end - if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 & - .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle + if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 & + .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -2570,15 +3175,45 @@ xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi + xmedi=dmod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=dmod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=dmod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize num_conti=0 - call eelecij(i,i+2,ees,evdw1,eel_loc) + if ((zmedi.gt.bordlipbot) & + .and.(zmedi.lt.bordliptop)) then +!C the energy transfer exist + if (zmedi.lt.buflipbot) then +!C what fraction I am in + fracinbuf=1.0d0- & + ((zmedi-bordlipbot)/lipbufthick) +!C lipbufthick is thickenes of lipid buffore + sslipi=sscalelip(fracinbuf) + ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick + elseif (zmedi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick) + sslipi=sscalelip(fracinbuf) + ssgradlipi=sscagradlip(fracinbuf)/lipbufthick + else + sslipi=1.0d0 + ssgradlipi=0.0 + endif + else + sslipi=0.0d0 + ssgradlipi=0.0 + endif +! print *,i,sslipi,ssgradlipi + call eelecij(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 - if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 & - .or. itype(i+3).eq.ntyp1 & - .or. itype(i+4).eq.ntyp1) cycle + if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 & + .or. itype(i+3,1).eq.ntyp1 & + .or. itype(i+4,1).eq.ntyp1) cycle +! print *,"before2",i,i+3, gshieldc_t4(2,i+3),gshieldc_t4(2,i) dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -2588,17 +3223,48 @@ xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi + xmedi=dmod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=dmod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=dmod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize + if ((zmedi.gt.bordlipbot) & + .and.(zmedi.lt.bordliptop)) then +!C the energy transfer exist + if (zmedi.lt.buflipbot) then +!C what fraction I am in + fracinbuf=1.0d0- & + ((zmedi-bordlipbot)/lipbufthick) +!C lipbufthick is thickenes of lipid buffore + sslipi=sscalelip(fracinbuf) + ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick + elseif (zmedi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick) + sslipi=sscalelip(fracinbuf) + ssgradlipi=sscagradlip(fracinbuf)/lipbufthick + else + sslipi=1.0d0 + ssgradlipi=0.0 + endif + else + sslipi=0.0d0 + ssgradlipi=0.0 + endif + num_conti=num_cont_hb(i) call eelecij(i,i+3,ees,evdw1,eel_loc) - if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) & + if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) & call eturn4(i,eello_turn4) +! print *,"before",i,i+3, gshieldc_t4(2,i+3),gshieldc_t4(2,i) num_cont_hb(i)=num_conti enddo ! i ! ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 ! +! print *,"iatel_s,iatel_e,",iatel_s,iatel_e do i=iatel_s,iatel_e - if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle + if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -2608,11 +3274,40 @@ xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi + xmedi=dmod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=dmod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=dmod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize + if ((zmedi.gt.bordlipbot) & + .and.(zmedi.lt.bordliptop)) then +!C the energy transfer exist + if (zmedi.lt.buflipbot) then +!C what fraction I am in + fracinbuf=1.0d0- & + ((zmedi-bordlipbot)/lipbufthick) +!C lipbufthick is thickenes of lipid buffore + sslipi=sscalelip(fracinbuf) + ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick + elseif (zmedi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick) + sslipi=sscalelip(fracinbuf) + ssgradlipi=sscagradlip(fracinbuf)/lipbufthick + else + sslipi=1.0d0 + ssgradlipi=0.0 + endif + else + sslipi=0.0d0 + ssgradlipi=0.0 + endif + ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) num_conti=num_cont_hb(i) do j=ielstart(i),ielend(i) -! write (iout,*) i,j,itype(i),itype(j) - if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle +! write (iout,*) i,j,itype(i,1),itype(j,1) + if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle call eelecij(i,j,ees,evdw1,eel_loc) enddo ! j num_cont_hb(i)=num_conti @@ -2649,11 +3344,14 @@ ! include 'COMMON.VECTORS' ! include 'COMMON.FFIELD' ! include 'COMMON.TIME1' - real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg + real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg real(kind=8),dimension(2,2) :: acipa !el,a_temp !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1 real(kind=8),dimension(4) :: muij + real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,& + dist_temp, dist_init,rlocshield,fracinbuf + integer xshift,yshift,zshift,ilist,iresshield !el integer :: num_conti,j1,j2 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,& !el dz_normi,xmedi,ymedi,zmedi @@ -2675,7 +3373,7 @@ 0.0d0,0.0d0,1.0d0/),shape(unmat)) ! integer :: maxconts=nres/4 !el local variables - integer :: k,i,j,iteli,itelj,kkk,l,kkll,m + integer :: k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,& @@ -2687,8 +3385,8 @@ ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,& ecosgp,ecosam,ecosbm,ecosgm,ghalf ! maxconts=nres/4 -! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres) -! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres) +! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres) +! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres) ! time00=MPI_Wtime() !d write (iout,*) "eelecij",i,j @@ -2706,12 +3404,86 @@ 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 +! xj=c(1,j)+0.5D0*dxj-xmedi +! yj=c(2,j)+0.5D0*dyj-ymedi +! zj=c(3,j)+0.5D0*dzj-zmedi + xj=c(1,j)+0.5D0*dxj + yj=c(2,j)+0.5D0*dyj + zj=c(3,j)+0.5D0*dzj + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + if ((zj.gt.bordlipbot) & + .and.(zj.lt.bordliptop)) then +!C the energy transfer exist + if (zj.lt.buflipbot) then +!C what fraction I am in + fracinbuf=1.0d0- & + ((zj-bordlipbot)/lipbufthick) +!C lipbufthick is thickenes of lipid buffore + sslipj=sscalelip(fracinbuf) + ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick + elseif (zj.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick) + sslipj=sscalelip(fracinbuf) + ssgradlipj=sscagradlip(fracinbuf)/lipbufthick + else + sslipj=1.0d0 + ssgradlipj=0.0 + endif + else + sslipj=0.0d0 + ssgradlipj=0.0 + endif + + isubchap=0 + dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + isubchap=1 + endif + enddo + enddo + enddo + if (isubchap.eq.1) then +!C print *,i,j + xj=xj_temp-xmedi + yj=yj_temp-ymedi + zj=zj_temp-zmedi + else + xj=xj_safe-xmedi + yj=yj_safe-ymedi + zj=zj_safe-zmedi + endif + rij=xj*xj+yj*yj+zj*zj rrmij=1.0D0/rij rij=dsqrt(rij) +!C print *,xmedi,ymedi,zmedi,xj,yj,zj,boxxsize,rij + sss_ele_cut=sscale_ele(rij) + sss_ele_grad=sscagrad_ele(rij) +! sss_ele_cut=1.0d0 +! sss_ele_grad=0.0d0 +! print *,sss_ele_cut,sss_ele_grad,& +! (rij),r_cut_ele,rlamb_ele +! if (sss_ele_cut.le.0.0) go to 128 + rmij=1.0D0/rij r3ij=rrmij*rmij r6ij=r3ij*r3ij @@ -2728,28 +3500,50 @@ evdwij=ev1+ev2 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)) el2=fac4*fac - eesij=el1+el2 +! eesij=el1+el2 + if (shield_mode.gt.0) then +!C fac_shield(i)=0.4 +!C fac_shield(j)=0.6 + el1=el1*fac_shield(i)**2*fac_shield(j)**2 + el2=el2*fac_shield(i)**2*fac_shield(j)**2 + eesij=(el1+el2) + ees=ees+eesij*sss_ele_cut +!C FOR NOW SHIELD IS NOT USED WITH LIPSCALE +!C & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) + else + fac_shield(i)=1.0 + fac_shield(j)=1.0 + eesij=(el1+el2) + ees=ees+eesij & + *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)*sss_ele_cut +!C print *,"TUCC",(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0 + endif + ! 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 +! ees=ees+eesij*sss_ele_cut + evdw1=evdw1+evdwij*sss_ele_cut & + *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)') !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i, !d & 1.0D0/dsqrt(rrmij),evdwij,eesij, !d & xmedi,ymedi,zmedi,xj,yj,zj if (energy_dec) then - write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') & - 'evdw1',i,j,evdwij,& - iteli,itelj,aaa,evdw1 +! write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') & +! 'evdw1',i,j,evdwij,& +! iteli,itelj,aaa,evdw1 + write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij endif ! ! Calculate contributions to the Cartesian gradient. ! #ifdef SPLITELE - facvdw=-6*rrmij*(ev1+evdwij) - facel=-3*rrmij*(el1+eesij) + facvdw=-6*rrmij*(ev1+evdwij)*sss_ele_cut & + *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) + facel=-3*rrmij*(el1+eesij)*sss_ele_cut & + *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) fac1=fac erij(1)=xj*rmij erij(2)=yj*rmij @@ -2757,9 +3551,61 @@ ! ! Radial derivatives. First process both termini of the fragment (i,j) ! - ggg(1)=facel*xj - ggg(2)=facel*yj - ggg(3)=facel*zj + ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj* & + ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) + ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj* & + ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) + ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj* & + ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) + + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. & + (shield_mode.gt.0)) then +!C print *,i,j + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)& + *2.0*sss_ele_cut + gshieldx(k,iresshield)=gshieldx(k,iresshield)+ & + rlocshield & + +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0 & + *sss_ele_cut + gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j) & + *2.0*sss_ele_cut + gshieldx(k,iresshield)=gshieldx(k,iresshield)+ & + rlocshield & + +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0 & + *sss_ele_cut + gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield + enddo + enddo + do k=1,3 + gshieldc(k,i)=gshieldc(k,i)+ & + grad_shield(k,i)*eesij/fac_shield(i)*2.0 & + *sss_ele_cut + + gshieldc(k,j)=gshieldc(k,j)+ & + grad_shield(k,j)*eesij/fac_shield(j)*2.0 & + *sss_ele_cut + + gshieldc(k,i-1)=gshieldc(k,i-1)+ & + grad_shield(k,i)*eesij/fac_shield(i)*2.0 & + *sss_ele_cut + + gshieldc(k,j-1)=gshieldc(k,j-1)+ & + grad_shield(k,j)*eesij/fac_shield(j)*2.0 & + *sss_ele_cut + + enddo + endif + + ! do k=1,3 ! ghalf=0.5D0*ggg(k) ! gelc(k,i)=gelc(k,i)+ghalf @@ -2770,6 +3616,15 @@ gelc_long(k,j)=gelc_long(k,j)+ggg(k) gelc_long(k,i)=gelc_long(k,i)-ggg(k) enddo + gelc_long(3,j)=gelc_long(3,j)+ & + ssgradlipj*eesij/2.0d0*lipscale**2& + *sss_ele_cut + + gelc_long(3,i)=gelc_long(3,i)+ & + ssgradlipi*eesij/2.0d0*lipscale**2& + *sss_ele_cut + + ! ! Loop over residues i+1 thru j-1. ! @@ -2778,9 +3633,13 @@ !grad gelc(l,k)=gelc(l,k)+ggg(l) !grad enddo !grad enddo - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj + ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj & + *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) + ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj & + *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) + ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj & + *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) + ! do k=1,3 ! ghalf=0.5D0*ggg(k) ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf @@ -2791,8 +3650,13 @@ gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) enddo -! -! Loop over residues i+1 thru j-1. + +!C Lipidic part for scaling weight + gvdwpp(3,j)=gvdwpp(3,j)+ & + sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2 + gvdwpp(3,i)=gvdwpp(3,i)+ & + sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2 +!! Loop over residues i+1 thru j-1. ! !grad do k=i+1,j-1 !grad do l=1,3 @@ -2800,8 +3664,10 @@ !grad enddo !grad enddo #else - facvdw=ev1+evdwij - facel=el1+eesij + facvdw=(ev1+evdwij)*sss_ele_cut & + *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) + + facel=(el1+eesij)*sss_ele_cut fac1=fac fac=-3*rrmij*(facvdw+facvdw+facel) erij(1)=xj*rmij @@ -2810,9 +3676,9 @@ ! ! Radial derivatives. First process both termini of the fragment (i,j) ! - ggg(1)=fac*xj - ggg(2)=fac*yj - ggg(3)=fac*zj + ggg(1)=fac*xj+sss_ele_grad*rmij*(eesij+evdwij)*xj + ggg(2)=fac*yj+sss_ele_grad*rmij*(eesij+evdwij)*yj + ggg(3)=fac*zj+sss_ele_grad*rmij*(eesij+evdwij)*zj ! do k=1,3 ! ghalf=0.5D0*ggg(k) ! gelc(k,i)=gelc(k,i)+ghalf @@ -2832,13 +3698,22 @@ !grad enddo !grad enddo ! 9/28/08 AL Gradient compotents will be summed only at the end - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj + ggg(1)=facvdw*xj & + *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) + ggg(2)=facvdw*yj & + *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) + ggg(3)=facvdw*zj & + *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) + do k=1,3 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) enddo + gvdwpp(3,j)=gvdwpp(3,j)+ & + sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2 + gvdwpp(3,i)=gvdwpp(3,i)+ & + sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2 + #endif ! ! Angular part @@ -2855,7 +3730,10 @@ !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3), !d & (dcosg(k),k=1,3) do k=1,3 - ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k) + ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*sss_ele_cut & + *fac_shield(i)**2*fac_shield(j)**2 & + *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) + enddo ! do k=1,3 ! ghalf=0.5D0*ggg(k) @@ -2874,13 +3752,22 @@ do k=1,3 gelc(k,i)=gelc(k,i) & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) & - + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) + + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)& + *sss_ele_cut & + *fac_shield(i)**2*fac_shield(j)**2 & + *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) + gelc(k,j)=gelc(k,j) & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) & - + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) + + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)& + *sss_ele_cut & + *fac_shield(i)**2*fac_shield(j)**2 & + *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0) + gelc_long(k,j)=gelc_long(k,j)+ggg(k) gelc_long(k,i)=gelc_long(k,i)-ggg(k) enddo + 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 @@ -2922,7 +3809,7 @@ a32=a32*fac a33=a33*fac !d write (iout,'(4i5,4f10.5)') -!d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33 +!d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i), !d & uy(:,j),uz(:,j) @@ -3068,31 +3955,137 @@ ! Contribution to the local-electrostatic energy coming from the i-j pair eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) & +a33*muij(4) -!d write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij + if (shield_mode.eq.0) then + fac_shield(i)=1.0 + fac_shield(j)=1.0 + endif + eel_loc_ij=eel_loc_ij & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) +!C Now derivative over eel_loc + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. & + (shield_mode.gt.0)) then +!C print *,i,j + + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij & + /fac_shield(i)& + *sss_ele_cut + gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ & + rlocshield & + +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i) & + *sss_ele_cut + + gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)& + +rlocshield + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij & + /fac_shield(j) & + *sss_ele_cut + gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ & + rlocshield & + +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j) & + *sss_ele_cut - if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') & - 'eelloc',i,j,eel_loc_ij -! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) + gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)& + +rlocshield + + enddo + enddo + + do k=1,3 + gshieldc_ll(k,i)=gshieldc_ll(k,i)+ & + grad_shield(k,i)*eel_loc_ij/fac_shield(i) & + *sss_ele_cut + gshieldc_ll(k,j)=gshieldc_ll(k,j)+ & + grad_shield(k,j)*eel_loc_ij/fac_shield(j) & + *sss_ele_cut + gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+ & + grad_shield(k,i)*eel_loc_ij/fac_shield(i) & + *sss_ele_cut + gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+ & + grad_shield(k,j)*eel_loc_ij/fac_shield(j) & + *sss_ele_cut + + enddo + endif - eel_loc=eel_loc+eel_loc_ij + +! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij +! eel_loc_ij=0.0 +! if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') & +! 'eelloc',i,j,eel_loc_ij + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,8f8.3)') & + 'eelloc',i,j,eel_loc_ij,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4) +! print *,"EELLOC",i,gel_loc_loc(i-1) + +! if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33 +! if (energy_dec) write (iout,*) "muij",muij +! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) + + eel_loc=eel_loc+eel_loc_ij*sss_ele_cut ! Partial derivatives in virtual-bond dihedral angles gamma if (i.gt.1) & gel_loc_loc(i-1)=gel_loc_loc(i-1)+ & - a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) & - +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j) + (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) & + +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) & + *sss_ele_cut & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) + gel_loc_loc(j-1)=gel_loc_loc(j-1)+ & - a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) & - +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j) + (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) & + +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) & + *sss_ele_cut & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2) - do l=1,3 - ggg(l)=agg(l,1)*muij(1)+ & - agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4) +! do l=1,3 +! ggg(1)=(agg(1,1)*muij(1)+ & +! agg(1,2)*muij(2)+agg(1,3)*muij(3)+agg(1,4)*muij(4)) & +! *sss_ele_cut & +! +eel_loc_ij*sss_ele_grad*rmij*xj +! ggg(2)=(agg(2,1)*muij(1)+ & +! agg(2,2)*muij(2)+agg(2,3)*muij(3)+agg(2,4)*muij(4)) & +! *sss_ele_cut & +! +eel_loc_ij*sss_ele_grad*rmij*yj +! ggg(3)=(agg(3,1)*muij(1)+ & +! agg(3,2)*muij(2)+agg(3,3)*muij(3)+agg(3,4)*muij(4)) & +! *sss_ele_cut & +! +eel_loc_ij*sss_ele_grad*rmij*zj + xtemp(1)=xj + xtemp(2)=yj + xtemp(3)=zj + + do l=1,3 + ggg(l)=(agg(l,1)*muij(1)+ & + agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))& + *sss_ele_cut & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) & + +eel_loc_ij*sss_ele_grad*rmij*xtemp(l) + + gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l) gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l) !grad ghalf=0.5d0*ggg(l) !grad gel_loc(l,i)=gel_loc(l,i)+ghalf !grad gel_loc(l,j)=gel_loc(l,j)+ghalf enddo + gel_loc_long(3,j)=gel_loc_long(3,j)+ & + ssgradlipj*eel_loc_ij/2.0d0*lipscale/ & + ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut + + gel_loc_long(3,i)=gel_loc_long(3,i)+ & + ssgradlipi*eel_loc_ij/2.0d0*lipscale/ & + ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut + !grad do k=i+1,j2 !grad do l=1,3 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l) @@ -3100,14 +4093,36 @@ !grad enddo ! Remaining derivatives of eello do l=1,3 - gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ & - aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4) - gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ & - aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4) - gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ & - aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4) - gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ & - aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4) + gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ & + aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))& + *sss_ele_cut & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) + +!+eel_loc_ij*sss_ele_grad*rmij*xtemp(l) + gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ & + aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3) & + +aggi1(l,4)*muij(4))& + *sss_ele_cut & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) + +!+eel_loc_ij*sss_ele_grad*rmij*xtemp(l) + gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ & + aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))& + *sss_ele_cut & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) + +!+eel_loc_ij*sss_ele_grad*rmij*xtemp(l) + gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ & + aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3) & + +aggj1(l,4)*muij(4))& + *sss_ele_cut & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) + +!+eel_loc_ij*sss_ele_grad*rmij*xtemp(l) enddo ENDIF ! Change 12/26/95 to calculate four-body contributions to H-bonding energy @@ -3125,6 +4140,7 @@ r0ij=2.20D0*rpp(iteli,itelj) ! r0ij=1.55D0*rpp(iteli,itelj) call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont) +!elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts if (fcont.gt.0.0D0) then num_conti=num_conti+1 if (num_conti.gt.maxconts) then @@ -3180,6 +4196,12 @@ else ees0pij=0 endif + if (shield_mode.eq.0) then + fac_shield(i)=1.0d0 + fac_shield(j)=1.0d0 + else + ees0plist(num_conti,i)=j + endif ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2) ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2 if (ees0tmp.gt.0) then @@ -3188,8 +4210,14 @@ ees0mij=0 endif ! ees0mij=0.0D0 - ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) - ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) + ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) & + *sss_ele_cut & + *fac_shield(i)*fac_shield(j) + + ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) & + *sss_ele_cut & + *fac_shield(i)*fac_shield(j) + ! Diagnostics. Comment out or remove after debugging! ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij @@ -3237,12 +4265,22 @@ gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k) gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k) enddo - gggp(1)=gggp(1)+ees0pijp*xj - gggp(2)=gggp(2)+ees0pijp*yj - gggp(3)=gggp(3)+ees0pijp*zj - gggm(1)=gggm(1)+ees0mijp*xj - gggm(2)=gggm(2)+ees0mijp*yj - gggm(3)=gggm(3)+ees0mijp*zj + gggp(1)=gggp(1)+ees0pijp*xj & + +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad + gggp(2)=gggp(2)+ees0pijp*yj & + +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad + gggp(3)=gggp(3)+ees0pijp*zj & + +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad + + gggm(1)=gggm(1)+ees0mijp*xj & + +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad + + gggm(2)=gggm(2)+ees0mijp*yj & + +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad + + gggm(3)=gggm(3)+ees0mijp*zj & + +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad + ! Derivatives due to the contact function gacont_hbr(1,num_conti,i)=fprimcont*xj gacont_hbr(2,num_conti,i)=fprimcont*yj @@ -3256,18 +4294,30 @@ !grad ghalfm=0.5D0*gggm(k) gacontp_hb1(k,num_conti,i)= & !ghalfp+ (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) & - + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) + + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) & + *sss_ele_cut*fac_shield(i)*fac_shield(j) + gacontp_hb2(k,num_conti,i)= & !ghalfp+ (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) & - + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) - gacontp_hb3(k,num_conti,i)=gggp(k) + + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)& + *sss_ele_cut*fac_shield(i)*fac_shield(j) + + gacontp_hb3(k,num_conti,i)=gggp(k) & + *sss_ele_cut*fac_shield(i)*fac_shield(j) + gacontm_hb1(k,num_conti,i)= & !ghalfm+ (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) & - + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) + + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) & + *sss_ele_cut*fac_shield(i)*fac_shield(j) + gacontm_hb2(k,num_conti,i)= & !ghalfm+ (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) & - + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) - gacontm_hb3(k,num_conti,i)=gggm(k) + + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) & + *sss_ele_cut*fac_shield(i)*fac_shield(j) + + gacontm_hb3(k,num_conti,i)=gggm(k) & + *sss_ele_cut*fac_shield(i)*fac_shield(j) + enddo ! Diagnostics. Comment out or remove after debugging! !diag do k=1,3 @@ -3299,6 +4349,7 @@ enddo endif endif + 128 continue ! t_eelecij=t_eelecij+MPI_Wtime()-time00 return end subroutine eelecij @@ -3335,11 +4386,38 @@ !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,& !el num_conti,j1,j2 !el local variables - integer :: i,j,l - real(kind=8) :: eello_turn3 + integer :: i,j,l,k,ilist,iresshield + real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield j=i+2 ! write (iout,*) "eturn3",i,j,j1,j2 + zj=(c(3,j)+c(3,j+1))/2.0d0 + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + if ((zj.lt.0)) write (*,*) "CHUJ" + if ((zj.gt.bordlipbot) & + .and.(zj.lt.bordliptop)) then +!C the energy transfer exist + if (zj.lt.buflipbot) then +!C what fraction I am in + fracinbuf=1.0d0- & + ((zj-bordlipbot)/lipbufthick) +!C lipbufthick is thickenes of lipid buffore + sslipj=sscalelip(fracinbuf) + ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick + elseif (zj.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick) + sslipj=sscalelip(fracinbuf) + ssgradlipj=sscagradlip(fracinbuf)/lipbufthick + else + sslipj=1.0d0 + ssgradlipj=0.0 + endif + else + sslipj=0.0d0 + ssgradlipj=0.0 + endif + a_temp(1,1)=a22 a_temp(1,2)=a23 a_temp(2,1)=a32 @@ -3358,9 +4436,60 @@ 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 (shield_mode.eq.0) then + fac_shield(i)=1.0d0 + fac_shield(j)=1.0d0 + endif + + eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) + eello_t3= & + 0.5d0*(pizda(1,1)+pizda(2,2)) & + *fac_shield(i)*fac_shield(j) + if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2)) + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. & + (shield_mode.gt.0)) then +!C print *,i,j + + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i) + gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ & + rlocshield & + +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i) + gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) & + +rlocshield + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j) + gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ & + rlocshield & + +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j) + gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) & + +rlocshield + + enddo + enddo + + do k=1,3 + gshieldc_t3(k,i)=gshieldc_t3(k,i)+ & + grad_shield(k,i)*eello_t3/fac_shield(i) + gshieldc_t3(k,j)=gshieldc_t3(k,j)+ & + grad_shield(k,j)*eello_t3/fac_shield(j) + gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+ & + grad_shield(k,i)*eello_t3/fac_shield(i) + gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+ & + grad_shield(k,j)*eello_t3/fac_shield(j) + enddo + endif + !d write (2,*) 'i,',i,' j',j,'eello_turn3', !d & 0.5d0*(pizda(1,1)+pizda(2,2)), !d & ' eello_turn3_num',4*eello_turn3_num @@ -3368,13 +4497,18 @@ 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)) + gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))& + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) ! 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)) + +0.5d0*(pizda(1,1)+pizda(2,2)) & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) + ! Cartesian derivatives do l=1,3 ! ghalf1=0.5d0*agg(l,1) @@ -3387,29 +4521,49 @@ a_temp(2,2)=aggi(l,4)!+ghalf4 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)) + +0.5d0*(pizda(1,1)+pizda(2,2)) & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) + a_temp(1,1)=aggi1(l,1)!+agg(l,1) a_temp(1,2)=aggi1(l,2)!+agg(l,2) a_temp(2,1)=aggi1(l,3)!+agg(l,3) a_temp(2,2)=aggi1(l,4)!+agg(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)) + +0.5d0*(pizda(1,1)+pizda(2,2)) & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) + a_temp(1,1)=aggj(l,1)!+ghalf1 a_temp(1,2)=aggj(l,2)!+ghalf2 a_temp(2,1)=aggj(l,3)!+ghalf3 a_temp(2,2)=aggj(l,4)!+ghalf4 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)) + +0.5d0*(pizda(1,1)+pizda(2,2)) & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) + 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)) + +0.5d0*(pizda(1,1)+pizda(2,2)) & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) enddo + gshieldc_t3(3,i)=gshieldc_t3(3,i)+ & + ssgradlipi*eello_t3/4.0d0*lipscale + gshieldc_t3(3,j)=gshieldc_t3(3,j)+ & + ssgradlipj*eello_t3/4.0d0*lipscale + gshieldc_t3(3,i-1)=gshieldc_t3(3,i-1)+ & + ssgradlipi*eello_t3/4.0d0*lipscale + gshieldc_t3(3,j-1)=gshieldc_t3(3,j-1)+ & + ssgradlipj*eello_t3/4.0d0*lipscale + return end subroutine eturn3 !----------------------------------------------------------------------------- @@ -3444,10 +4598,13 @@ !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,& !el num_conti,j1,j2 !el local variables - integer :: i,j,iti1,iti2,iti3,l - real(kind=8) :: eello_turn4,s1,s2,s3 - + integer :: i,j,iti1,iti2,iti3,l,k,ilist,iresshield + real(kind=8) :: eello_turn4,s1,s2,s3,zj,fracinbuf,eello_t4,& + rlocshield + j=i+3 +! if (j.ne.20) return +! print *,i,j,gshieldc_t4(2,j),gshieldc_t4(2,j+1) !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ! ! Fourth-order contributions @@ -3461,13 +4618,39 @@ !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC !d call checkint_turn4(i,a_temp,eello_turn4_num) ! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2 + zj=(c(3,j)+c(3,j+1))/2.0d0 + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + if ((zj.gt.bordlipbot) & + .and.(zj.lt.bordliptop)) then +!C the energy transfer exist + if (zj.lt.buflipbot) then +!C what fraction I am in + fracinbuf=1.0d0- & + ((zj-bordlipbot)/lipbufthick) +!C lipbufthick is thickenes of lipid buffore + sslipj=sscalelip(fracinbuf) + ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick + elseif (zj.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick) + sslipj=sscalelip(fracinbuf) + ssgradlipj=sscagradlip(fracinbuf)/lipbufthick + else + sslipj=1.0d0 + ssgradlipj=0.0 + endif + else + sslipj=0.0d0 + ssgradlipj=0.0 + endif + a_temp(1,1)=a22 a_temp(1,2)=a23 a_temp(2,1)=a32 a_temp(2,2)=a33 - iti1=itortyp(itype(i+1)) - iti2=itortyp(itype(i+2)) - iti3=itortyp(itype(i+3)) + iti1=itortyp(itype(i+1,1)) + iti2=itortyp(itype(i+2,1)) + iti3=itortyp(itype(i+3,1)) ! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3 call transpose2(EUg(1,1,i+1),e1t(1,1)) call transpose2(Eug(1,1,i+2),e2t(1,1)) @@ -3481,10 +4664,63 @@ 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) -!d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3), + if (shield_mode.eq.0) then + fac_shield(i)=1.0 + fac_shield(j)=1.0 + endif + + eello_turn4=eello_turn4-(s1+s2+s3) & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) + eello_t4=-(s1+s2+s3) & + *fac_shield(i)*fac_shield(j) +!C Now derivative over shield: + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. & + (shield_mode.gt.0)) then +!C print *,i,j + + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do k=1,3 + rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i) +! print *,"rlocshield",rlocshield,grad_shield_side(k,ilist,i),iresshield + gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ & + rlocshield & + +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i) + gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) & + +rlocshield + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do k=1,3 +! print *,"rlocshieldj",j,rlocshield,grad_shield_side(k,ilist,j),iresshield + rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j) + gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ & + rlocshield & + +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j) + gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) & + +rlocshield +! print *,"after", gshieldc_t4(k,iresshield-1),iresshield-1,gshieldc_t4(k,iresshield) + + enddo + enddo + do k=1,3 + gshieldc_t4(k,i)=gshieldc_t4(k,i)+ & + grad_shield(k,i)*eello_t4/fac_shield(i) + gshieldc_t4(k,j)=gshieldc_t4(k,j)+ & + grad_shield(k,j)*eello_t4/fac_shield(j) + gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+ & + grad_shield(k,i)*eello_t4/fac_shield(i) + gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+ & + grad_shield(k,j)*eello_t4/fac_shield(j) +! print *,"gshieldc_t4(k,j+1)",j,gshieldc_t4(k,j+1) + enddo + endif + + if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') & + 'eturn4',i,j,-(s1+s2+s3) +!d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3), !d & ' eello_turn4_num',8*eello_turn4_num ! Derivatives in gamma(i) call transpose2(EUgder(1,1,i+1),e1tder(1,1)) @@ -3493,7 +4729,10 @@ 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) + gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) + ! 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)) @@ -3501,7 +4740,10 @@ 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) + gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) + ! 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)) @@ -3512,7 +4754,10 @@ 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) + gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) + ! Cartesian derivatives ! Derivatives of this turn contributions in DC(i+2) if (j.lt.nres-1) then @@ -3531,7 +4776,10 @@ 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) + gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)& + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) + enddo endif ! Remaining derivatives of this turn contribution @@ -3549,7 +4797,11 @@ 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) + gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) + + a_temp(1,1)=aggi1(l,1) a_temp(1,2)=aggi1(l,2) a_temp(2,1)=aggi1(l,3) @@ -3563,7 +4815,11 @@ 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) + gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) + + a_temp(1,1)=aggj(l,1) a_temp(1,2)=aggj(l,2) a_temp(2,1)=aggj(l,3) @@ -3577,7 +4833,12 @@ 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) +! if (j.lt.nres-1) then + gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) +! endif + a_temp(1,1)=aggj1(l,1) a_temp(1,2)=aggj1(l,2) a_temp(2,1)=aggj1(l,3) @@ -3592,8 +4853,27 @@ call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1)) s3=0.5d0*(pizda(1,1)+pizda(2,2)) ! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3 - gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) +! if (j.lt.nres-1) then +! print *,"juest before",j1, gcorr4_turn(l,j1) + gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) & + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) +! if (shield_mode.gt.0) then +! print *,"juest after",j1, gcorr4_turn(l,j1),gshieldc_t4(k,j1),gshieldc_loc_t4(k,j1),gel_loc_turn4(i+2) +! else +! print *,"juest after",j1, gcorr4_turn(l,j1),gel_loc_turn4(i+2) +! endif +! endif enddo + gshieldc_t4(3,i)=gshieldc_t4(3,i)+ & + ssgradlipi*eello_t4/4.0d0*lipscale + gshieldc_t4(3,j)=gshieldc_t4(3,j)+ & + ssgradlipj*eello_t4/4.0d0*lipscale + gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+ & + ssgradlipi*eello_t4/4.0d0*lipscale + gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+ & + ssgradlipj*eello_t4/4.0d0*lipscale + return end subroutine eturn4 !----------------------------------------------------------------------------- @@ -3604,7 +4884,7 @@ ! implicit none real(kind=8),dimension(3) :: u,vec real(kind=8),dimension(3,3) ::ugrad,ungrad - real(kind=8) :: unorm !,scalar + real(kind=8) :: unorm !,scalar integer :: i,j ! write (2,*) 'ugrad',ugrad ! write (2,*) 'u',u @@ -3650,7 +4930,7 @@ !d print '(a)','Enter ESCP' !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e do i=iatscp_s,iatscp_e - if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle + if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle iteli=itel(i) xi=0.5D0*(c(1,i)+c(1,i+1)) yi=0.5D0*(c(2,i)+c(2,i+1)) @@ -3659,8 +4939,8 @@ do iint=1,nscp_gr(i) do j=iscpstart(i,iint),iscpend(i,iint) - if (itype(j).eq.ntyp1) cycle - itypj=iabs(itype(j)) + if (itype(j,1).eq.ntyp1) cycle + itypj=iabs(itype(j,1)) ! Uncomment following three lines for SC-p interactions ! xj=c(1,nres+j)-xi ! yj=c(2,nres+j)-yi @@ -3742,52 +5022,110 @@ ! include 'COMMON.CONTROL' real(kind=8),dimension(3) :: ggg !el local variables - integer :: i,iint,j,k,iteli,itypj + integer :: i,iint,j,k,iteli,itypj,subchap real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,& - e1,e2,evdwij + e1,e2,evdwij,rij + real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,& + dist_temp, dist_init + integer xshift,yshift,zshift evdw2=0.0D0 evdw2_14=0.0d0 !d print '(a)','Enter ESCP' !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e do i=iatscp_s,iatscp_e - if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle + if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle iteli=itel(i) xi=0.5D0*(c(1,i)+c(1,i+1)) yi=0.5D0*(c(2,i)+c(2,i+1)) zi=0.5D0*(c(3,i)+c(3,i+1)) + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize do iint=1,nscp_gr(i) do j=iscpstart(i,iint),iscpend(i,iint) - itypj=iabs(itype(j)) + itypj=iabs(itype(j,1)) if (itypj.eq.ntyp1) cycle ! Uncomment following three lines for SC-p interactions ! xj=c(1,nres+j)-xi ! yj=c(2,nres+j)-yi ! zj=c(3,nres+j)-zi ! Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi +! xj=c(1,j)-xi +! yj=c(2,j)-yi +! zj=c(3,j)-zi + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + rrij=1.0D0/(xj*xj+yj*yj+zj*zj) + rij=dsqrt(1.0d0/rrij) + sss_ele_cut=sscale_ele(rij) + sss_ele_grad=sscagrad_ele(rij) +! print *,sss_ele_cut,sss_ele_grad,& +! (rij),r_cut_ele,rlamb_ele + if (sss_ele_cut.le.0.0) cycle 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 + evdw2_14=evdw2_14+(e1+e2)*sss_ele_cut endif evdwij=e1+e2 - evdw2=evdw2+evdwij - if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') & - 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),& - bad(itypj,iteli) + evdw2=evdw2+evdwij*sss_ele_cut +! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') & +! 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),& + if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') & + 'evdw2',i,j,evdwij ! ! Calculate contributions to the gradient in the virtual-bond and SC vectors. ! - fac=-(evdwij+e1)*rrij + fac=-(evdwij+e1)*rrij*sss_ele_cut + fac=fac+evdwij*sss_ele_grad/rij/expon ggg(1)=xj*fac ggg(2)=yj*fac ggg(3)=zj*fac @@ -3887,51 +5225,107 @@ ! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds if (.not.dyn_ss .and. i.le.nss) then ! 15/02/13 CC dynamic SSbond - additional check - if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. & - iabs(itype(jjj)).eq.1) then + if (ii.gt.nres .and. iabs(itype(iii,1)).eq.1 .and. & + iabs(itype(jjj,1)).eq.1) then call ssbond_ene(iii,jjj,eij) ehpb=ehpb+2*eij !d write (iout,*) "eij",eij endif + else if (ii.gt.nres .and. jj.gt.nres) then +!c Restraints from contact prediction + dd=dist(ii,jj) + if (constr_dist.eq.11) then + ehpb=ehpb+fordepth(i)**4.0d0 & + *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i)) + fac=fordepth(i)**4.0d0 & + *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd + if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, & + ehpb,fordepth(i),dd + else + if (dhpb1(i).gt.0.0d0) then + ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) + fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd +!c write (iout,*) "beta nmr", +!c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) + else + 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 write (iout,*) "beta reg",dd,waga*rdis*rdis +!C +!C Evaluate gradient. +!C + fac=waga*rdis/dd + endif + endif + do j=1,3 + ggg(j)=fac*(c(j,jj)-c(j,ii)) + enddo + do j=1,3 + ghpbx(j,iii)=ghpbx(j,iii)-ggg(j) + ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j) + enddo + do k=1,3 + ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k) + ghpbc(k,iii)=ghpbc(k,iii)-ggg(k) + enddo else -! Calculate the distance between the two points and its difference from the -! target distance. - dd=dist(ii,jj) - rdis=dd-dhpb(i) -! Get the force constant corresponding to this distance. - waga=forcon(i) -! Calculate the contribution to energy. - ehpb=ehpb+waga*rdis*rdis -! -! Evaluate gradient. -! - fac=waga*rdis/dd -!d print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd, -!d & ' waga=',waga,' fac=',fac - do j=1,3 - ggg(j)=fac*(c(j,jj)-c(j,ii)) - enddo -!d print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3) -! If this is a SC-SC distance, we need to calculate the contributions to the -! Cartesian gradient in the SC vectors (ghpbx). - if (iii.lt.ii) then + dd=dist(ii,jj) + if (constr_dist.eq.11) then + ehpb=ehpb+fordepth(i)**4.0d0 & + *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i)) + fac=fordepth(i)**4.0d0 & + *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd + if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, & + ehpb,fordepth(i),dd + else + if (dhpb1(i).gt.0.0d0) then + ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) + fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd +!c write (iout,*) "alph nmr", +!c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) + else + 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 write (iout,*) "alpha reg",dd,waga*rdis*rdis +!C +!C Evaluate gradient. +!C + fac=waga*rdis/dd + endif + endif + + 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 -!grad do j=iii,jjj-1 -!grad do k=1,3 -!grad ghpbc(k,j)=ghpbc(k,j)+ggg(k) -!grad enddo -!grad enddo - do k=1,3 - ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k) - ghpbc(k,iii)=ghpbc(k,iii)-ggg(k) - enddo + endif +!cgrad do j=iii,jjj-1 +!cgrad do k=1,3 +!cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k) +!cgrad enddo +!cgrad enddo + do k=1,3 + ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k) + ghpbc(k,iii)=ghpbc(k,iii)-ggg(k) + enddo endif enddo - ehpb=0.5D0*ehpb + if (constr_dist.ne.11) ehpb=0.5D0*ehpb + return end subroutine edis !----------------------------------------------------------------------------- @@ -3960,7 +5354,7 @@ deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,& cosphi,ggk - itypi=iabs(itype(i)) + itypi=iabs(itype(i,1)) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -3969,7 +5363,7 @@ dzi=dc_norm(3,nres+i) ! dsci_inv=dsc_inv(itypi) dsci_inv=vbld_inv(nres+i) - itypj=iabs(itype(j)) + itypj=iabs(itype(j,1)) ! dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(nres+j) xj=c(1,nres+j)-xi @@ -4059,31 +5453,36 @@ ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres) do i=ibondp_start,ibondp_end - if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then - estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax) - do j=1,3 - gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) & - *dc(j,i-1)/vbld(i) - enddo - if (energy_dec) write(iout,*) & - "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax) + if (itype(i-1,1).eq.ntyp1 .and. itype(i,1).eq.ntyp1) cycle + if (itype(i-1,1).eq.ntyp1 .or. itype(i,1).eq.ntyp1) then +!C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax) +!C do j=1,3 +!C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) & +!C *dc(j,i-1)/vbld(i) +!C enddo +!C if (energy_dec) write(iout,*) & +!C "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax) + diff = vbld(i)-vbldpDUM else diff = vbld(i)-vbldp0 - if (energy_dec) write (iout,*) & + endif + if (energy_dec) write (iout,'(a7,i5,4f7.3)') & "estr bb",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 ! write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3) - endif +! endif enddo estr=0.5d0*AKP*estr+estr1 +! print *,"estr_bb",estr,AKP ! ! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included ! do i=ibond_start,ibond_end - iti=iabs(itype(i)) + iti=iabs(itype(i,1)) + if (iti.eq.0) print *,"WARNING WRONG SETTTING",i if (iti.ne.10 .and. iti.ne.ntyp1) then nbi=nbondterm(iti) if (nbi.eq.1) then @@ -4092,6 +5491,7 @@ "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,& AKSC(1,iti),AKSC(1,iti)*diff*diff estr=estr+0.5d0*AKSC(1,iti)*diff*diff +! print *,"estr_sc",estr do j=1,3 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres) enddo @@ -4120,6 +5520,11 @@ usumsqder=usumsqder+ud(j)*uprod2 enddo estr=estr+uprod/usum +! print *,"estr_sc",estr,i + + if (energy_dec) write (iout,*) & + "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,& + AKSC(1,iti),uprod/usum do j=1,3 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres) enddo @@ -4169,26 +5574,26 @@ etheta=0.0D0 ! write (*,'(a,i2)') 'EBEND ICG=',icg do i=ithet_start,ithet_end - if (itype(i-1).eq.ntyp1) cycle + if (itype(i-1,1).eq.ntyp1) cycle ! Zero the energy function and its derivative at 0 or pi. call splinthet(theta(i),0.5d0*delta,ss,ssd) - it=itype(i-1) - ichir1=isign(1,itype(i-2)) - ichir2=isign(1,itype(i)) - if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1)) - if (itype(i).eq.10) ichir2=isign(1,itype(i-1)) - if (itype(i-1).eq.10) then - itype1=isign(10,itype(i-2)) - ichir11=isign(1,itype(i-2)) - ichir12=isign(1,itype(i-2)) - itype2=isign(10,itype(i)) - ichir21=isign(1,itype(i)) - ichir22=isign(1,itype(i)) + it=itype(i-1,1) + ichir1=isign(1,itype(i-2,1)) + ichir2=isign(1,itype(i,1)) + if (itype(i-2,1).eq.10) ichir1=isign(1,itype(i-1,1)) + if (itype(i,1).eq.10) ichir2=isign(1,itype(i-1,1)) + if (itype(i-1,1).eq.10) then + itype1=isign(10,itype(i-2,1)) + ichir11=isign(1,itype(i-2,1)) + ichir12=isign(1,itype(i-2,1)) + itype2=isign(10,itype(i,1)) + ichir21=isign(1,itype(i,1)) + ichir22=isign(1,itype(i,1)) endif - if (i.gt.3 .and. itype(i-2).ne.ntyp1) then + if (i.gt.3 .and. itype(i-2,1).ne.ntyp1) then #ifdef OSF - phii=phi(i) + phii=phi(i) if (phii.ne.phii) phii=150.0 #else phii=phi(i) @@ -4199,9 +5604,9 @@ y(1)=0.0D0 y(2)=0.0D0 endif - if (i.lt.nres .and. itype(i).ne.ntyp1) then + if (i.lt.nres .and. itype(i,1).ne.ntyp1) then #ifdef OSF - phii1=phi(i+1) + phii1=phi(i+1) if (phii1.ne.phii1) phii1=150.0 phii1=pinorm(phii1) z(1)=cos(phii1) @@ -4268,6 +5673,8 @@ 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 +! print *,ithetaconstr_start,ithetaconstr_end,"TU" + ! Ufff.... We've done all this!!! return end subroutine ebend @@ -4363,7 +5770,7 @@ end subroutine theteng #else !----------------------------------------------------------------------------- - subroutine ebend(etheta) + subroutine ebend(etheta,ethetacnstr) ! ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral ! angles gamma and its derivatives in consecutive thetas and gammas. @@ -4389,30 +5796,34 @@ !el local variables integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai - real(kind=8) :: aux,etheta,ccl,ssl,scl,csl + real(kind=8) :: aux,etheta,ccl,ssl,scl,csl,ethetacnstr +! local variables for constrains + real(kind=8) :: difi,thetiii + integer itheta etheta=0.0D0 do i=ithet_start,ithet_end - if (itype(i-1).eq.ntyp1) cycle - if (iabs(itype(i+1)).eq.20) iblock=2 - if (iabs(itype(i+1)).ne.20) iblock=1 + if (itype(i-1,1).eq.ntyp1) cycle + if (itype(i-2,1).eq.ntyp1.or.itype(i,1).eq.ntyp1) cycle + if (iabs(itype(i+1,1)).eq.20) iblock=2 + if (iabs(itype(i+1,1)).ne.20) iblock=1 dethetai=0.0d0 dephii=0.0d0 dephii1=0.0d0 theti2=0.5d0*theta(i) - ityp2=ithetyp((itype(i-1))) + ityp2=ithetyp((itype(i-1,1))) do k=1,nntheterm coskt(k)=dcos(k*theti2) sinkt(k)=dsin(k*theti2) enddo - if (i.gt.3 .and. itype(i-2).ne.ntyp1) then + if (i.gt.3 .and. itype(max0(i-3,1),1).ne.ntyp1) then #ifdef OSF phii=phi(i) if (phii.ne.phii) phii=150.0 #else phii=phi(i) #endif - ityp1=ithetyp((itype(i-2))) + ityp1=ithetyp((itype(i-2,1))) ! propagation of chirality for glycine type do k=1,nsingle cosph1(k)=dcos(k*phii) @@ -4420,13 +5831,13 @@ enddo else phii=0.0d0 - ityp1=nthetyp+1 + ityp1=ithetyp(itype(i-2,1)) do k=1,nsingle cosph1(k)=0.0d0 sinph1(k)=0.0d0 enddo endif - if (i.lt.nres .and. itype(i).ne.ntyp1) then + if (i.lt.nres .and. itype(i+1,1).ne.ntyp1) then #ifdef OSF phii1=phi(i+1) if (phii1.ne.phii1) phii1=150.0 @@ -4434,14 +5845,14 @@ #else phii1=phi(i+1) #endif - ityp3=ithetyp((itype(i))) + ityp3=ithetyp((itype(i,1))) do k=1,nsingle cosph2(k)=dcos(k*phii1) sinph2(k)=dsin(k*phii1) enddo else phii1=0.0d0 - ityp3=nthetyp+1 + ityp3=ithetyp(itype(i,1)) do k=1,nsingle cosph2(k)=0.0d0 sinph2(k)=0.0d0 @@ -4556,10 +5967,43 @@ phii1*rad2deg,ethetai ! lprn1=.false. 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*dephii if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1 gloc(nphi+i-2,icg)=wang*dethetai enddo +!-----------thete constrains +! if (tor_mode.ne.2) then + ethetacnstr=0.0d0 +! print *,ithetaconstr_start,ithetaconstr_end,"TU" + do i=ithetaconstr_start,ithetaconstr_end + itheta=itheta_constr(i) + thetiii=theta(itheta) + difi=pinorm(thetiii-theta_constr0(i)) + if (difi.gt.theta_drange(i)) then + difi=difi-theta_drange(i) + ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4 + gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) & + +for_thet_constr(i)*difi**3 + else if (difi.lt.-drange(i)) then + difi=difi+drange(i) + ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4 + gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) & + +for_thet_constr(i)*difi**3 + else + difi=0.0 + endif + if (energy_dec) then + write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc", & + i,itheta,rad2deg*thetiii, & + rad2deg*theta_constr0(i), rad2deg*theta_drange(i), & + rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4, & + gloc(itheta+nphi-2,icg) + endif + enddo +! endif + return end subroutine ebend #endif @@ -4597,7 +6041,7 @@ escloc=0.0D0 ! write (iout,'(a)') 'ESC' do i=loc_start,loc_end - it=itype(i) + it=itype(i,1) if (it.eq.ntyp1) cycle if (it.eq.10) goto 1 nlobit=nlob(iabs(it)) @@ -4917,7 +6361,6 @@ sumene1x,sumene2x,sumene3x,sumene4x,& sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,& cosfac2xx,sinfac2yy -!el #define DEBUG #ifdef DEBUG real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,& de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,& @@ -4928,7 +6371,7 @@ delta=0.02d0*pi escloc=0.0D0 do i=loc_start,loc_end - if (itype(i).eq.ntyp1) cycle + if (itype(i,1).eq.ntyp1) cycle 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))) @@ -4937,7 +6380,7 @@ cosfac=dsqrt(cosfac2) sinfac2=0.5d0/(1.0d0-costtab(i+1)) sinfac=dsqrt(sinfac2) - it=iabs(itype(i)) + it=iabs(itype(i,1)) if (it.eq.10) goto 1 ! ! Compute the axes of tghe local cartesian coordinates system; store in @@ -4955,7 +6398,7 @@ 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)*dsign(1.0d0,dfloat(itype(i))) + z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i,1))) enddo ! write (2,*) "i",i ! write (2,*) "x_prime",(x_prime(j),j=1,3) @@ -4987,7 +6430,7 @@ ! Compute the energy of the ith side cbain ! ! write (2,*) "xx",xx," yy",yy," zz",zz - it=iabs(itype(i)) + it=iabs(itype(i,1)) do j = 1,65 x(j) = sc_parmin(j,it) enddo @@ -4995,7 +6438,7 @@ !c diagnostics - remove later xx1 = dcos(alph(2)) yy1 = dsin(alph(2))*dcos(omeg(2)) - zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2)) + zz1 = -dsign(1.0,dfloat(itype(i,1)))*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 @@ -5037,7 +6480,7 @@ ! & dscp1,dscp2,sumene ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) escloc = escloc + sumene -! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i) +! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i,1) ! & ,zz,xx,yy !#define DEBUG #ifdef DEBUG @@ -5083,7 +6526,7 @@ ! ! Compute the gradient of esc ! -! zz=zz*dsign(1.0,dfloat(itype(i))) +! zz=zz*dsign(1.0,dfloat(itype(i,1))) 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 @@ -5108,7 +6551,7 @@ +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) & +(pom1+pom2)*pom_dx #ifdef DEBUG - write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i) + write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i,1) #endif ! sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz @@ -5123,7 +6566,7 @@ +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) & +(pom1-pom2)*pom_dy #ifdef DEBUG - write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i) + write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i,1) #endif ! de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy & @@ -5135,16 +6578,15 @@ +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,itype(i) + write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i,1) #endif ! 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,itype(i) + write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i,1) #endif -!#undef DEBUG ! ! cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres)) @@ -5170,9 +6612,9 @@ dZZ_Ci(k)=0.0d0 do j=1,3 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) & - *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres) + *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres) dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) & - *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres) + *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres) enddo dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres)) @@ -5219,7 +6661,6 @@ 1 continue enddo -!el #undef DUBUG return end subroutine esc !----------------------------------------------------------------------------- @@ -5373,10 +6814,10 @@ etors=0.0D0 do i=iphi_start,iphi_end etors_ii=0.0D0 - if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1 & - .or. itype(i).eq.ntyp1) cycle - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) + if (itype(i-2,1).eq.ntyp1.or. itype(i-1,1).eq.ntyp1 & + .or. itype(i,1).eq.ntyp1) cycle + itori=itortyp(itype(i-2,1)) + itori1=itortyp(itype(i-1,1)) phii=phi(i) gloci=0.0D0 ! Proline-Proline pair is a special case... @@ -5412,11 +6853,11 @@ gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) enddo endif - if (energy_dec) write (iout,'(a6,i5,0pf7.3)') + 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,& + restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),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 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) @@ -5429,12 +6870,12 @@ 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 + edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4 + gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*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 + edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4 + gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*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) @@ -5476,16 +6917,17 @@ ! lprn=.true. etors=0.0D0 do i=iphi_start,iphi_end - if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 & - .or. itype(i).eq.ntyp1) cycle + if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 & + .or. itype(i-3,1).eq.ntyp1 & + .or. itype(i,1).eq.ntyp1) cycle etors_ii=0.0D0 - if (iabs(itype(i)).eq.20) then + if (iabs(itype(i,1)).eq.20) then iblock=2 else iblock=1 endif - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) + itori=itortyp(itype(i-2,1)) + itori1=itortyp(itype(i-1,1)) phii=phi(i) gloci=0.0D0 ! Regular cosine and sine terms @@ -5524,7 +6966,7 @@ 'etor',i,etors_ii-v0(itori,itori1,iblock) 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,& + restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,& (v1(j,itori,itori1,iblock),j=1,6),& (v2(j,itori,itori1,iblock),j=1,6) gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci @@ -5539,12 +6981,12 @@ 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 + edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4 + gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*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 + edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4 + gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3 else difi=0.0 endif @@ -5571,7 +7013,7 @@ ! include 'COMMON.IOUNITS' ! include 'COMMON.FFIELD' ! include 'COMMON.TORCNSTR' - real(kind=8) :: etors_d + real(kind=8) :: etors_d,etors_d_ii logical :: lprn !el local variables integer :: i,j,k,l,itori,itori1,itori2,iblock @@ -5585,17 +7027,19 @@ etors_d=0.0D0 ! write(iout,*) "a tu??" do i=iphid_start,iphid_end - if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1 & - .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle - itori=itortyp(itype(i-2)) - itori1=itortyp(itype(i-1)) - itori2=itortyp(itype(i)) + etors_d_ii=0.0D0 + if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 & + .or. itype(i-3,1).eq.ntyp1 & + .or. itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle + itori=itortyp(itype(i-2,1)) + itori1=itortyp(itype(i-1,1)) + itori2=itortyp(itype(i,1)) phii=phi(i) phii1=phi(i+1) gloci1=0.0D0 gloci2=0.0D0 iblock=1 - if (iabs(itype(i+1)).eq.20) iblock=2 + if (iabs(itype(i+1,1)).eq.20) iblock=2 ! Regular cosine and sine terms do j=1,ntermd_1(itori,itori1,itori2,iblock) @@ -5609,6 +7053,8 @@ sinphi2=dsin(j*phii1) etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ & v2cij*cosphi2+v2sij*sinphi2 + if (energy_dec) etors_d_ii=etors_d_ii+ & + v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1) gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2) enddo @@ -5624,12 +7070,17 @@ sinphi1m2=dsin(l*phii-(k-l)*phii1) etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ & v1sdij*sinphi1p2+v2sdij*sinphi1m2 + if (energy_dec) etors_d_ii=etors_d_ii+ & + 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 + if (energy_dec) write (iout,'(a6,i5,0pf7.3)') & + 'etor_d',i,etors_d_ii gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2 enddo @@ -5668,44 +7119,49 @@ ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end esccor=0.0D0 do i=itau_start,itau_end - if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle + if ((itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1)) cycle esccor_ii=0.0D0 - isccori=isccortyp(itype(i-2)) - isccori1=isccortyp(itype(i-1)) + isccori=isccortyp(itype(i-2,1)) + isccori1=isccortyp(itype(i-1,1)) + ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1) phii=phi(i) do intertyp=1,3 !intertyp + esccor_ii=0.0D0 !c Added 09 May 2012 (Adasko) !c Intertyp means interaction type of backbone mainchain correlation: ! 1 = SC...Ca...Ca...Ca ! 2 = Ca...Ca...Ca...SC ! 3 = SC...Ca...Ca...SCi gloci=0.0D0 - if (((intertyp.eq.3).and.((itype(i-2).eq.10).or. & - (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or. & - (itype(i-1).eq.ntyp1))) & - .or. ((intertyp.eq.1).and.((itype(i-2).eq.10) & - .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1) & - .or.(itype(i).eq.ntyp1))) & - .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or. & - (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or. & - (itype(i-3).eq.ntyp1)))) cycle - if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle - if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1)) & + if (((intertyp.eq.3).and.((itype(i-2,1).eq.10).or. & + (itype(i-1,1).eq.10).or.(itype(i-2,1).eq.ntyp1).or. & + (itype(i-1,1).eq.ntyp1))) & + .or. ((intertyp.eq.1).and.((itype(i-2,1).eq.10) & + .or.(itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1) & + .or.(itype(i,1).eq.ntyp1))) & + .or.((intertyp.eq.2).and.((itype(i-1,1).eq.10).or. & + (itype(i-1,1).eq.ntyp1).or.(itype(i-2,1).eq.ntyp1).or. & + (itype(i-3,1).eq.ntyp1)))) cycle + if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1,1).eq.ntyp1)) cycle + if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres,1).eq.ntyp1)) & cycle do j=1,nterm_sccor(isccori,isccori1) v1ij=v1sccor(j,intertyp,isccori,isccori1) v2ij=v2sccor(j,intertyp,isccori,isccori1) cosphi=dcos(j*tauangle(intertyp,i)) sinphi=dsin(j*tauangle(intertyp,i)) + if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi esccor=esccor+v1ij*cosphi+v2ij*sinphi gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi) enddo + if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') & + 'esccor',i,intertyp,esccor_ii ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci 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,isccori,isccori1,& + restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,isccori,isccori1,& (v1sccor(j,intertyp,isccori,isccori1),j=1,6),& (v2sccor(j,intertyp,isccori,isccori1),j=1,6) gsccor_loc(i-3)=gsccor_loc(i-3)+gloci @@ -6648,10 +8104,11 @@ real(kind=8),dimension(3) :: gx,gx1 logical :: lprn !el local variables - integer :: i,j,k,l,jj,kk,ll + integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,& ees0mkl,ees,coeffpees0pij,coeffmees0mij,& - coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl + coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, & + rlocshield lprn=.false. eij=facont_hb(jj,i) @@ -6726,6 +8183,80 @@ !grad enddo ! write (iout,*) "ehbcorr",ekont*ees ehbcorr=ekont*ees + if (shield_mode.gt.0) then + j=ees0plist(jj,i) + l=ees0plist(kk,k) +!C print *,i,j,fac_shield(i),fac_shield(j), +!C &fac_shield(k),fac_shield(l) + if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. & + (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then + do ilist=1,ishield_list(i) + iresshield=shield_list(ilist,i) + do m=1,3 + rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i) + gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ & + rlocshield & + +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i) + gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) & + +rlocshield + enddo + enddo + do ilist=1,ishield_list(j) + iresshield=shield_list(ilist,j) + do m=1,3 + rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j) + gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ & + rlocshield & + +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j) + gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) & + +rlocshield + enddo + enddo + + do ilist=1,ishield_list(k) + iresshield=shield_list(ilist,k) + do m=1,3 + rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k) + gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ & + rlocshield & + +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k) + gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) & + +rlocshield + enddo + enddo + do ilist=1,ishield_list(l) + iresshield=shield_list(ilist,l) + do m=1,3 + rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l) + gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ & + rlocshield & + +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l) + gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) & + +rlocshield + enddo + enddo + do m=1,3 + gshieldc_ec(m,i)=gshieldc_ec(m,i)+ & + grad_shield(m,i)*ehbcorr/fac_shield(i) + gshieldc_ec(m,j)=gshieldc_ec(m,j)+ & + grad_shield(m,j)*ehbcorr/fac_shield(j) + gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ & + grad_shield(m,i)*ehbcorr/fac_shield(i) + gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ & + grad_shield(m,j)*ehbcorr/fac_shield(j) + + gshieldc_ec(m,k)=gshieldc_ec(m,k)+ & + grad_shield(m,k)*ehbcorr/fac_shield(k) + gshieldc_ec(m,l)=gshieldc_ec(m,l)+ & + grad_shield(m,l)*ehbcorr/fac_shield(l) + gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ & + grad_shield(m,k)*ehbcorr/fac_shield(k) + gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ & + grad_shield(m,l)*ehbcorr/fac_shield(l) + + enddo + endif + endif return end function ehbcorr #ifdef MOMENT @@ -6750,9 +8281,9 @@ allocate(dipderx(3,5,4,maxconts,nres)) ! - iti1 = itortyp(itype(i+1)) + iti1 = itortyp(itype(i+1,1)) if (j.lt.nres-1) then - itj1 = itortyp(itype(j+1)) + itj1 = itortyp(itype(j+1,1)) else itj1=ntortyp+1 endif @@ -6845,14 +8376,14 @@ if (l.eq.j+1) then ! parallel orientation of the two CA-CA-CA frames. if (i.gt.1) then - iti=itortyp(itype(i)) + iti=itortyp(itype(i,1)) else iti=ntortyp+1 endif - itk1=itortyp(itype(k+1)) - itj=itortyp(itype(j)) + itk1=itortyp(itype(k+1,1)) + itj=itortyp(itype(j,1)) if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) + itl1=itortyp(itype(l+1,1)) else itl1=ntortyp+1 endif @@ -6998,15 +8529,15 @@ else ! Antiparallel orientation of the two CA-CA-CA frames. if (i.gt.1) then - iti=itortyp(itype(i)) + iti=itortyp(itype(i,1)) else iti=ntortyp+1 endif - itk1=itortyp(itype(k+1)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) + itk1=itortyp(itype(k+1,1)) + itl=itortyp(itype(l,1)) + itj=itortyp(itype(j,1)) if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) + itj1=itortyp(itype(j+1,1)) else itj1=ntortyp+1 endif @@ -7323,7 +8854,7 @@ ! o o o o C ! /l\ / \ \ / \ / \ / C ! / \ / \ \ / \ / \ / C -! j| o |l1 | o | o| o | | o |o C +! j| o |l1 | o | o| o | | o |o C ! \ |/k\| |/ \| / |/ \| |/ \| C ! \i/ \ / \ / / \ / \ C ! o k1 o C @@ -7336,7 +8867,7 @@ ! o o o o C ! /j\ / \ \ / \ / \ / C ! / \ / \ \ / \ / \ / C -! j1| o |l | o | o| o | | o |o C +! j1| o |l | o | o| o | | o |o C ! \ |/k\| |/ \| / |/ \| |/ \| C ! \i/ \ / \ / / \ / \ C ! o k1 o C @@ -7354,9 +8885,9 @@ !d write (iout,*) !d & 'EELLO5: Contacts have occurred for peptide groups',i,j, !d & ' and',k,l - itk=itortyp(itype(k)) - itl=itortyp(itype(l)) - itj=itortyp(itype(j)) + itk=itortyp(itype(k,1)) + itl=itortyp(itype(l,1)) + itj=itortyp(itype(j,1)) eello5_1=0.0d0 eello5_2=0.0d0 eello5_3=0.0d0 @@ -7884,7 +9415,7 @@ ! i i C ! C !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - itk=itortyp(itype(k)) + itk=itortyp(itype(k,1)) 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)) @@ -8180,16 +9711,16 @@ ! ! 4/7/01 AL Component s1 was removed, because it pertains to the respective ! energy moment and not to the cluster cumulant. - iti=itortyp(itype(i)) + iti=itortyp(itype(i,1)) if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) + itj1=itortyp(itype(j+1,1)) else itj1=ntortyp+1 endif - itk=itortyp(itype(k)) - itk1=itortyp(itype(k+1)) + itk=itortyp(itype(k,1)) + itk1=itortyp(itype(k+1,1)) if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) + itl1=itortyp(itype(l+1,1)) else itl1=ntortyp+1 endif @@ -8301,22 +9832,22 @@ ! 4/7/01 AL Component s1 was removed, because it pertains to the respective ! energy moment and not to the cluster cumulant. !d write (2,*) 'eello_graph4: wturn6',wturn6 - iti=itortyp(itype(i)) - itj=itortyp(itype(j)) + iti=itortyp(itype(i,1)) + itj=itortyp(itype(j,1)) if (j.lt.nres-1) then - itj1=itortyp(itype(j+1)) + itj1=itortyp(itype(j+1,1)) else itj1=ntortyp+1 endif - itk=itortyp(itype(k)) + itk=itortyp(itype(k,1)) if (k.lt.nres-1) then - itk1=itortyp(itype(k+1)) + itk1=itortyp(itype(k+1,1)) else itk1=ntortyp+1 endif - itl=itortyp(itype(l)) + itl=itortyp(itype(l,1)) if (l.lt.nres-1) then - itl1=itortyp(itype(l+1)) + itl1=itortyp(itype(l+1,1)) else itl1=ntortyp+1 endif @@ -8543,11 +10074,11 @@ 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)) + iti=itortyp(itype(i,1)) + itk=itortyp(itype(k,1)) + itk1=itortyp(itype(k+1,1)) + itl=itortyp(itype(l,1)) + itj=itortyp(itype(j,1)) !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj !d write (2,*) 'i',i,' k',k,' j',j,' l',l !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then @@ -8995,12 +10526,12 @@ #endif #ifdef MPI include 'mpif.h' -!el#endif - real(kind=8),dimension(3,nres) :: gradbufc,gradbufx,gradbufc_sum,& +#endif + real(kind=8),dimension(3,-1:nres) :: gradbufc,gradbufx,gradbufc_sum,& gloc_scbuf !(3,maxres) real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres) -#endif +!#endif !el local variables integer :: i,j,k,ierror,ierr real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,& @@ -9074,7 +10605,7 @@ call flush(iout) #endif #ifdef SPLITELE - do i=1,nct + do i=0,nct do j=1,3 gradbufc(j,i)=wsc*gvdwc(j,i)+ & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ & @@ -9084,11 +10615,35 @@ wcorr5*gradcorr5_long(j,i)+ & wcorr6*gradcorr6_long(j,i)+ & wturn6*gcorr6_turn_long(j,i)+ & - wstrain*ghpbc(j,i) + wstrain*ghpbc(j,i) & + +wliptran*gliptranc(j,i) & + +gradafm(j,i) & + +welec*gshieldc(j,i) & + +wcorr*gshieldc_ec(j,i) & + +wturn3*gshieldc_t3(j,i)& + +wturn4*gshieldc_t4(j,i)& + +wel_loc*gshieldc_ll(j,i)& + +wtube*gg_tube(j,i) & + +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ & + wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ & + wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ & + wcorr_nucl*gradcorr_nucl(j,i)& + +wcorr3_nucl*gradcorr3_nucl(j,i)+& + wcatprot* gradpepcat(j,i)+ & + wcatcat*gradcatcat(j,i)+ & + wscbase*gvdwc_scbase(j,i)+ & + wpepbase*gvdwc_pepbase(j,i)+& + wscpho*gvdwc_scpho(j,i)+ & + wpeppho*gvdwc_peppho(j,i) + + + + + enddo enddo #else - do i=1,nct + do i=0,nct do j=1,3 gradbufc(j,i)=wsc*gvdwc(j,i)+ & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ & @@ -9099,7 +10654,27 @@ wcorr5*gradcorr5_long(j,i)+ & wcorr6*gradcorr6_long(j,i)+ & wturn6*gcorr6_turn_long(j,i)+ & - wstrain*ghpbc(j,i) + wstrain*ghpbc(j,i) & + +wliptran*gliptranc(j,i) & + +gradafm(j,i) & + +welec*gshieldc(j,i)& + +wcorr*gshieldc_ec(j,i) & + +wturn4*gshieldc_t4(j,i) & + +wel_loc*gshieldc_ll(j,i)& + +wtube*gg_tube(j,i) & + +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ & + wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ & + wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ & + wcorr_nucl*gradcorr_nucl(j,i) & + +wcorr3_nucl*gradcorr3_nucl(j,i) +& + wcatprot* gradpepcat(j,i)+ & + wcatcat*gradcatcat(j,i)+ & + wscbase*gvdwc_scbase(j,i) & + wpepbase*gvdwc_pepbase(j,i)+& + wscpho*gvdwc_scpho(j,i)+& + wpeppho*gvdwc_peppho(j,i) + + enddo enddo #endif @@ -9113,7 +10688,7 @@ enddo call flush(iout) #endif - do i=1,nres + do i=0,nres do j=1,3 gradbufc_sum(j,i)=gradbufc(j,i) enddo @@ -9131,7 +10706,7 @@ #ifdef TIMING ! time_allreduce=time_allreduce+MPI_Wtime()-time00 #endif - do i=nnt,nres + do i=0,nres do k=1,3 gradbufc(k,i)=0.0d0 enddo @@ -9156,7 +10731,7 @@ do j=1,3 gradbufc(j,nres-1)=gradbufc_sum(j,nres) enddo - do i=nres-2,nnt,-1 + do i=nres-2,-1,-1 do j=1,3 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1) enddo @@ -9179,7 +10754,7 @@ call flush(iout) #endif !el#undef DEBUG - do i=1,nres + do i=-1,nres do j=1,3 gradbufc_sum(j,i)=gradbufc(j,i) gradbufc(j,i)=0.0d0 @@ -9188,7 +10763,7 @@ do j=1,3 gradbufc(j,nres-1)=gradbufc_sum(j,nres) enddo - do i=nres-2,nnt,-1 + do i=nres-2,-1,-1 do j=1,3 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1) enddo @@ -9222,7 +10797,7 @@ !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2) !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2) !el----------------- - do i=1,nct + do i=-1,nct do j=1,3 #ifdef SPLITELE gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ & @@ -9242,7 +10817,67 @@ wcorr6*gradcorr6(j,i)+ & wturn6*gcorr6_turn(j,i)+ & wsccor*gsccorc(j,i) & - +wscloc*gscloc(j,i) + +wscloc*gscloc(j,i) & + +wliptran*gliptranc(j,i) & + +gradafm(j,i) & + +welec*gshieldc(j,i) & + +welec*gshieldc_loc(j,i) & + +wcorr*gshieldc_ec(j,i) & + +wcorr*gshieldc_loc_ec(j,i) & + +wturn3*gshieldc_t3(j,i) & + +wturn3*gshieldc_loc_t3(j,i) & + +wturn4*gshieldc_t4(j,i) & + +wturn4*gshieldc_loc_t4(j,i) & + +wel_loc*gshieldc_ll(j,i) & + +wel_loc*gshieldc_loc_ll(j,i) & + +wtube*gg_tube(j,i) & + +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)& + +wvdwpsb*gvdwpsb1(j,i))& + +wbond_nucl*gradb_nucl(j,i)+wsbloc*gsbloc(j,i) +! if (i.eq.21) then +! print *,"in sum",gradc(j,i,icg),wturn4*gcorr4_turn(j,i),& +! wturn4*gshieldc_t4(j,i), & +! wturn4*gshieldc_loc_t4(j,i) +! endif +! if ((i.le.2).and.(i.ge.1)) +! print *,gradc(j,i,icg),& +! gradbufc(j,i),welec*gelc(j,i), & +! wel_loc*gel_loc(j,i), & +! wscp*gvdwc_scpp(j,i), & +! welec*gelc_long(j,i),wvdwpp*gvdwpp(j,i), & +! wel_loc*gel_loc_long(j,i), & +! wcorr*gradcorr_long(j,i), & +! wcorr5*gradcorr5_long(j,i), & +! wcorr6*gradcorr6_long(j,i), & +! wturn6*gcorr6_turn_long(j,i), & +! wbond*gradb(j,i), & +! wcorr*gradcorr(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) & +! ,wliptran*gliptranc(j,i) & +! ,gradafm(j,i) & +! ,welec*gshieldc(j,i) & +! ,welec*gshieldc_loc(j,i) & +! ,wcorr*gshieldc_ec(j,i) & +! ,wcorr*gshieldc_loc_ec(j,i) & +! ,wturn3*gshieldc_t3(j,i) & +! ,wturn3*gshieldc_loc_t3(j,i) & +! ,wturn4*gshieldc_t4(j,i) & +! ,wturn4*gshieldc_loc_t4(j,i) & +! ,wel_loc*gshieldc_ll(j,i) & +! ,wel_loc*gshieldc_loc_ll(j,i) & +! ,wtube*gg_tube(j,i) & +! ,wbond_nucl*gradb_nucl(j,i) & +! ,wvdwpp_nucl*gvdwpp_nucl(j,i),welpp*gelpp(j,i),& +! wvdwpsb*gvdwpsb1(j,i)& +! ,wbond_nucl*gradb_nucl(j,i),wsbloc*gsbloc(j,i) +! + #else gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ & wel_loc*gel_loc(j,i)+ & @@ -9261,15 +10896,56 @@ wcorr6*gradcorr6(j,i)+ & wturn6*gcorr6_turn(j,i)+ & wsccor*gsccorc(j,i) & - +wscloc*gscloc(j,i) + +wscloc*gscloc(j,i) & + +gradafm(j,i) & + +wliptran*gliptranc(j,i) & + +welec*gshieldc(j,i) & + +welec*gshieldc_loc(j,) & + +wcorr*gshieldc_ec(j,i) & + +wcorr*gshieldc_loc_ec(j,i) & + +wturn3*gshieldc_t3(j,i) & + +wturn3*gshieldc_loc_t3(j,i) & + +wturn4*gshieldc_t4(j,i) & + +wturn4*gshieldc_loc_t4(j,i) & + +wel_loc*gshieldc_ll(j,i) & + +wel_loc*gshieldc_loc_ll(j,i) & + +wtube*gg_tube(j,i) & + +wbond_nucl*gradb_nucl(j,i) & + +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)& + +wvdwpsb*gvdwpsb1(j,i))& + +wsbloc*gsbloc(j,i) + + + + #endif 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) + +wscloc*gsclocx(j,i) & + +wliptran*gliptranx(j,i) & + +welec*gshieldx(j,i) & + +wcorr*gshieldx_ec(j,i) & + +wturn3*gshieldx_t3(j,i) & + +wturn4*gshieldx_t4(j,i) & + +wel_loc*gshieldx_ll(j,i)& + +wtube*gg_tube_sc(j,i) & + +wbond_nucl*gradbx_nucl(j,i) & + +wvdwsb*gvdwsbx(j,i) & + +welsb*gelsbx(j,i) & + +wcorr_nucl*gradxorr_nucl(j,i)& + +wcorr3_nucl*gradxorr3_nucl(j,i) & + +wsbloc*gsblocx(j,i) & + +wcatprot* gradpepcatx(j,i)& + +wscbase*gvdwx_scbase(j,i) & + +wpepbase*gvdwx_pepbase(j,i)& + +wscpho*gvdwx_scpho(j,i) +! if (i.eq.3) print *,"tu?", wscpho,gvdwx_scpho(j,i) + enddo - enddo + enddo +!#define DEBUG #ifdef DEBUG write (iout,*) "gloc before adding corr" do i=1,4*nres @@ -9291,10 +10967,11 @@ write (iout,*) i,gloc(i,icg) enddo #endif +!#undef DEBUG #ifdef MPI if (nfgtasks.gt.1) then do j=1,3 - do i=1,nres + do i=0,nres gradbufc(j,i)=gradc(j,i,icg) gradbufx(j,i)=gradx(j,i,icg) enddo @@ -9321,9 +10998,9 @@ call MPI_Barrier(FG_COMM,IERR) time_barrier_g=time_barrier_g+MPI_Wtime()-time00 time00=MPI_Wtime() - call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,& + call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,& MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) - call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,& + call MPI_Reduce(gradbufx(1,0),gradx(1,0,icg),3*nres+3,& 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) @@ -9332,6 +11009,7 @@ MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR) time_reduce=time_reduce+MPI_Wtime()-time00 !#define DEBUG +! print *,"gradbuf",gradbufc(1,1),gradc(1,1,icg) #ifdef DEBUG write (iout,*) "gloc_sc after reduce" do i=1,nres @@ -9451,7 +11129,7 @@ endif endif endif -!el#define DEBUG +!#define DEBUG #ifdef DEBUG write (iout,*) "gradc gradx gloc" do i=1,nres @@ -9459,7 +11137,7 @@ i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg) enddo #endif -!el#undef DEBUG +!#undef DEBUG #ifdef TIMING time_sumgradient=time_sumgradient+MPI_Wtime()-time01 #endif @@ -9475,11 +11153,15 @@ ! include 'COMMON.CALC' ! include 'COMMON.IOUNITS' real(kind=8), dimension(3) :: dcosom1,dcosom2 +! print *,"wchodze" + eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 & + +dCAVdOM1+ dGCLdOM1+ dPOLdOM1 + eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 & + +dCAVdOM2+ dGCLdOM2+ dPOLdOM2 - eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 - eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 & - -2.0D0*alf12*eps3der+sigder*sigsq_om12 + -2.0D0*alf12*eps3der+sigder*sigsq_om12& + +dCAVdOM12+ dGCLdOM12 ! diagnostics only ! eom1=0.0d0 ! eom2=0.0d0 @@ -9489,21 +11171,28 @@ ! " sigder",sigder ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12 +!C print *,sss_ele_cut,'in sc_grad' 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 do k=1,3 - gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k) - enddo + gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut +!C print *,'gg',k,gg(k) + enddo +! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut ! write (iout,*) "gg",(gg(k),k=1,3) do k=1,3 - gvdwx(k,i)=gvdwx(k,i)-gg(k) & + gvdwx(k,i)=gvdwx(k,i)-gg(k) +gg_lipi(k)& +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) & - +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv - gvdwx(k,j)=gvdwx(k,j)+gg(k) & + +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv & + *sss_ele_cut + + gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)& +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) & - +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv + +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv & + *sss_ele_cut + ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) & ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) & @@ -9518,8 +11207,8 @@ !grad enddo !grad enddo do l=1,3 - gvdwc(l,i)=gvdwc(l,i)-gg(l) - gvdwc(l,j)=gvdwc(l,j)+gg(l) + gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l) + gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l) enddo return end subroutine sc_grad @@ -9699,7 +11388,7 @@ ! ind1=0 do i=1,nres-2 - ind1=ind1+1 + ind1=ind1+1 ! ! Derivatives of DC(i+1) in theta(i+2) ! @@ -9788,8 +11477,8 @@ ! theta(nres) and phi(i+3) thru phi(nres). ! do j=i+1,nres-2 - ind1=ind1+1 - ind=indmat(i+1,j+1) + ind1=ind1+1 + ind=indmat(i+1,j+1) !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1 do k=1,3 do l=1,3 @@ -9830,7 +11519,7 @@ enddo do k=1,3 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1) - enddo + enddo do k=1,3 dxoijk=0.0D0 do l=1,3 @@ -9844,7 +11533,7 @@ ! Derivatives in alpha and omega: ! do i=2,nres-1 -! dsci=dsc(itype(i)) +! dsci=dsc(itype(i,1)) dsci=vbld(i+nres) #ifdef OSF alphi=alph(i) @@ -9852,43 +11541,43 @@ if(alphi.ne.alphi) alphi=100.0 if(omegi.ne.omegi) omegi=-100.0 #else - alphi=alph(i) - omegi=omeg(i) + alphi=alph(i) + omegi=omeg(i) #endif !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi - cosalphi=dcos(alphi) - sinalphi=dsin(alphi) - cosomegi=dcos(omegi) - sinomegi=dsin(omegi) - temp(1,1)=-dsci*sinalphi - temp(2,1)= dsci*cosalphi*cosomegi - temp(3,1)=-dsci*cosalphi*sinomegi - temp(1,2)=0.0D0 - temp(2,2)=-dsci*sinalphi*sinomegi - temp(3,2)=-dsci*sinalphi*cosomegi - theta2=pi-0.5D0*theta(i+1) - cost2=dcos(theta2) - sint2=dsin(theta2) - jjj=0 + cosalphi=dcos(alphi) + sinalphi=dsin(alphi) + cosomegi=dcos(omegi) + sinomegi=dsin(omegi) + temp(1,1)=-dsci*sinalphi + temp(2,1)= dsci*cosalphi*cosomegi + temp(3,1)=-dsci*cosalphi*sinomegi + temp(1,2)=0.0D0 + temp(2,2)=-dsci*sinalphi*sinomegi + temp(3,2)=-dsci*sinalphi*cosomegi + theta2=pi-0.5D0*theta(i+1) + cost2=dcos(theta2) + sint2=dsin(theta2) + jjj=0 !d print *,((temp(l,k),l=1,3),k=1,2) do j=1,2 - xp=temp(1,j) - yp=temp(2,j) - xxp= xp*cost2+yp*sint2 - yyp=-xp*sint2+yp*cost2 - zzp=temp(3,j) - xx(1)=xxp - xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1) - xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1) - do k=1,3 - dj=0.0D0 - do l=1,3 - dj=dj+prod(k,l,i-1)*xx(l) + xp=temp(1,j) + yp=temp(2,j) + xxp= xp*cost2+yp*sint2 + yyp=-xp*sint2+yp*cost2 + zzp=temp(3,j) + xx(1)=xxp + xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1) + xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1) + do k=1,3 + dj=0.0D0 + do l=1,3 + dj=dj+prod(k,l,i-1)*xx(l) enddo - dxds(jjj+k,i)=dj + dxds(jjj+k,i)=dj enddo - jjj=jjj+3 - enddo + jjj=jjj+3 + enddo enddo return end subroutine cartder @@ -9914,39 +11603,39 @@ ! Check the gradient of the virtual-bond and SC vectors in the internal ! coordinates. ! - aincr=1.0d-7 - aincr2=5.0d-8 + aincr=1.0d-6 + aincr2=5.0d-7 call cartder write (iout,'(a)') '**************** dx/dalpha' write (iout,'(a)') do i=2,nres-1 - alphi=alph(i) - alph(i)=alph(i)+aincr - do k=1,3 - temp(k,i)=dc(k,nres+i) + alphi=alph(i) + alph(i)=alph(i)+aincr + do k=1,3 + temp(k,i)=dc(k,nres+i) enddo - call chainbuild - do k=1,3 - gg(k)=(dc(k,nres+i)-temp(k,i))/aincr - xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr)) + call chainbuild + do k=1,3 + gg(k)=(dc(k,nres+i)-temp(k,i))/aincr + xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr)) enddo write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') & i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3) write (iout,'(a)') - alph(i)=alphi - call chainbuild + alph(i)=alphi + call chainbuild enddo write (iout,'(a)') write (iout,'(a)') '**************** dx/domega' write (iout,'(a)') do i=2,nres-1 - omegi=omeg(i) - omeg(i)=omeg(i)+aincr - do k=1,3 - temp(k,i)=dc(k,nres+i) + omegi=omeg(i) + omeg(i)=omeg(i)+aincr + do k=1,3 + temp(k,i)=dc(k,nres+i) enddo - call chainbuild - do k=1,3 + call chainbuild + do k=1,3 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr xx(k)=dabs((gg(k)-dxds(k+3,i))/ & (aincr*dabs(dxds(k+3,i))+aincr)) @@ -9954,14 +11643,14 @@ write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') & i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3) write (iout,'(a)') - omeg(i)=omegi - call chainbuild + omeg(i)=omegi + call chainbuild enddo write (iout,'(a)') write (iout,'(a)') '**************** dx/dtheta' write (iout,'(a)') do i=3,nres - theti=theta(i) + theti=theta(i) theta(i)=theta(i)+aincr do j=i-1,nres-1 do k=1,3 @@ -9970,11 +11659,11 @@ enddo call chainbuild do j=i-1,nres-1 - ii = indmat(i-2,j) + ii = indmat(i-2,j) ! print *,'i=',i-2,' j=',j-1,' ii=',ii - do k=1,3 - gg(k)=(dc(k,nres+j)-temp(k,j))/aincr - xx(k)=dabs((gg(k)-dxdv(k,ii))/ & + do k=1,3 + gg(k)=(dc(k,nres+j)-temp(k,j))/aincr + xx(k)=dabs((gg(k)-dxdv(k,ii))/ & (aincr*dabs(dxdv(k,ii))+aincr)) enddo write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') & @@ -9996,10 +11685,10 @@ enddo call chainbuild do j=i-1,nres-1 - ii = indmat(i-2,j) + ii = indmat(i-2,j) ! print *,'ii=',ii - do k=1,3 - gg(k)=(dc(k,nres+j)-temp(k,j))/aincr + do k=1,3 + gg(k)=(dc(k,nres+j)-temp(k,j))/aincr xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ & (aincr*dabs(dxdv(k+3,ii))+aincr)) enddo @@ -10021,16 +11710,16 @@ enddo call chainbuild do j=i+1,nres-1 - ii = indmat(i,j) + ii = indmat(i,j) ! print *,'ii=',ii - do k=1,3 - gg(k)=(dc(k,j)-temp(k,j))/aincr - xx(k)=dabs((gg(k)-dcdv(k,ii))/ & + do k=1,3 + gg(k)=(dc(k,j)-temp(k,j))/aincr + xx(k)=dabs((gg(k)-dcdv(k,ii))/ & (aincr*dabs(dcdv(k,ii))+aincr)) enddo write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') & i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3) - write (iout,'(a)') + write (iout,'(a)') enddo do j=1,nres do k=1,3 @@ -10050,16 +11739,16 @@ enddo call chainbuild do j=i+2,nres-1 - ii = indmat(i+1,j) + ii = indmat(i+1,j) ! print *,'ii=',ii - do k=1,3 - gg(k)=(dc(k,j)-temp(k,j))/aincr + do k=1,3 + gg(k)=(dc(k,j)-temp(k,j))/aincr xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ & (aincr*dabs(dcdv(k+3,ii))+aincr)) enddo write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') & i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3) - write (iout,'(a)') + write (iout,'(a)') enddo do j=1,nres do k=1,3 @@ -10097,8 +11786,8 @@ nf=0 nfl=0 call zerograd - aincr=1.0D-7 - print '(a)','CG processor',me,' calling CHECK_CART.' + aincr=1.0D-5 + print '(a)','CG processor',me,' calling CHECK_CART.',aincr nf=0 icall=0 call geom_to_var(nvar,x) @@ -10111,48 +11800,51 @@ write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3) enddo do i=1,nres - do j=1,3 - grad_s(j,i)=gradc(j,i,icg) - grad_s(j+3,i)=gradx(j,i,icg) + do j=1,3 + grad_s(j,i)=gradc(j,i,icg) + grad_s(j+3,i)=gradx(j,i,icg) enddo enddo call flush(iout) write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors' do i=1,nres do j=1,3 - xx(j)=c(j,i+nres) - ddc(j)=dc(j,i) - ddx(j)=dc(j,i+nres) + xx(j)=c(j,i+nres) + ddc(j)=dc(j,i) + ddx(j)=dc(j,i+nres) enddo - do j=1,3 - dc(j,i)=dc(j,i)+aincr - do k=i+1,nres - c(j,k)=c(j,k)+aincr - c(j,k+nres)=c(j,k+nres)+aincr + do j=1,3 + dc(j,i)=dc(j,i)+aincr + do k=i+1,nres + c(j,k)=c(j,k)+aincr + c(j,k+nres)=c(j,k+nres)+aincr enddo + call zerograd call etotal(energia1) etot1=energia1(0) - ggg(j)=(etot1-etot)/aincr - dc(j,i)=ddc(j) - do k=i+1,nres - c(j,k)=c(j,k)-aincr - c(j,k+nres)=c(j,k+nres)-aincr + ggg(j)=(etot1-etot)/aincr + dc(j,i)=ddc(j) + do k=i+1,nres + c(j,k)=c(j,k)-aincr + c(j,k+nres)=c(j,k+nres)-aincr enddo enddo - do j=1,3 - c(j,i+nres)=c(j,i+nres)+aincr - dc(j,i+nres)=dc(j,i+nres)+aincr + do j=1,3 + c(j,i+nres)=c(j,i+nres)+aincr + dc(j,i+nres)=dc(j,i+nres)+aincr + call zerograd call etotal(energia1) etot1=energia1(0) - ggg(j+3)=(etot1-etot)/aincr - c(j,i+nres)=xx(j) - dc(j,i+nres)=ddx(j) + ggg(j+3)=(etot1-etot)/aincr + c(j,i+nres)=xx(j) + dc(j,i+nres)=ddx(j) enddo - write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') & + write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') & i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6) enddo return end subroutine check_ecart +#ifdef CARGRAD !----------------------------------------------------------------------------- subroutine check_ecartint ! Check the gradient of the energy in Cartesian coordinates. @@ -10172,9 +11864,9 @@ !el integer :: icall !el common /srutu/ icall real(kind=8),dimension(6) :: ggg,ggg1 - real(kind=8),dimension(3) :: cc,xx,ddc,ddx + real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres) - real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe + real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres) real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres) real(kind=8),dimension(0:n_ene) :: energia,energia1 @@ -10193,25 +11885,18 @@ ! call intcartderiv ! call checkintcartgrad call zerograd - aincr=1.0D-5 + aincr=1.0D-4 write(iout,*) 'Calling CHECK_ECARTINT.' nf=0 icall=0 call geom_to_var(nvar,x) + write (iout,*) "split_ene ",split_ene + call flush(iout) if (.not.split_ene) then -write(iout,*) 'Calling CHECK_ECARTINT if' + call zerograd call etotal(energia) -!elwrite(iout,*) 'Calling CHECK_ECARTINT if' etot=energia(0) -!el call enerprint(energia) -!elwrite(iout,*) 'Calling CHECK_ECARTINT if' - call flush(iout) - write (iout,*) "enter cartgrad" - call flush(iout) call cartgrad -!elwrite(iout,*) 'Calling CHECK_ECARTINT if' - write (iout,*) "exit cartgrad" - call flush(iout) icall =1 do i=1,nres write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3) @@ -10219,7 +11904,6 @@ write(iout,*) 'Calling CHECK_ECARTINT if' do j=1,3 grad_s(j,0)=gcart(j,0) enddo -!elwrite(iout,*) 'Calling CHECK_ECARTINT if' do i=1,nres do j=1,3 grad_s(j,i)=gcart(j,i) @@ -10227,19 +11911,12 @@ write(iout,*) 'Calling CHECK_ECARTINT if' enddo enddo else -write(iout,*) 'Calling CHECK_ECARTIN else.' !- split gradient check call zerograd call etotal_long(energia) !el call enerprint(energia) - call flush(iout) - write (iout,*) "enter cartgrad" - call flush(iout) call cartgrad - write (iout,*) "exit cartgrad" - call flush(iout) icall =1 - write (iout,*) "longrange grad" do i=1,nres write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),& (gxcart(j,i),j=1,3) @@ -10255,15 +11932,9 @@ write(iout,*) 'Calling CHECK_ECARTIN else.' enddo call zerograd call etotal_short(energia) -!el call enerprint(energia) - call flush(iout) - write (iout,*) "enter cartgrad" - call flush(iout) + call enerprint(energia) call cartgrad - write (iout,*) "exit cartgrad" - call flush(iout) icall =1 - write (iout,*) "shortrange grad" do i=1,nres write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),& (gxcart(j,i),j=1,3) @@ -10279,72 +11950,80 @@ write(iout,*) 'Calling CHECK_ECARTIN else.' enddo endif write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors' - do i=0,nres +! do i=1,nres + do i=nnt,nct do j=1,3 - xx(j)=c(j,i+nres) - ddc(j)=dc(j,i) - ddx(j)=dc(j,i+nres) - do k=1,3 - dcnorm_safe(k)=dc_norm(k,i) - dxnorm_safe(k)=dc_norm(k,i+nres) - enddo + if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1) + if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres) + ddc(j)=c(j,i) + ddx(j)=c(j,i+nres) + dcnorm_safe1(j)=dc_norm(j,i-1) + dcnorm_safe2(j)=dc_norm(j,i) + dxnorm_safe(j)=dc_norm(j,i+nres) enddo - do j=1,3 - dc(j,i)=ddc(j)+aincr - call chainbuild_cart -#ifdef MPI -! Broadcast the order to compute internal coordinates to the slaves. -! if (nfgtasks.gt.1) -! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR) -#endif -! call int_from_cart1(.false.) + do j=1,3 + c(j,i)=ddc(j)+aincr + if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr + if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr + if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1) + dc(j,i)=c(j,i+1)-c(j,i) + dc(j,i+nres)=c(j,i+nres)-c(j,i) + call int_from_cart1(.false.) if (.not.split_ene) then + call zerograd call etotal(energia1) etot1=energia1(0) + write (iout,*) "ij",i,j," etot1",etot1 else !- split gradient call etotal_long(energia1) etot11=energia1(0) call etotal_short(energia1) etot12=energia1(0) -! write (iout,*) "etot11",etot11," etot12",etot12 endif !- end split gradient ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1 - dc(j,i)=ddc(j)-aincr - call chainbuild_cart -! call int_from_cart1(.false.) + c(j,i)=ddc(j)-aincr + if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr + if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr + if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1) + dc(j,i)=c(j,i+1)-c(j,i) + dc(j,i+nres)=c(j,i+nres)-c(j,i) + call int_from_cart1(.false.) if (.not.split_ene) then + call zerograd call etotal(energia1) etot2=energia1(0) - ggg(j)=(etot1-etot2)/(2*aincr) + write (iout,*) "ij",i,j," etot2",etot2 + ggg(j)=(etot1-etot2)/(2*aincr) else !- split gradient call etotal_long(energia1) etot21=energia1(0) - ggg(j)=(etot11-etot21)/(2*aincr) + ggg(j)=(etot11-etot21)/(2*aincr) call etotal_short(energia1) etot22=energia1(0) - ggg1(j)=(etot12-etot22)/(2*aincr) + ggg1(j)=(etot12-etot22)/(2*aincr) !- end split gradient ! write (iout,*) "etot21",etot21," etot22",etot22 endif ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2 - dc(j,i)=ddc(j) - call chainbuild_cart + c(j,i)=ddc(j) + if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j) + if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j) + if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1) + dc(j,i)=c(j,i+1)-c(j,i) + dc(j,i+nres)=c(j,i+nres)-c(j,i) + dc_norm(j,i-1)=dcnorm_safe1(j) + dc_norm(j,i)=dcnorm_safe2(j) + dc_norm(j,i+nres)=dxnorm_safe(j) enddo - do j=1,3 - dc(j,i+nres)=ddx(j)+aincr - call chainbuild_cart -! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm" -! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3) -! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3) -! write (iout,*) "dxnormnorm",dsqrt( -! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2) -! write (iout,*) "dxnormnormsafe",dsqrt( -! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2) -! write (iout,*) + do j=1,3 + c(j,i+nres)=ddx(j)+aincr + dc(j,i+nres)=c(j,i+nres)-c(j,i) + call int_from_cart1(.false.) if (.not.split_ene) then + call zerograd call etotal(energia1) etot1=energia1(0) else @@ -10355,36 +12034,31 @@ write(iout,*) 'Calling CHECK_ECARTIN else.' etot12=energia1(0) endif !- end split gradient -! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1 - dc(j,i+nres)=ddx(j)-aincr - call chainbuild_cart -! write (iout,*) "i",i," j",j," dxnorm- and dxnorm" -! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3) -! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3) -! write (iout,*) -! write (iout,*) "dxnormnorm",dsqrt( -! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2) -! write (iout,*) "dxnormnormsafe",dsqrt( -! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2) + c(j,i+nres)=ddx(j)-aincr + dc(j,i+nres)=c(j,i+nres)-c(j,i) + call int_from_cart1(.false.) if (.not.split_ene) then - call etotal(energia1) + call zerograd + call etotal(energia1) etot2=energia1(0) - ggg(j+3)=(etot1-etot2)/(2*aincr) + ggg(j+3)=(etot1-etot2)/(2*aincr) else !- split gradient call etotal_long(energia1) etot21=energia1(0) - ggg(j+3)=(etot11-etot21)/(2*aincr) + ggg(j+3)=(etot11-etot21)/(2*aincr) call etotal_short(energia1) etot22=energia1(0) - ggg1(j+3)=(etot12-etot22)/(2*aincr) + ggg1(j+3)=(etot12-etot22)/(2*aincr) !- end split gradient endif ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2 - dc(j,i+nres)=ddx(j) - call chainbuild_cart + c(j,i+nres)=ddx(j) + dc(j,i+nres)=c(j,i+nres)-c(j,i) + dc_norm(j,i+nres)=dxnorm_safe(j) + call int_from_cart1(.false.) enddo - write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') & + write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') & i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6) if (split_ene) then write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') & @@ -10397,22 +12071,254 @@ write(iout,*) 'Calling CHECK_ECARTIN else.' enddo return end subroutine check_ecartint +#else !----------------------------------------------------------------------------- - subroutine check_eint -! Check the gradient of energy in internal coordinates. + subroutine check_ecartint +! Check the gradient of the energy in Cartesian coordinates. + use io_base, only: intout ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' +! include 'COMMON.CONTROL' ! include 'COMMON.CHAIN' ! include 'COMMON.DERIV' ! include 'COMMON.IOUNITS' ! include 'COMMON.VAR' -! include 'COMMON.GEO' +! include 'COMMON.CONTACTS' +! include 'COMMON.MD' +! include 'COMMON.LOCAL' +! include 'COMMON.SPLITELE' use comm_srutu !el integer :: icall !el common /srutu/ icall - real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres) - integer :: uiparm(1) - real(kind=8) :: urparm(1) + real(kind=8),dimension(6) :: ggg,ggg1 + real(kind=8),dimension(3) :: cc,xx,ddc,ddx + real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres) + real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe + real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres) + real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres) + real(kind=8),dimension(0:n_ene) :: energia,energia1 + integer :: uiparm(1) + real(kind=8) :: urparm(1) +!EL external fdum + integer :: i,j,k,nf + real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,& + etot21,etot22 + r_cut=2.0d0 + rlambd=0.3d0 + icg=1 + nf=0 + nfl=0 + call intout +! call intcartderiv +! call checkintcartgrad + call zerograd + aincr=2.0D-5 + write(iout,*) 'Calling CHECK_ECARTINT.',aincr + nf=0 + icall=0 + call geom_to_var(nvar,x) + if (.not.split_ene) then + call etotal(energia) + etot=energia(0) +!el call enerprint(energia) + call cartgrad + icall =1 + do i=1,nres + write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3) + enddo + do j=1,3 + grad_s(j,0)=gcart(j,0) + enddo + do i=1,nres + do j=1,3 + grad_s(j,i)=gcart(j,i) +! if (i.eq.21) print *,"PRZEKAZANIE",gcart(j,i) + +! if (i.le.2) print *,"tu?!",gcart(j,i),grad_s(j,i),gxcart(j,i) + grad_s(j+3,i)=gxcart(j,i) + enddo + enddo + else +!- split gradient check + call zerograd + call etotal_long(energia) +!el call enerprint(energia) + call cartgrad + icall =1 + do i=1,nres + write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),& + (gxcart(j,i),j=1,3) + enddo + do j=1,3 + grad_s(j,0)=gcart(j,0) + enddo + do i=1,nres + do j=1,3 + grad_s(j,i)=gcart(j,i) +! if (i.eq.21) print *,"PRZEKAZANIE",gcart(j,i) + grad_s(j+3,i)=gxcart(j,i) + enddo + enddo + call zerograd + call etotal_short(energia) +!el call enerprint(energia) + call cartgrad + icall =1 + do i=1,nres + write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),& + (gxcart(j,i),j=1,3) + enddo + do j=1,3 + grad_s1(j,0)=gcart(j,0) + enddo + do i=1,nres + do j=1,3 + grad_s1(j,i)=gcart(j,i) + grad_s1(j+3,i)=gxcart(j,i) + enddo + enddo + endif + write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors' + do i=0,nres + do j=1,3 + xx(j)=c(j,i+nres) + ddc(j)=dc(j,i) + ddx(j)=dc(j,i+nres) + do k=1,3 + dcnorm_safe(k)=dc_norm(k,i) + dxnorm_safe(k)=dc_norm(k,i+nres) + enddo + enddo + do j=1,3 + dc(j,i)=ddc(j)+aincr + call chainbuild_cart +#ifdef MPI +! Broadcast the order to compute internal coordinates to the slaves. +! if (nfgtasks.gt.1) +! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR) +#endif +! call int_from_cart1(.false.) + if (.not.split_ene) then + call zerograd + call etotal(energia1) + etot1=energia1(0) +! call enerprint(energia1) + else +!- split gradient + call etotal_long(energia1) + etot11=energia1(0) + call etotal_short(energia1) + etot12=energia1(0) +! write (iout,*) "etot11",etot11," etot12",etot12 + endif +!- end split gradient +! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1 + dc(j,i)=ddc(j)-aincr + call chainbuild_cart +! call int_from_cart1(.false.) + if (.not.split_ene) then + call zerograd + call etotal(energia1) + etot2=energia1(0) + ggg(j)=(etot1-etot2)/(2*aincr) + else +!- split gradient + call etotal_long(energia1) + etot21=energia1(0) + ggg(j)=(etot11-etot21)/(2*aincr) + call etotal_short(energia1) + etot22=energia1(0) + ggg1(j)=(etot12-etot22)/(2*aincr) +!- end split gradient +! write (iout,*) "etot21",etot21," etot22",etot22 + endif +! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2 + dc(j,i)=ddc(j) + call chainbuild_cart + enddo + do j=1,3 + dc(j,i+nres)=ddx(j)+aincr + call chainbuild_cart +! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm" +! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3) +! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3) +! write (iout,*) "dxnormnorm",dsqrt( +! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2) +! write (iout,*) "dxnormnormsafe",dsqrt( +! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2) +! write (iout,*) + if (.not.split_ene) then + call zerograd + call etotal(energia1) + etot1=energia1(0) + else +!- split gradient + call etotal_long(energia1) + etot11=energia1(0) + call etotal_short(energia1) + etot12=energia1(0) + endif +!- end split gradient +! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1 + dc(j,i+nres)=ddx(j)-aincr + call chainbuild_cart +! write (iout,*) "i",i," j",j," dxnorm- and dxnorm" +! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3) +! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3) +! write (iout,*) +! write (iout,*) "dxnormnorm",dsqrt( +! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2) +! write (iout,*) "dxnormnormsafe",dsqrt( +! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2) + if (.not.split_ene) then + call zerograd + call etotal(energia1) + etot2=energia1(0) + ggg(j+3)=(etot1-etot2)/(2*aincr) + else +!- split gradient + call etotal_long(energia1) + etot21=energia1(0) + ggg(j+3)=(etot11-etot21)/(2*aincr) + call etotal_short(energia1) + etot22=energia1(0) + ggg1(j+3)=(etot12-etot22)/(2*aincr) +!- end split gradient + endif +! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2 + dc(j,i+nres)=ddx(j) + call chainbuild_cart + enddo + write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') & + i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6) + if (split_ene) then + write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') & + i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),& + k=1,6) + write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') & + i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),& + ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6) + endif + enddo + return + end subroutine check_ecartint +#endif +!----------------------------------------------------------------------------- + subroutine check_eint +! Check the gradient of energy in internal coordinates. +! implicit real*8 (a-h,o-z) +! include 'DIMENSIONS' +! include 'COMMON.CHAIN' +! include 'COMMON.DERIV' +! include 'COMMON.IOUNITS' +! include 'COMMON.VAR' +! include 'COMMON.GEO' + use comm_srutu +!el integer :: icall +!el common /srutu/ icall + real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres) + integer :: uiparm(1) + real(kind=8) :: urparm(1) real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2 character(len=6) :: key !EL external fdum @@ -10421,20 +12327,18 @@ write(iout,*) 'Calling CHECK_ECARTIN else.' call zerograd aincr=1.0D-7 print '(a)','Calling CHECK_INT.' -write(iout,*) 'Calling CHECK_INT.' nf=0 nfl=0 icg=1 call geom_to_var(nvar,x) call var_to_geom(nvar,x) call chainbuild -write(iout,*) 'Calling CHECK_INT.' icall=1 - print *,'ICG=',ICG +! print *,'ICG=',ICG call etotal(energia) etot = energia(0) !el call enerprint(energia) - print *,'ICG=',ICG +! print *,'ICG=',ICG #ifdef MPL if (MyID.ne.BossID) then call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID) @@ -10447,7 +12351,7 @@ write(iout,*) 'Calling CHECK_INT.' nfl=3 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar) call gradient(nvar,x,nf,gana,uiparm,urparm,fdum) - write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp +!d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp icall=1 do i=1,nvar xi=x(i) @@ -10485,7 +12389,6 @@ write(iout,*) 'Calling CHECK_INT.' i,key,ii,gg(i),gana(i),& 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr) enddo -write(iout,*) "jestesmy sobie w check eint!!" return end subroutine check_eint !----------------------------------------------------------------------------- @@ -10606,6 +12509,61 @@ write(iout,*) "jestesmy sobie w check eint!!" endif return end function sscale + real(kind=8) function sscale_grad(r) +! include "COMMON.SPLITELE" + real(kind=8) :: r,gamm + if(r.lt.r_cut-rlamb) then + sscale_grad=0.0d0 + else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then + gamm=(r-(r_cut-rlamb))/rlamb + sscale_grad=gamm*(6*gamm-6.0d0)/rlamb + else + sscale_grad=0d0 + endif + return + end function sscale_grad + +!!!!!!!!!! PBCSCALE + real(kind=8) function sscale_ele(r) +! include "COMMON.SPLITELE" + real(kind=8) :: r,gamm + if(r.lt.r_cut_ele-rlamb_ele) then + sscale_ele=1.0d0 + else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then + gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele + sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0) + else + sscale_ele=0d0 + endif + return + end function sscale_ele + + real(kind=8) function sscagrad_ele(r) + real(kind=8) :: r,gamm +! include "COMMON.SPLITELE" + if(r.lt.r_cut_ele-rlamb_ele) then + sscagrad_ele=0.0d0 + else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then + gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele + sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele + else + sscagrad_ele=0.0d0 + endif + return + end function sscagrad_ele + real(kind=8) function sscalelip(r) + real(kind=8) r,gamm + sscalelip=1.0d0+r*r*(2.0d0*r-3.0d0) + return + end function sscalelip +!C----------------------------------------------------------------------- + real(kind=8) function sscagradlip(r) + real(kind=8) r,gamm + sscagradlip=r*(6.0d0*r-6.0d0) + return + end function sscagradlip + +!!!!!!!!!!!!!!! !----------------------------------------------------------------------------- subroutine elj_long(evdw) ! @@ -10626,7 +12584,7 @@ write(iout,*) "jestesmy sobie w check eint!!" ! include 'COMMON.IOUNITS' ! include 'COMMON.CONTACTS' real(kind=8),parameter :: accur=1.0d-10 - real(kind=8),dimension(3) :: gg + real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj !el local variables integer :: i,iint,j,k,itypi,itypi1,itypj real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij @@ -10634,9 +12592,9 @@ write(iout,*) "jestesmy sobie w check eint!!" ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 do i=iatsc_s,iatsc_e - itypi=itype(i) + itypi=itype(i,1) if (itypi.eq.ntyp1) cycle - itypi1=itype(i+1) + itypi1=itype(i+1,1) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -10647,7 +12605,7 @@ write(iout,*) "jestesmy sobie w check eint!!" !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), !d & 'iend=',iend(i,iint) do j=istart(i,iint),iend(i,iint) - itypj=itype(j) + itypj=itype(j,1) if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi @@ -10658,8 +12616,8 @@ write(iout,*) "jestesmy sobie w check eint!!" rrij=1.0D0/rij eps0ij=eps(itypi,itypj) fac=rrij**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa_aq(itypi,itypj) + e2=fac*bb_aq(itypi,itypj) evdwij=e1+e2 evdw=evdw+(1.0d0-sss)*evdwij ! @@ -10716,7 +12674,7 @@ write(iout,*) "jestesmy sobie w check eint!!" ! include 'COMMON.IOUNITS' ! include 'COMMON.CONTACTS' real(kind=8),parameter :: accur=1.0d-10 - real(kind=8),dimension(3) :: gg + real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj !el local variables integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij @@ -10724,9 +12682,9 @@ write(iout,*) "jestesmy sobie w check eint!!" ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 do i=iatsc_s,iatsc_e - itypi=itype(i) + itypi=itype(i,1) if (itypi.eq.ntyp1) cycle - itypi1=itype(i+1) + itypi1=itype(i+1,1) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -10739,7 +12697,7 @@ write(iout,*) "jestesmy sobie w check eint!!" !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint), !d & 'iend=',iend(i,iint) do j=istart(i,iint),iend(i,iint) - itypj=itype(j) + itypj=itype(j,1) if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi @@ -10751,8 +12709,8 @@ write(iout,*) "jestesmy sobie w check eint!!" rrij=1.0D0/rij eps0ij=eps(itypi,itypj) fac=rrij**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa_aq(itypi,itypj) + e2=fac*bb_aq(itypi,itypj) evdwij=e1+e2 evdw=evdw+sss*evdwij ! @@ -10805,7 +12763,7 @@ write(iout,*) "jestesmy sobie w check eint!!" ! include 'COMMON.INTERACT' ! include 'COMMON.IOUNITS' ! include 'COMMON.NAMES' - real(kind=8),dimension(3) :: gg + real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj logical :: scheck !el local variables integer :: i,iint,j,k,itypi,itypi1,itypj @@ -10814,9 +12772,9 @@ write(iout,*) "jestesmy sobie w check eint!!" ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 do i=iatsc_s,iatsc_e - itypi=itype(i) + itypi=itype(i,1) if (itypi.eq.ntyp1) cycle - itypi1=itype(i+1) + itypi1=itype(i+1,1) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -10825,7 +12783,7 @@ write(iout,*) "jestesmy sobie w check eint!!" ! do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) - itypj=itype(j) + itypj=itype(j,1) if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi @@ -10839,13 +12797,13 @@ write(iout,*) "jestesmy sobie w check eint!!" 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) + e1=fac*fac*aa_aq(itypi,itypj) + e2=fac*bb_aq(itypi,itypj) evdwij=e_augm+e1+e2 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj) !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)') -!d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), +!d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj), !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm, !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij, !d & (c(k,i),k=1,3),(c(k,j),k=1,3) @@ -10892,7 +12850,7 @@ write(iout,*) "jestesmy sobie w check eint!!" ! include 'COMMON.INTERACT' ! include 'COMMON.IOUNITS' ! include 'COMMON.NAMES' - real(kind=8),dimension(3) :: gg + real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj logical :: scheck !el local variables integer :: i,iint,j,k,itypi,itypi1,itypj @@ -10901,9 +12859,9 @@ write(iout,*) "jestesmy sobie w check eint!!" ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 do i=iatsc_s,iatsc_e - itypi=itype(i) + itypi=itype(i,1) if (itypi.eq.ntyp1) cycle - itypi1=itype(i+1) + itypi1=itype(i+1,1) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -10912,7 +12870,7 @@ write(iout,*) "jestesmy sobie w check eint!!" ! do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) - itypj=itype(j) + itypj=itype(j,1) if (itypj.eq.ntyp1) cycle xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi @@ -10926,13 +12884,13 @@ write(iout,*) "jestesmy sobie w check eint!!" 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) + e1=fac*fac*aa_aq(itypi,itypj) + e2=fac*bb_aq(itypi,itypj) evdwij=e_augm+e1+e2 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj) !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)') -!d & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj), +!d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj), !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm, !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij, !d & (c(k,i),k=1,3),(c(k,j),k=1,3) @@ -11000,9 +12958,9 @@ write(iout,*) "jestesmy sobie w check eint!!" ! endif !el ind=0 do i=iatsc_s,iatsc_e - itypi=itype(i) + itypi=itype(i,1) if (itypi.eq.ntyp1) cycle - itypi1=itype(i+1) + itypi1=itype(i+1,1) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -11017,7 +12975,7 @@ write(iout,*) "jestesmy sobie w check eint!!" do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) !el ind=ind+1 - itypj=itype(j) + itypj=itype(j,1) if (itypj.eq.ntyp1) cycle ! dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) @@ -11047,18 +13005,18 @@ write(iout,*) "jestesmy sobie w check eint!!" ! Calculate whole angle-dependent part of epsilon and contributions ! to its derivatives fac=(rrij*sigsq)**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa_aq(itypi,itypj) + e2=fac*bb_aq(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) + sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0) + epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj) !d write (iout,'(2(a3,i3,2x),15(0pf7.3))') -!d & restyp(itypi),i,restyp(itypj),j, +!d & restyp(itypi,1),i,restyp(itypj,1),j, !d & epsi,sigm,chi1,chi2,chip1,chip2, !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq), !d & om1,om2,om12,1.0D0/dsqrt(rrij), @@ -11120,9 +13078,9 @@ write(iout,*) "jestesmy sobie w check eint!!" ! endif !el ind=0 do i=iatsc_s,iatsc_e - itypi=itype(i) + itypi=itype(i,1) if (itypi.eq.ntyp1) cycle - itypi1=itype(i+1) + itypi1=itype(i+1,1) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -11137,7 +13095,7 @@ write(iout,*) "jestesmy sobie w check eint!!" do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) !el ind=ind+1 - itypj=itype(j) + itypj=itype(j,1) if (itypj.eq.ntyp1) cycle ! dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) @@ -11167,18 +13125,18 @@ write(iout,*) "jestesmy sobie w check eint!!" ! Calculate whole angle-dependent part of epsilon and contributions ! to its derivatives fac=(rrij*sigsq)**expon2 - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa_aq(itypi,itypj) + e2=fac*bb_aq(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) + sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0) + epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj) !d write (iout,'(2(a3,i3,2x),15(0pf7.3))') -!d & restyp(itypi),i,restyp(itypj),j, +!d & restyp(itypi,1),i,restyp(itypj,1),j, !d & epsi,sigm,chi1,chi2,chip1,chip2, !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq), !d & om1,om2,om12,1.0D0/dsqrt(rrij), @@ -11224,9 +13182,14 @@ write(iout,*) "jestesmy sobie w check eint!!" ! include 'COMMON.CONTROL' logical :: lprn !el local variables - integer :: iint,itypi,itypi1,itypj + integer :: iint,itypi,itypi1,itypj,subchap real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift - real(kind=8) :: sss,e1,e2,evdw + real(kind=8) :: sss,e1,e2,evdw,sss_grad + real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,& + dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,& + ssgradlipi,ssgradlipj + + evdw=0.0D0 !cccc energy_dec=.false. ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon @@ -11235,12 +13198,41 @@ write(iout,*) "jestesmy sobie w check eint!!" ! if (icall.eq.0) lprn=.false. !el ind=0 do i=iatsc_s,iatsc_e - itypi=itype(i) + itypi=itype(i,1) if (itypi.eq.ntyp1) cycle - itypi1=itype(i+1) + itypi1=itype(i+1,1) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize + if ((zi.gt.bordlipbot) & + .and.(zi.lt.bordliptop)) then +!C the energy transfer exist + if (zi.lt.buflipbot) then +!C what fraction I am in + fracinbuf=1.0d0- & + ((zi-bordlipbot)/lipbufthick) +!C lipbufthick is thickenes of lipid buffore + sslipi=sscalelip(fracinbuf) + ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick + elseif (zi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick) + sslipi=sscalelip(fracinbuf) + ssgradlipi=sscagradlip(fracinbuf)/lipbufthick + else + sslipi=1.0d0 + ssgradlipi=0.0 + endif + else + sslipi=0.0d0 + ssgradlipi=0.0 + endif + dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -11253,14 +13245,44 @@ write(iout,*) "jestesmy sobie w check eint!!" ! do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) + IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN +! call dyn_ssbond_ene(i,j,evdwij) +! evdw=evdw+evdwij +! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') & +! 'evdw',i,j,evdwij,' ss' +! if (energy_dec) write (iout,*) & +! 'evdw',i,j,evdwij,' ss' +! do k=j+1,iend(i,iint) +!C search over all next residues +! if (dyn_ss_mask(k)) then +!C check if they are cysteins +!C write(iout,*) 'k=',k + +!c write(iout,*) "PRZED TRI", evdwij +! evdwij_przed_tri=evdwij +! call triple_ssbond_ene(i,j,k,evdwij) +!c if(evdwij_przed_tri.ne.evdwij) then +!c write (iout,*) "TRI:", evdwij, evdwij_przed_tri +!c endif + +!c write(iout,*) "PO TRI", evdwij +!C call the energy function that removes the artifical triple disulfide +!C bond the soubroutine is located in ssMD.F +! evdw=evdw+evdwij + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') & + 'evdw',i,j,evdwij,'tss' +! endif!dyn_ss_mask(k) +! enddo! k + + ELSE !el ind=ind+1 - itypj=itype(j) + itypj=itype(j,1) if (itypj.eq.ntyp1) cycle ! dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, ! & 1.0d0/vbld(j+nres) -! write (iout,*) "i",i," j", j," itype",itype(i),itype(j) +! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1) sig0ij=sigma(itypi,itypj) chi1=chi(itypi,itypj) chi2=chi(itypj,itypi) @@ -11271,16 +13293,85 @@ write(iout,*) "jestesmy sobie w check eint!!" alf1=alp(itypi) alf2=alp(itypj) alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) +! Searching for nearest neighbour + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + if ((zj.gt.bordlipbot) & + .and.(zj.lt.bordliptop)) then +!C the energy transfer exist + if (zj.lt.buflipbot) then +!C what fraction I am in + fracinbuf=1.0d0- & + ((zj-bordlipbot)/lipbufthick) +!C lipbufthick is thickenes of lipid buffore + sslipj=sscalelip(fracinbuf) + ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick + elseif (zj.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick) + sslipj=sscalelip(fracinbuf) + ssgradlipj=sscagradlip(fracinbuf)/lipbufthick + else + sslipj=1.0d0 + ssgradlipj=0.0 + endif + else + sslipj=0.0d0 + ssgradlipj=0.0 + endif + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 & + +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 & + +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + 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))) - + sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj))) + sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj))) + sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj))) + if (sss_ele_cut.le.0.0) cycle if (sss.lt.1.0d0) then ! Calculate angle-dependent terms of energy and contributions to their @@ -11295,7 +13386,7 @@ write(iout,*) "jestesmy sobie w check eint!!" if (rij_shift.le.0.0D0) then evdw=1.0D20 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))') -!d & restyp(itypi),i,restyp(itypj),j, +!d & restyp(itypi,1),i,restyp(itypj,1),j, !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) return endif @@ -11303,20 +13394,20 @@ write(iout,*) "jestesmy sobie w check eint!!" !--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+evdwij*(1.0d0-sss) + evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) + sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0) + epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj) write (iout,'(2(a3,i3,2x),17(0pf7.3))') & - restyp(itypi),i,restyp(itypj),j,& + restyp(itypi,1),i,restyp(itypj,1),j,& epsi,sigm,chi1,chi2,chip1,chip2,& eps1,eps2rt**2,eps3rt**2,sig,sig0ij,& om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,& @@ -11325,12 +13416,17 @@ write(iout,*) "jestesmy sobie w check eint!!" if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') & 'evdw',i,j,evdwij +! if (energy_dec) write (iout,*) & +! 'evdw',i,j,evdwij,"egb_long" ! Calculate gradient components. e1=e1*eps1*eps2rt**2*eps3rt**2 fac=-expon*(e1+evdwij)*rij_shift sigder=fac*sigder fac=rij*fac + fac=fac+evdwij*(sss_ele_grad/sss_ele_cut& + /sigma(itypi,itypj)*rij-sss_grad/(1.0-sss)*rij & + /sigmaii(itypi,itypj)) ! fac=0.0d0 ! Calculate the radial part of the gradient gg(1)=xj*fac @@ -11338,6 +13434,7 @@ write(iout,*) "jestesmy sobie w check eint!!" gg(3)=zj*fac ! Calculate angular part of the gradient. call sc_grad_scale(1.0d0-sss) + ENDIF !mask_dyn_ss endif enddo ! j enddo ! iint @@ -11367,9 +13464,12 @@ write(iout,*) "jestesmy sobie w check eint!!" ! include 'COMMON.CONTROL' logical :: lprn !el local variables - integer :: iint,itypi,itypi1,itypj + integer :: iint,itypi,itypi1,itypj,subchap real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig - real(kind=8) :: sss,e1,e2,evdw,rij_shift + real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad + real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,& + dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,& + ssgradlipi,ssgradlipj evdw=0.0D0 !cccc energy_dec=.false. ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon @@ -11378,12 +13478,47 @@ write(iout,*) "jestesmy sobie w check eint!!" ! if (icall.eq.0) lprn=.false. !el ind=0 do i=iatsc_s,iatsc_e - itypi=itype(i) + itypi=itype(i,1) if (itypi.eq.ntyp1) cycle - itypi1=itype(i+1) + itypi1=itype(i+1,1) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize + if ((zi.gt.bordlipbot) & + .and.(zi.lt.bordliptop)) then +!C the energy transfer exist + if (zi.lt.buflipbot) then +!C what fraction I am in + fracinbuf=1.0d0- & + ((zi-bordlipbot)/lipbufthick) +!C lipbufthick is thickenes of lipid buffore + sslipi=sscalelip(fracinbuf) + ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick + elseif (zi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick) + sslipi=sscalelip(fracinbuf) + ssgradlipi=sscagradlip(fracinbuf)/lipbufthick + else + sslipi=1.0d0 + ssgradlipi=0.0 + endif + else + sslipi=0.0d0 + ssgradlipi=0.0 + endif + + dxi=dc_norm(1,nres+i) + dyi=dc_norm(2,nres+i) + dzi=dc_norm(3,nres+i) +! dsci_inv=dsc_inv(itypi) + dsci_inv=vbld_inv(i+nres) + dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -11396,14 +13531,44 @@ write(iout,*) "jestesmy sobie w check eint!!" ! do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) + IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN + call dyn_ssbond_ene(i,j,evdwij) + evdw=evdw+evdwij + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') & + 'evdw',i,j,evdwij,' ss' + do k=j+1,iend(i,iint) +!C search over all next residues + if (dyn_ss_mask(k)) then +!C check if they are cysteins +!C write(iout,*) 'k=',k + +!c write(iout,*) "PRZED TRI", evdwij +! evdwij_przed_tri=evdwij + call triple_ssbond_ene(i,j,k,evdwij) +!c if(evdwij_przed_tri.ne.evdwij) then +!c write (iout,*) "TRI:", evdwij, evdwij_przed_tri +!c endif + +!c write(iout,*) "PO TRI", evdwij +!C call the energy function that removes the artifical triple disulfide +!C bond the soubroutine is located in ssMD.F + evdw=evdw+evdwij + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') & + 'evdw',i,j,evdwij,'tss' + endif!dyn_ss_mask(k) + enddo! k + +! if (energy_dec) write (iout,*) & +! 'evdw',i,j,evdwij,' ss' + ELSE !el ind=ind+1 - itypj=itype(j) + itypj=itype(j,1) if (itypj.eq.ntyp1) cycle ! dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv, ! & 1.0d0/vbld(j+nres) -! write (iout,*) "i",i," j", j," itype",itype(i),itype(j) +! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1) sig0ij=sigma(itypi,itypj) chi1=chi(itypi,itypj) chi2=chi(itypj,itypi) @@ -11414,15 +13579,89 @@ write(iout,*) "jestesmy sobie w check eint!!" alf1=alp(itypi) alf2=alp(itypj) alf12=0.5D0*(alf1+alf2) - xj=c(1,nres+j)-xi - yj=c(2,nres+j)-yi - zj=c(3,nres+j)-zi +! xj=c(1,nres+j)-xi +! yj=c(2,nres+j)-yi +! zj=c(3,nres+j)-zi + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) +! Searching for nearest neighbour + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + if ((zj.gt.bordlipbot) & + .and.(zj.lt.bordliptop)) then +!C the energy transfer exist + if (zj.lt.buflipbot) then +!C what fraction I am in + fracinbuf=1.0d0- & + ((zj-bordlipbot)/lipbufthick) +!C lipbufthick is thickenes of lipid buffore + sslipj=sscalelip(fracinbuf) + ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick + elseif (zj.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick) + sslipj=sscalelip(fracinbuf) + ssgradlipj=sscagradlip(fracinbuf)/lipbufthick + else + sslipj=1.0d0 + ssgradlipj=0.0 + endif + else + sslipj=0.0d0 + ssgradlipj=0.0 + endif + aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 & + +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 & + +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0 + + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + 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))) + sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj))) + sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj))) + sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj))) + if (sss_ele_cut.le.0.0) cycle if (sss.gt.0.0d0) then @@ -11438,7 +13677,7 @@ write(iout,*) "jestesmy sobie w check eint!!" if (rij_shift.le.0.0D0) then evdw=1.0D20 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))') -!d & restyp(itypi),i,restyp(itypj),j, +!d & restyp(itypi,1),i,restyp(itypj,1),j, !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq) return endif @@ -11446,20 +13685,20 @@ write(iout,*) "jestesmy sobie w check eint!!" !--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa + e2=fac*bb evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt, ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2 evdwij=evdwij*eps2rt*eps3rt - evdw=evdw+evdwij*sss + evdw=evdw+evdwij*sss*sss_ele_cut if (lprn) then - sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) - epsi=bb(itypi,itypj)**2/aa(itypi,itypj) + sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0) + epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj) write (iout,'(2(a3,i3,2x),17(0pf7.3))') & - restyp(itypi),i,restyp(itypj),j,& + restyp(itypi,1),i,restyp(itypj,1),j,& epsi,sigm,chi1,chi2,chip1,chip2,& eps1,eps2rt**2,eps3rt**2,sig,sig0ij,& om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,& @@ -11468,12 +13707,18 @@ write(iout,*) "jestesmy sobie w check eint!!" if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') & 'evdw',i,j,evdwij +! if (energy_dec) write (iout,*) & +! 'evdw',i,j,evdwij,"egb_short" ! Calculate gradient components. e1=e1*eps1*eps2rt**2*eps3rt**2 fac=-expon*(e1+evdwij)*rij_shift sigder=fac*sigder fac=rij*fac + fac=fac+evdwij*(sss_ele_grad/sss_ele_cut& + /sigma(itypi,itypj)*rij+sss_grad/sss*rij & + /sigmaii(itypi,itypj)) + ! fac=0.0d0 ! Calculate the radial part of the gradient gg(1)=xj*fac @@ -11482,6 +13727,7 @@ write(iout,*) "jestesmy sobie w check eint!!" ! Calculate angular part of the gradient. call sc_grad_scale(sss) endif + ENDIF !mask_dyn_ss enddo ! j enddo ! iint enddo ! i @@ -11522,9 +13768,9 @@ write(iout,*) "jestesmy sobie w check eint!!" ! if (icall.eq.0) lprn=.true. !el ind=0 do i=iatsc_s,iatsc_e - itypi=itype(i) + itypi=itype(i,1) if (itypi.eq.ntyp1) cycle - itypi1=itype(i+1) + itypi1=itype(i+1,1) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -11539,7 +13785,7 @@ write(iout,*) "jestesmy sobie w check eint!!" do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) !el ind=ind+1 - itypj=itype(j) + itypj=itype(j,1) if (itypj.eq.ntyp1) cycle ! dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) @@ -11582,8 +13828,8 @@ write(iout,*) "jestesmy sobie w check eint!!" !--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa_aq(itypi,itypj) + e2=fac*bb_aq(itypi,itypj) evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt @@ -11592,10 +13838,10 @@ write(iout,*) "jestesmy sobie w check eint!!" 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) + sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0) + epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj) write (iout,'(2(a3,i3,2x),17(0pf7.3))') & - restyp(itypi),i,restyp(itypj),j,& + restyp(itypi,1),i,restyp(itypj,1),j,& epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),& chi1,chi2,chip1,chip2,& eps1,eps2rt**2,eps3rt**2,& @@ -11651,9 +13897,9 @@ write(iout,*) "jestesmy sobie w check eint!!" ! if (icall.eq.0) lprn=.true. !el ind=0 do i=iatsc_s,iatsc_e - itypi=itype(i) + itypi=itype(i,1) if (itypi.eq.ntyp1) cycle - itypi1=itype(i+1) + itypi1=itype(i+1,1) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) @@ -11668,7 +13914,7 @@ write(iout,*) "jestesmy sobie w check eint!!" do iint=1,nint_gr(i) do j=istart(i,iint),iend(i,iint) !el ind=ind+1 - itypj=itype(j) + itypj=itype(j,1) if (itypj.eq.ntyp1) cycle ! dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) @@ -11711,8 +13957,8 @@ write(iout,*) "jestesmy sobie w check eint!!" !--------------------------------------------------------------- rij_shift=1.0D0/rij_shift fac=rij_shift**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa_aq(itypi,itypj) + e2=fac*bb_aq(itypi,itypj) evdwij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=evdwij*eps3rt eps3der=evdwij*eps2rt @@ -11721,10 +13967,10 @@ write(iout,*) "jestesmy sobie w check eint!!" 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) + sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0) + epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj) write (iout,'(2(a3,i3,2x),17(0pf7.3))') & - restyp(itypi),i,restyp(itypj),j,& + restyp(itypi,1),i,restyp(itypj,1),j,& epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),& chi1,chi2,chip1,chip2,& eps1,eps2rt**2,eps3rt**2,& @@ -11833,7 +14079,9 @@ write(iout,*) "jestesmy sobie w check eint!!" #ifdef TIMING time01=MPI_Wtime() #endif +! print *, "before set matrices" call set_matrices +! print *,"after set martices" #ifdef TIMING time_mat=time_mat+MPI_Wtime()-time01 #endif @@ -11873,8 +14121,8 @@ write(iout,*) "jestesmy sobie w check eint!!" ! Loop over i,i+2 and i,i+3 pairs of the peptide groups ! do i=iturn3_start,iturn3_end - if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1 & - .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle + if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1 & + .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -11884,15 +14132,21 @@ write(iout,*) "jestesmy sobie w check eint!!" xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi + xmedi=dmod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=dmod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=dmod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize 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 - if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1 & - .or. itype(i+3).eq.ntyp1 & - .or. itype(i+4).eq.ntyp1) cycle + if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 & + .or. itype(i+3,1).eq.ntyp1 & + .or. itype(i+4,1).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -11902,9 +14156,15 @@ write(iout,*) "jestesmy sobie w check eint!!" xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi + xmedi=dmod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=dmod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=dmod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize num_conti=num_cont_hb(i) call eelecij_scale(i,i+3,ees,evdw1,eel_loc) - if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1) & + if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) & call eturn4(i,eello_turn4) num_cont_hb(i)=num_conti enddo ! i @@ -11912,7 +14172,7 @@ write(iout,*) "jestesmy sobie w check eint!!" ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 ! do i=iatel_s,iatel_e - if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle + if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -11922,10 +14182,16 @@ write(iout,*) "jestesmy sobie w check eint!!" xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi + xmedi=dmod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=dmod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=dmod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i) num_conti=num_cont_hb(i) do j=ielstart(i),ielend(i) - if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle + if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle call eelecij_scale(i,j,ees,evdw1,eel_loc) enddo ! j num_cont_hb(i)=num_conti @@ -11962,11 +14228,15 @@ write(iout,*) "jestesmy sobie w check eint!!" ! include 'COMMON.VECTORS' ! include 'COMMON.FFIELD' ! include 'COMMON.TIME1' - real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg + real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg real(kind=8),dimension(2,2) :: acipa !el,a_temp !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1 real(kind=8),dimension(4) :: muij + real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,& + dist_temp, dist_init,sss_grad + integer xshift,yshift,zshift + !el integer :: num_conti,j1,j2 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,& !el dz_normi,xmedi,ymedi,zmedi @@ -11985,7 +14255,7 @@ write(iout,*) "jestesmy sobie w check eint!!" 0.0d0,1.0d0,0.0d0,& 0.0d0,0.0d0,1.0d0/),shape(unmat)) !el local variables - integer :: i,j,k,l,iteli,itelj,kkk,kkll,m + integer :: i,j,k,l,iteli,itelj,kkk,kkll,m,isubchap real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij @@ -12013,8 +14283,8 @@ write(iout,*) "jestesmy sobie w check eint!!" ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres) ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres) -! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres) -! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres) +! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres) +! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres) #ifdef MPI time00=MPI_Wtime() @@ -12034,15 +14304,63 @@ write(iout,*) "jestesmy sobie w check eint!!" 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 +! xj=c(1,j)+0.5D0*dxj-xmedi +! yj=c(2,j)+0.5D0*dyj-ymedi +! zj=c(3,j)+0.5D0*dzj-zmedi + xj=c(1,j)+0.5D0*dxj + yj=c(2,j)+0.5D0*dyj + zj=c(3,j)+0.5D0*dzj + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + isubchap=0 + dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + isubchap=1 + endif + enddo + enddo + enddo + if (isubchap.eq.1) then +!C print *,i,j + xj=xj_temp-xmedi + yj=yj_temp-ymedi + zj=zj_temp-zmedi + else + xj=xj_safe-xmedi + yj=yj_safe-ymedi + zj=zj_safe-zmedi + endif + rij=xj*xj+yj*yj+zj*zj rrmij=1.0D0/rij rij=dsqrt(rij) rmij=1.0D0/rij ! For extracting the short-range part of Evdwpp sss=sscale(rij/rpp(iteli,itelj)) + sss_ele_cut=sscale_ele(rij) + sss_ele_grad=sscagrad_ele(rij) + sss_grad=sscale_grad((rij/rpp(iteli,itelj))) +! sss_ele_cut=1.0d0 +! sss_ele_grad=0.0d0 + if (sss_ele_cut.le.0.0) go to 128 r3ij=rrmij*rmij r6ij=r3ij*r3ij @@ -12062,8 +14380,8 @@ write(iout,*) "jestesmy sobie w check eint!!" eesij=el1+el2 ! 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) + ees=ees+eesij*sss_ele_cut + evdw1=evdw1+evdwij*(1.0d0-sss)*sss_ele_cut !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)') !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i, !d & 1.0D0/dsqrt(rrmij),evdwij,eesij, @@ -12078,8 +14396,8 @@ write(iout,*) "jestesmy sobie w check eint!!" ! Calculate contributions to the Cartesian gradient. ! #ifdef SPLITELE - facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss) - facel=-3*rrmij*(el1+eesij) + facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut + facel=-3*rrmij*(el1+eesij)*sss_ele_cut fac1=fac erij(1)=xj*rmij erij(2)=yj*rmij @@ -12087,9 +14405,9 @@ write(iout,*) "jestesmy sobie w check eint!!" ! ! Radial derivatives. First process both termini of the fragment (i,j) ! - ggg(1)=facel*xj - ggg(2)=facel*yj - ggg(3)=facel*zj + ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj + ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj + ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj ! do k=1,3 ! ghalf=0.5D0*ggg(k) ! gelc(k,i)=gelc(k,i)+ghalf @@ -12108,9 +14426,12 @@ write(iout,*) "jestesmy sobie w check eint!!" !grad gelc(l,k)=gelc(l,k)+ggg(l) !grad enddo !grad enddo - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj + ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*(1.0d0-sss) & + -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj + ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*(1.0d0-sss) & + -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj + ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*(1.0d0-sss) & + -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj ! do k=1,3 ! ghalf=0.5D0*ggg(k) ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf @@ -12130,8 +14451,8 @@ write(iout,*) "jestesmy sobie w check eint!!" !grad enddo !grad enddo #else - facvdw=ev1+evdwij*(1.0d0-sss) - facel=el1+eesij + facvdw=(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut + facel=(el1+eesij)*sss_ele_cut fac1=fac fac=-3*rrmij*(facvdw+facvdw+facel) erij(1)=xj*rmij @@ -12185,7 +14506,7 @@ write(iout,*) "jestesmy sobie w check eint!!" !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3), !d & (dcosg(k),k=1,3) do k=1,3 - ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k) + ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k) )*sss_ele_cut enddo ! do k=1,3 ! ghalf=0.5D0*ggg(k) @@ -12204,10 +14525,12 @@ write(iout,*) "jestesmy sobie w check eint!!" do k=1,3 gelc(k,i)=gelc(k,i) & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) & - + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) + + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)& + *sss_ele_cut gelc(k,j)=gelc(k,j) & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) & - + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) + + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)& + *sss_ele_cut gelc_long(k,j)=gelc_long(k,j)+ggg(k) gelc_long(k,i)=gelc_long(k,i)-ggg(k) enddo @@ -12252,7 +14575,7 @@ write(iout,*) "jestesmy sobie w check eint!!" a32=a32*fac a33=a33*fac !d write (iout,'(4i5,4f10.5)') -!d & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33 +!d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i), !d & uy(:,j),uz(:,j) @@ -12398,25 +14721,34 @@ write(iout,*) "jestesmy sobie w check eint!!" ! Contribution to the local-electrostatic energy coming from the i-j pair eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) & +a33*muij(4) -!d write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij - +! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij +! print *,"EELLOC",i,gel_loc_loc(i-1) if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') & 'eelloc',i,j,eel_loc_ij -! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) +! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d - eel_loc=eel_loc+eel_loc_ij + eel_loc=eel_loc+eel_loc_ij*sss_ele_cut ! Partial derivatives in virtual-bond dihedral angles gamma if (i.gt.1) & gel_loc_loc(i-1)=gel_loc_loc(i-1)+ & - a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) & - +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j) + (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) & + +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) & + *sss_ele_cut gel_loc_loc(j-1)=gel_loc_loc(j-1)+ & - a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) & - +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j) + (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) & + +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) & + *sss_ele_cut + xtemp(1)=xj + xtemp(2)=yj + xtemp(3)=zj + ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2) do l=1,3 - ggg(l)=agg(l,1)*muij(1)+ & - agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4) + ggg(l)=(agg(l,1)*muij(1)+ & + agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))& + *sss_ele_cut & + +eel_loc_ij*sss_ele_grad*rmij*xtemp(l) + gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l) gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l) !grad ghalf=0.5d0*ggg(l) @@ -12430,14 +14762,22 @@ write(iout,*) "jestesmy sobie w check eint!!" !grad enddo ! Remaining derivatives of eello do l=1,3 - gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+ & - aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4) - gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+ & - aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4) - gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+ & - aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4) - gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+ & - aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4) + gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ & + aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))& + *sss_ele_cut + + gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ & + aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))& + *sss_ele_cut + + gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ & + aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))& + *sss_ele_cut + + gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ & + aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))& + *sss_ele_cut + enddo ENDIF ! Change 12/26/95 to calculate four-body contributions to H-bonding energy @@ -12518,8 +14858,12 @@ write(iout,*) "jestesmy sobie w check eint!!" ees0mij=0 endif ! ees0mij=0.0D0 - ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) - ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) + ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) & + *sss_ele_cut + + ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) & + *sss_ele_cut + ! Diagnostics. Comment out or remove after debugging! ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij @@ -12567,12 +14911,28 @@ write(iout,*) "jestesmy sobie w check eint!!" gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k) gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k) enddo - gggp(1)=gggp(1)+ees0pijp*xj - gggp(2)=gggp(2)+ees0pijp*yj - gggp(3)=gggp(3)+ees0pijp*zj - gggm(1)=gggm(1)+ees0mijp*xj - gggm(2)=gggm(2)+ees0mijp*yj - gggm(3)=gggm(3)+ees0mijp*zj +! gggp(1)=gggp(1)+ees0pijp*xj +! gggp(2)=gggp(2)+ees0pijp*yj +! gggp(3)=gggp(3)+ees0pijp*zj +! gggm(1)=gggm(1)+ees0mijp*xj +! gggm(2)=gggm(2)+ees0mijp*yj +! gggm(3)=gggm(3)+ees0mijp*zj + gggp(1)=gggp(1)+ees0pijp*xj & + +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad + gggp(2)=gggp(2)+ees0pijp*yj & + +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad + gggp(3)=gggp(3)+ees0pijp*zj & + +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad + + gggm(1)=gggm(1)+ees0mijp*xj & + +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad + + gggm(2)=gggm(2)+ees0mijp*yj & + +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad + + gggm(3)=gggm(3)+ees0mijp*zj & + +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad + ! Derivatives due to the contact function gacont_hbr(1,num_conti,i)=fprimcont*xj gacont_hbr(2,num_conti,i)=fprimcont*yj @@ -12584,20 +14944,46 @@ write(iout,*) "jestesmy sobie w check eint!!" ! !grad ghalfp=0.5D0*gggp(k) !grad ghalfm=0.5D0*gggm(k) - gacontp_hb1(k,num_conti,i)= & !ghalfp - +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) & - + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gacontp_hb2(k,num_conti,i)= & !ghalfp - +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) & - + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) - gacontp_hb3(k,num_conti,i)=gggp(k) - gacontm_hb1(k,num_conti,i)= &!ghalfm - +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) & - + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) - gacontm_hb2(k,num_conti,i)= & !ghalfm - +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) & - + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) - gacontm_hb3(k,num_conti,i)=gggm(k) +! gacontp_hb1(k,num_conti,i)= & !ghalfp +! +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) & +! + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) +! gacontp_hb2(k,num_conti,i)= & !ghalfp +! +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) & +! + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) +! gacontp_hb3(k,num_conti,i)=gggp(k) +! gacontm_hb1(k,num_conti,i)= &!ghalfm +! +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) & +! + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) +! gacontm_hb2(k,num_conti,i)= & !ghalfm +! +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) & +! + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) +! gacontm_hb3(k,num_conti,i)=gggm(k) + gacontp_hb1(k,num_conti,i)= & !ghalfp+ + (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) & + + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) & + *sss_ele_cut + + gacontp_hb2(k,num_conti,i)= & !ghalfp+ + (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) & + + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)& + *sss_ele_cut + + gacontp_hb3(k,num_conti,i)=gggp(k) & + *sss_ele_cut + + gacontm_hb1(k,num_conti,i)= & !ghalfm+ + (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) & + + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) & + *sss_ele_cut + + gacontm_hb2(k,num_conti,i)= & !ghalfm+ + (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) & + + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) & + *sss_ele_cut + + gacontm_hb3(k,num_conti,i)=gggm(k) & + *sss_ele_cut + enddo ENDIF ! wcorr endif ! num_conti.le.maxconts @@ -12620,6 +15006,7 @@ write(iout,*) "jestesmy sobie w check eint!!" enddo endif endif + 128 continue ! t_eelecij=t_eelecij+MPI_Wtime()-time00 return end subroutine eelecij_scale @@ -12650,18 +15037,22 @@ write(iout,*) "jestesmy sobie w check eint!!" real(kind=8) :: scal_el=0.5d0 #endif !el local variables - integer :: i,j,k,iteli,itelj,num_conti + integer :: i,j,k,iteli,itelj,num_conti,isubchap real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,& dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,& dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw + real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,& + dist_temp, dist_init,sss_grad + integer xshift,yshift,zshift + evdw1=0.0D0 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw, ! & " iatel_e_vdw",iatel_e_vdw call flush(iout) do i=iatel_s_vdw,iatel_e_vdw - if (itype(i).eq.ntyp1.or. itype(i+1).eq.ntyp1) cycle + if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1) cycle dxi=dc(1,i) dyi=dc(2,i) dzi=dc(3,i) @@ -12671,12 +15062,18 @@ write(iout,*) "jestesmy sobie w check eint!!" xmedi=c(1,i)+0.5d0*dxi ymedi=c(2,i)+0.5d0*dyi zmedi=c(3,i)+0.5d0*dzi + xmedi=dmod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=dmod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=dmod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize num_conti=0 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i), ! & ' ielend',ielend_vdw(i) call flush(iout) do j=ielstart_vdw(i),ielend_vdw(i) - if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle + if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle !el ind=ind+1 iteli=itel(i) itelj=itel(j) @@ -12689,13 +15086,59 @@ write(iout,*) "jestesmy sobie w check eint!!" 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 +! xj=c(1,j)+0.5D0*dxj-xmedi +! yj=c(2,j)+0.5D0*dyj-ymedi +! zj=c(3,j)+0.5D0*dzj-zmedi + xj=c(1,j)+0.5D0*dxj + yj=c(2,j)+0.5D0*dyj + zj=c(3,j)+0.5D0*dzj + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + isubchap=0 + dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + isubchap=1 + endif + enddo + enddo + enddo + if (isubchap.eq.1) then +!C print *,i,j + xj=xj_temp-xmedi + yj=yj_temp-ymedi + zj=zj_temp-zmedi + else + xj=xj_safe-xmedi + yj=yj_safe-ymedi + zj=zj_safe-zmedi + endif + rij=xj*xj+yj*yj+zj*zj rrmij=1.0D0/rij rij=dsqrt(rij) sss=sscale(rij/rpp(iteli,itelj)) + sss_ele_cut=sscale_ele(rij) + sss_ele_grad=sscagrad_ele(rij) + sss_grad=sscale_grad((rij/rpp(iteli,itelj))) + if (sss_ele_cut.le.0.0) cycle if (sss.gt.0.0d0) then rmij=1.0D0/rij r3ij=rrmij*rmij @@ -12708,14 +15151,21 @@ write(iout,*) "jestesmy sobie w check eint!!" if (energy_dec) then write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss endif - evdw1=evdw1+evdwij*sss + evdw1=evdw1+evdwij*sss*sss_ele_cut ! ! Calculate contributions to the Cartesian gradient. ! - facvdw=-6*rrmij*(ev1+evdwij)*sss - ggg(1)=facvdw*xj - ggg(2)=facvdw*yj - ggg(3)=facvdw*zj + facvdw=-6*rrmij*(ev1+evdwij)*sss*sss_ele_cut +! ggg(1)=facvdw*xj +! ggg(2)=facvdw*yj +! ggg(3)=facvdw*zj + ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*sss & + +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj + ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*sss & + +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj + ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*sss & + +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj + do k=1,3 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k) gvdwpp(k,i)=gvdwpp(k,i)-ggg(k) @@ -12745,37 +15195,89 @@ write(iout,*) "jestesmy sobie w check eint!!" ! include 'COMMON.CONTROL' real(kind=8),dimension(3) :: ggg !el local variables - integer :: i,iint,j,k,iteli,itypj - real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2 + integer :: i,iint,j,k,iteli,itypj,subchap + real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij real(kind=8) :: evdw2,evdw2_14,evdwij + real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,& + dist_temp, dist_init + evdw2=0.0D0 evdw2_14=0.0d0 !d print '(a)','Enter ESCP' !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e do i=iatscp_s,iatscp_e - if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle + if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle iteli=itel(i) xi=0.5D0*(c(1,i)+c(1,i+1)) yi=0.5D0*(c(2,i)+c(2,i+1)) zi=0.5D0*(c(3,i)+c(3,i+1)) + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize do iint=1,nscp_gr(i) do j=iscpstart(i,iint),iscpend(i,iint) - itypj=itype(j) + itypj=itype(j,1) if (itypj.eq.ntyp1) cycle ! Uncomment following three lines for SC-p interactions ! xj=c(1,nres+j)-xi ! yj=c(2,nres+j)-yi ! zj=c(3,nres+j)-zi ! Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli))) - + rij=dsqrt(1.0d0/rrij) + sss_ele_cut=sscale_ele(rij) + sss_ele_grad=sscagrad_ele(rij) +! print *,sss_ele_cut,sss_ele_grad,& +! (rij),r_cut_ele,rlamb_ele + if (sss_ele_cut.le.0.0) cycle + sss=sscale((rij/rscp(itypj,iteli))) + sss_grad=sscale_grad(rij/rscp(itypj,iteli)) if (sss.lt.1.0d0) then fac=rrij**expon2 @@ -12784,16 +15286,18 @@ write(iout,*) "jestesmy sobie w check eint!!" if (iabs(j-i) .le. 2) then e1=scal14*e1 e2=scal14*e2 - evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss) + evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)*sss_ele_cut endif evdwij=e1+e2 - evdw2=evdw2+evdwij*(1.0d0-sss) + evdw2=evdw2+evdwij*(1.0d0-sss)*sss_ele_cut if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') & 'evdw2',i,j,sss,evdwij ! ! Calculate contributions to the gradient in the virtual-bond and SC vectors. ! - fac=-(evdwij+e1)*rrij*(1.0d0-sss) + fac=-(evdwij+e1)*rrij*(1.0d0-sss)*sss_ele_cut + fac=fac+evdwij*sss_ele_grad/rij/expon*(1.0d0-sss)& + -evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli) ggg(1)=xj*fac ggg(2)=yj*fac ggg(3)=zj*fac @@ -12850,37 +15354,92 @@ write(iout,*) "jestesmy sobie w check eint!!" ! include 'COMMON.CONTROL' real(kind=8),dimension(3) :: ggg !el local variables - integer :: i,iint,j,k,iteli,itypj - real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2 + integer :: i,iint,j,k,iteli,itypj,subchap + real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij real(kind=8) :: evdw2,evdw2_14,evdwij + real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,& + dist_temp, dist_init + evdw2=0.0D0 evdw2_14=0.0d0 !d print '(a)','Enter ESCP' !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e do i=iatscp_s,iatscp_e - if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle + if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle iteli=itel(i) xi=0.5D0*(c(1,i)+c(1,i+1)) yi=0.5D0*(c(2,i)+c(2,i+1)) zi=0.5D0*(c(3,i)+c(3,i+1)) + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize do iint=1,nscp_gr(i) do j=iscpstart(i,iint),iscpend(i,iint) - itypj=itype(j) + itypj=itype(j,1) if (itypj.eq.ntyp1) cycle ! Uncomment following three lines for SC-p interactions ! xj=c(1,nres+j)-xi ! yj=c(2,nres+j)-yi ! zj=c(3,nres+j)-zi ! Uncomment following three lines for Ca-p interactions - xj=c(1,j)-xi - yj=c(2,j)-yi - zj=c(3,j)-zi - rrij=1.0D0/(xj*xj+yj*yj+zj*zj) - - sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli))) +! xj=c(1,j)-xi +! yj=c(2,j)-yi +! zj=c(3,j)-zi + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + rrij=1.0D0/(xj*xj+yj*yj+zj*zj) + rij=dsqrt(1.0d0/rrij) + sss_ele_cut=sscale_ele(rij) + sss_ele_grad=sscagrad_ele(rij) +! print *,sss_ele_cut,sss_ele_grad,& +! (rij),r_cut_ele,rlamb_ele + if (sss_ele_cut.le.0.0) cycle + sss=sscale(rij/rscp(itypj,iteli)) + sss_grad=sscale_grad(rij/rscp(itypj,iteli)) if (sss.gt.0.0d0) then fac=rrij**expon2 @@ -12889,16 +15448,19 @@ write(iout,*) "jestesmy sobie w check eint!!" if (iabs(j-i) .le. 2) then e1=scal14*e1 e2=scal14*e2 - evdw2_14=evdw2_14+(e1+e2)*sss + evdw2_14=evdw2_14+(e1+e2)*sss*sss_ele_cut endif evdwij=e1+e2 - evdw2=evdw2+evdwij*sss + evdw2=evdw2+evdwij*sss*sss_ele_cut if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') & 'evdw2',i,j,sss,evdwij ! ! Calculate contributions to the gradient in the virtual-bond and SC vectors. ! - fac=-(evdwij+e1)*rrij*sss + fac=-(evdwij+e1)*rrij*sss*sss_ele_cut + fac=fac+evdwij*sss_ele_grad/rij/expon*sss & + +evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli) + ggg(1)=xj*fac ggg(2)=yj*fac ggg(3)=zj*fac @@ -12969,16 +15531,19 @@ write(iout,*) "jestesmy sobie w check eint!!" dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k)) enddo do k=1,3 - gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac + gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac& + *sss_ele_cut enddo ! write (iout,*) "gg",(gg(k),k=1,3) do k=1,3 gvdwx(k,i)=gvdwx(k,i)-gg(k) & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) & - +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac + +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac& + *sss_ele_cut gvdwx(k,j)=gvdwx(k,j)+gg(k) & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) & - +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac + +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac& + *sss_ele_cut ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) @@ -13002,7 +15567,7 @@ write(iout,*) "jestesmy sobie w check eint!!" ! ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' - use MD_data, only: totT + use MD_data, only: totT,usampl,eq_time #ifndef ISNAN external proc_proc #ifdef WINPGI @@ -13275,7 +15840,7 @@ write(iout,*) "jestesmy sobie w check eint!!" !el local variables integer :: i,nres6 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors - real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr + real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr nres6=6*nres ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot @@ -13430,7 +15995,7 @@ write(iout,*) "jestesmy sobie w check eint!!" ! ! Calculate the virtual-bond-angle energy. ! - call ebend(ebe) + call ebend(ebe,ethetacnstr) ! ! Calculate the SC local energy. ! @@ -13516,7 +16081,35 @@ write(iout,*) "jestesmy sobie w check eint!!" endif return end function gnmr1prim -!----------------------------------------------------------------------------- +!---------------------------------------------------------------------------- + real(kind=8) function rlornmr1(y,ymin,ymax,sigma) + real(kind=8) y,ymin,ymax,sigma + real(kind=8) wykl /4.0d0/ + if (y.lt.ymin) then + rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl) + else if (y.gt.ymax) then + rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl) + else + rlornmr1=0.0d0 + endif + return + end function rlornmr1 +!------------------------------------------------------------------------------ + real(kind=8) function rlornmr1prim(y,ymin,ymax,sigma) + real(kind=8) y,ymin,ymax,sigma + real(kind=8) wykl /4.0d0/ + if (y.lt.ymin) then + rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ & + ((ymin-y)**wykl+sigma**wykl)**2 + else if (y.gt.ymax) then + rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ & + ((y-ymax)**wykl+sigma**wykl)**2 + else + rlornmr1prim=0.0d0 + endif + return + end function rlornmr1prim + real(kind=8) function harmonic(y,ymax) ! implicit none real(kind=8) :: y,ymax @@ -13584,44 +16177,44 @@ write(iout,*) "jestesmy sobie w check eint!!" ind=0 ind1=0 do i=1,nres-2 - gthetai=0.0D0 - gphii=0.0D0 - do j=i+1,nres-1 + gthetai=0.0D0 + gphii=0.0D0 + do j=i+1,nres-1 ind=ind+1 ! ind=indmat(i,j) ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind - do k=1,3 + do k=1,3 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg) enddo - do k=1,3 - gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) + do k=1,3 + gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg) enddo enddo - do j=i+1,nres-1 + do j=i+1,nres-1 ind1=ind1+1 ! ind1=indmat(i,j) ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1 - do k=1,3 - gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg) - gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg) + do k=1,3 + gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg) + gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg) enddo enddo - if (i.gt.1) g(i-1)=gphii - if (n.gt.nphi) g(nphi+i)=gthetai + if (i.gt.1) g(i-1)=gphii + if (n.gt.nphi) g(nphi+i)=gthetai enddo if (n.le.nphi+ntheta) goto 10 do i=2,nres-1 - if (itype(i).ne.10) then + if (itype(i,1).ne.10) then galphai=0.0D0 - gomegai=0.0D0 - do k=1,3 - galphai=galphai+dxds(k,i)*gradx(k,i,icg) + gomegai=0.0D0 + do k=1,3 + galphai=galphai+dxds(k,i)*gradx(k,i,icg) enddo - do k=1,3 - gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) + do k=1,3 + gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg) enddo g(ialph(i,1))=galphai - g(ialph(i,1)+nside)=gomegai + g(ialph(i,1)+nside)=gomegai endif enddo ! @@ -13656,7 +16249,7 @@ write(iout,*) "jestesmy sobie w check eint!!" real(kind=8) :: urparm(1) real(kind=8) :: f real(kind=8),external :: ufparm - real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres) + real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres) ! if (jjj.gt.0) then ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n) ! endif @@ -13682,7 +16275,7 @@ write(iout,*) "jestesmy sobie w check eint!!" ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' use energy_data - use MD_data, only: totT + use MD_data, only: totT,usampl,eq_time #ifdef MPI include 'mpif.h' #endif @@ -13700,7 +16293,7 @@ write(iout,*) "jestesmy sobie w check eint!!" ! This subrouting calculates total Cartesian coordinate gradient. ! The subroutine chainbuild_cart and energy MUST be called beforehand. ! -!el#define DEBUG +!#define DEBUG #ifdef TIMING time00=MPI_Wtime() #endif @@ -13708,12 +16301,16 @@ write(iout,*) "jestesmy sobie w check eint!!" call sum_gradient #ifdef TIMING #endif +!#define DEBUG +!el write (iout,*) "After sum_gradient" #ifdef DEBUG +!el write (iout,*) "After sum_gradient" do i=1,nres-1 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3) write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3) enddo #endif +!#undef DEBUG ! If performing constraint dynamics, add the gradients of the constraint energy if(usampl.and.totT.gt.eq_time) then do i=1,nct @@ -13729,22 +16326,26 @@ write(iout,*) "jestesmy sobie w check eint!!" gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i) enddo endif +!elwrite (iout,*) "After sum_gradient" #ifdef TIMING time01=MPI_Wtime() #endif call intcartderiv +!elwrite (iout,*) "After sum_gradient" #ifdef TIMING time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01 #endif ! call checkintcartgrad ! write(iout,*) 'calling int_to_cart' +!#define DEBUG #ifdef DEBUG write (iout,*) "gcart, gxcart, gloc before int_to_cart" #endif - do i=1,nct + do i=0,nct do j=1,3 gcart(j,i)=gradc(j,i,icg) gxcart(j,i)=gradx(j,i,icg) +! if (i.le.2) print *,"gcart_one",gcart(j,i),gradc(j,i,icg) enddo #ifdef DEBUG write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),& @@ -13754,762 +16355,863 @@ write(iout,*) "jestesmy sobie w check eint!!" #ifdef TIMING time01=MPI_Wtime() #endif +! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg) call int_to_cart +! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg) + #ifdef TIMING - time_inttocart=time_inttocart+MPI_Wtime()-time01 + time_inttocart=time_inttocart+MPI_Wtime()-time01 #endif #ifdef DEBUG - write (iout,*) "gcart and gxcart after int_to_cart" - do i=0,nres-1 - write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),& - (gxcart(j,i),j=1,3) - enddo + write (iout,*) "gcart and gxcart after int_to_cart" + do i=0,nres-1 + write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),& + (gxcart(j,i),j=1,3) + enddo +#endif +!#undef DEBUG +#ifdef CARGRAD +#ifdef DEBUG + write (iout,*) "CARGRAD" +#endif + do i=nres,0,-1 + do j=1,3 + gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i) + ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i) + enddo + ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), & + ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3) + enddo + ! Correction: dummy residues + if (nnt.gt.1) then + do j=1,3 + ! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1) + gcart(j,nnt)=gcart(j,nnt)+gcart(j,1) + enddo + endif + if (nct.lt.nres) then + do j=1,3 + ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres) + gcart(j,nct)=gcart(j,nct)+gcart(j,nres) + enddo + endif #endif #ifdef TIMING - time_cartgrad=time_cartgrad+MPI_Wtime()-time00 + time_cartgrad=time_cartgrad+MPI_Wtime()-time00 #endif -!el#undef DEBUG - return - end subroutine cartgrad -!----------------------------------------------------------------------------- - subroutine zerograd -! implicit real*8 (a-h,o-z) -! include 'DIMENSIONS' -! include 'COMMON.DERIV' -! include 'COMMON.CHAIN' -! include 'COMMON.VAR' -! include 'COMMON.MD' -! include 'COMMON.SCCOR' -! -!el local variables - integer :: i,j,intertyp -! Initialize Cartesian-coordinate gradient -! -! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2) -! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2) - -! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres)) -! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres)) -! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres)) -! allocate(gradcorr_long(3,nres)) -! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres)) -! allocate(gcorr6_turn_long(3,nres)) -! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres) - -! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres) - -! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres)) -! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres)) - -! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres) -! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres) - -! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres) -! allocate(gscloc(3,nres)) !(3,maxres) -! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres) - - - -! common /deriv_scloc/ -! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres)) -! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres)) -! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres) -! common /mpgrad/ -! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres) - - - -! gradc(j,i,icg)=0.0d0 -! gradx(j,i,icg)=0.0d0 - -! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres -!elwrite(iout,*) "icg",icg - do i=1,nres - do j=1,3 - gvdwx(j,i)=0.0D0 - gradx_scp(j,i)=0.0D0 - gvdwc(j,i)=0.0D0 - gvdwc_scp(j,i)=0.0D0 - gvdwc_scpp(j,i)=0.0d0 - gelc(j,i)=0.0D0 - gelc_long(j,i)=0.0D0 - gradb(j,i)=0.0d0 - gradbx(j,i)=0.0d0 - gvdwpp(j,i)=0.0d0 - gel_loc(j,i)=0.0d0 - gel_loc_long(j,i)=0.0d0 - ghpbc(j,i)=0.0D0 - ghpbx(j,i)=0.0D0 - gcorr3_turn(j,i)=0.0d0 - gcorr4_turn(j,i)=0.0d0 - gradcorr(j,i)=0.0d0 - gradcorr_long(j,i)=0.0d0 - gradcorr5_long(j,i)=0.0d0 - gradcorr6_long(j,i)=0.0d0 - gcorr6_turn_long(j,i)=0.0d0 - gradcorr5(j,i)=0.0d0 - gradcorr6(j,i)=0.0d0 - gcorr6_turn(j,i)=0.0d0 - gsccorc(j,i)=0.0d0 - gsccorx(j,i)=0.0d0 - gradc(j,i,icg)=0.0d0 - gradx(j,i,icg)=0.0d0 - gscloc(j,i)=0.0d0 - gsclocx(j,i)=0.0d0 - do intertyp=1,3 - gloc_sc(intertyp,i,icg)=0.0d0 - enddo - enddo - enddo -! -! Initialize the gradient of local energy terms. -! -! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres) -! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres) -! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres) -! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres) -! allocate(gel_loc_turn3(nres)) -! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres) -! allocate(gsccor_loc(nres)) !(maxres) +!#undef DEBUG + return + end subroutine cartgrad + !----------------------------------------------------------------------------- + subroutine zerograd + ! implicit real*8 (a-h,o-z) + ! include 'DIMENSIONS' + ! include 'COMMON.DERIV' + ! include 'COMMON.CHAIN' + ! include 'COMMON.VAR' + ! include 'COMMON.MD' + ! include 'COMMON.SCCOR' + ! + !el local variables + integer :: i,j,intertyp,k + ! Initialize Cartesian-coordinate gradient + ! + ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2) + ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2) + + ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres)) + ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres)) + ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres)) + ! allocate(gradcorr_long(3,nres)) + ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres)) + ! allocate(gcorr6_turn_long(3,nres)) + ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres) + + ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres) + + ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres)) + ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres)) + + ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres) + ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres) + + ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres) + ! allocate(gscloc(3,nres)) !(3,maxres) + ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres) + + + + ! common /deriv_scloc/ + ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres)) + ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres)) + ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres) + ! common /mpgrad/ + ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres) + + + + ! gradc(j,i,icg)=0.0d0 + ! gradx(j,i,icg)=0.0d0 + + ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres + !elwrite(iout,*) "icg",icg + do i=-1,nres + do j=1,3 + gvdwx(j,i)=0.0D0 + gradx_scp(j,i)=0.0D0 + gvdwc(j,i)=0.0D0 + gvdwc_scp(j,i)=0.0D0 + gvdwc_scpp(j,i)=0.0d0 + gelc(j,i)=0.0D0 + gelc_long(j,i)=0.0D0 + gradb(j,i)=0.0d0 + gradbx(j,i)=0.0d0 + gvdwpp(j,i)=0.0d0 + gel_loc(j,i)=0.0d0 + gel_loc_long(j,i)=0.0d0 + ghpbc(j,i)=0.0D0 + ghpbx(j,i)=0.0D0 + gcorr3_turn(j,i)=0.0d0 + gcorr4_turn(j,i)=0.0d0 + gradcorr(j,i)=0.0d0 + gradcorr_long(j,i)=0.0d0 + gradcorr5_long(j,i)=0.0d0 + gradcorr6_long(j,i)=0.0d0 + gcorr6_turn_long(j,i)=0.0d0 + gradcorr5(j,i)=0.0d0 + gradcorr6(j,i)=0.0d0 + gcorr6_turn(j,i)=0.0d0 + gsccorc(j,i)=0.0d0 + gsccorx(j,i)=0.0d0 + gradc(j,i,icg)=0.0d0 + gradx(j,i,icg)=0.0d0 + gscloc(j,i)=0.0d0 + gsclocx(j,i)=0.0d0 + gliptran(j,i)=0.0d0 + gliptranx(j,i)=0.0d0 + gliptranc(j,i)=0.0d0 + gshieldx(j,i)=0.0d0 + gshieldc(j,i)=0.0d0 + gshieldc_loc(j,i)=0.0d0 + gshieldx_ec(j,i)=0.0d0 + gshieldc_ec(j,i)=0.0d0 + gshieldc_loc_ec(j,i)=0.0d0 + gshieldx_t3(j,i)=0.0d0 + gshieldc_t3(j,i)=0.0d0 + gshieldc_loc_t3(j,i)=0.0d0 + gshieldx_t4(j,i)=0.0d0 + gshieldc_t4(j,i)=0.0d0 + gshieldc_loc_t4(j,i)=0.0d0 + gshieldx_ll(j,i)=0.0d0 + gshieldc_ll(j,i)=0.0d0 + gshieldc_loc_ll(j,i)=0.0d0 + gg_tube(j,i)=0.0d0 + gg_tube_sc(j,i)=0.0d0 + gradafm(j,i)=0.0d0 + gradb_nucl(j,i)=0.0d0 + gradbx_nucl(j,i)=0.0d0 + gvdwpp_nucl(j,i)=0.0d0 + gvdwpp(j,i)=0.0d0 + gelpp(j,i)=0.0d0 + gvdwpsb(j,i)=0.0d0 + gvdwpsb1(j,i)=0.0d0 + gvdwsbc(j,i)=0.0d0 + gvdwsbx(j,i)=0.0d0 + gelsbc(j,i)=0.0d0 + gradcorr_nucl(j,i)=0.0d0 + gradcorr3_nucl(j,i)=0.0d0 + gradxorr_nucl(j,i)=0.0d0 + gradxorr3_nucl(j,i)=0.0d0 + gelsbx(j,i)=0.0d0 + gsbloc(j,i)=0.0d0 + gsblocx(j,i)=0.0d0 + gradpepcat(j,i)=0.0d0 + gradpepcatx(j,i)=0.0d0 + gradcatcat(j,i)=0.0d0 + gvdwx_scbase(j,i)=0.0d0 + gvdwc_scbase(j,i)=0.0d0 + gvdwx_pepbase(j,i)=0.0d0 + gvdwc_pepbase(j,i)=0.0d0 + gvdwx_scpho(j,i)=0.0d0 + gvdwc_scpho(j,i)=0.0d0 + gvdwc_peppho(j,i)=0.0d0 + enddo + enddo + do i=0,nres + do j=1,3 + do intertyp=1,3 + gloc_sc(intertyp,i,icg)=0.0d0 + enddo + enddo + enddo + do i=1,nres + do j=1,maxcontsshi + shield_list(j,i)=0 + do k=1,3 + !C print *,i,j,k + grad_shield_side(k,j,i)=0.0d0 + grad_shield_loc(k,j,i)=0.0d0 + enddo + enddo + ishield_list(i)=0 + enddo - do i=1,4*nres - gloc(i,icg)=0.0D0 - enddo - do i=1,nres - gel_loc_loc(i)=0.0d0 - gcorr_loc(i)=0.0d0 - g_corr5_loc(i)=0.0d0 - g_corr6_loc(i)=0.0d0 - gel_loc_turn3(i)=0.0d0 - gel_loc_turn4(i)=0.0d0 - gel_loc_turn6(i)=0.0d0 - gsccor_loc(i)=0.0d0 - enddo -! initialize gcart and gxcart -! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES) - do i=0,nres - do j=1,3 - gcart(j,i)=0.0d0 - gxcart(j,i)=0.0d0 - enddo - enddo - return - end subroutine zerograd -!----------------------------------------------------------------------------- - real(kind=8) function fdum() - fdum=0.0D0 - return - end function fdum -!----------------------------------------------------------------------------- -! intcartderiv.F -!----------------------------------------------------------------------------- - subroutine intcartderiv -! implicit real*8 (a-h,o-z) -! include 'DIMENSIONS' + ! + ! Initialize the gradient of local energy terms. + ! + ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres) + ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres) + ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres) + ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres) + ! allocate(gel_loc_turn3(nres)) + ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres) + ! allocate(gsccor_loc(nres)) !(maxres) + + do i=1,4*nres + gloc(i,icg)=0.0D0 + enddo + do i=1,nres + gel_loc_loc(i)=0.0d0 + gcorr_loc(i)=0.0d0 + g_corr5_loc(i)=0.0d0 + g_corr6_loc(i)=0.0d0 + gel_loc_turn3(i)=0.0d0 + gel_loc_turn4(i)=0.0d0 + gel_loc_turn6(i)=0.0d0 + gsccor_loc(i)=0.0d0 + enddo + ! initialize gcart and gxcart + ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES) + do i=0,nres + do j=1,3 + gcart(j,i)=0.0d0 + gxcart(j,i)=0.0d0 + enddo + enddo + return + end subroutine zerograd + !----------------------------------------------------------------------------- + real(kind=8) function fdum() + fdum=0.0D0 + return + end function fdum + !----------------------------------------------------------------------------- + ! intcartderiv.F + !----------------------------------------------------------------------------- + subroutine intcartderiv + ! implicit real*8 (a-h,o-z) + ! include 'DIMENSIONS' #ifdef MPI - include 'mpif.h' + include 'mpif.h' #endif -! include 'COMMON.SETUP' -! include 'COMMON.CHAIN' -! include 'COMMON.VAR' -! include 'COMMON.GEO' -! include 'COMMON.INTERACT' -! include 'COMMON.DERIV' -! include 'COMMON.IOUNITS' -! include 'COMMON.LOCAL' -! include 'COMMON.SCCOR' - real(kind=8) :: pi4,pi34 - real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres) - real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,& - dcosomega,dsinomega !(3,3,maxres) - real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n - - integer :: i,j,k - real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,& - fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,& - fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,& - fac17,coso_inv,fac10,fac11,fac12,fac13,fac14 - integer :: nres2 - nres2=2*nres + ! include 'COMMON.SETUP' + ! include 'COMMON.CHAIN' + ! include 'COMMON.VAR' + ! include 'COMMON.GEO' + ! include 'COMMON.INTERACT' + ! include 'COMMON.DERIV' + ! include 'COMMON.IOUNITS' + ! include 'COMMON.LOCAL' + ! include 'COMMON.SCCOR' + real(kind=8) :: pi4,pi34 + real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres) + real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,& + dcosomega,dsinomega !(3,3,maxres) + real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n + + integer :: i,j,k + real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,& + fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,& + fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,& + fac17,coso_inv,fac10,fac11,fac12,fac13,fac14 + integer :: nres2 + nres2=2*nres -!el from module energy------------- -!el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres -!el allocate(dsintau(3,3,3,itau_start:itau_end)) -!el allocate(dtauangle(3,3,3,itau_start:itau_end)) + !el from module energy------------- + !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres + !el allocate(dsintau(3,3,3,itau_start:itau_end)) + !el allocate(dtauangle(3,3,3,itau_start:itau_end)) -!el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres -!el allocate(dsintau(3,3,3,0:nres2)) -!el allocate(dtauangle(3,3,3,0:nres2)) -!el allocate(domicron(3,2,2,0:nres2)) -!el allocate(dcosomicron(3,2,2,0:nres2)) + !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres + !el allocate(dsintau(3,3,3,0:nres2)) + !el allocate(dtauangle(3,3,3,0:nres2)) + !el allocate(domicron(3,2,2,0:nres2)) + !el allocate(dcosomicron(3,2,2,0:nres2)) #if defined(MPI) && defined(PARINTDER) - if (nfgtasks.gt.1 .and. me.eq.king) & - call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR) + if (nfgtasks.gt.1 .and. me.eq.king) & + call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR) #endif - pi4 = 0.5d0*pipol - pi34 = 3*pi4 + pi4 = 0.5d0*pipol + pi34 = 3*pi4 -! allocate(dtheta(3,2,nres)) !(3,2,maxres) -! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres) + ! allocate(dtheta(3,2,nres)) !(3,2,maxres) + ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres) -! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end - do i=1,nres - do j=1,3 - dtheta(j,1,i)=0.0d0 - dtheta(j,2,i)=0.0d0 - dphi(j,1,i)=0.0d0 - dphi(j,2,i)=0.0d0 - dphi(j,3,i)=0.0d0 - enddo - enddo -! Derivatives of theta's + ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end + do i=1,nres + do j=1,3 + dtheta(j,1,i)=0.0d0 + dtheta(j,2,i)=0.0d0 + dphi(j,1,i)=0.0d0 + dphi(j,2,i)=0.0d0 + dphi(j,3,i)=0.0d0 + enddo + enddo + ! Derivatives of theta's #if defined(MPI) && defined(PARINTDER) -! We need dtheta(:,:,i-1) to compute dphi(:,:,i) - do i=max0(ithet_start-1,3),ithet_end + ! We need dtheta(:,:,i-1) to compute dphi(:,:,i) + do i=max0(ithet_start-1,3),ithet_end #else - do i=3,nres + do i=3,nres #endif - cost=dcos(theta(i)) - sint=sqrt(1-cost*cost) - do j=1,3 - dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/& - vbld(i-1) - if (itype(i-1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint - dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/& - vbld(i) - if (itype(i-1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint - enddo - enddo + cost=dcos(theta(i)) + sint=sqrt(1-cost*cost) + do j=1,3 + dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/& + vbld(i-1) + if (itype(i-1,1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint + dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/& + vbld(i) + if (itype(i-1,1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint + enddo + enddo #if defined(MPI) && defined(PARINTDER) -! We need dtheta(:,:,i-1) to compute dphi(:,:,i) - do i=max0(ithet_start-1,3),ithet_end + ! We need dtheta(:,:,i-1) to compute dphi(:,:,i) + do i=max0(ithet_start-1,3),ithet_end #else - do i=3,nres + do i=3,nres #endif - if ((itype(i-1).ne.10).and.(itype(i-1).ne.ntyp1)) then - cost1=dcos(omicron(1,i)) - sint1=sqrt(1-cost1*cost1) - cost2=dcos(omicron(2,i)) - sint2=sqrt(1-cost2*cost2) - do j=1,3 -!C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1) - dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ & - cost1*dc_norm(j,i-2))/ & - vbld(i-1) - domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i) - dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) & - +cost1*(dc_norm(j,i-1+nres)))/ & - vbld(i-1+nres) - domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i) -!C Calculate derivative over second omicron Sci-1,Cai-1 Cai -!C Looks messy but better than if in loop - dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) & - +cost2*dc_norm(j,i-1))/ & - vbld(i) - domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i) - dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) & - +cost2*(-dc_norm(j,i-1+nres)))/ & - vbld(i-1+nres) -! write(iout,*) "vbld", i,itype(i),vbld(i-1+nres) - domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i) - enddo - endif - enddo -!elwrite(iout,*) "after vbld write" -! Derivatives of phi: -! If phi is 0 or 180 degrees, then the formulas -! have to be derived by power series expansion of the -! conventional formulas around 0 and 180. + if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1)) then + cost1=dcos(omicron(1,i)) + sint1=sqrt(1-cost1*cost1) + cost2=dcos(omicron(2,i)) + sint2=sqrt(1-cost2*cost2) + do j=1,3 + !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1) + dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ & + cost1*dc_norm(j,i-2))/ & + vbld(i-1) + domicron(j,1,1,i)=-1.0/sint1*dcosomicron(j,1,1,i) + dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) & + +cost1*(dc_norm(j,i-1+nres)))/ & + vbld(i-1+nres) + domicron(j,1,2,i)=-1.0/sint1*dcosomicron(j,1,2,i) + !C Calculate derivative over second omicron Sci-1,Cai-1 Cai + !C Looks messy but better than if in loop + dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) & + +cost2*dc_norm(j,i-1))/ & + vbld(i) + domicron(j,2,1,i)=-1.0/sint2*dcosomicron(j,2,1,i) + dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) & + +cost2*(-dc_norm(j,i-1+nres)))/ & + vbld(i-1+nres) + ! write(iout,*) "vbld", i,itype(i,1),vbld(i-1+nres) + domicron(j,2,2,i)=-1.0/sint2*dcosomicron(j,2,2,i) + enddo + endif + enddo + !elwrite(iout,*) "after vbld write" + ! Derivatives of phi: + ! If phi is 0 or 180 degrees, then the formulas + ! have to be derived by power series expansion of the + ! conventional formulas around 0 and 180. #ifdef PARINTDER - do i=iphi1_start,iphi1_end + do i=iphi1_start,iphi1_end #else - do i=4,nres -#endif -! if (itype(i-1).eq.21 .or. itype(i-2).eq.21 ) cycle -! the conventional case - sint=dsin(theta(i)) - sint1=dsin(theta(i-1)) - sing=dsin(phi(i)) - cost=dcos(theta(i)) - cost1=dcos(theta(i-1)) - cosg=dcos(phi(i)) - scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1)) - fac0=1.0d0/(sint1*sint) - fac1=cost*fac0 - fac2=cost1*fac0 - fac3=cosg*cost1/(sint1*sint1) - fac4=cosg*cost/(sint*sint) -! Obtaining the gamma derivatives from sine derivative - if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. & - phi(i).gt.pi34.and.phi(i).le.pi.or. & - phi(i).gt.-pi.and.phi(i).le.-pi34) then - call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1) - call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2) - call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3) - do j=1,3 - ctgt=cost/sint - ctgt1=cost1/sint1 - cosg_inv=1.0d0/cosg - if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then - dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) & - -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2) - dphi(j,1,i)=cosg_inv*dsinphi(j,1,i) - dsinphi(j,2,i)= & - -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) & - -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) - dphi(j,2,i)=cosg_inv*dsinphi(j,2,i) - dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) & - +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i) -! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) - dphi(j,3,i)=cosg_inv*dsinphi(j,3,i) - endif -! Bug fixed 3/24/05 (AL) - enddo -! Obtaining the gamma derivatives from cosine derivative - else - do j=1,3 - if (itype(i-1).ne.ntyp1 .and. itype(i-2).ne.ntyp1) then - dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* & - dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* & - dc_norm(j,i-3))/vbld(i-2) - dphi(j,1,i)=-1/sing*dcosphi(j,1,i) - dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* & - dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* & - dcostheta(j,1,i) - dphi(j,2,i)=-1/sing*dcosphi(j,2,i) - dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* & - dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* & - dc_norm(j,i-1))/vbld(i) - dphi(j,3,i)=-1/sing*dcosphi(j,3,i) - endif - enddo - endif - enddo -!alculate derivative of Tauangle - do i=1,nres-1 - do j=1,3 - dc_norm2(j,i+nres)=-dc_norm(j,i+nres) - enddo - enddo + do i=4,nres +#endif + ! if (itype(i-1,1).eq.21 .or. itype(i-2,1).eq.21 ) cycle + ! the conventional case + sint=dsin(theta(i)) + sint1=dsin(theta(i-1)) + sing=dsin(phi(i)) + cost=dcos(theta(i)) + cost1=dcos(theta(i-1)) + cosg=dcos(phi(i)) + scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1)) + fac0=1.0d0/(sint1*sint) + fac1=cost*fac0 + fac2=cost1*fac0 + fac3=cosg*cost1/(sint1*sint1) + fac4=cosg*cost/(sint*sint) + ! Obtaining the gamma derivatives from sine derivative + if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. & + phi(i).gt.pi34.and.phi(i).le.pi.or. & + phi(i).ge.-pi.and.phi(i).le.-pi34) then + call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1) + call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2) + call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3) + do j=1,3 + ctgt=cost/sint + ctgt1=cost1/sint1 + cosg_inv=1.0d0/cosg + if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then + dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) & + -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2) + dphi(j,1,i)=cosg_inv*dsinphi(j,1,i) + dsinphi(j,2,i)= & + -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) & + -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) + dphi(j,2,i)=cosg_inv*dsinphi(j,2,i) + dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) & + +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i) + ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) + dphi(j,3,i)=cosg_inv*dsinphi(j,3,i) + endif + ! Bug fixed 3/24/05 (AL) + enddo + ! Obtaining the gamma derivatives from cosine derivative + else + do j=1,3 + if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then + dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* & + dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* & + dc_norm(j,i-3))/vbld(i-2) + dphi(j,1,i)=-1.0/sing*dcosphi(j,1,i) + dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* & + dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* & + dcostheta(j,1,i) + dphi(j,2,i)=-1.0/sing*dcosphi(j,2,i) + dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* & + dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* & + dc_norm(j,i-1))/vbld(i) + dphi(j,3,i)=-1.0/sing*dcosphi(j,3,i) +!#define DEBUG +#ifdef DEBUG + write(iout,*) "just after",dphi(j,3,i),sing,dcosphi(j,3,i) +#endif +!#undef DEBUG + endif + enddo + endif + enddo + !alculate derivative of Tauangle #ifdef PARINTDER - do i=itau_start,itau_end + do i=itau_start,itau_end #else - do i=3,nres -!elwrite(iout,*) " vecpr",i,nres -#endif - if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle -! if ((itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10).or. -! & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1)) cycle -!c dtauangle(j,intertyp,dervityp,residue number) -!c INTERTYP=1 SC...Ca...Ca..Ca -! the conventional case - sint=dsin(theta(i)) - sint1=dsin(omicron(2,i-1)) - sing=dsin(tauangle(1,i)) - cost=dcos(theta(i)) - cost1=dcos(omicron(2,i-1)) - cosg=dcos(tauangle(1,i)) - do j=1,3 - dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres) -! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm" - enddo - scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1)) - fac0=1.0d0/(sint1*sint) - fac1=cost*fac0 - fac2=cost1*fac0 - fac3=cosg*cost1/(sint1*sint1) - fac4=cosg*cost/(sint*sint) -! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4 -! Obtaining the gamma derivatives from sine derivative - if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. & - tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. & - tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then - call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1) - call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2) - call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3) - do j=1,3 - ctgt=cost/sint - ctgt1=cost1/sint1 - cosg_inv=1.0d0/cosg - dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) & - -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) & - *vbld_inv(i-2+nres) - dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i) - dsintau(j,1,2,i)= & - -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) & - -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) -! write(iout,*) "dsintau", dsintau(j,1,2,i) - dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i) -! Bug fixed 3/24/05 (AL) - dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) & - +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i) -! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) - dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i) - enddo -! Obtaining the gamma derivatives from cosine derivative - else - do j=1,3 - dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* & - dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* & - (dc_norm2(j,i-2+nres)))/vbld(i-2+nres) - dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i) - dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* & - dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* & - dcostheta(j,1,i) - dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i) - dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* & - dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* & - dc_norm(j,i-1))/vbld(i) - dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i) -! write (iout,*) "else",i - enddo - endif -! do k=1,3 -! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3) -! enddo - enddo -!C Second case Ca...Ca...Ca...SC + do i=3,nres + !elwrite(iout,*) " vecpr",i,nres +#endif + if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle + ! if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10).or. + ! & (itype(i-1,1).eq.ntyp1).or.(itype(i,1).eq.ntyp1)) cycle + !c dtauangle(j,intertyp,dervityp,residue number) + !c INTERTYP=1 SC...Ca...Ca..Ca + ! the conventional case + sint=dsin(theta(i)) + sint1=dsin(omicron(2,i-1)) + sing=dsin(tauangle(1,i)) + cost=dcos(theta(i)) + cost1=dcos(omicron(2,i-1)) + cosg=dcos(tauangle(1,i)) + !elwrite(iout,*) " vecpr5",i,nres + do j=1,3 + !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres + !elwrite(iout,*) " vecpr5",dc_norm2(1,1) + dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres) + ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm" + enddo + scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1)) + fac0=1.0d0/(sint1*sint) + fac1=cost*fac0 + fac2=cost1*fac0 + fac3=cosg*cost1/(sint1*sint1) + fac4=cosg*cost/(sint*sint) + ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4 + ! Obtaining the gamma derivatives from sine derivative + if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. & + tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. & + tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then + call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1) + call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2) + call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3) + do j=1,3 + ctgt=cost/sint + ctgt1=cost1/sint1 + cosg_inv=1.0d0/cosg + dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) & + -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) & + *vbld_inv(i-2+nres) + dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i) + dsintau(j,1,2,i)= & + -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) & + -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) + ! write(iout,*) "dsintau", dsintau(j,1,2,i) + dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i) + ! Bug fixed 3/24/05 (AL) + dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) & + +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i) + ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) + dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i) + enddo + ! Obtaining the gamma derivatives from cosine derivative + else + do j=1,3 + dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* & + dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* & + (dc_norm2(j,i-2+nres)))/vbld(i-2+nres) + dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i) + dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* & + dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* & + dcostheta(j,1,i) + dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i) + dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* & + dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* & + dc_norm(j,i-1))/vbld(i) + dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i) + ! write (iout,*) "else",i + enddo + endif + ! do k=1,3 + ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3) + ! enddo + enddo + !C Second case Ca...Ca...Ca...SC #ifdef PARINTDER - do i=itau_start,itau_end + do i=itau_start,itau_end #else - do i=4,nres + do i=4,nres #endif - if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. & - (itype(i-2).eq.ntyp1).or.(itype(i-3).eq.ntyp1)) cycle -! the conventional case - sint=dsin(omicron(1,i)) - sint1=dsin(theta(i-1)) - sing=dsin(tauangle(2,i)) - cost=dcos(omicron(1,i)) - cost1=dcos(theta(i-1)) - cosg=dcos(tauangle(2,i)) -! do j=1,3 -! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres) -! enddo - scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres)) - fac0=1.0d0/(sint1*sint) - fac1=cost*fac0 - fac2=cost1*fac0 - fac3=cosg*cost1/(sint1*sint1) - fac4=cosg*cost/(sint*sint) -! Obtaining the gamma derivatives from sine derivative - if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. & - tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. & - tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then - call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1) - call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2) - call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3) - do j=1,3 - ctgt=cost/sint - ctgt1=cost1/sint1 - cosg_inv=1.0d0/cosg - dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) & - +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2) -! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1), -! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)" - dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i) - dsintau(j,2,2,i)= & - -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) & - -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) -! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1), -! & sing*ctgt*domicron(j,1,2,i), -! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) - dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i) -! Bug fixed 3/24/05 (AL) - dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) & - +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres) -! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) - dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i) - enddo -! Obtaining the gamma derivatives from cosine derivative - else - do j=1,3 - dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* & - dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* & - dc_norm(j,i-3))/vbld(i-2) - dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i) - dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* & - dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* & - dcosomicron(j,1,1,i) - dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i) - dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* & - dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* & - dc_norm(j,i-1+nres))/vbld(i-1+nres) - dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i) -! write(iout,*) i,j,"else", dtauangle(j,2,3,i) - enddo - endif - enddo + if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. & + (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle + ! the conventional case + sint=dsin(omicron(1,i)) + sint1=dsin(theta(i-1)) + sing=dsin(tauangle(2,i)) + cost=dcos(omicron(1,i)) + cost1=dcos(theta(i-1)) + cosg=dcos(tauangle(2,i)) + ! do j=1,3 + ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres) + ! enddo + scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres)) + fac0=1.0d0/(sint1*sint) + fac1=cost*fac0 + fac2=cost1*fac0 + fac3=cosg*cost1/(sint1*sint1) + fac4=cosg*cost/(sint*sint) + ! Obtaining the gamma derivatives from sine derivative + if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. & + tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. & + tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then + call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1) + call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2) + call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3) + do j=1,3 + ctgt=cost/sint + ctgt1=cost1/sint1 + cosg_inv=1.0d0/cosg + dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) & + +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2) + ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1), + ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)" + dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i) + dsintau(j,2,2,i)= & + -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) & + -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) + ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1), + ! & sing*ctgt*domicron(j,1,2,i), + ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) + dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i) + ! Bug fixed 3/24/05 (AL) + dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) & + +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres) + ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) + dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i) + enddo + ! Obtaining the gamma derivatives from cosine derivative + else + do j=1,3 + dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* & + dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* & + dc_norm(j,i-3))/vbld(i-2) + dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i) + dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* & + dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* & + dcosomicron(j,1,1,i) + dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i) + dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* & + dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* & + dc_norm(j,i-1+nres))/vbld(i-1+nres) + dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i) + ! write(iout,*) i,j,"else", dtauangle(j,2,3,i) + enddo + endif + enddo -!CC third case SC...Ca...Ca...SC + !CC third case SC...Ca...Ca...SC #ifdef PARINTDER - do i=itau_start,itau_end + do i=itau_start,itau_end #else - do i=3,nres + do i=3,nres #endif -! the conventional case - if ((itype(i-1).eq.ntyp1).or.(itype(i-1).eq.10).or. & - (itype(i-2).eq.ntyp1).or.(itype(i-2).eq.10)) cycle - sint=dsin(omicron(1,i)) - sint1=dsin(omicron(2,i-1)) - sing=dsin(tauangle(3,i)) - cost=dcos(omicron(1,i)) - cost1=dcos(omicron(2,i-1)) - cosg=dcos(tauangle(3,i)) - do j=1,3 - dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres) -! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres) - enddo - scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres)) - fac0=1.0d0/(sint1*sint) - fac1=cost*fac0 - fac2=cost1*fac0 - fac3=cosg*cost1/(sint1*sint1) - fac4=cosg*cost/(sint*sint) -! Obtaining the gamma derivatives from sine derivative - if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. & - tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. & - tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then - call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1) - call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2) - call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3) - do j=1,3 - ctgt=cost/sint - ctgt1=cost1/sint1 - cosg_inv=1.0d0/cosg - dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) & - -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) & - *vbld_inv(i-2+nres) - dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i) - dsintau(j,3,2,i)= & - -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) & - -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) - dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i) -! Bug fixed 3/24/05 (AL) - dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) & - +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) & - *vbld_inv(i-1+nres) -! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) - dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i) - enddo -! Obtaining the gamma derivatives from cosine derivative - else - do j=1,3 - dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* & - dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* & - dc_norm2(j,i-2+nres))/vbld(i-2+nres) - dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i) - dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* & - dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* & - dcosomicron(j,1,1,i) - dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i) - dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* & - dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* & - dc_norm(j,i-1+nres))/vbld(i-1+nres) - dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i) -! write(iout,*) "else",i - enddo - endif - enddo + ! the conventional case + if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. & + (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle + sint=dsin(omicron(1,i)) + sint1=dsin(omicron(2,i-1)) + sing=dsin(tauangle(3,i)) + cost=dcos(omicron(1,i)) + cost1=dcos(omicron(2,i-1)) + cosg=dcos(tauangle(3,i)) + do j=1,3 + dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres) + ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres) + enddo + scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres)) + fac0=1.0d0/(sint1*sint) + fac1=cost*fac0 + fac2=cost1*fac0 + fac3=cosg*cost1/(sint1*sint1) + fac4=cosg*cost/(sint*sint) + ! Obtaining the gamma derivatives from sine derivative + if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. & + tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. & + tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then + call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1) + call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2) + call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3) + do j=1,3 + ctgt=cost/sint + ctgt1=cost1/sint1 + cosg_inv=1.0d0/cosg + dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) & + -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) & + *vbld_inv(i-2+nres) + dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i) + dsintau(j,3,2,i)= & + -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) & + -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1) + dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i) + ! Bug fixed 3/24/05 (AL) + dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) & + +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) & + *vbld_inv(i-1+nres) + ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1) + dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i) + enddo + ! Obtaining the gamma derivatives from cosine derivative + else + do j=1,3 + dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* & + dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* & + dc_norm2(j,i-2+nres))/vbld(i-2+nres) + dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i) + dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* & + dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* & + dcosomicron(j,1,1,i) + dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i) + dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* & + dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* & + dc_norm(j,i-1+nres))/vbld(i-1+nres) + dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i) + ! write(iout,*) "else",i + enddo + endif + enddo #ifdef CRYST_SC -! Derivatives of side-chain angles alpha and omega + ! Derivatives of side-chain angles alpha and omega #if defined(MPI) && defined(PARINTDER) - do i=ibond_start,ibond_end + do i=ibond_start,ibond_end #else - do i=2,nres-1 -#endif - if(itype(i).ne.10 .and. itype(i).ne.ntyp1) then - fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1)))) - fac6=fac5/vbld(i) - fac7=fac5*fac5 - fac8=fac5/vbld(i+1) - fac9=fac5/vbld(i+nres) - scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres)) - scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres)) - cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* & - (scalar(dC_norm(1,i),dC_norm(1,i+nres)) & - -scalar(dC_norm(1,i-1),dC_norm(1,i+nres))) - sina=sqrt(1-cosa*cosa) - sino=dsin(omeg(i)) -! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino - do j=1,3 - dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- & - dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1) - dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i) - dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- & - scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1) - dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i) - dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- & - dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ & - vbld(i+nres)) - dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i) - enddo -! obtaining the derivatives of omega from sines - if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. & - omeg(i).gt.pi34.and.omeg(i).le.pi.or. & - omeg(i).gt.-pi.and.omeg(i).le.-pi34) then - fac15=dcos(theta(i+1))/(dsin(theta(i+1))* & - dsin(theta(i+1))) - fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i))) - fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i))) - call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1) - call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2) - call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3) - coso_inv=1.0d0/dcos(omeg(i)) + do i=2,nres-1 +#endif + if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then + fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1)))) + fac6=fac5/vbld(i) + fac7=fac5*fac5 + fac8=fac5/vbld(i+1) + fac9=fac5/vbld(i+nres) + scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres)) + scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres)) + cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* & + (scalar(dC_norm(1,i),dC_norm(1,i+nres)) & + -scalar(dC_norm(1,i-1),dC_norm(1,i+nres))) + sina=sqrt(1-cosa*cosa) + sino=dsin(omeg(i)) + ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino + do j=1,3 + dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- & + dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1) + dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i) + dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- & + scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1) + dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i) + dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- & + dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ & + vbld(i+nres)) + dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i) + enddo + ! obtaining the derivatives of omega from sines + if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. & + omeg(i).gt.pi34.and.omeg(i).le.pi.or. & + omeg(i).gt.-pi.and.omeg(i).le.-pi34) then + fac15=dcos(theta(i+1))/(dsin(theta(i+1))* & + dsin(theta(i+1))) + fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i))) + fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i))) + call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1) + call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2) + call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3) + coso_inv=1.0d0/dcos(omeg(i)) + do j=1,3 + dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) & + +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- & + (sino*dc_norm(j,i-1))/vbld(i) + domega(j,1,i)=coso_inv*dsinomega(j,1,i) + dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) & + +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) & + -sino*dc_norm(j,i)/vbld(i+1) + domega(j,2,i)=coso_inv*dsinomega(j,2,i) + dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- & + fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ & + vbld(i+nres) + domega(j,3,i)=coso_inv*dsinomega(j,3,i) + enddo + else + ! obtaining the derivatives of omega from cosines + fac10=sqrt(0.5d0*(1-dcos(theta(i+1)))) + fac11=sqrt(0.5d0*(1+dcos(theta(i+1)))) + fac12=fac10*sina + fac13=fac12*fac12 + fac14=sina*sina + do j=1,3 + dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* & + dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ & + (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* & + fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13 + domega(j,1,i)=-1/sino*dcosomega(j,1,i) + dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* & + dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* & + dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ & + (scala2-fac11*cosa)*(0.25d0*sina/fac10* & + dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13 + domega(j,2,i)=-1/sino*dcosomega(j,2,i) + dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- & + scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ & + (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14 + domega(j,3,i)=-1/sino*dcosomega(j,3,i) + enddo + endif + else do j=1,3 - dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) & - +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- & - (sino*dc_norm(j,i-1))/vbld(i) - domega(j,1,i)=coso_inv*dsinomega(j,1,i) - dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) & - +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) & - -sino*dc_norm(j,i)/vbld(i+1) - domega(j,2,i)=coso_inv*dsinomega(j,2,i) - dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- & - fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ & - vbld(i+nres) - domega(j,3,i)=coso_inv*dsinomega(j,3,i) - enddo - else -! obtaining the derivatives of omega from cosines - fac10=sqrt(0.5d0*(1-dcos(theta(i+1)))) - fac11=sqrt(0.5d0*(1+dcos(theta(i+1)))) - fac12=fac10*sina - fac13=fac12*fac12 - fac14=sina*sina - do j=1,3 - dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* & - dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ & - (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* & - fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13 - domega(j,1,i)=-1/sino*dcosomega(j,1,i) - dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* & - dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* & - dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ & - (scala2-fac11*cosa)*(0.25d0*sina/fac10* & - dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13 - domega(j,2,i)=-1/sino*dcosomega(j,2,i) - dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- & - scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ & - (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14 - domega(j,3,i)=-1/sino*dcosomega(j,3,i) - enddo - endif - else - do j=1,3 - do k=1,3 - dalpha(k,j,i)=0.0d0 - domega(k,j,i)=0.0d0 - enddo - enddo - endif - enddo + do k=1,3 + dalpha(k,j,i)=0.0d0 + domega(k,j,i)=0.0d0 + enddo + enddo + endif + enddo #endif #if defined(MPI) && defined(PARINTDER) - if (nfgtasks.gt.1) then + if (nfgtasks.gt.1) then #ifdef DEBUG -!d write (iout,*) "Gather dtheta" -!d call flush(iout) - write (iout,*) "dtheta before gather" - do i=1,nres - write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2) - enddo + !d write (iout,*) "Gather dtheta" + !d call flush(iout) + write (iout,*) "dtheta before gather" + do i=1,nres + write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2) + enddo #endif - call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),& - MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,& - king,FG_COMM,IERROR) + call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),& + MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,& + king,FG_COMM,IERROR) +!#define DEBUG #ifdef DEBUG -!d write (iout,*) "Gather dphi" -!d call flush(iout) - write (iout,*) "dphi before gather" - do i=1,nres - write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3) - enddo + !d write (iout,*) "Gather dphi" + !d call flush(iout) + write (iout,*) "dphi before gather" + do i=1,nres + write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3) + enddo #endif - call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),& - MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,& - king,FG_COMM,IERROR) -!d write (iout,*) "Gather dalpha" -!d call flush(iout) +!#undef DEBUG + call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),& + MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,& + king,FG_COMM,IERROR) + !d write (iout,*) "Gather dalpha" + !d call flush(iout) #ifdef CRYST_SC - call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),& - MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,& - king,FG_COMM,IERROR) -!d write (iout,*) "Gather domega" -!d call flush(iout) - call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),& - MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,& - king,FG_COMM,IERROR) + call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),& + MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,& + king,FG_COMM,IERROR) + !d write (iout,*) "Gather domega" + !d call flush(iout) + call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),& + MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,& + king,FG_COMM,IERROR) #endif - endif + endif #endif +!#define DEBUG #ifdef DEBUG - write (iout,*) "dtheta after gather" - do i=1,nres - write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2) - enddo - write (iout,*) "dphi after gather" - do i=1,nres - write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3) - enddo - write (iout,*) "dalpha after gather" - do i=1,nres - write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3) - enddo - write (iout,*) "domega after gather" - do i=1,nres - write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3) - enddo + write (iout,*) "dtheta after gather" + do i=1,nres + write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2) + enddo + write (iout,*) "dphi after gather" + do i=1,nres + write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3) + enddo + write (iout,*) "dalpha after gather" + do i=1,nres + write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3) + enddo + write (iout,*) "domega after gather" + do i=1,nres + write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3) + enddo #endif - return - end subroutine intcartderiv -!----------------------------------------------------------------------------- - subroutine checkintcartgrad -! implicit real*8 (a-h,o-z) -! include 'DIMENSIONS' +!#undef DEBUG + return + end subroutine intcartderiv + !----------------------------------------------------------------------------- + subroutine checkintcartgrad + ! implicit real*8 (a-h,o-z) + ! include 'DIMENSIONS' #ifdef MPI - include 'mpif.h' + include 'mpif.h' #endif -! include 'COMMON.CHAIN' -! include 'COMMON.VAR' -! include 'COMMON.GEO' -! include 'COMMON.INTERACT' -! include 'COMMON.DERIV' -! include 'COMMON.IOUNITS' -! include 'COMMON.SETUP' - real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres) - real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres) - real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres) - real(kind=8),dimension(3) :: dc_norm_s - real(kind=8) :: aincr=1.0d-5 - integer :: i,j - real(kind=8) :: dcji - do i=1,nres - phi_s(i)=phi(i) - theta_s(i)=theta(i) - alph_s(i)=alph(i) - omeg_s(i)=omeg(i) - enddo -! Check theta gradient - write (iout,*) & - "Analytical (upper) and numerical (lower) gradient of theta" - write (iout,*) - do i=3,nres - do j=1,3 - dcji=dc(j,i-2) - dc(j,i-2)=dcji+aincr - call chainbuild_cart - call int_from_cart1(.false.) + ! include 'COMMON.CHAIN' + ! include 'COMMON.VAR' + ! include 'COMMON.GEO' + ! include 'COMMON.INTERACT' + ! include 'COMMON.DERIV' + ! include 'COMMON.IOUNITS' + ! include 'COMMON.SETUP' + real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres) + real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres) + real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres) + real(kind=8),dimension(3) :: dc_norm_s + real(kind=8) :: aincr=1.0d-5 + integer :: i,j + real(kind=8) :: dcji + do i=1,nres + phi_s(i)=phi(i) + theta_s(i)=theta(i) + alph_s(i)=alph(i) + omeg_s(i)=omeg(i) + enddo + ! Check theta gradient + write (iout,*) & + "Analytical (upper) and numerical (lower) gradient of theta" + write (iout,*) + do i=3,nres + do j=1,3 + dcji=dc(j,i-2) + dc(j,i-2)=dcji+aincr + call chainbuild_cart + call int_from_cart1(.false.) dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr dc(j,i-2)=dcji dcji=dc(j,i-1) dc(j,i-1)=dc(j,i-1)+aincr - call chainbuild_cart + call chainbuild_cart dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr dc(j,i-1)=dcji enddo @@ -14531,7 +17233,7 @@ write(iout,*) "jestesmy sobie w check eint!!" dc(j,i-3)=dcji+aincr call chainbuild_cart dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr - dc(j,i-3)=dcji + dc(j,i-3)=dcji dcji=dc(j,i-2) dc(j,i-2)=dcji+aincr call chainbuild_cart @@ -14557,28 +17259,28 @@ write(iout,*) "jestesmy sobie w check eint!!" write (iout,*) & "Analytical (upper) and numerical (lower) gradient of alpha" do i=2,nres-1 - if(itype(i).ne.10) then - do j=1,3 - dcji=dc(j,i-1) - dc(j,i-1)=dcji+aincr + if(itype(i,1).ne.10) then + do j=1,3 + dcji=dc(j,i-1) + dc(j,i-1)=dcji+aincr call chainbuild_cart dalphanum(j,1,i)=(alph(i)-alph_s(i)) & - /aincr - dc(j,i-1)=dcji + /aincr + dc(j,i-1)=dcji dcji=dc(j,i) dc(j,i)=dcji+aincr call chainbuild_cart dalphanum(j,2,i)=(alph(i)-alph_s(i)) & - /aincr + /aincr dc(j,i)=dcji dcji=dc(j,i+nres) dc(j,i+nres)=dc(j,i+nres)+aincr call chainbuild_cart dalphanum(j,3,i)=(alph(i)-alph_s(i)) & - /aincr + /aincr dc(j,i+nres)=dcji enddo - endif + endif !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),& !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3) !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),& @@ -14593,28 +17295,28 @@ write(iout,*) "jestesmy sobie w check eint!!" write (iout,*) & "Analytical (upper) and numerical (lower) gradient of omega" do i=2,nres-1 - if(itype(i).ne.10) then - do j=1,3 - dcji=dc(j,i-1) - dc(j,i-1)=dcji+aincr + if(itype(i,1).ne.10) then + do j=1,3 + dcji=dc(j,i-1) + dc(j,i-1)=dcji+aincr call chainbuild_cart domeganum(j,1,i)=(omeg(i)-omeg_s(i)) & - /aincr - dc(j,i-1)=dcji + /aincr + dc(j,i-1)=dcji dcji=dc(j,i) dc(j,i)=dcji+aincr call chainbuild_cart domeganum(j,2,i)=(omeg(i)-omeg_s(i)) & - /aincr + /aincr dc(j,i)=dcji dcji=dc(j,i+nres) dc(j,i+nres)=dc(j,i+nres)+aincr call chainbuild_cart domeganum(j,3,i)=(omeg(i)-omeg_s(i)) & - /aincr + /aincr dc(j,i+nres)=dcji enddo - endif + endif !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),& !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3) !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),& @@ -14639,7 +17341,7 @@ write(iout,*) "jestesmy sobie w check eint!!" ! include 'COMMON.VAR' integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg integer :: kkk,nsep=3 - real(kind=8) :: qm !dist, + real(kind=8) :: qm !dist, real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax logical :: lprn=.false. logical :: flag @@ -14659,7 +17361,7 @@ write(iout,*) "jestesmy sobie w check eint!!" (cref(3,jl,kkk)-cref(3,il,kkk))**2) dij=dist(il,jl) qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2) - if (itype(il).ne.10 .or. itype(jl).ne.10) then + if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then nl=nl+1 d0ijCM=dsqrt( & (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ & @@ -14670,7 +17372,7 @@ write(iout,*) "jestesmy sobie w check eint!!" endif qq = qq+qqij+qqijCM enddo - enddo + enddo qq = qq/nl else do il=seg1,seg2 @@ -14686,7 +17388,7 @@ write(iout,*) "jestesmy sobie w check eint!!" (cref(3,jl,kkk)-cref(3,il,kkk))**2) dij=dist(il,jl) qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2) - if (itype(il).ne.10 .or. itype(jl).ne.10) then + if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then nl=nl+1 d0ijCM=dsqrt( & (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ & @@ -14721,12 +17423,12 @@ write(iout,*) "jestesmy sobie w check eint!!" logical :: lprn=.false. logical :: flag real(kind=8) :: sim,dd0,fac,ddqij -!el sigm(x)=0.25d0*x ! local function +!el sigm(x)=0.25d0*x ! local function do kkk=1,nperm do i=0,nres do j=1,3 dqwol(j,i)=0.0d0 - dxqwol(j,i)=0.0d0 + dxqwol(j,i)=0.0d0 enddo enddo nl=0 @@ -14742,13 +17444,13 @@ write(iout,*) "jestesmy sobie w check eint!!" sim = sim*sim dd0 = dij-d0ij fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim) - do k=1,3 + do k=1,3 ddqij = (c(k,il)-c(k,jl))*fac dqwol(k,il)=dqwol(k,il)+ddqij dqwol(k,jl)=dqwol(k,jl)-ddqij enddo - - if (itype(il).ne.10 .or. itype(jl).ne.10) then + + if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then nl=nl+1 d0ijCM=dsqrt( & (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ & @@ -14764,9 +17466,9 @@ write(iout,*) "jestesmy sobie w check eint!!" dxqwol(k,il)=dxqwol(k,il)+ddqij dxqwol(k,jl)=dxqwol(k,jl)-ddqij enddo - endif + endif enddo - enddo + enddo else do il=seg1,seg2 if((seg3-il).lt.3) then @@ -14789,7 +17491,7 @@ write(iout,*) "jestesmy sobie w check eint!!" dqwol(k,il)=dqwol(k,il)+ddqij dqwol(k,jl)=dqwol(k,jl)-ddqij enddo - if (itype(il).ne.10 .or. itype(jl).ne.10) then + if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then nl=nl+1 d0ijCM=dsqrt( & (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ & @@ -14807,7 +17509,7 @@ write(iout,*) "jestesmy sobie w check eint!!" enddo endif enddo - enddo + enddo endif enddo do i=0,nres @@ -14909,11 +17611,11 @@ write(iout,*) "jestesmy sobie w check eint!!" Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),& qinfrag(i,iset)) ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset)) -! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset)) -! hmnum=(hm2-hm1)/delta +! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset)) +! hmnum=(hm2-hm1)/delta ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset), ! & qinfrag(i,iset)) -! write(iout,*) "harmonicnum frag", hmnum +! write(iout,*) "harmonicnum frag", hmnum ! Calculating the derivatives of Q with respect to cartesian coordinates call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,& idummy,idummy) @@ -14935,7 +17637,7 @@ write(iout,*) "jestesmy sobie w check eint!!" dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii) enddo enddo - enddo + enddo do i=1,npair kstart=ifrag(1,ipair(1,i,iset),iset) kend=ifrag(2,ipair(1,i,iset),iset) @@ -14946,11 +17648,11 @@ write(iout,*) "jestesmy sobie w check eint!!" ! Calculating dU/dQ Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset)) ! hm1=harmonic(qpair(i),qinpair(i,iset)) -! hm2=harmonic(qpair(i)+delta,qinpair(i,iset)) -! hmnum=(hm2-hm1)/delta +! hm2=harmonic(qpair(i)+delta,qinpair(i,iset)) +! hmnum=(hm2-hm1)/delta ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i), ! & qinpair(i,iset)) -! write(iout,*) "harmonicnum pair ", hmnum +! write(iout,*) "harmonicnum pair ", hmnum ! Calculating dQ/dXi call qwolynes_prim(kstart,kend,.false.,& lstart,lend) @@ -14987,7 +17689,7 @@ write(iout,*) "jestesmy sobie w check eint!!" do j=1,3 dudxconst(j,i)=duxconst(j,i) enddo - enddo + enddo ! write(iout,*) "dU/ddc backbone " ! do ii=0,nres ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3) @@ -15027,7 +17729,7 @@ write(iout,*) "jestesmy sobie w check eint!!" integer :: kstart,kend,lstart,lend,idummy real(kind=8) :: delta=1.0d-7 !el local variables - integer :: i,ii,j + integer :: i,ii,j ! real(kind=8) :: ! For the backbone do i=0,nres-1 @@ -15036,7 +17738,7 @@ write(iout,*) "jestesmy sobie w check eint!!" cdummy(j,i)=dc(j,i) dc(j,i)=dc(j,i)+delta call chainbuild_cart - uzap2=0.0d0 + uzap2=0.0d0 do ii=1,nfrag qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,& idummy,idummy) @@ -15070,7 +17772,7 @@ write(iout,*) "jestesmy sobie w check eint!!" uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),& qinpair(ii,iset)) enddo - ducartan(j,i)=(uzap2-uzap1)/(delta) + ducartan(j,i)=(uzap2-uzap1)/(delta) enddo enddo ! Calculating numerical gradients for dU/ddx @@ -15080,7 +17782,7 @@ write(iout,*) "jestesmy sobie w check eint!!" cdummy(j,i)=dc(j,i+nres) dc(j,i+nres)=dc(j,i+nres)+delta call chainbuild_cart - uzap2=0.0d0 + uzap2=0.0d0 do ii=1,nfrag qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,& idummy,idummy) @@ -15114,7 +17816,7 @@ write(iout,*) "jestesmy sobie w check eint!!" uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),& qinpair(ii,iset)) enddo - duxcartan(j,i)=(uzap2-uzap1)/(delta) + duxcartan(j,i)=(uzap2-uzap1)/(delta) enddo enddo write(iout,*) "Numerical dUconst/ddc backbone " @@ -15273,19 +17975,20 @@ write(iout,*) "jestesmy sobie w check eint!!" real(kind=8) :: deps,ssx0,ljx0 !-------END TESTING CODE + eij=0.0d0 i=resi j=resj !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres)) !el allocate(dyn_ssbond_ij(0:nres+4,nres)) - itypi=itype(i) + itypi=itype(i,1) dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) dsci_inv=vbld_inv(i+nres) - itypj=itype(j) + itypj=itype(j,1) xj=c(1,nres+j)-c(1,nres+i) yj=c(2,nres+j)-c(2,nres+i) zj=c(3,nres+j)-c(3,nres+i) @@ -15321,9 +18024,9 @@ write(iout,*) "jestesmy sobie w check eint!!" ljXs=sig-sig0ij ljA=eps1*eps2rt**2*eps3rt**2 - ljB=ljA*bb(itypi,itypj) - ljA=ljA*aa(itypi,itypj) - ljxm=ljXs+(-2.0D0*aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0) + ljB=ljA*bb_aq(itypi,itypj) + ljA=ljA*aa_aq(itypi,itypj) + ljxm=ljXs+(-2.0D0*aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0) ssXs=d0cm deltat1=1.0d0-om1 @@ -15357,7 +18060,7 @@ write(iout,*) "jestesmy sobie w check eint!!" ! Stop and plot energy and derivative as a function of distance if (checkstop) then ssm=ssC-0.25D0*ssB*ssB/ssA - ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj) + ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj) if (ssm.lt.ljm .and. & dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then nicheck=1000 @@ -15382,8 +18085,8 @@ write(iout,*) "jestesmy sobie w check eint!!" havebond=.false. ljd=rij-ljXs fac=(1.0D0/ljd)**expon - e1=fac*fac*aa(itypi,itypj) - e2=fac*bb(itypi,itypj) + e1=fac*fac*aa_aq(itypi,itypj) + e2=fac*bb_aq(itypi,itypj) eij=eps1*eps2rt*eps3rt*(e1+e2) eps2der=eij*eps3rt eps3der=eij*eps2rt @@ -15448,8 +18151,8 @@ write(iout,*) "jestesmy sobie w check eint!!" eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3) else havebond=.false. - ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj) - d_ljm(1)=-0.5D0*bb(itypi,itypj)/aa(itypi,itypj)*ljB + ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj) + d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt) d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- & alf12/eps3rt) @@ -15532,31 +18235,31 @@ write(iout,*) "jestesmy sobie w check eint!!" endif if (havebond) then -#ifndef CLUST -#ifndef WHAM +!#ifndef CLUST +!#ifndef WHAM ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then ! write(iout,'(a15,f12.2,f8.1,2i5)') ! & "SSBOND_E_FORM",totT,t_bath,i,j ! endif -#endif -#endif +!#endif +!#endif dyn_ssbond_ij(i,j)=eij else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then dyn_ssbond_ij(i,j)=1.0d300 -#ifndef CLUST -#ifndef WHAM +!#ifndef CLUST +!#ifndef WHAM ! write(iout,'(a15,f12.2,f8.1,2i5)') ! & "SSBOND_E_BREAK",totT,t_bath,i,j -#endif -#endif +!#endif +!#endif endif !-------TESTING CODE - if (checkstop) then +!el if (checkstop) then if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') & "CHECKSTOP",rij,eij,ed echeck(jcheck)=eij - endif +!el endif enddo if (checkstop) then write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps @@ -15596,6 +18299,176 @@ write(iout,*) "jestesmy sobie w check eint!!" return end subroutine dyn_ssbond_ene +!-------------------------------------------------------------------------- + subroutine triple_ssbond_ene(resi,resj,resk,eij) +! implicit none +! Includes + use calc_data + use comm_sschecks +! include 'DIMENSIONS' +! include 'COMMON.SBRIDGE' +! include 'COMMON.CHAIN' +! include 'COMMON.DERIV' +! include 'COMMON.LOCAL' +! include 'COMMON.INTERACT' +! include 'COMMON.VAR' +! include 'COMMON.IOUNITS' +! include 'COMMON.CALC' +#ifndef CLUST +#ifndef WHAM + use MD_data +! include 'COMMON.MD' +! use MD, only: totT,t_bath +#endif +#endif + double precision h_base + external h_base + +!c Input arguments + integer resi,resj,resk,m,itypi,itypj,itypk + +!c Output arguments + double precision eij,eij1,eij2,eij3 + +!c Local variables + logical havebond +!c integer itypi,itypj,k,l + double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi + double precision rrik,rrjk,rik,rjk,xi,xk,yi,yk,zi,zk,xij,yij,zij + double precision xik,yik,zik,xjk,yjk,zjk,dxk,dyk,dzk + double precision sig0ij,ljd,sig,fac,e1,e2 + double precision dcosom1(3),dcosom2(3),ed + double precision pom1,pom2 + double precision ljA,ljB,ljXs + double precision d_ljB(1:3) + double precision ssA,ssB,ssC,ssXs + double precision ssxm,ljxm,ssm,ljm + double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3) + eij=0.0 + if (dtriss.eq.0) return + i=resi + j=resj + k=resk +!C write(iout,*) resi,resj,resk + itypi=itype(i,1) + dxi=dc_norm(1,nres+i) + dyi=dc_norm(2,nres+i) + dzi=dc_norm(3,nres+i) + dsci_inv=vbld_inv(i+nres) + xi=c(1,nres+i) + yi=c(2,nres+i) + zi=c(3,nres+i) + itypj=itype(j,1) + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + + dxj=dc_norm(1,nres+j) + dyj=dc_norm(2,nres+j) + dzj=dc_norm(3,nres+j) + dscj_inv=vbld_inv(j+nres) + itypk=itype(k,1) + xk=c(1,nres+k) + yk=c(2,nres+k) + zk=c(3,nres+k) + + dxk=dc_norm(1,nres+k) + dyk=dc_norm(2,nres+k) + dzk=dc_norm(3,nres+k) + dscj_inv=vbld_inv(k+nres) + xij=xj-xi + xik=xk-xi + xjk=xk-xj + yij=yj-yi + yik=yk-yi + yjk=yk-yj + zij=zj-zi + zik=zk-zi + zjk=zk-zj + rrij=(xij*xij+yij*yij+zij*zij) + rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse + rrik=(xik*xik+yik*yik+zik*zik) + rik=dsqrt(rrik) + rrjk=(xjk*xjk+yjk*yjk+zjk*zjk) + rjk=dsqrt(rrjk) +!C there are three combination of distances for each trisulfide bonds +!C The first case the ith atom is the center +!C Energy function is E=d/(a*(x-y)**2+b*(x+y)**2+c) where x is first +!C distance y is second distance the a,b,c,d are parameters derived for +!C this problem d parameter was set as a penalty currenlty set to 1. + if ((iabs(j-i).le.2).or.(iabs(i-k).le.2)) then + eij1=0.0d0 + else + eij1=dtriss/(atriss*(rij-rik)**2+btriss*(rij+rik)**6+ctriss) + endif +!C second case jth atom is center + if ((iabs(j-i).le.2).or.(iabs(j-k).le.2)) then + eij2=0.0d0 + else + eij2=dtriss/(atriss*(rij-rjk)**2+btriss*(rij+rjk)**6+ctriss) + endif +!C the third case kth atom is the center + if ((iabs(i-k).le.2).or.(iabs(j-k).le.2)) then + eij3=0.0d0 + else + eij3=dtriss/(atriss*(rik-rjk)**2+btriss*(rik+rjk)**6+ctriss) + endif +!C eij2=0.0 +!C eij3=0.0 +!C eij1=0.0 + eij=eij1+eij2+eij3 +!C write(iout,*)i,j,k,eij +!C The energy penalty calculated now time for the gradient part +!C derivative over rij + fac=-eij1**2/dtriss*(2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) & + -eij2**2/dtriss*(2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5) + gg(1)=xij*fac/rij + gg(2)=yij*fac/rij + gg(3)=zij*fac/rij + do m=1,3 + gvdwx(m,i)=gvdwx(m,i)-gg(m) + gvdwx(m,j)=gvdwx(m,j)+gg(m) + enddo + + do l=1,3 + gvdwc(l,i)=gvdwc(l,i)-gg(l) + gvdwc(l,j)=gvdwc(l,j)+gg(l) + enddo +!C now derivative over rik + fac=-eij1**2/dtriss* & + (-2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) & + -eij3**2/dtriss*(2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5) + gg(1)=xik*fac/rik + gg(2)=yik*fac/rik + gg(3)=zik*fac/rik + do m=1,3 + gvdwx(m,i)=gvdwx(m,i)-gg(m) + gvdwx(m,k)=gvdwx(m,k)+gg(m) + enddo + do l=1,3 + gvdwc(l,i)=gvdwc(l,i)-gg(l) + gvdwc(l,k)=gvdwc(l,k)+gg(l) + enddo +!C now derivative over rjk + fac=-eij2**2/dtriss* & + (-2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)- & + eij3**2/dtriss*(-2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5) + gg(1)=xjk*fac/rjk + gg(2)=yjk*fac/rjk + gg(3)=zjk*fac/rjk + do m=1,3 + gvdwx(m,j)=gvdwx(m,j)-gg(m) + gvdwx(m,k)=gvdwx(m,k)+gg(m) + enddo + do l=1,3 + gvdwc(l,j)=gvdwc(l,j)-gg(l) + gvdwc(l,k)=gvdwc(l,k)+gg(l) + enddo + return + end subroutine triple_ssbond_ene + + + !----------------------------------------------------------------------------- real(kind=8) function h_base(x,deriv) ! A smooth function going 0->1 in range [0,1] @@ -15649,11 +18522,7 @@ write(iout,*) "jestesmy sobie w check eint!!" ! include 'COMMON.CHAIN' ! include 'COMMON.IOUNITS' ! include 'COMMON.SETUP' -#ifndef CLUST -#ifndef WHAM ! include 'COMMON.MD' -#endif -#endif ! Local variables real(kind=8) :: emin integer :: i,j,imin,ierr @@ -15746,15 +18615,18 @@ write(iout,*) "jestesmy sobie w check eint!!" diff=newnss-nss !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss) - +! print *,newnss,nss,maxdim do i=1,nss found=.false. +! print *,newnss do j=1,newnss +!! print *,j if (idssb(i).eq.newihpb(j) .and. & jdssb(i).eq.newjhpb(j)) found=.true. enddo #ifndef CLUST #ifndef WHAM +! write(iout,*) "found",found,i,j if (.not.found.and.fg_rank.eq.0) & write(iout,'(a15,f12.2,f8.1,2i5)') & "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i) @@ -15765,11 +18637,13 @@ write(iout,*) "jestesmy sobie w check eint!!" do i=1,newnss found=.false. do j=1,nss +! print *,i,j if (newihpb(i).eq.idssb(j) .and. & newjhpb(i).eq.jdssb(j)) found=.true. enddo #ifndef CLUST #ifndef WHAM +! write(iout,*) "found",found,i,j if (.not.found.and.fg_rank.eq.0) & write(iout,'(a15,f12.2,f8.1,2i5)') & "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i) @@ -15785,25 +18659,1017 @@ write(iout,*) "jestesmy sobie w check eint!!" return end subroutine dyn_set_nss -!----------------------------------------------------------------------------- -#ifdef WHAM - subroutine read_ssHist - implicit none -! Includes -! include 'DIMENSIONS' -! include "DIMENSIONS.FREE" -! include 'COMMON.FREE' -! Local variables - integer :: i,j - character(len=80) :: controlcard - - do i=1,dyn_nssHist - call card_concat(controlcard,.true.) - read(controlcard,*) & - dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0)) +! Lipid transfer energy function + subroutine Eliptransfer(eliptran) +!C this is done by Adasko +!C print *,"wchodze" +!C structure of box: +!C water +!C--bordliptop-- buffore starts +!C--bufliptop--- here true lipid starts +!C lipid +!C--buflipbot--- lipid ends buffore starts +!C--bordlipbot--buffore ends + real(kind=8) :: fracinbuf,eliptran,sslip,positi,ssgradlip + integer :: i + eliptran=0.0 +! print *, "I am in eliptran" + do i=ilip_start,ilip_end +!C do i=1,1 + if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))& + cycle + + positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize)) + if (positi.le.0.0) positi=positi+boxzsize +!C print *,i +!C first for peptide groups +!c for each residue check if it is in lipid or lipid water border area + if ((positi.gt.bordlipbot) & + .and.(positi.lt.bordliptop)) then +!C the energy transfer exist + if (positi.lt.buflipbot) then +!C what fraction I am in + fracinbuf=1.0d0- & + ((positi-bordlipbot)/lipbufthick) +!C lipbufthick is thickenes of lipid buffore + sslip=sscalelip(fracinbuf) + ssgradlip=-sscagradlip(fracinbuf)/lipbufthick + eliptran=eliptran+sslip*pepliptran + gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0 + gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0 +!C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran + +!C print *,"doing sccale for lower part" +!C print *,i,sslip,fracinbuf,ssgradlip + elseif (positi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick) + sslip=sscalelip(fracinbuf) + ssgradlip=sscagradlip(fracinbuf)/lipbufthick + eliptran=eliptran+sslip*pepliptran + gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0 + gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0 +!C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran +!C print *, "doing sscalefor top part" +!C print *,i,sslip,fracinbuf,ssgradlip + else + eliptran=eliptran+pepliptran +!C print *,"I am in true lipid" + endif +!C else +!C eliptran=elpitran+0.0 ! I am in water + endif + if (energy_dec) write(iout,*) i,"eliptran=",eliptran,positi,sslip + enddo +! here starts the side chain transfer + do i=ilip_start,ilip_end + if (itype(i,1).eq.ntyp1) cycle + positi=(mod(c(3,i+nres),boxzsize)) + if (positi.le.0) positi=positi+boxzsize +!C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop +!c for each residue check if it is in lipid or lipid water border area +!C respos=mod(c(3,i+nres),boxzsize) +!C print *,positi,bordlipbot,buflipbot + if ((positi.gt.bordlipbot) & + .and.(positi.lt.bordliptop)) then +!C the energy transfer exist + if (positi.lt.buflipbot) then + fracinbuf=1.0d0- & + ((positi-bordlipbot)/lipbufthick) +!C lipbufthick is thickenes of lipid buffore + sslip=sscalelip(fracinbuf) + ssgradlip=-sscagradlip(fracinbuf)/lipbufthick + eliptran=eliptran+sslip*liptranene(itype(i,1)) + gliptranx(3,i)=gliptranx(3,i) & + +ssgradlip*liptranene(itype(i,1)) + gliptranc(3,i-1)= gliptranc(3,i-1) & + +ssgradlip*liptranene(itype(i,1)) +!C print *,"doing sccale for lower part" + elseif (positi.gt.bufliptop) then + fracinbuf=1.0d0- & + ((bordliptop-positi)/lipbufthick) + sslip=sscalelip(fracinbuf) + ssgradlip=sscagradlip(fracinbuf)/lipbufthick + eliptran=eliptran+sslip*liptranene(itype(i,1)) + gliptranx(3,i)=gliptranx(3,i) & + +ssgradlip*liptranene(itype(i,1)) + gliptranc(3,i-1)= gliptranc(3,i-1) & + +ssgradlip*liptranene(itype(i,1)) +!C print *, "doing sscalefor top part",sslip,fracinbuf + else + eliptran=eliptran+liptranene(itype(i,1)) +!C print *,"I am in true lipid" + endif + endif ! if in lipid or buffor +!C else +!C eliptran=elpitran+0.0 ! I am in water + if (energy_dec) write(iout,*) i,"eliptran=",eliptran + enddo + return + end subroutine Eliptransfer +!----------------------------------NANO FUNCTIONS +!C----------------------------------------------------------------------- +!C----------------------------------------------------------- +!C This subroutine is to mimic the histone like structure but as well can be +!C utilizet to nanostructures (infinit) small modification has to be used to +!C make it finite (z gradient at the ends has to be changes as well as the x,y +!C gradient has to be modified at the ends +!C The energy function is Kihara potential +!C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6) +!C 4eps is depth of well sigma is r_minimum r is distance from center of tube +!C and r0 is the excluded size of nanotube (can be set to 0 if we want just a +!C simple Kihara potential + subroutine calctube(Etube) + real(kind=8),dimension(3) :: vectube + real(kind=8) :: Etube,xtemp,xminact,yminact,& + ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi, & + sc_aa_tube,sc_bb_tube + integer :: i,j,iti + Etube=0.0d0 + do i=itube_start,itube_end + enetube(i)=0.0d0 + enetube(i+nres)=0.0d0 + enddo +!C first we calculate the distance from tube center +!C for UNRES + do i=itube_start,itube_end +!C lets ommit dummy atoms for now + if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle +!C now calculate distance from center of tube and direction vectors + xmin=boxxsize + ymin=boxysize +! Find minimum distance in periodic box + do j=-1,1 + vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize) + vectube(1)=vectube(1)+boxxsize*j + vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize) + vectube(2)=vectube(2)+boxysize*j + xminact=abs(vectube(1)-tubecenter(1)) + yminact=abs(vectube(2)-tubecenter(2)) + if (xmin.gt.xminact) then + xmin=xminact + xtemp=vectube(1) + endif + if (ymin.gt.yminact) then + ymin=yminact + ytemp=vectube(2) + endif + enddo + vectube(1)=xtemp + vectube(2)=ytemp + vectube(1)=vectube(1)-tubecenter(1) + vectube(2)=vectube(2)-tubecenter(2) + +!C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1) +!C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2) + +!C as the tube is infinity we do not calculate the Z-vector use of Z +!C as chosen axis + vectube(3)=0.0d0 +!C now calculte the distance + tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2) +!C now normalize vector + vectube(1)=vectube(1)/tub_r + vectube(2)=vectube(2)/tub_r +!C calculte rdiffrence between r and r0 + rdiff=tub_r-tubeR0 +!C and its 6 power + rdiff6=rdiff**6.0d0 +!C for vectorization reasons we will sumup at the end to avoid depenence of previous + enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6 +!C write(iout,*) "TU13",i,rdiff6,enetube(i) +!C print *,rdiff,rdiff6,pep_aa_tube +!C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6 +!C now we calculate gradient + fac=(-12.0d0*pep_aa_tube/rdiff6- & + 6.0d0*pep_bb_tube)/rdiff6/rdiff +!C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i), +!C &rdiff,fac +!C now direction of gg_tube vector + do j=1,3 + gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0 + gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0 + enddo + enddo +!C basically thats all code now we split for side-chains (REMEMBER to sum up at the END) +!C print *,gg_tube(1,0),"TU" + + + do i=itube_start,itube_end +!C Lets not jump over memory as we use many times iti + iti=itype(i,1) +!C lets ommit dummy atoms for now + if ((iti.eq.ntyp1) & +!C in UNRES uncomment the line below as GLY has no side-chain... +!C .or.(iti.eq.10) + ) cycle + xmin=boxxsize + ymin=boxysize + do j=-1,1 + vectube(1)=mod((c(1,i+nres)),boxxsize) + vectube(1)=vectube(1)+boxxsize*j + vectube(2)=mod((c(2,i+nres)),boxysize) + vectube(2)=vectube(2)+boxysize*j + + xminact=abs(vectube(1)-tubecenter(1)) + yminact=abs(vectube(2)-tubecenter(2)) + if (xmin.gt.xminact) then + xmin=xminact + xtemp=vectube(1) + endif + if (ymin.gt.yminact) then + ymin=yminact + ytemp=vectube(2) + endif + enddo + vectube(1)=xtemp + vectube(2)=ytemp +!C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2), +!C & tubecenter(2) + vectube(1)=vectube(1)-tubecenter(1) + vectube(2)=vectube(2)-tubecenter(2) + +!C as the tube is infinity we do not calculate the Z-vector use of Z +!C as chosen axis + vectube(3)=0.0d0 +!C now calculte the distance + tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2) +!C now normalize vector + vectube(1)=vectube(1)/tub_r + vectube(2)=vectube(2)/tub_r + +!C calculte rdiffrence between r and r0 + rdiff=tub_r-tubeR0 +!C and its 6 power + rdiff6=rdiff**6.0d0 +!C for vectorization reasons we will sumup at the end to avoid depenence of previous + sc_aa_tube=sc_aa_tube_par(iti) + sc_bb_tube=sc_bb_tube_par(iti) + enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6 + fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- & + 6.0d0*sc_bb_tube/rdiff6/rdiff +!C now direction of gg_tube vector + do j=1,3 + gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac + gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac + enddo + enddo + do i=itube_start,itube_end + Etube=Etube+enetube(i)+enetube(i+nres) + enddo +!C print *,"ETUBE", etube + return + end subroutine calctube +!C TO DO 1) add to total energy +!C 2) add to gradient summation +!C 3) add reading parameters (AND of course oppening of PARAM file) +!C 4) add reading the center of tube +!C 5) add COMMONs +!C 6) add to zerograd +!C 7) allocate matrices + + +!C----------------------------------------------------------------------- +!C----------------------------------------------------------- +!C This subroutine is to mimic the histone like structure but as well can be +!C utilizet to nanostructures (infinit) small modification has to be used to +!C make it finite (z gradient at the ends has to be changes as well as the x,y +!C gradient has to be modified at the ends +!C The energy function is Kihara potential +!C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6) +!C 4eps is depth of well sigma is r_minimum r is distance from center of tube +!C and r0 is the excluded size of nanotube (can be set to 0 if we want just a +!C simple Kihara potential + subroutine calctube2(Etube) + real(kind=8),dimension(3) :: vectube + real(kind=8) :: Etube,xtemp,xminact,yminact,& + ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi,fracinbuf,& + sstube,ssgradtube,sc_aa_tube,sc_bb_tube + integer:: i,j,iti + Etube=0.0d0 + do i=itube_start,itube_end + enetube(i)=0.0d0 + enetube(i+nres)=0.0d0 enddo +!C first we calculate the distance from tube center +!C first sugare-phosphate group for NARES this would be peptide group +!C for UNRES + do i=itube_start,itube_end +!C lets ommit dummy atoms for now + + if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle +!C now calculate distance from center of tube and direction vectors +!C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize) +!C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize +!C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize) +!C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize + xmin=boxxsize + ymin=boxysize + do j=-1,1 + vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize) + vectube(1)=vectube(1)+boxxsize*j + vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize) + vectube(2)=vectube(2)+boxysize*j + + xminact=abs(vectube(1)-tubecenter(1)) + yminact=abs(vectube(2)-tubecenter(2)) + if (xmin.gt.xminact) then + xmin=xminact + xtemp=vectube(1) + endif + if (ymin.gt.yminact) then + ymin=yminact + ytemp=vectube(2) + endif + enddo + vectube(1)=xtemp + vectube(2)=ytemp + vectube(1)=vectube(1)-tubecenter(1) + vectube(2)=vectube(2)-tubecenter(2) + +!C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1) +!C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2) + +!C as the tube is infinity we do not calculate the Z-vector use of Z +!C as chosen axis + vectube(3)=0.0d0 +!C now calculte the distance + tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2) +!C now normalize vector + vectube(1)=vectube(1)/tub_r + vectube(2)=vectube(2)/tub_r +!C calculte rdiffrence between r and r0 + rdiff=tub_r-tubeR0 +!C and its 6 power + rdiff6=rdiff**6.0d0 +!C THIS FRAGMENT MAKES TUBE FINITE + positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize) + if (positi.le.0) positi=positi+boxzsize +!C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop +!c for each residue check if it is in lipid or lipid water border area +!C respos=mod(c(3,i+nres),boxzsize) +!C print *,positi,bordtubebot,buftubebot,bordtubetop + if ((positi.gt.bordtubebot) & + .and.(positi.lt.bordtubetop)) then +!C the energy transfer exist + if (positi.lt.buftubebot) then + fracinbuf=1.0d0- & + ((positi-bordtubebot)/tubebufthick) +!C lipbufthick is thickenes of lipid buffore + sstube=sscalelip(fracinbuf) + ssgradtube=-sscagradlip(fracinbuf)/tubebufthick +!C print *,ssgradtube, sstube,tubetranene(itype(i,1)) + enetube(i)=enetube(i)+sstube*tubetranenepep +!C gg_tube_SC(3,i)=gg_tube_SC(3,i) +!C &+ssgradtube*tubetranene(itype(i,1)) +!C gg_tube(3,i-1)= gg_tube(3,i-1) +!C &+ssgradtube*tubetranene(itype(i,1)) +!C print *,"doing sccale for lower part" + elseif (positi.gt.buftubetop) then + fracinbuf=1.0d0- & + ((bordtubetop-positi)/tubebufthick) + sstube=sscalelip(fracinbuf) + ssgradtube=sscagradlip(fracinbuf)/tubebufthick + enetube(i)=enetube(i)+sstube*tubetranenepep +!C gg_tube_SC(3,i)=gg_tube_SC(3,i) +!C &+ssgradtube*tubetranene(itype(i,1)) +!C gg_tube(3,i-1)= gg_tube(3,i-1) +!C &+ssgradtube*tubetranene(itype(i,1)) +!C print *, "doing sscalefor top part",sslip,fracinbuf + else + sstube=1.0d0 + ssgradtube=0.0d0 + enetube(i)=enetube(i)+sstube*tubetranenepep +!C print *,"I am in true lipid" + endif + else +!C sstube=0.0d0 +!C ssgradtube=0.0d0 + cycle + endif ! if in lipid or buffor + +!C for vectorization reasons we will sumup at the end to avoid depenence of previous + enetube(i)=enetube(i)+sstube* & + (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6) +!C write(iout,*) "TU13",i,rdiff6,enetube(i) +!C print *,rdiff,rdiff6,pep_aa_tube +!C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6 +!C now we calculate gradient + fac=(-12.0d0*pep_aa_tube/rdiff6- & + 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube +!C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i), +!C &rdiff,fac + +!C now direction of gg_tube vector + do j=1,3 + gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0 + gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0 + enddo + gg_tube(3,i)=gg_tube(3,i) & + +ssgradtube*enetube(i)/sstube/2.0d0 + gg_tube(3,i-1)= gg_tube(3,i-1) & + +ssgradtube*enetube(i)/sstube/2.0d0 - return + enddo +!C basically thats all code now we split for side-chains (REMEMBER to sum up at the END) +!C print *,gg_tube(1,0),"TU" + do i=itube_start,itube_end +!C Lets not jump over memory as we use many times iti + iti=itype(i,1) +!C lets ommit dummy atoms for now + if ((iti.eq.ntyp1) & +!!C in UNRES uncomment the line below as GLY has no side-chain... + .or.(iti.eq.10) & + ) cycle + vectube(1)=c(1,i+nres) + vectube(1)=mod(vectube(1),boxxsize) + if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize + vectube(2)=c(2,i+nres) + vectube(2)=mod(vectube(2),boxysize) + if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize + + vectube(1)=vectube(1)-tubecenter(1) + vectube(2)=vectube(2)-tubecenter(2) +!C THIS FRAGMENT MAKES TUBE FINITE + positi=(mod(c(3,i+nres),boxzsize)) + if (positi.le.0) positi=positi+boxzsize +!C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop +!c for each residue check if it is in lipid or lipid water border area +!C respos=mod(c(3,i+nres),boxzsize) +!C print *,positi,bordtubebot,buftubebot,bordtubetop + + if ((positi.gt.bordtubebot) & + .and.(positi.lt.bordtubetop)) then +!C the energy transfer exist + if (positi.lt.buftubebot) then + fracinbuf=1.0d0- & + ((positi-bordtubebot)/tubebufthick) +!C lipbufthick is thickenes of lipid buffore + sstube=sscalelip(fracinbuf) + ssgradtube=-sscagradlip(fracinbuf)/tubebufthick +!C print *,ssgradtube, sstube,tubetranene(itype(i,1)) + enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1)) +!C gg_tube_SC(3,i)=gg_tube_SC(3,i) +!C &+ssgradtube*tubetranene(itype(i,1)) +!C gg_tube(3,i-1)= gg_tube(3,i-1) +!C &+ssgradtube*tubetranene(itype(i,1)) +!C print *,"doing sccale for lower part" + elseif (positi.gt.buftubetop) then + fracinbuf=1.0d0- & + ((bordtubetop-positi)/tubebufthick) + + sstube=sscalelip(fracinbuf) + ssgradtube=sscagradlip(fracinbuf)/tubebufthick + enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1)) +!C gg_tube_SC(3,i)=gg_tube_SC(3,i) +!C &+ssgradtube*tubetranene(itype(i,1)) +!C gg_tube(3,i-1)= gg_tube(3,i-1) +!C &+ssgradtube*tubetranene(itype(i,1)) +!C print *, "doing sscalefor top part",sslip,fracinbuf + else + sstube=1.0d0 + ssgradtube=0.0d0 + enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1)) +!C print *,"I am in true lipid" + endif + else +!C sstube=0.0d0 +!C ssgradtube=0.0d0 + cycle + endif ! if in lipid or buffor +!CEND OF FINITE FRAGMENT +!C as the tube is infinity we do not calculate the Z-vector use of Z +!C as chosen axis + vectube(3)=0.0d0 +!C now calculte the distance + tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2) +!C now normalize vector + vectube(1)=vectube(1)/tub_r + vectube(2)=vectube(2)/tub_r +!C calculte rdiffrence between r and r0 + rdiff=tub_r-tubeR0 +!C and its 6 power + rdiff6=rdiff**6.0d0 +!C for vectorization reasons we will sumup at the end to avoid depenence of previous + sc_aa_tube=sc_aa_tube_par(iti) + sc_bb_tube=sc_bb_tube_par(iti) + enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)& + *sstube+enetube(i+nres) +!C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6 +!C now we calculate gradient + fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-& + 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube +!C now direction of gg_tube vector + do j=1,3 + gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac + gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac + enddo + gg_tube_SC(3,i)=gg_tube_SC(3,i) & + +ssgradtube*enetube(i+nres)/sstube + gg_tube(3,i-1)= gg_tube(3,i-1) & + +ssgradtube*enetube(i+nres)/sstube + + enddo + do i=itube_start,itube_end + Etube=Etube+enetube(i)+enetube(i+nres) + enddo +!C print *,"ETUBE", etube + return + end subroutine calctube2 +!===================================================================================================================================== + subroutine calcnano(Etube) + real(kind=8),dimension(3) :: vectube + + real(kind=8) :: Etube,xtemp,xminact,yminact,& + ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,denominator,faccav,& + sc_aa_tube,sc_bb_tube,zmin,ztemp,zminact + integer:: i,j,iti,r + + Etube=0.0d0 +! print *,itube_start,itube_end,"poczatek" + do i=itube_start,itube_end + enetube(i)=0.0d0 + enetube(i+nres)=0.0d0 + enddo +!C first we calculate the distance from tube center +!C first sugare-phosphate group for NARES this would be peptide group +!C for UNRES + do i=itube_start,itube_end +!C lets ommit dummy atoms for now + if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle +!C now calculate distance from center of tube and direction vectors + xmin=boxxsize + ymin=boxysize + zmin=boxzsize + + do j=-1,1 + vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize) + vectube(1)=vectube(1)+boxxsize*j + vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize) + vectube(2)=vectube(2)+boxysize*j + vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize) + vectube(3)=vectube(3)+boxzsize*j + + + xminact=dabs(vectube(1)-tubecenter(1)) + yminact=dabs(vectube(2)-tubecenter(2)) + zminact=dabs(vectube(3)-tubecenter(3)) + + if (xmin.gt.xminact) then + xmin=xminact + xtemp=vectube(1) + endif + if (ymin.gt.yminact) then + ymin=yminact + ytemp=vectube(2) + endif + if (zmin.gt.zminact) then + zmin=zminact + ztemp=vectube(3) + endif + enddo + vectube(1)=xtemp + vectube(2)=ytemp + vectube(3)=ztemp + + vectube(1)=vectube(1)-tubecenter(1) + vectube(2)=vectube(2)-tubecenter(2) + vectube(3)=vectube(3)-tubecenter(3) + +!C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1) +!C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2) +!C as the tube is infinity we do not calculate the Z-vector use of Z +!C as chosen axis +!C vectube(3)=0.0d0 +!C now calculte the distance + tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2) +!C now normalize vector + vectube(1)=vectube(1)/tub_r + vectube(2)=vectube(2)/tub_r + vectube(3)=vectube(3)/tub_r +!C calculte rdiffrence between r and r0 + rdiff=tub_r-tubeR0 +!C and its 6 power + rdiff6=rdiff**6.0d0 +!C for vectorization reasons we will sumup at the end to avoid depenence of previous + enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6 +!C write(iout,*) "TU13",i,rdiff6,enetube(i) +!C print *,rdiff,rdiff6,pep_aa_tube +!C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6 +!C now we calculate gradient + fac=(-12.0d0*pep_aa_tube/rdiff6- & + 6.0d0*pep_bb_tube)/rdiff6/rdiff +!C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i), +!C &rdiff,fac + if (acavtubpep.eq.0.0d0) then +!C go to 667 + enecavtube(i)=0.0 + faccav=0.0 + else + denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6) + enecavtube(i)= & + (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) & + /denominator + enecavtube(i)=0.0 + faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) & + *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) & + +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) & + /denominator**2.0d0 +!C faccav=0.0 +!C fac=fac+faccav +!C 667 continue + endif + if (energy_dec) write(iout,*),i,rdiff,enetube(i),enecavtube(i) + do j=1,3 + gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0 + gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0 + enddo + enddo + + do i=itube_start,itube_end + enecavtube(i)=0.0d0 +!C Lets not jump over memory as we use many times iti + iti=itype(i,1) +!C lets ommit dummy atoms for now + if ((iti.eq.ntyp1) & +!C in UNRES uncomment the line below as GLY has no side-chain... +!C .or.(iti.eq.10) + ) cycle + xmin=boxxsize + ymin=boxysize + zmin=boxzsize + do j=-1,1 + vectube(1)=dmod((c(1,i+nres)),boxxsize) + vectube(1)=vectube(1)+boxxsize*j + vectube(2)=dmod((c(2,i+nres)),boxysize) + vectube(2)=vectube(2)+boxysize*j + vectube(3)=dmod((c(3,i+nres)),boxzsize) + vectube(3)=vectube(3)+boxzsize*j + + + xminact=dabs(vectube(1)-tubecenter(1)) + yminact=dabs(vectube(2)-tubecenter(2)) + zminact=dabs(vectube(3)-tubecenter(3)) + + if (xmin.gt.xminact) then + xmin=xminact + xtemp=vectube(1) + endif + if (ymin.gt.yminact) then + ymin=yminact + ytemp=vectube(2) + endif + if (zmin.gt.zminact) then + zmin=zminact + ztemp=vectube(3) + endif + enddo + vectube(1)=xtemp + vectube(2)=ytemp + vectube(3)=ztemp + +!C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2), +!C & tubecenter(2) + vectube(1)=vectube(1)-tubecenter(1) + vectube(2)=vectube(2)-tubecenter(2) + vectube(3)=vectube(3)-tubecenter(3) +!C now calculte the distance + tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2) +!C now normalize vector + vectube(1)=vectube(1)/tub_r + vectube(2)=vectube(2)/tub_r + vectube(3)=vectube(3)/tub_r + +!C calculte rdiffrence between r and r0 + rdiff=tub_r-tubeR0 +!C and its 6 power + rdiff6=rdiff**6.0d0 + sc_aa_tube=sc_aa_tube_par(iti) + sc_bb_tube=sc_bb_tube_par(iti) + enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6 +!C enetube(i+nres)=0.0d0 +!C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6 +!C now we calculate gradient + fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- & + 6.0d0*sc_bb_tube/rdiff6/rdiff +!C fac=0.0 +!C now direction of gg_tube vector +!C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12) + if (acavtub(iti).eq.0.0d0) then +!C go to 667 + enecavtube(i+nres)=0.0d0 + faccav=0.0d0 + else + denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6) + enecavtube(i+nres)= & + (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) & + /denominator +!C enecavtube(i)=0.0 + faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) & + *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) & + +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) & + /denominator**2.0d0 +!C faccav=0.0 + fac=fac+faccav +!C 667 continue + endif +!C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator, +!C & enecavtube(i),faccav +!C print *,"licz=", +!C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti)) +!C print *,"finene=",enetube(i+nres)+enecavtube(i) + do j=1,3 + gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac + gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac + enddo + if (energy_dec) write(iout,*),i,rdiff,enetube(i+nres),enecavtube(i+nres) + enddo + + + + do i=itube_start,itube_end + Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) & + +enecavtube(i+nres) + enddo +! do i=1,20 +! print *,"begin", i,"a" +! do r=1,10000 +! rdiff=r/100.0d0 +! rdiff6=rdiff**6.0d0 +! sc_aa_tube=sc_aa_tube_par(i) +! sc_bb_tube=sc_bb_tube_par(i) +! enetube(i)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6 +! denominator=(1.0d0+dcavtub(i)*rdiff6*rdiff6) +! enecavtube(i)= & +! (bcavtub(i)*rdiff+acavtub(i)*dsqrt(rdiff)+ccavtub(i)) & +! /denominator + +! print '(5(f10.3,1x))',rdiff,enetube(i),enecavtube(i),enecavtube(i)+enetube(i) +! enddo +! print *,"end",i,"a" +! enddo +!C print *,"ETUBE", etube + return + end subroutine calcnano + +!=============================================== +!-------------------------------------------------------------------------------- +!C first for shielding is setting of function of side-chains + + subroutine set_shield_fac2 + real(kind=8) :: div77_81=0.974996043d0, & + div4_81=0.2222222222d0 + real (kind=8) :: dist_pep_side,dist_side_calf,dist_pept_group, & + scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,& + short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, & + sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin +!C the vector between center of side_chain and peptide group + real(kind=8),dimension(3) :: pep_side_long,side_calf, & + pept_group,costhet_grad,cosphi_grad_long, & + cosphi_grad_loc,pep_side_norm,side_calf_norm, & + sh_frac_dist_grad,pep_side + integer i,j,k +!C write(2,*) "ivec",ivec_start,ivec_end + do i=1,nres + fac_shield(i)=0.0d0 + do j=1,3 + grad_shield(j,i)=0.0d0 + enddo + enddo + do i=ivec_start,ivec_end +!C do i=1,nres-1 +!C if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle + ishield_list(i)=0 + if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle +!Cif there two consequtive dummy atoms there is no peptide group between them +!C the line below has to be changed for FGPROC>1 + VolumeTotal=0.0 + do k=1,nres + if ((itype(k,1).eq.ntyp1).or.(itype(k,1).eq.10)) cycle + dist_pep_side=0.0 + dist_side_calf=0.0 + do j=1,3 +!C first lets set vector conecting the ithe side-chain with kth side-chain + pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0 +!C pep_side(j)=2.0d0 +!C and vector conecting the side-chain with its proper calfa + side_calf(j)=c(j,k+nres)-c(j,k) +!C side_calf(j)=2.0d0 + pept_group(j)=c(j,i)-c(j,i+1) +!C lets have their lenght + dist_pep_side=pep_side(j)**2+dist_pep_side + dist_side_calf=dist_side_calf+side_calf(j)**2 + dist_pept_group=dist_pept_group+pept_group(j)**2 + enddo + dist_pep_side=sqrt(dist_pep_side) + dist_pept_group=sqrt(dist_pept_group) + dist_side_calf=sqrt(dist_side_calf) + do j=1,3 + pep_side_norm(j)=pep_side(j)/dist_pep_side + side_calf_norm(j)=dist_side_calf + enddo +!C now sscale fraction + sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield +! print *,buff_shield,"buff",sh_frac_dist +!C now sscale + if (sh_frac_dist.le.0.0) cycle +!C print *,ishield_list(i),i +!C If we reach here it means that this side chain reaches the shielding sphere +!C Lets add him to the list for gradient + ishield_list(i)=ishield_list(i)+1 +!C ishield_list is a list of non 0 side-chain that contribute to factor gradient +!C this list is essential otherwise problem would be O3 + shield_list(ishield_list(i),i)=k +!C Lets have the sscale value + if (sh_frac_dist.gt.1.0) then + scale_fac_dist=1.0d0 + do j=1,3 + sh_frac_dist_grad(j)=0.0d0 + enddo + else + scale_fac_dist=-sh_frac_dist*sh_frac_dist & + *(2.0d0*sh_frac_dist-3.0d0) + fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) & + /dist_pep_side/buff_shield*0.5d0 + do j=1,3 + sh_frac_dist_grad(j)=fac_help_scale*pep_side(j) +!C sh_frac_dist_grad(j)=0.0d0 +!C scale_fac_dist=1.0d0 +!C print *,"jestem",scale_fac_dist,fac_help_scale, +!C & sh_frac_dist_grad(j) + enddo + endif +!C this is what is now we have the distance scaling now volume... + short=short_r_sidechain(itype(k,1)) + long=long_r_sidechain(itype(k,1)) + costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2) + sinthet=short/dist_pep_side*costhet +! print *,"SORT",short,long,sinthet,costhet +!C now costhet_grad +!C costhet=0.6d0 +!C sinthet=0.8 + costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4 +!C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet +!C & -short/dist_pep_side**2/costhet) +!C costhet_fac=0.0d0 + do j=1,3 + costhet_grad(j)=costhet_fac*pep_side(j) + enddo +!C remember for the final gradient multiply costhet_grad(j) +!C for side_chain by factor -2 ! +!C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1 +!C pep_side0pept_group is vector multiplication + pep_side0pept_group=0.0d0 + do j=1,3 + pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j) + enddo + cosalfa=(pep_side0pept_group/ & + (dist_pep_side*dist_side_calf)) + fac_alfa_sin=1.0d0-cosalfa**2 + fac_alfa_sin=dsqrt(fac_alfa_sin) + rkprim=fac_alfa_sin*(long-short)+short +!C rkprim=short + +!C now costhet_grad + cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2) +!C cosphi=0.6 + cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4 + sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ & + dist_pep_side**2) +!C sinphi=0.8 + do j=1,3 + cosphi_grad_long(j)=cosphi_fac*pep_side(j) & + +cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) & + *(long-short)/fac_alfa_sin*cosalfa/ & + ((dist_pep_side*dist_side_calf))* & + ((side_calf(j))-cosalfa* & + ((pep_side(j)/dist_pep_side)*dist_side_calf)) +!C cosphi_grad_long(j)=0.0d0 + cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) & + *(long-short)/fac_alfa_sin*cosalfa & + /((dist_pep_side*dist_side_calf))* & + (pep_side(j)- & + cosalfa*side_calf(j)/dist_side_calf*dist_pep_side) +!C cosphi_grad_loc(j)=0.0d0 + enddo +!C print *,sinphi,sinthet + VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) & + /VSolvSphere_div +!C & *wshield +!C now the gradient... + do j=1,3 + grad_shield(j,i)=grad_shield(j,i) & +!C gradient po skalowaniu + +(sh_frac_dist_grad(j)*VofOverlap & +!C gradient po costhet + +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* & + (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( & + sinphi/sinthet*costhet*costhet_grad(j) & + +sinthet/sinphi*cosphi*cosphi_grad_long(j))) & + )*wshield +!C grad_shield_side is Cbeta sidechain gradient + grad_shield_side(j,ishield_list(i),i)=& + (sh_frac_dist_grad(j)*-2.0d0& + *VofOverlap& + -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*& + (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(& + sinphi/sinthet*costhet*costhet_grad(j)& + +sinthet/sinphi*cosphi*cosphi_grad_long(j))) & + )*wshield +! print *, 1.0d0/(-dsqrt(1.0d0-sinphi*sinthet)),& +! sinphi/sinthet,& +! +sinthet/sinphi,"HERE" + grad_shield_loc(j,ishield_list(i),i)= & + scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*& + (1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(& + sinthet/sinphi*cosphi*cosphi_grad_loc(j)& + ))& + *wshield +! print *,grad_shield_loc(j,ishield_list(i),i) + enddo + VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist + enddo + fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield) + +! write(2,*) "TOTAL VOLUME",i,itype(i,1),fac_shield(i) + enddo + return + end subroutine set_shield_fac2 +!---------------------------------------------------------------------------- +! SOUBROUTINE FOR AFM + subroutine AFMvel(Eafmforce) + use MD_data, only:totTafm + real(kind=8),dimension(3) :: diffafm + real(kind=8) :: afmdist,Eafmforce + integer :: i +!C Only for check grad COMMENT if not used for checkgrad +!C totT=3.0d0 +!C-------------------------------------------------------- +!C print *,"wchodze" + afmdist=0.0d0 + Eafmforce=0.0d0 + do i=1,3 + diffafm(i)=c(i,afmend)-c(i,afmbeg) + afmdist=afmdist+diffafm(i)**2 + enddo + afmdist=dsqrt(afmdist) +! totTafm=3.0 + Eafmforce=0.5d0*forceAFMconst & + *(distafminit+totTafm*velAFMconst-afmdist)**2 +!C Eafmforce=-forceAFMconst*(dist-distafminit) + do i=1,3 + gradafm(i,afmend-1)=-forceAFMconst* & + (distafminit+totTafm*velAFMconst-afmdist) & + *diffafm(i)/afmdist + gradafm(i,afmbeg-1)=forceAFMconst* & + (distafminit+totTafm*velAFMconst-afmdist) & + *diffafm(i)/afmdist + enddo +! print *,'AFM',Eafmforce,totTafm*velAFMconst,afmdist + return + end subroutine AFMvel +!--------------------------------------------------------- + subroutine AFMforce(Eafmforce) + + real(kind=8),dimension(3) :: diffafm +! real(kind=8) ::afmdist + real(kind=8) :: afmdist,Eafmforce + integer :: i + afmdist=0.0d0 + Eafmforce=0.0d0 + do i=1,3 + diffafm(i)=c(i,afmend)-c(i,afmbeg) + afmdist=afmdist+diffafm(i)**2 + enddo + afmdist=dsqrt(afmdist) +! print *,afmdist,distafminit + Eafmforce=-forceAFMconst*(afmdist-distafminit) + do i=1,3 + gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/afmdist + gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/afmdist + enddo +!C print *,'AFM',Eafmforce + return + end subroutine AFMforce + +!----------------------------------------------------------------------------- +#ifdef WHAM + subroutine read_ssHist +! implicit none +! Includes +! include 'DIMENSIONS' +! include "DIMENSIONS.FREE" +! include 'COMMON.FREE' +! Local variables + integer :: i,j + character(len=80) :: controlcard + + do i=1,dyn_nssHist + call card_concat(controlcard,.true.) + read(controlcard,*) & + dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0)) + enddo + + return end subroutine read_ssHist #endif !----------------------------------------------------------------------------- @@ -15827,45 +19693,72 @@ write(iout,*) "jestesmy sobie w check eint!!" !----------------------------------------------------------------------------- subroutine alloc_ener_arrays !EL Allocation of arrays used by module energy - + use MD_data, only: mset !el local variables integer :: i,j if(nres.lt.100) then maxconts=nres elseif(nres.lt.200) then - maxconts=0.8*nres ! Max. number of contacts per residue + maxconts=0.8*nres ! Max. number of contacts per residue else maxconts=0.6*nres ! (maxconts=maxres/4) endif - maxcont=12*nres ! Max. number of SC contacts - maxvar=6*nres ! Max. number of variables + maxcont=12*nres ! Max. number of SC contacts + maxvar=6*nres ! Max. number of variables !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond !---------------------- ! arrays in subroutine init_int_table +!el#ifdef MPI +!el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1) +!el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1) +!el#endif allocate(nint_gr(nres)) allocate(nscp_gr(nres)) allocate(ielstart(nres)) - allocate(ielend(nres)) !(maxres) + allocate(ielend(nres)) +!(maxres) allocate(istart(nres,maxint_gr)) - allocate(iend(nres,maxint_gr)) !(maxres,maxint_gr) + allocate(iend(nres,maxint_gr)) +!(maxres,maxint_gr) allocate(iscpstart(nres,maxint_gr)) - allocate(iscpend(nres,maxint_gr)) !(maxres,maxint_gr) + allocate(iscpend(nres,maxint_gr)) +!(maxres,maxint_gr) allocate(ielstart_vdw(nres)) - allocate(ielend_vdw(nres)) !(maxres) - - allocate(lentyp(0:nfgtasks-1)) !(0:maxprocs-1) + allocate(ielend_vdw(nres)) +!(maxres) + allocate(nint_gr_nucl(nres)) + allocate(nscp_gr_nucl(nres)) + allocate(ielstart_nucl(nres)) + allocate(ielend_nucl(nres)) +!(maxres) + allocate(istart_nucl(nres,maxint_gr)) + allocate(iend_nucl(nres,maxint_gr)) +!(maxres,maxint_gr) + allocate(iscpstart_nucl(nres,maxint_gr)) + allocate(iscpend_nucl(nres,maxint_gr)) +!(maxres,maxint_gr) + allocate(ielstart_vdw_nucl(nres)) + allocate(ielend_vdw_nucl(nres)) + + allocate(lentyp(0:nfgtasks-1)) +!(0:maxprocs-1) !---------------------- ! commom.contacts ! common /contacts/ if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont)) - allocate(icont(2,maxcont)) !(2,maxcont) + allocate(icont(2,maxcont)) +!(2,maxcont) ! common /contacts1/ - allocate(num_cont(0:nres+4)) !(maxres) - allocate(jcont(maxconts,nres)) !(maxconts,maxres) - allocate(facont(maxconts,nres)) !(maxconts,maxres) - allocate(gacont(3,maxconts,nres)) !(3,maxconts,maxres) + allocate(num_cont(0:nres+4)) +!(maxres) + allocate(jcont(maxconts,nres)) +!(maxconts,maxres) + allocate(facont(maxconts,nres)) +!(maxconts,maxres) + allocate(gacont(3,maxconts,nres)) +!(3,maxconts,maxres) ! common /contacts_hb/ allocate(gacontp_hb1(3,maxconts,nres)) allocate(gacontp_hb2(3,maxconts,nres)) @@ -15874,31 +19767,43 @@ write(iout,*) "jestesmy sobie w check eint!!" allocate(gacontm_hb2(3,maxconts,nres)) allocate(gacontm_hb3(3,maxconts,nres)) allocate(gacont_hbr(3,maxconts,nres)) - allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) + allocate(grij_hb_cont(3,maxconts,nres)) +!(3,maxconts,maxres) allocate(facont_hb(maxconts,nres)) + allocate(ees0p(maxconts,nres)) allocate(ees0m(maxconts,nres)) - allocate(d_cont(maxconts,nres)) !(maxconts,maxres) - allocate(num_cont_hb(nres)) !(maxres) - allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres) + allocate(d_cont(maxconts,nres)) + allocate(ees0plist(maxconts,nres)) + +!(maxconts,maxres) + allocate(num_cont_hb(nres)) +!(maxres) + allocate(jcont_hb(maxconts,nres)) +!(maxconts,maxres) ! common /rotat/ allocate(Ug(2,2,nres)) allocate(Ugder(2,2,nres)) allocate(Ug2(2,2,nres)) - allocate(Ug2der(2,2,nres)) !(2,2,maxres) + allocate(Ug2der(2,2,nres)) +!(2,2,maxres) allocate(obrot(2,nres)) allocate(obrot2(2,nres)) allocate(obrot_der(2,nres)) - allocate(obrot2_der(2,nres)) !(2,maxres) + allocate(obrot2_der(2,nres)) +!(2,maxres) ! common /precomp1/ allocate(mu(2,nres)) allocate(muder(2,nres)) allocate(Ub2(2,nres)) + Ub2(1,:)=0.0d0 + Ub2(2,:)=0.0d0 allocate(Ub2der(2,nres)) allocate(Ctobr(2,nres)) allocate(Ctobrder(2,nres)) allocate(Dtobr2(2,nres)) - allocate(Dtobr2der(2,nres)) !(2,maxres) + allocate(Dtobr2der(2,nres)) +!(2,maxres) allocate(EUg(2,2,nres)) allocate(EUgder(2,2,nres)) allocate(CUg(2,2,nres)) @@ -15906,25 +19811,30 @@ write(iout,*) "jestesmy sobie w check eint!!" allocate(DUg(2,2,nres)) allocate(Dugder(2,2,nres)) allocate(DtUg2(2,2,nres)) - allocate(DtUg2der(2,2,nres)) !(2,2,maxres) + allocate(DtUg2der(2,2,nres)) +!(2,2,maxres) ! common /precomp2/ allocate(Ug2Db1t(2,nres)) allocate(Ug2Db1tder(2,nres)) allocate(CUgb2(2,nres)) - allocate(CUgb2der(2,nres)) !(2,maxres) + allocate(CUgb2der(2,nres)) +!(2,maxres) allocate(EUgC(2,2,nres)) allocate(EUgCder(2,2,nres)) allocate(EUgD(2,2,nres)) allocate(EUgDder(2,2,nres)) allocate(DtUg2EUg(2,2,nres)) - allocate(Ug2DtEUg(2,2,nres)) !(2,2,maxres) + allocate(Ug2DtEUg(2,2,nres)) +!(2,2,maxres) allocate(Ug2DtEUgder(2,2,2,nres)) - allocate(DtUg2EUgder(2,2,2,nres)) !(2,2,2,maxres) + allocate(DtUg2EUgder(2,2,2,nres)) +!(2,2,2,maxres) ! common /rotat_old/ allocate(costab(nres)) allocate(sintab(nres)) allocate(costab2(nres)) - allocate(sintab2(nres)) !(maxres) + allocate(sintab2(nres)) +!(maxres) ! common /dipmat/ allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)(maxconts=maxres/4) @@ -15934,67 +19844,137 @@ write(iout,*) "jestesmy sobie w check eint!!" allocate(ncont_sent(nres)) allocate(ncont_recv(nres)) - allocate(iat_sent(nres)) !(maxres) + allocate(iat_sent(nres)) +!(maxres) allocate(iint_sent(4,nres,nres)) - allocate(iint_sent_local(4,nres,nres)) !(4,maxres,maxres) + allocate(iint_sent_local(4,nres,nres)) +!(4,maxres,maxres) allocate(iturn3_sent(4,0:nres+4)) allocate(iturn4_sent(4,0:nres+4)) allocate(iturn3_sent_local(4,nres)) - allocate(iturn4_sent_local(4,nres)) !(4,maxres) + allocate(iturn4_sent_local(4,nres)) +!(4,maxres) allocate(itask_cont_from(0:nfgtasks-1)) - allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1) + allocate(itask_cont_to(0:nfgtasks-1)) +!(0:max_fg_procs-1) + + !---------------------- ! commom.deriv; ! common /derivat/ allocate(dcdv(6,maxdim)) - allocate(dxdv(6,maxdim)) !(6,maxdim) - allocate(dxds(6,nres)) !(6,maxres) - allocate(gradx(3,nres,0:2)) - allocate(gradc(3,nres,0:2)) !(3,maxres,2) - allocate(gvdwx(3,nres)) - allocate(gvdwc(3,nres)) - allocate(gelc(3,nres)) - allocate(gelc_long(3,nres)) - allocate(gvdwpp(3,nres)) - allocate(gvdwc_scpp(3,nres)) - allocate(gradx_scp(3,nres)) - allocate(gvdwc_scp(3,nres)) - allocate(ghpbx(3,nres)) - allocate(ghpbc(3,nres)) - allocate(gradcorr(3,nres)) - allocate(gradcorr_long(3,nres)) - allocate(gradcorr5_long(3,nres)) - allocate(gradcorr6_long(3,nres)) - allocate(gcorr6_turn_long(3,nres)) - allocate(gradxorr(3,nres)) - allocate(gradcorr5(3,nres)) - allocate(gradcorr6(3,nres)) !(3,maxres) + allocate(dxdv(6,maxdim)) +!(6,maxdim) + allocate(dxds(6,nres)) +!(6,maxres) + allocate(gradx(3,-1:nres,0:2)) + allocate(gradc(3,-1:nres,0:2)) +!(3,maxres,2) + allocate(gvdwx(3,-1:nres)) + allocate(gvdwc(3,-1:nres)) + allocate(gelc(3,-1:nres)) + allocate(gelc_long(3,-1:nres)) + allocate(gvdwpp(3,-1:nres)) + allocate(gvdwc_scpp(3,-1:nres)) + allocate(gradx_scp(3,-1:nres)) + allocate(gvdwc_scp(3,-1:nres)) + allocate(ghpbx(3,-1:nres)) + allocate(ghpbc(3,-1:nres)) + allocate(gradcorr(3,-1:nres)) + allocate(gradcorr_long(3,-1:nres)) + allocate(gradcorr5_long(3,-1:nres)) + allocate(gradcorr6_long(3,-1:nres)) + allocate(gcorr6_turn_long(3,-1:nres)) + allocate(gradxorr(3,-1:nres)) + allocate(gradcorr5(3,-1:nres)) + allocate(gradcorr6(3,-1:nres)) + allocate(gliptran(3,-1:nres)) + allocate(gliptranc(3,-1:nres)) + allocate(gliptranx(3,-1:nres)) + allocate(gshieldx(3,-1:nres)) + allocate(gshieldc(3,-1:nres)) + allocate(gshieldc_loc(3,-1:nres)) + allocate(gshieldx_ec(3,-1:nres)) + allocate(gshieldc_ec(3,-1:nres)) + allocate(gshieldc_loc_ec(3,-1:nres)) + allocate(gshieldx_t3(3,-1:nres)) + allocate(gshieldc_t3(3,-1:nres)) + allocate(gshieldc_loc_t3(3,-1:nres)) + allocate(gshieldx_t4(3,-1:nres)) + allocate(gshieldc_t4(3,-1:nres)) + allocate(gshieldc_loc_t4(3,-1:nres)) + allocate(gshieldx_ll(3,-1:nres)) + allocate(gshieldc_ll(3,-1:nres)) + allocate(gshieldc_loc_ll(3,-1:nres)) + allocate(grad_shield(3,-1:nres)) + allocate(gg_tube_sc(3,-1:nres)) + allocate(gg_tube(3,-1:nres)) + allocate(gradafm(3,-1:nres)) + allocate(gradb_nucl(3,-1:nres)) + allocate(gradbx_nucl(3,-1:nres)) + allocate(gvdwpsb1(3,-1:nres)) + allocate(gelpp(3,-1:nres)) + allocate(gvdwpsb(3,-1:nres)) + allocate(gelsbc(3,-1:nres)) + allocate(gelsbx(3,-1:nres)) + allocate(gvdwsbx(3,-1:nres)) + allocate(gvdwsbc(3,-1:nres)) + allocate(gsbloc(3,-1:nres)) + allocate(gsblocx(3,-1:nres)) + allocate(gradcorr_nucl(3,-1:nres)) + allocate(gradxorr_nucl(3,-1:nres)) + allocate(gradcorr3_nucl(3,-1:nres)) + allocate(gradxorr3_nucl(3,-1:nres)) + allocate(gvdwpp_nucl(3,-1:nres)) + allocate(gradpepcat(3,-1:nres)) + allocate(gradpepcatx(3,-1:nres)) + allocate(gradcatcat(3,-1:nres)) +!(3,maxres) + allocate(grad_shield_side(3,50,nres)) + allocate(grad_shield_loc(3,50,nres)) +! grad for shielding surroing allocate(gloc(0:maxvar,0:2)) - allocate(gloc_x(0:maxvar,2)) !(maxvar,2) - allocate(gel_loc(3,nres)) - allocate(gel_loc_long(3,nres)) - allocate(gcorr3_turn(3,nres)) - allocate(gcorr4_turn(3,nres)) - allocate(gcorr6_turn(3,nres)) - allocate(gradb(3,nres)) - allocate(gradbx(3,nres)) !(3,maxres) + allocate(gloc_x(0:maxvar,2)) +!(maxvar,2) + allocate(gel_loc(3,-1:nres)) + allocate(gel_loc_long(3,-1:nres)) + allocate(gcorr3_turn(3,-1:nres)) + allocate(gcorr4_turn(3,-1:nres)) + allocate(gcorr6_turn(3,-1:nres)) + allocate(gradb(3,-1:nres)) + allocate(gradbx(3,-1:nres)) +!(3,maxres) allocate(gel_loc_loc(maxvar)) allocate(gel_loc_turn3(maxvar)) allocate(gel_loc_turn4(maxvar)) allocate(gel_loc_turn6(maxvar)) allocate(gcorr_loc(maxvar)) allocate(g_corr5_loc(maxvar)) - allocate(g_corr6_loc(maxvar)) !(maxvar) - allocate(gsccorc(3,nres)) - allocate(gsccorx(3,nres)) !(3,maxres) - allocate(gsccor_loc(nres)) !(maxres) - allocate(dtheta(3,2,nres)) !(3,2,maxres) - allocate(gscloc(3,nres)) - allocate(gsclocx(3,nres)) !(3,maxres) - allocate(dphi(3,3,nres)) - allocate(dalpha(3,3,nres)) - allocate(domega(3,3,nres)) !(3,3,maxres) + allocate(g_corr6_loc(maxvar)) +!(maxvar) + allocate(gsccorc(3,-1:nres)) + allocate(gsccorx(3,-1:nres)) +!(3,maxres) + allocate(gsccor_loc(-1:nres)) +!(maxres) + allocate(gvdwx_scbase(3,-1:nres)) + allocate(gvdwc_scbase(3,-1:nres)) + allocate(gvdwx_pepbase(3,-1:nres)) + allocate(gvdwc_pepbase(3,-1:nres)) + allocate(gvdwx_scpho(3,-1:nres)) + allocate(gvdwc_scpho(3,-1:nres)) + allocate(gvdwc_peppho(3,-1:nres)) + + allocate(dtheta(3,2,-1:nres)) +!(3,2,maxres) + allocate(gscloc(3,-1:nres)) + allocate(gsclocx(3,-1:nres)) +!(3,maxres) + allocate(dphi(3,3,-1:nres)) + allocate(dalpha(3,3,-1:nres)) + allocate(domega(3,3,-1:nres)) +!(3,3,maxres) ! common /deriv_scloc/ allocate(dXX_C1tab(3,nres)) allocate(dYY_C1tab(3,nres)) @@ -16004,10 +19984,13 @@ write(iout,*) "jestesmy sobie w check eint!!" allocate(dZZ_Ctab(3,nres)) allocate(dXX_XYZtab(3,nres)) allocate(dYY_XYZtab(3,nres)) - allocate(dZZ_XYZtab(3,nres)) !(3,maxres) + allocate(dZZ_XYZtab(3,nres)) +!(3,maxres) ! common /mpgrad/ allocate(jgrad_start(nres)) - allocate(jgrad_end(nres)) !(maxres) + allocate(jgrad_end(nres)) +!(maxres) +!---------------------- ! common /indices/ allocate(ibond_displ(0:nfgtasks-1)) @@ -16023,20 +20006,25 @@ write(iout,*) "jestesmy sobie w check eint!!" allocate(iset_displ(0:nfgtasks-1)) allocate(iset_count(0:nfgtasks-1)) allocate(iint_count(0:nfgtasks-1)) - allocate(iint_displ(0:nfgtasks-1)) !(0:max_fg_procs-1) + allocate(iint_displ(0:nfgtasks-1)) +!(0:max_fg_procs-1) !---------------------- ! common.MD ! common /mdgrad/ - allocate(gcart(3,0:nres)) - allocate(gxcart(3,0:nres)) !(3,0:MAXRES) - allocate(gradcag(3,nres)) - allocate(gradxag(3,nres)) !(3,MAXRES) + allocate(gcart(3,-1:nres)) + allocate(gxcart(3,-1:nres)) +!(3,0:MAXRES) + allocate(gradcag(3,-1:nres)) + allocate(gradxag(3,-1:nres)) +!(3,MAXRES) ! common /back_constr/ !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back) allocate(dutheta(nres)) - allocate(dugamma(nres)) !(maxres) + allocate(dugamma(nres)) +!(maxres) allocate(duscdiff(3,nres)) - allocate(duscdiffx(3,nres)) !(3,maxres) + allocate(duscdiffx(3,nres)) +!(3,maxres) !el i io:read_fragments ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20) ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20) @@ -16044,38 +20032,45 @@ write(iout,*) "jestesmy sobie w check eint!!" ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20) ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20) allocate(mset(0:nprocs)) !(maxprocs/20) - do i=0,nprocs - mset(i)=0 - enddo + mset(:)=0 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20) ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20) allocate(dUdconst(3,0:nres)) allocate(dUdxconst(3,0:nres)) allocate(dqwol(3,0:nres)) - allocate(dxqwol(3,0:nres)) !(3,0:MAXRES) + allocate(dxqwol(3,0:nres)) +!(3,0:MAXRES) !---------------------- ! common.sbridge ! common /sbridge/ in io_common: read_bridge -!el allocate((:),allocatable :: iss !(maxss) +!el allocate((:),allocatable :: iss !(maxss) ! common /links/ in io_common: read_bridge !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane ! common /dyn_ssbond/ ! and side-chain vectors in theta or phi. - allocate(dyn_ssbond_ij(0:nres+4,0:nres+4)) !(maxres,maxres) - do i=1,nres - do j=i+1,nres - dyn_ssbond_ij(i,j)=1.0d300 - enddo - enddo + allocate(dyn_ssbond_ij(0:nres+4,0:nres+4)) +!(maxres,maxres) +! do i=1,nres +! do j=i+1,nres + dyn_ssbond_ij(:,:)=1.0d300 +! enddo +! enddo - if (nss.gt.0) then - allocate(idssb(nss),jdssb(nss)) !(maxdim) - endif - allocate(dyn_ss_mask(nres)) !(maxres) - do i=1,nres - dyn_ss_mask(i)=.false. - enddo +! if (nss.gt.0) then + allocate(idssb(maxdim),jdssb(maxdim)) +! allocate(newihpb(nss),newjhpb(nss)) +!(maxdim) +! endif + allocate(ishield_list(nres)) + allocate(shield_list(50,nres)) + allocate(dyn_ss_mask(nres)) + allocate(fac_shield(nres)) + allocate(enetube(nres*2)) + allocate(enecavtube(nres*2)) + +!(maxres) + dyn_ss_mask(:)=.false. !---------------------- ! common.sccor ! Parameters of the SCCOR term @@ -16089,64 +20084,5661 @@ write(iout,*) "jestesmy sobie w check eint!!" ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp) ! allocate(vlor1sccor(maxterm_sccor,20,20)) ! allocate(vlor2sccor(maxterm_sccor,20,20)) -! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20) +! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20) !---------------- - allocate(gloc_sc(3,0:2*nres,0:10)) !(3,0:maxres2,10)maxres2=2*maxres + allocate(gloc_sc(3,0:2*nres,0:10)) +!(3,0:maxres2,10)maxres2=2*maxres allocate(dcostau(3,3,3,2*nres)) allocate(dsintau(3,3,3,2*nres)) allocate(dtauangle(3,3,3,2*nres)) allocate(dcosomicron(3,3,3,2*nres)) - allocate(domicron(3,3,3,2*nres)) !(3,3,3,maxres2)maxres2=2*maxres -!---------------------- -! common.scrot -! Parameters of the SC rotamers (local) term -! common/scrot/ in io_conf: parmread -! allocate((:,:),allocatable :: sc_parmin !(maxsccoef,ntyp) -!---------------------- -! common.torcnstr -! common /torcnstr/ -!el in io_conf:molread -! allocate((:),allocatable :: idih_constr,idih_nconstr !(maxdih_constr) -! allocate((:),allocatable :: phi0,drange !(maxdih_constr) -!---------------------- -! common.torsion -! common/torsion/ in io_conf: parmread -! allocate((:,:,:),allocatable :: v0 !(-maxtor:maxtor,-maxtor:maxtor,2) -! allocate((:,:,:,:),allocatable :: v1,v2 !(maxterm,-maxtor:maxtor,-maxtor:maxtor,2) -! allocate((:,:,:),allocatable :: vlor1 !(maxlor,-maxtor:maxtor,-maxtor:maxtor) -! allocate((:,:,:),allocatable :: vlor2,vlor3 !(maxlor,maxtor,maxtor) -! allocate((:),allocatable :: itortyp !(-ntyp1:ntyp1) -! allocate((:,:,:),allocatable :: nterm,nlor !(-maxtor:maxtor,-maxtor:maxtor,2) -! -! common /torsiond/ in io_conf: parmread -! allocate((:,:,:,:,:,:),allocatable :: v1c,v1s - !(2,maxtermd_1,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2) -! allocate((:,:,:,:,:,:),allocatable :: v2c,v2s - !(maxtermd_2,maxtermd_2,-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2) -! allocate((:,:,:,:),allocatable :: ntermd_1,ntermd_2 - !(-maxtor:maxtor,-maxtor:maxtor,-maxtor:maxtor,2) -! common/fourier/ in io_conf: parmread -! allocate((:,:),allocatable :: b1,b2,& -! b1tilde !(2,-maxtor:maxtor) -! allocate((:,:,:),allocatable :: cc,dd,ee,& -! ctilde,dtilde !(2,2,-maxtor:maxtor) + allocate(domicron(3,3,3,2*nres)) +!(3,3,3,maxres2)maxres2=2*maxres !---------------------- ! common.var ! common /restr/ - allocate(varall(maxvar)) !(maxvar)(maxvar=6*maxres) + allocate(varall(maxvar)) +!(maxvar)(maxvar=6*maxres) allocate(mask_theta(nres)) allocate(mask_phi(nres)) - allocate(mask_side(nres)) !(maxres) + allocate(mask_side(nres)) +!(maxres) !---------------------- ! common.vectors ! common /vectors/ allocate(uy(3,nres)) - allocate(uz(3,nres)) !(3,maxres) + allocate(uz(3,nres)) +!(3,maxres) allocate(uygrad(3,3,2,nres)) - allocate(uzgrad(3,3,2,nres)) !(3,3,2,maxres) + allocate(uzgrad(3,3,2,nres)) +!(3,3,2,maxres) return end subroutine alloc_ener_arrays +!----------------------------------------------------------------- + subroutine ebond_nucl(estr_nucl) +!c +!c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds +!c + + real(kind=8),dimension(3) :: u,ud + real(kind=8) :: usum,uprod,uprod1,uprod2,usumsqder + real(kind=8) :: estr_nucl,diff + integer :: iti,i,j,k,nbi + estr_nucl=0.0d0 +!C print *,"I enter ebond" + if (energy_dec) & + write (iout,*) "ibondp_start,ibondp_end",& + ibondp_nucl_start,ibondp_nucl_end + do i=ibondp_nucl_start,ibondp_nucl_end + if (itype(i-1,2).eq.ntyp1_molec(2) .or. & + itype(i,2).eq.ntyp1_molec(2)) cycle +! estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax) +! do j=1,3 +! gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) +! & *dc(j,i-1)/vbld(i) +! enddo +! if (energy_dec) write(iout,*) +! & "estr1",i,vbld(i),distchainmax, +! & gnmr1(vbld(i),-1.0d0,distchainmax) + + diff = vbld(i)-vbldp0_nucl + if(energy_dec)write(iout,*) "estr_nucl_bb" , i,vbld(i),& + vbldp0_nucl,diff,AKP_nucl*diff*diff + estr_nucl=estr_nucl+diff*diff +! print *,estr_nucl + do j=1,3 + gradb_nucl(j,i-1)=AKP_nucl*diff*dc(j,i-1)/vbld(i) + enddo +!c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3) + enddo + estr_nucl=0.5d0*AKP_nucl*estr_nucl +! print *,"partial sum", estr_nucl,AKP_nucl + + if (energy_dec) & + write (iout,*) "ibondp_start,ibondp_end",& + ibond_nucl_start,ibond_nucl_end + + do i=ibond_nucl_start,ibond_nucl_end +!C print *, "I am stuck",i + iti=itype(i,2) + if (iti.eq.ntyp1_molec(2)) cycle + nbi=nbondterm_nucl(iti) +!C print *,iti,nbi + if (nbi.eq.1) then + diff=vbld(i+nres)-vbldsc0_nucl(1,iti) + + if (energy_dec) & + write (iout,*) "estr_nucl_sc", i,iti,vbld(i+nres),vbldsc0_nucl(1,iti),diff, & + AKSC_nucl(1,iti),AKSC_nucl(1,iti)*diff*diff + estr_nucl=estr_nucl+0.5d0*AKSC_nucl(1,iti)*diff*diff +! print *,estr_nucl + do j=1,3 + gradbx_nucl(j,i)=AKSC_nucl(1,iti)*diff*dc(j,i+nres)/vbld(i+nres) + enddo + else + do j=1,nbi + diff=vbld(i+nres)-vbldsc0_nucl(j,iti) + ud(j)=aksc_nucl(j,iti)*diff + u(j)=abond0_nucl(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_nucl=estr_nucl+uprod/usum + do j=1,3 + gradbx_nucl(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres) + enddo + endif + enddo +!C print *,"I am about to leave ebond" + return + end subroutine ebond_nucl + !----------------------------------------------------------------------------- -!----------------------------------------------------------------------------- + subroutine ebend_nucl(etheta_nucl) + real(kind=8),dimension(nntheterm_nucl+1) :: coskt,sinkt !mmaxtheterm + real(kind=8),dimension(nsingle_nucl+1) :: cosph1,sinph1,cosph2,sinph2 !maxsingle + real(kind=8),dimension(ndouble_nucl+1,ndouble_nucl+1) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble + logical :: lprn=.false., lprn1=.false. +!el local variables + integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m + real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai + real(kind=8) :: aux,etheta_nucl,ccl,ssl,scl,csl,ethetacnstr +! local variables for constrains + real(kind=8) :: difi,thetiii + integer itheta + etheta_nucl=0.0D0 +! print *,"ithet_start",ithet_nucl_start," ithet_end",ithet_nucl_end,nres + do i=ithet_nucl_start,ithet_nucl_end + if ((itype(i-1,2).eq.ntyp1_molec(2)).or.& + (itype(i-2,2).eq.ntyp1_molec(2)).or. & + (itype(i,2).eq.ntyp1_molec(2))) cycle + dethetai=0.0d0 + dephii=0.0d0 + dephii1=0.0d0 + theti2=0.5d0*theta(i) + ityp2=ithetyp_nucl(itype(i-1,2)) + do k=1,nntheterm_nucl + coskt(k)=dcos(k*theti2) + sinkt(k)=dsin(k*theti2) + enddo + if (i.gt.3 .and. itype(i-2,2).ne.ntyp1_molec(2)) then +#ifdef OSF + phii=phi(i) + if (phii.ne.phii) phii=150.0 +#else + phii=phi(i) +#endif + ityp1=ithetyp_nucl(itype(i-2,2)) + do k=1,nsingle_nucl + cosph1(k)=dcos(k*phii) + sinph1(k)=dsin(k*phii) + enddo + else + phii=0.0d0 + ityp1=nthetyp_nucl+1 + do k=1,nsingle_nucl + cosph1(k)=0.0d0 + sinph1(k)=0.0d0 + enddo + endif + + if (i.lt.nres .and. itype(i,2).ne.ntyp1_molec(2)) 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_nucl(itype(i,2)) + do k=1,nsingle_nucl + cosph2(k)=dcos(k*phii1) + sinph2(k)=dsin(k*phii1) + enddo + else + phii1=0.0d0 + ityp3=nthetyp_nucl+1 + do k=1,nsingle_nucl + cosph2(k)=0.0d0 + sinph2(k)=0.0d0 + enddo + endif + ethetai=aa0thet_nucl(ityp1,ityp2,ityp3) + do k=1,ndouble_nucl + 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",nntheterm_nucl + do k=1,nntheterm_nucl + write (iout,*) k,coskt(k),sinkt(k) + enddo + endif + do k=1,ntheterm_nucl + ethetai=ethetai+aathet_nucl(k,ityp1,ityp2,ityp3)*sinkt(k) + dethetai=dethetai+0.5d0*k*aathet_nucl(k,ityp1,ityp2,ityp3)& + *coskt(k) + if (lprn)& + write (iout,*) "k",k," aathet",aathet_nucl(k,ityp1,ityp2,ityp3),& + " ethetai",ethetai + enddo + if (lprn) then + write (iout,*) "cosph and sinph" + do k=1,nsingle_nucl + write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k) + enddo + write (iout,*) "cosph1ph2 and sinph2ph2" + do k=2,ndouble_nucl + 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_nucl + do k=1,nsingle_nucl + aux=bbthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)& + +ccthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k)& + +ddthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)& + +eethet_nucl(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_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)-& + bbthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k)) + dephii1=dephii1+k*sinkt(m)*(& + eethet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)-& + ddthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k)) + if (lprn) & + write (iout,*) "m",m," k",k," bbthet",& + bbthet_nucl(k,m,ityp1,ityp2,ityp3)," ccthet",& + ccthet_nucl(k,m,ityp1,ityp2,ityp3)," ddthet",& + ddthet_nucl(k,m,ityp1,ityp2,ityp3)," eethet",& + eethet_nucl(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai + enddo + enddo + if (lprn) & + write(iout,*) "ethetai",ethetai + do m=1,ntheterm3_nucl + do k=2,ndouble_nucl + do l=1,k-1 + aux=ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+& + ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+& + ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+& + ggthet_nucl(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_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-& + ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+& + ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+& + ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) + dephii1=dephii1+(k-l)*sinkt(m)*( & + -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+& + ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+& + ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-& + ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)) + if (lprn) then + write (iout,*) "m",m," k",k," l",l," ffthet", & + ffthet_nucl(l,k,m,ityp1,ityp2,ityp3), & + ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ggthet",& + ggthet_nucl(l,k,m,ityp1,ityp2,ityp3),& + ggthet_nucl(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_nucl=etheta_nucl+ethetai +! print *,i,"partial sum",etheta_nucl + if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang_nucl*dephii + if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang_nucl*dephii1 + gloc(nphi+i-2,icg)=wang_nucl*dethetai + enddo + return + end subroutine ebend_nucl +!---------------------------------------------------- + subroutine etor_nucl(etors_nucl) +! 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' + real(kind=8) :: etors_nucl,edihcnstr + logical :: lprn +!el local variables + integer :: i,j,iblock,itori,itori1 + real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,& + vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom +! Set lprn=.true. for debugging + lprn=.false. +! lprn=.true. + etors_nucl=0.0D0 +! print *,"iphi_nucl_start/end", iphi_nucl_start,iphi_nucl_end + do i=iphi_nucl_start,iphi_nucl_end + if (itype(i-2,2).eq.ntyp1_molec(2) .or. itype(i-1,2).eq.ntyp1_molec(2) & + .or. itype(i-3,2).eq.ntyp1_molec(2) & + .or. itype(i,2).eq.ntyp1_molec(2)) cycle + etors_ii=0.0D0 + itori=itortyp_nucl(itype(i-2,2)) + itori1=itortyp_nucl(itype(i-1,2)) + phii=phi(i) +! print *,i,itori,itori1 + gloci=0.0D0 +!C Regular cosine and sine terms + do j=1,nterm_nucl(itori,itori1) + v1ij=v1_nucl(j,itori,itori1) + v2ij=v2_nucl(j,itori,itori1) + cosphi=dcos(j*phii) + sinphi=dsin(j*phii) + etors_nucl=etors_nucl+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_nucl(itori,itori1) + vl1ij=vlor1_nucl(j,itori,itori1) + vl2ij=vlor2_nucl(j,itori,itori1) + vl3ij=vlor3_nucl(j,itori,itori1) + pom=vl2ij*cosphi+vl3ij*sinphi + pom1=1.0d0/(pom*pom+1.0d0) + etors_nucl=etors_nucl+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_nucl=etors_nucl-v0_nucl(itori,itori1) + if (energy_dec) write (iout,'(a6,i5,0pf7.3)') & + 'etor',i,etors_ii-v0_nucl(itori,itori1) + if (lprn) & + write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') & + restyp(itype(i-2,2),2),i-2,restyp(itype(i-1,2),2),i-1,itori,itori1, & + (v1_nucl(j,itori,itori1),j=1,6),(v2_nucl(j,itori,itori1),j=1,6) + gloc(i-3,icg)=gloc(i-3,icg)+wtor_nucl*gloci +!c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) + enddo + return + end subroutine etor_nucl +!------------------------------------------------------------ + subroutine epp_nucl_sub(evdw1,ees) +!C +!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 + integer :: i,j,k,iteli,itelj,num_conti,isubchap,ind + real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb + real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,& + dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,& + dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw + real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,& + dist_temp, dist_init,sss_grad,fac,evdw1ij + integer xshift,yshift,zshift + real(kind=8),dimension(3):: ggg,gggp,gggm,erij + real(kind=8) :: ees,eesij +!c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions + real(kind=8) scal_el /0.5d0/ + t_eelecij=0.0d0 + ees=0.0D0 + evdw1=0.0D0 + ind=0 +!c +!c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3 +!c +! print *,"iatel_s_nucl,iatel_e_nucl",iatel_s_nucl,iatel_e_nucl + do i=iatel_s_nucl,iatel_e_nucl + if (itype(i,2).eq.ntyp1_molec(2) .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle + 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 + xmedi=dmod(xmedi,boxxsize) + if (xmedi.lt.0) xmedi=xmedi+boxxsize + ymedi=dmod(ymedi,boxysize) + if (ymedi.lt.0) ymedi=ymedi+boxysize + zmedi=dmod(zmedi,boxzsize) + if (zmedi.lt.0) zmedi=zmedi+boxzsize + + do j=ielstart_nucl(i),ielend_nucl(i) + if (itype(j,2).eq.ntyp1_molec(2) .or. itype(j+1,2).eq.ntyp1_molec(2)) cycle + ind=ind+1 + 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 + xj=c(1,j)+0.5D0*dxj + yj=c(2,j)+0.5D0*dyj + zj=c(3,j)+0.5D0*dzj + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + isubchap=0 + dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + isubchap=1 + endif + enddo + enddo + enddo + if (isubchap.eq.1) then +!C print *,i,j + xj=xj_temp-xmedi + yj=yj_temp-ymedi + zj=zj_temp-zmedi + else + xj=xj_safe-xmedi + yj=yj_safe-ymedi + zj=zj_safe-zmedi + endif + + rij=xj*xj+yj*yj+zj*zj +!c write (2,*)"ij",i,j," r0pp",r0pp," rij",rij," epspp",epspp + fac=(r0pp**2/rij)**3 + ev1=epspp*fac*fac + ev2=epspp*fac + evdw1ij=ev1-2*ev2 + fac=(-ev1-evdw1ij)/rij +! write (2,*)"fac",fac," ev1",ev1," ev2",ev2," evdw1ij",evdw1ij + if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"evdw1ij",evdw1ij + 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 + gvdwpp_nucl(k,i)=gvdwpp_nucl(k,i)-ggg(k) + gvdwpp_nucl(k,j)=gvdwpp_nucl(k,j)+ggg(k) + enddo +!c phoshate-phosphate electrostatic interactions + rij=dsqrt(rij) + fac=1.0d0/rij + eesij=dexp(-BEES*rij)*fac +! write (2,*)"fac",fac," eesijpp",eesij + if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"eesijpp",eesij + ees=ees+eesij +!c fac=-eesij*fac + fac=-(fac+BEES)*eesij*fac + ggg(1)=fac*xj + ggg(2)=fac*yj + ggg(3)=fac*zj +!c write(2,*) "ggg",i,j,ggg(1),ggg(2),ggg(3) +!c write(2,*) "gelpp",i,(gelpp(k,i),k=1,3) +!c write(2,*) "gelpp",j,(gelpp(k,j),k=1,3) + do k=1,3 + gelpp(k,i)=gelpp(k,i)-ggg(k) + gelpp(k,j)=gelpp(k,j)+ggg(k) + enddo + enddo ! j + enddo ! i +!c ees=332.0d0*ees + ees=AEES*ees + do i=nnt,nct +!c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3) + do k=1,3 + gvdwpp_nucl(k,i)=6*gvdwpp_nucl(k,i) +!c gelpp(k,i)=332.0d0*gelpp(k,i) + gelpp(k,i)=AEES*gelpp(k,i) + enddo +!c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3) + enddo +!c write (2,*) "total EES",ees + return + end subroutine epp_nucl_sub +!--------------------------------------------------------------------- + subroutine epsb(evdwpsb,eelpsb) +! use comm_locel +!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 + real(kind=8),dimension(3):: ggg + integer :: i,iint,j,k,iteli,itypj,subchap + real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,& + e1,e2,evdwij,rij,evdwpsb,eelpsb + real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,& + dist_temp, dist_init + integer xshift,yshift,zshift + +!cd print '(a)','Enter ESCP' +!cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e + eelpsb=0.0d0 + evdwpsb=0.0d0 +! print *,"iatscp_s_nucl,iatscp_e_nucl",iatscp_s_nucl,iatscp_e_nucl + do i=iatscp_s_nucl,iatscp_e_nucl + if (itype(i,2).eq.ntyp1_molec(2) & + .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle + xi=0.5D0*(c(1,i)+c(1,i+1)) + yi=0.5D0*(c(2,i)+c(2,i+1)) + zi=0.5D0*(c(3,i)+c(3,i+1)) + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize + + do iint=1,nscp_gr_nucl(i) + + do j=iscpstart_nucl(i,iint),iscpend_nucl(i,iint) + itypj=itype(j,2) + if (itypj.eq.ntyp1_molec(2)) cycle +!C Uncomment following three lines for SC-p interactions +!c xj=c(1,nres+j)-xi +!c yj=c(2,nres+j)-yi +!c zj=c(3,nres+j)-zi +!C Uncomment following three lines for Ca-p interactions +! xj=c(1,j)-xi +! yj=c(2,j)-yi +! zj=c(3,j)-zi + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + xj=mod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=mod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=mod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + + rrij=1.0D0/(xj*xj+yj*yj+zj*zj) + fac=rrij**expon2 + e1=fac*fac*aad_nucl(itypj) + e2=fac*bad_nucl(itypj) + if (iabs(j-i) .le. 2) then + e1=scal14*e1 + e2=scal14*e2 + endif + evdwij=e1+e2 + evdwpsb=evdwpsb+evdwij + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a4)') & + 'evdw2',i,j,evdwij,"tu4" +!C +!C Calculate contributions to the gradient in the virtual-bond and SC vectors. +!C + fac=-(evdwij+e1)*rrij + ggg(1)=xj*fac + ggg(2)=yj*fac + ggg(3)=zj*fac + do k=1,3 + gvdwpsb1(k,i)=gvdwpsb1(k,i)-ggg(k) + gvdwpsb(k,j)=gvdwpsb(k,j)+ggg(k) + enddo + enddo + + enddo ! iint + enddo ! i + do i=1,nct + do j=1,3 + gvdwpsb(j,i)=expon*gvdwpsb(j,i) + gvdwpsb1(j,i)=expon*gvdwpsb1(j,i) + enddo + enddo + return + end subroutine epsb + +!------------------------------------------------------ + subroutine esb_gb(evdwsb,eelsb) + use comm_locel + use calc_data_nucl + integer :: iint,itypi,itypi1,itypj,subchap,num_conti2 + real(kind=8) :: xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi + real(kind=8) :: evdw,sig0iji,evdwsb,eelsb,ecorr,eelij + real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,& + dist_temp, dist_init,aa,bb,faclip,sig0ij + integer :: ii + logical lprn + evdw=0.0D0 + eelsb=0.0d0 + ecorr=0.0d0 + evdwsb=0.0D0 + lprn=.false. + ind=0 +! print *,"iastsc_nucl",iatsc_s_nucl,iatsc_e_nucl + do i=iatsc_s_nucl,iatsc_e_nucl + num_conti=0 + num_conti2=0 + itypi=itype(i,2) +! PRINT *,"I=",i,itypi + if (itypi.eq.ntyp1_molec(2)) cycle + itypi1=itype(i+1,2) + xi=c(1,nres+i) + yi=c(2,nres+i) + zi=c(3,nres+i) + xi=dmod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=dmod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=dmod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize + + dxi=dc_norm(1,nres+i) + dyi=dc_norm(2,nres+i) + dzi=dc_norm(3,nres+i) + dsci_inv=vbld_inv(i+nres) +!C +!C Calculate SC interaction energy. +!C + do iint=1,nint_gr_nucl(i) +! print *,"tu?",i,istart_nucl(i,iint),iend_nucl(i,iint) + do j=istart_nucl(i,iint),iend_nucl(i,iint) + ind=ind+1 +! print *,"JESTEM" + itypj=itype(j,2) + if (itypj.eq.ntyp1_molec(2)) cycle + dscj_inv=vbld_inv(j+nres) + sig0ij=sigma_nucl(itypi,itypj) + chi1=chi_nucl(itypi,itypj) + chi2=chi_nucl(itypj,itypi) + chi12=chi1*chi2 + chip1=chip_nucl(itypi,itypj) + chip2=chip_nucl(itypj,itypi) + chip12=chip1*chip2 +! xj=c(1,nres+j)-xi +! yj=c(2,nres+j)-yi +! zj=c(3,nres+j)-zi + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + xj=dmod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=dmod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=dmod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + + 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) +!C Calculate angle-dependent terms of energy and contributions to their +!C derivatives. + 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 + call sc_angular_nucl + sigsq=1.0D0/sigsq + sig=sig0ij*dsqrt(sigsq) + rij_shift=1.0D0/rij-sig+sig0ij +! print *,rij_shift,"rij_shift" +!c write (2,*) " rij",1.0D0/rij," sig",sig," sig0ij",sig0ij, +!c & " rij_shift",rij_shift + 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_nucl(itypi,itypj) + e2=fac*bb_nucl(itypi,itypj) + evdwij=eps1*eps2rt*(e1+e2) +!c write (2,*) "eps1",eps1," eps2rt",eps2rt, +!c & " e1",e1," e2",e2," evdwij",evdwij + eps2der=evdwij + evdwij=evdwij*eps2rt + evdwsb=evdwsb+evdwij + if (lprn) then + sigm=dabs(aa_nucl(itypi,itypj)/bb_nucl(itypi,itypj))**(1.0D0/6.0D0) + epsi=bb_nucl(itypi,itypj)**2/aa_nucl(itypi,itypj) + write (iout,'(2(a3,i3,2x),17(0pf7.3))') & + restyp(itypi,2),i,restyp(itypj,2),j, & + epsi,sigm,chi1,chi2,chip1,chip2, & + eps1,eps2rt**2,sig,sig0ij, & + om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,& + evdwij + write (iout,*) "aa",aa_nucl(itypi,itypj)," bb",bb_nucl(itypi,itypj) + endif + + if (energy_dec) write (iout,'(a6,2i5,e15.3,a4)') & + 'evdw',i,j,evdwij,"tu3" + + +!C Calculate gradient components. + e1=e1*eps1*eps2rt**2 + fac=-expon*(e1+evdwij)*rij_shift + sigder=fac*sigder + fac=rij*fac +!c fac=0.0d0 +!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_nucl + call eelsbij(eelij,num_conti2) + if (energy_dec .and. & + (j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2)) & + write (istat,'(e14.5)') evdwij + eelsb=eelsb+eelij + enddo ! j + enddo ! iint + num_cont_hb(i)=num_conti2 + enddo ! i +!c write (iout,*) "Number of loop steps in EGB:",ind +!cccc energy_dec=.false. + return + end subroutine esb_gb +!------------------------------------------------------------------------------- + subroutine eelsbij(eesij,num_conti2) + use comm_locel + use calc_data_nucl + real(kind=8),dimension(3) :: ggg,gggp,gggm,dcosb,dcosg + real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg + real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,& + dist_temp, dist_init,rlocshield,fracinbuf + integer xshift,yshift,zshift,ilist,iresshield,num_conti2 + +!c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions + real(kind=8) scal_el /0.5d0/ + integer :: iteli,itelj,kkk,kkll,m,isubchap + real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp,facfac + real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i,ael63i,ael32i + real(kind=8) :: dx_normj,dy_normj,dz_normj,& + r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,fac5,fac6,& + el1,el2,el3,el4,eesij,ees0ij,facvdw,facel,fac1,ecosa,& + ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,& + a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,& + ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,& + ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,& + ecosgp,ecosam,ecosbm,ecosgm,ghalf,itypi,itypj + ind=ind+1 + itypi=itype(i,2) + itypj=itype(j,2) +! print *,i,j,itypi,itypj,istype(i),istype(j),"????" + ael6i=ael6_nucl(itypi,itypj) + ael3i=ael3_nucl(itypi,itypj) + ael63i=ael63_nucl(itypi,itypj) + ael32i=ael32_nucl(itypi,itypj) +!c write (iout,*) "eelecij",i,j,itype(i),itype(j), +!c & ael6i,ael3i,ael63i,al32i,rij,rrij + dxj=dc(1,j+nres) + dyj=dc(2,j+nres) + dzj=dc(3,j+nres) + dx_normi=dc_norm(1,i+nres) + dy_normi=dc_norm(2,i+nres) + dz_normi=dc_norm(3,i+nres) + dx_normj=dc_norm(1,j+nres) + dy_normj=dc_norm(2,j+nres) + dz_normj=dc_norm(3,j+nres) +!c xj=c(1,j)+0.5D0*dxj-xmedi +!c yj=c(2,j)+0.5D0*dyj-ymedi +!c zj=c(3,j)+0.5D0*dzj-zmedi + if (ipot_nucl.ne.2) then + 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 + else + cosa=om12 + cosb=om1 + cosg=om2 + endif + r3ij=rij*rrij + r6ij=r3ij*r3ij + fac=cosa-3.0D0*cosb*cosg + facfac=fac*fac + fac1=3.0d0*(cosb*cosb+cosg*cosg) + fac3=ael6i*r6ij + fac4=ael3i*r3ij + fac5=ael63i*r6ij + fac6=ael32i*r6ij +!c write (iout,*) "r3ij",r3ij," r6ij",r6ij," fac",fac," fac1",fac1, +!c & " fac2",fac2," fac3",fac3," fac4",fac4," fac5",fac5," fac6",fac6 + el1=fac3*(4.0D0+facfac-fac1) + el2=fac4*fac + el3=fac5*(2.0d0-2.0d0*facfac+fac1) + el4=fac6*facfac + eesij=el1+el2+el3+el4 +!C 12/26/95 - for the evaluation of multi-body H-bonding interactions + ees0ij=4.0D0+facfac-fac1 + + if (energy_dec) then + if(j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2) & + write (istat,'(2a1,i4,1x,2a1,i4,4f10.5,3e12.5,$)') & + sugartyp(istype(i)),restyp(itypi,2),i,sugartyp(istype(j)),& + restyp(itypj,2),j,1.0d0/rij,cosa,cosb,cosg,fac*r3ij, & + (4.0D0+facfac-fac1)*r6ij,(2.0d0-2.0d0*facfac+fac1)*r6ij + write (iout,'(a6,2i5,e15.3)') 'ees',i,j,eesij + endif + +!C +!C Calculate contributions to the Cartesian gradient. +!C + facel=-3.0d0*rrij*(eesij+el1+el3+el4) + fac1=fac +!c erij(1)=xj*rmij +!c erij(2)=yj*rmij +!c erij(3)=zj*rmij +!* +!* Radial derivatives. First process both termini of the fragment (i,j) +!* + ggg(1)=facel*xj + ggg(2)=facel*yj + ggg(3)=facel*zj + do k=1,3 + gelsbc(k,j)=gelsbc(k,j)+ggg(k) + gelsbc(k,i)=gelsbc(k,i)-ggg(k) + gelsbx(k,j)=gelsbx(k,j)+ggg(k) + gelsbx(k,i)=gelsbx(k,i)-ggg(k) + enddo +!* +!* Angular part +!* + ecosa=2.0D0*fac3*fac1+fac4+(-4.0d0*fac5+2.0d0*fac6)*fac1 + fac4=-3.0D0*fac4 + fac3=-6.0D0*fac3 + fac5= 6.0d0*fac5 + fac6=-6.0d0*fac6 + ecosb=fac3*(fac1*cosg+cosb)+cosg*fac4+(cosb+2*fac1*cosg)*fac5+& + fac6*fac1*cosg + ecosg=fac3*(fac1*cosb+cosg)+cosb*fac4+(cosg+2*fac1*cosb)*fac5+& + fac6*fac1*cosb + do k=1,3 + dcosb(k)=rij*(dc_norm(k,i+nres)-erij(k)*cosb) + dcosg(k)=rij*(dc_norm(k,j+nres)-erij(k)*cosg) + enddo + do k=1,3 + ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k) + enddo + do k=1,3 + gelsbx(k,i)=gelsbx(k,i)-ggg(k) & + +(ecosa*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres))& + + ecosb*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres) + gelsbx(k,j)=gelsbx(k,j)+ggg(k) & + +(ecosa*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))& + + ecosg*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres) + gelsbc(k,j)=gelsbc(k,j)+ggg(k) + gelsbc(k,i)=gelsbc(k,i)-ggg(k) + enddo +! IF ( (wcorr_nucl.gt.0.0d0.or.wcorr3_nucl.gt.0.0d0) .and. + IF ( j.gt.i+1 .and.& + num_conti.le.maxconts) THEN +!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. + r0ij=2.20D0*sigma(itypi,itypj) +!c write (2,*) "ij",i,j," rij",1.0d0/rij," r0ij",r0ij + call gcont(rij,r0ij,1.0D0,0.2d0/r0ij,fcont,fprimcont) +!c write (2,*) "fcont",fcont + if (fcont.gt.0.0D0) then + num_conti=num_conti+1 + num_conti2=num_conti2+1 + + if (num_conti.gt.maxconts) then + write (iout,*) 'WARNING - max. # of contacts exceeded;',& + ' will skip next contacts for this conf.' + else + jcont_hb(num_conti,i)=j +!c write (iout,*) "num_conti",num_conti, +!c & " jcont_hb",jcont_hb(num_conti,i) +!C Calculate contact energies + cosa4=4.0D0*cosa + wij=cosa-3.0D0*cosb*cosg + cosbg1=cosb+cosg + cosbg2=cosb-cosg + fac3=dsqrt(-ael6i)*r3ij +!c write (2,*) "ael6i",ael6i," r3ij",r3ij," fac3",fac3 + ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1 + if (ees0tmp.gt.0) then + ees0pij=dsqrt(ees0tmp) + else + ees0pij=0 + endif + ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2 + if (ees0tmp.gt.0) then + ees0mij=dsqrt(ees0tmp) + else + ees0mij=0 + endif + ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) + ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) +!c write (iout,*) "i",i," j",j, +!c & " ees0m",ees0m(num_conti,i)," ees0p",ees0p(num_conti,i) + ees0pij1=fac3/ees0pij + ees0mij1=fac3/ees0mij + fac3p=-3.0D0*fac3*rrij + ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij) + ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij) + ecosa1= ees0pij1*( 1.0D0+0.5D0*wij) + ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1) + ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1) + ecosa2= ees0mij1*(-1.0D0+0.5D0*wij) + ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2) + ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2) + ecosap=ecosa1+ecosa2 + ecosbp=ecosb1+ecosb2 + ecosgp=ecosg1+ecosg2 + ecosam=ecosa1-ecosa2 + ecosbm=ecosb1-ecosb2 + ecosgm=ecosg1-ecosg2 +!C End diagnostics + facont_hb(num_conti,i)=fcont + fprimcont=fprimcont/rij + do k=1,3 + gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k) + gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k) + enddo + gggp(1)=gggp(1)+ees0pijp*xj + gggp(2)=gggp(2)+ees0pijp*yj + gggp(3)=gggp(3)+ees0pijp*zj + gggm(1)=gggm(1)+ees0mijp*xj + gggm(2)=gggm(2)+ees0mijp*yj + gggm(3)=gggm(3)+ees0mijp*zj +!C Derivatives due to the contact function + gacont_hbr(1,num_conti,i)=fprimcont*xj + gacont_hbr(2,num_conti,i)=fprimcont*yj + gacont_hbr(3,num_conti,i)=fprimcont*zj + do k=1,3 +!c +!c Gradient of the correlation terms +!c + gacontp_hb1(k,num_conti,i)= & + (ecosap*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) & + + ecosbp*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres) + gacontp_hb2(k,num_conti,i)= & + (ecosap*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres)) & + + ecosgp*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres) + gacontp_hb3(k,num_conti,i)=gggp(k) + gacontm_hb1(k,num_conti,i)= & + (ecosam*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) & + + ecosbm*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres) + gacontm_hb2(k,num_conti,i)= & + (ecosam*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))& + + ecosgm*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres) + gacontm_hb3(k,num_conti,i)=gggm(k) + enddo + endif + endif + ENDIF + return + end subroutine eelsbij +!------------------------------------------------------------------ + subroutine sc_grad_nucl + use comm_locel + use calc_data_nucl + real(kind=8),dimension(3) :: dcosom1,dcosom2 + eom1=eps2der*eps2rt_om1+sigder*sigsq_om1 + eom2=eps2der*eps2rt_om2+sigder*sigsq_om2 + eom12=evdwij*eps1_om12+eps2der*eps2rt_om12+sigder*sigsq_om12 + 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 + do k=1,3 + gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k) + enddo + do k=1,3 + gvdwsbx(k,i)=gvdwsbx(k,i)-gg(k) & + +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))& + +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv + gvdwsbx(k,j)=gvdwsbx(k,j)+gg(k) & + +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) & + +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv + enddo +!C +!C Calculate the components of the gradient in DC and X +!C + do l=1,3 + gvdwsbc(l,i)=gvdwsbc(l,i)-gg(l) + gvdwsbc(l,j)=gvdwsbc(l,j)+gg(l) + enddo + return + end subroutine sc_grad_nucl +!----------------------------------------------------------------------- + subroutine esb(esbloc) +!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 + real(kind=8),dimension(3):: x_prime,y_prime,z_prime + real(kind=8),dimension(9):: x + real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1, & + sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,& + de_dxx,de_dyy,de_dzz,de_dt,s1_t,s1_6_t,s2_t,s2_6_t + real(kind=8),dimension(3):: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,& + dYY_Ci,dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1 + real(kind=8) :: esbloc,delta,cosfac2,cosfac,sinfac2,sinfac,de_dtt,& + cossc,cossc1,cosfac2xx,sinfac2yy,pom1,pom + integer::it,nlobit,i,j,k +! common /sccalc/ time11,time12,time112,theti,it,nlobit + delta=0.02d0*pi + esbloc=0.0D0 + do i=loc_start_nucl,loc_end_nucl + if (itype(i,2).eq.ntyp1_molec(2)) cycle + 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,2) + 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) +! z_prime(j)=0.0 + enddo + + 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 + it=itype(i,2) + do j = 1,9 + x(j) = sc_parmin_nucl(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 + sumene = enesc_nucl(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1)) + esbloc = esbloc + sumene + sumene2= enesc_nucl(x,xx,yy,0.0d0,cost2tab(i+1),sint2tab(i+1)) +! print *,"enecomp",sumene,sumene2 +! if (energy_dec) write(iout,*) "i",i," esbloc",sumene,esbloc,xx,yy,zz +! if (energy_dec) write(iout,*) "x",(x(k),k=1,9) +#ifdef DEBUG + write (2,*) "x",(x(k),k=1,9) +!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,sumene + 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,sumene + 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,sumene + 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,sumene + cost2tab(i+1)=costsave + sint2tab(i+1)=sintsave +!C End of diagnostics section. +#endif +!C +!C Compute the gradient of esc +!C + de_dxx=x(1)+2*x(4)*xx+x(7)*zz+x(8)*yy + de_dyy=x(2)+2*x(5)*yy+x(8)*xx+x(9)*zz + de_dzz=x(3)+2*x(6)*zz+x(7)*xx+x(9)*yy + de_dtt=0.0d0 +#ifdef DEBUG + write (2,*) "x",(x(k),k=1,9) + write (2,*) "xx",xx," yy",yy," zz",zz + write (2,*) "de_xx ",de_xx," de_yy ",de_yy,& + " de_zz ",de_zz," de_tt ",de_tt + write (2,*) "de_xx_num",de_dxx_num," de_yy_num",de_dyy_num,& + " de_zz_num",de_dzz_num," de_dt_num",de_dt_num +#endif +!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) + gsbloc(k,i-1)=gsbloc(k,i-1)+(de_dxx*dxx_ci1(k) & + +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)) + gsbloc(k,i)=gsbloc(k,i)+(de_dxx*dxx_Ci(k) & + +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)) + gsblocx(k,i)= de_dxx*dxx_XYZ(k)& + +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k) +! print *,i,de_dxx*dxx_ci1(k)+de_dyy*dyy_ci1(k),de_dzz*dzz_ci1(k)*2 + enddo +!c write(iout,*) "ENERGY GRAD = ", (gsbloc(k,i-1),k=1,3), +!c & (gsbloc(k,i),k=1,3),(gsblocx(k,i),k=1,3) + +!C to check gradient call subroutine check_grad + + 1 continue + enddo + return + end subroutine esb +!=------------------------------------------------------- + real(kind=8) function enesc_nucl(x,xx,yy,zz,cost2,sint2) +! implicit none + real(kind=8),dimension(9):: x(9) + real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2, & + sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6 + integer i +!c write (2,*) "enesc" +!c write (2,*) "x",(x(i),i=1,9) +!c write(2,*)"xx",xx," yy",yy," zz",zz," cost2",cost2," sint2",sint2 + sumene=x(1)*xx+x(2)*yy+x(3)*zz+x(4)*xx**2 & + + x(5)*yy**2+x(6)*zz**2+x(7)*xx*zz+x(8)*xx*yy & + + x(9)*yy*zz + enesc_nucl=sumene + return + end function enesc_nucl +!----------------------------------------------------------------------------- + subroutine multibody_hb_nucl(ecorr,ecorr3,n_corr,n_corr1) +#ifdef MPI + include 'mpif.h' + integer,parameter :: max_cont=2000 + integer,parameter:: max_dim=2*(8*3+6) + integer, parameter :: msglen1=max_cont*max_dim + integer,parameter :: msglen2=2*msglen1 + integer source,CorrelType,CorrelID,Error + real(kind=8) :: buffer(max_cont,max_dim) + integer status(MPI_STATUS_SIZE) + integer :: ierror,nbytes +#endif + real(kind=8),dimension(3):: gx(3),gx1(3) + real(kind=8) :: time00 + logical lprn,ldone + integer i,j,i1,j1,jj,kk,num_conti,num_conti1,nn + real(kind=8) ecorr,ecorr3 + integer :: n_corr,n_corr1,mm,msglen +!C Set lprn=.true. for debugging + lprn=.false. + n_corr=0 + n_corr1=0 +#ifdef MPI + if(.not.allocated(zapas2)) allocate(zapas2(3,maxconts,nres,8)) + + if (nfgtasks.le.1) goto 30 + if (lprn) then + write (iout,'(a)') 'Contact function values:' + do i=nnt,nct-1 + 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_nucl) + 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_nucl(iatel_s_nucl).gt.iatel_s_nucl+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_nucl+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_nucl)=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_nucl(iatel_e_nucl).lt.nct_molec(2)-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_nucl+1,0,buffer) + else if (msglen.eq.msglen2) then + call unpack_buffer(max_cont,max_dim,iatel_e_nucl,0,buffer) + call unpack_buffer(max_cont,max_dim,iatel_e_nucl+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_molec(2),nct_molec(2)-1 + 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 + ecorr3=0.0d0 +!C Remove the loop below after debugging !!! +! do i=nnt_molec(2),nct_molec(2) +! do j=1,3 +! gradcorr_nucl(j,i)=0.0D0 +! gradxorr_nucl(j,i)=0.0D0 +! gradcorr3_nucl(j,i)=0.0D0 +! gradxorr3_nucl(j,i)=0.0D0 +! enddo +! enddo +! print *,"iatsc_s_nucl,iatsc_e_nucl",iatsc_s_nucl,iatsc_e_nucl +!C Calculate the local-electrostatic correlation terms + do i=iatsc_s_nucl,iatsc_e_nucl + i1=i+1 + num_conti=num_cont_hb(i) + num_conti1=num_cont_hb(i+1) +! print *,i,num_conti,num_conti1 + 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 +!C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously. +!C The system gains extra energy. +!C Tentative expression & coefficients; assumed d(stacking)=4.5 A, +!C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7 +!C Need to implement full formulas 34 and 35 from Liwo et al., 1998. +!C + ecorr=ecorr+ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0) + if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') & + 'ecorrh',i,j,ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0) + n_corr=n_corr+1 + else if (j1.eq.j) then +!C +!C Contacts I-J and I-(J+1) occur simultaneously. +!C The system loses extra energy. +!C Tentative expression & c?oefficients; assumed d(stacking)=4.5 A, +!C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7 +!C Need to implement full formulas 32 from Liwo et al., 1998. +!C +!c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1, +!c & ' jj=',jj,' kk=',kk + ecorr3=ecorr3+ehbcorr3_nucl(i,j,i+1,j,jj,kk,0.310D0,-0.155D0) + endif + enddo ! kk + do kk=1,num_conti + j1=jcont_hb(kk,i) +!c write (iout,*) 'ecorr3: 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. + ecorr3=ecorr3+ehbcorr3_nucl(i,j,i,j+1,jj,kk,0.310D0,-0.155D0) + endif ! j1==j+1 + enddo ! kk + enddo ! jj + enddo ! i + return + end subroutine multibody_hb_nucl +!----------------------------------------------------------- + real(kind=8) function ehbcorr_nucl(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' + real(kind=8),dimension(3) :: gx,gx1 + logical :: lprn +!el local variables + integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield + real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,& + ees0mkl,ees,coeffpees0pij,coeffmees0mij,& + coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, & + rlocshield + + 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) +! print *,"ehbcorr_nucl",ekont,ees +!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 +!cd write (iout,*)'Contacts have occurred for nucleic bases', +!cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l +!cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees +!C Calculate the multi-body contribution to energy. +! ecorr_nucl=ecorr_nucl+ekont*ees +!C Calculate multi-body contributions to the gradient. + coeffpees0pij=coeffp*ees0pij + coeffmees0mij=coeffm*ees0mij + coeffpees0pkl=coeffp*ees0pkl + coeffmees0mkl=coeffm*ees0mkl + do ll=1,3 + gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i) & + -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+& + coeffmees0mkl*gacontm_hb1(ll,jj,i)) + gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j) & + -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+& + coeffmees0mkl*gacontm_hb2(ll,jj,i)) + gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k) & + -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+& + coeffmees0mij*gacontm_hb1(ll,kk,k)) + gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l) & + -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ & + coeffmees0mij*gacontm_hb2(ll,kk,k)) + gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- & + ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ & + coeffmees0mkl*gacontm_hb3(ll,jj,i)) + gradcorr_nucl(ll,j)=gradcorr_nucl(ll,j)+gradlongij + gradcorr_nucl(ll,i)=gradcorr_nucl(ll,i)-gradlongij + gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- & + ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ & + coeffmees0mij*gacontm_hb3(ll,kk,k)) + gradcorr_nucl(ll,l)=gradcorr_nucl(ll,l)+gradlongkl + gradcorr_nucl(ll,k)=gradcorr_nucl(ll,k)-gradlongkl + gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i)-gradlongij + gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j)+gradlongij + gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k)-gradlongkl + gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l)+gradlongkl + enddo + ehbcorr_nucl=ekont*ees + return + end function ehbcorr_nucl +!------------------------------------------------------------------------- + + real(kind=8) function ehbcorr3_nucl(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' + real(kind=8),dimension(3) :: gx,gx1 + logical :: lprn +!el local variables + integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield + real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,& + ees0mkl,ees,coeffpees0pij,coeffmees0mij,& + coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, & + rlocshield + + 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 +!cd write (iout,*)'Contacts have occurred for nucleic bases', +!cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l +!cd & ,' 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. + coeffpees0pij=coeffp*ees0pij + coeffmees0mij=coeffm*ees0mij + coeffpees0pkl=coeffp*ees0pkl + coeffmees0mkl=coeffm*ees0mkl + do ll=1,3 + gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i) & + -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+& + coeffmees0mkl*gacontm_hb1(ll,jj,i)) + gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j) & + -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ & + coeffmees0mkl*gacontm_hb2(ll,jj,i)) + gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k) & + -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ & + coeffmees0mij*gacontm_hb1(ll,kk,k)) + gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l) & + -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ & + coeffmees0mij*gacontm_hb2(ll,kk,k)) + gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- & + ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ & + coeffmees0mkl*gacontm_hb3(ll,jj,i)) + gradcorr3_nucl(ll,j)=gradcorr3_nucl(ll,j)+gradlongij + gradcorr3_nucl(ll,i)=gradcorr3_nucl(ll,i)-gradlongij + gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- & + ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ & + coeffmees0mij*gacontm_hb3(ll,kk,k)) + gradcorr3_nucl(ll,l)=gradcorr3_nucl(ll,l)+gradlongkl + gradcorr3_nucl(ll,k)=gradcorr3_nucl(ll,k)-gradlongkl + gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i)-gradlongij + gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j)+gradlongij + gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k)-gradlongkl + gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l)+gradlongkl + enddo + ehbcorr3_nucl=ekont*ees + return + end function ehbcorr3_nucl +#ifdef MPI + subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer) + integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old + real(kind=8):: buffer(dimen1,dimen2) + 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)=zapas2(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 subroutine pack_buffer +!c------------------------------------------------------------------------------ + subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer) + integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old + real(kind=8):: 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 + zapas2(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 subroutine unpack_buffer +!c------------------------------------------------------------------------------ +#endif + subroutine ecatcat(ecationcation) + integer :: i,j,itmp,xshift,yshift,zshift,subchap,k + real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,& + r7,r4,ecationcation,k0,rcal + real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, & + dist_init,dist_temp,Evan1cat,Evan2cat,Eeleccat + real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,& + gg,r + + ecationcation=0.0d0 + if (nres_molec(5).eq.0) return + rcat0=3.472 + epscalc=0.05 + r06 = rcat0**6 + r012 = r06**2 + k0 = 332.0*(2.0*2.0)/80.0 + itmp=0 + + do i=1,4 + itmp=itmp+nres_molec(i) + enddo +! write(iout,*) "itmp",itmp + do i=itmp+1,itmp+nres_molec(5)-1 + + xi=c(1,i) + yi=c(2,i) + zi=c(3,i) + + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize + + do j=i+1,itmp+nres_molec(5) +! print *,i,j,'catcat' + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + xj=dmod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=dmod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=dmod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize +! write(iout,*) c(1,i),xi,xj,"xy",boxxsize + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + rcal =xj**2+yj**2+zj**2 + ract=sqrt(rcal) +! rcat0=3.472 +! epscalc=0.05 +! r06 = rcat0**6 +! r012 = r06**2 +! k0 = 332*(2*2)/80 + Evan1cat=epscalc*(r012/rcal**6) + Evan2cat=epscalc*2*(r06/rcal**3) + Eeleccat=k0/ract + r7 = rcal**7 + r4 = rcal**4 + r(1)=xj + r(2)=yj + r(3)=zj + do k=1,3 + dEvan1Cmcat(k)=-12*r(k)*epscalc*r012/r7 + dEvan2Cmcat(k)=-12*r(k)*epscalc*r06/r4 + dEeleccat(k)=-k0*r(k)/ract**3 + enddo + do k=1,3 + gg(k) = dEvan1Cmcat(k)+dEvan2Cmcat(k)+dEeleccat(k) + gradcatcat(k,i)=gradcatcat(k,i)-gg(k) + gradcatcat(k,j)=gradcatcat(k,j)+gg(k) + enddo + +! write(iout,*) "ecatcat",i,j, ecationcation,xj,yj,zj + ecationcation=ecationcation+Evan1cat+Evan2cat+Eeleccat + enddo + enddo + return + end subroutine ecatcat +!--------------------------------------------------------------------------- + subroutine ecat_prot(ecation_prot) + integer i,j,k,subchap,itmp,inum + real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,& + r7,r4,ecationcation + real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, & + dist_init,dist_temp,ecation_prot,rcal,rocal, & + Evan1,Evan2,EC,cm1mag,DASGL,delta,r0p,Epepcat, & + catl,cml,calpl, Etotal_p, Etotal_m,rtab,wdip,wmodquad,wquad1, & + wquad2,wvan1,E1,E2,wconst,wvan2,rcpm,dcmag,sin2thet,sinthet, & + costhet,v1m,v2m,wh2o,wc,rsecp,Ir,Irsecp,Irthrp,Irfourp,Irfiftp,& + Irsistp,Irseven,Irtwelv,Irthir,dE1dr,dE2dr,dEdcos,wquad2p,opt, & + rs,rthrp,rfourp,rsixp,reight,Irsixp,Ireight,Irtw,Irfourt, & + opt1,opt2,opt3,opt4,opt5,opt6,opt7,opt8,opt9,opt10,opt11,opt12,& + opt13,opt14,opt15,opt16,opt17,opt18,opt19, & + Equad1,Equad2,dscmag,v1dpv2,dscmag3,constA,constB,Edip + real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,& + gg,r,EtotalCat,dEtotalCm,dEtotalCalp,dEvan1Cm,dEvan2Cm, & + dEtotalpep,dEtotalcat_num,dEddci,dEtotalcm_num,dEtotalcalp_num, & + tab1,tab2,tab3,diff,cm1,sc,p,tcat,talp,cm,drcp,drcp_norm,vcat, & + v1,v2,v3,myd_norm,dx,vcm,valpha,drdpep,dcosdpep,dcosddci,dEdpep,& + dEcCat,dEdipCm,dEdipCalp,dEquad1Cat,dEquad1Cm,dEquad1Calp, & + dEquad2Cat,dEquad2Cm,dEquad2Calpd,Evan1Cat,dEvan1Calp,dEvan2Cat,& + dEvan2Calp,dEtotalCat,dscvec,dEcCm,dEcCalp,dEdipCat,dEquad2Calp,& + dEvan1Cat + real(kind=8),dimension(6) :: vcatprm + ecation_prot=0.0d0 +! first lets calculate interaction with peptide groups + if (nres_molec(5).eq.0) return + wconst=78 + wdip =1.092777950857032D2 + wdip=wdip/wconst + wmodquad=-2.174122713004870D4 + wmodquad=wmodquad/wconst + wquad1 = 3.901232068562804D1 + wquad1=wquad1/wconst + wquad2 = 3 + wquad2=wquad2/wconst + wvan1 = 0.1 + wvan2 = 6 + itmp=0 + do i=1,4 + itmp=itmp+nres_molec(i) + enddo +! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization + do i=ibond_start,ibond_end +! cycle + if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle ! leave dummy atoms + xi=0.5d0*(c(1,i)+c(1,i+1)) + yi=0.5d0*(c(2,i)+c(2,i+1)) + zi=0.5d0*(c(3,i)+c(3,i+1)) + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize + + do j=itmp+1,itmp+nres_molec(5) + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + xj=dmod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=dmod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=dmod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif +! enddo +! enddo + rcpm = sqrt(xj**2+yj**2+zj**2) + drcp_norm(1)=xj/rcpm + drcp_norm(2)=yj/rcpm + drcp_norm(3)=zj/rcpm + dcmag=0.0 + do k=1,3 + dcmag=dcmag+dc(k,i)**2 + enddo + dcmag=dsqrt(dcmag) + do k=1,3 + myd_norm(k)=dc(k,i)/dcmag + enddo + costhet=drcp_norm(1)*myd_norm(1)+drcp_norm(2)*myd_norm(2)+& + drcp_norm(3)*myd_norm(3) + rsecp = rcpm**2 + Ir = 1.0d0/rcpm + Irsecp = 1.0d0/rsecp + Irthrp = Irsecp/rcpm + Irfourp = Irthrp/rcpm + Irfiftp = Irfourp/rcpm + Irsistp=Irfiftp/rcpm + Irseven=Irsistp/rcpm + Irtwelv=Irsistp*Irsistp + Irthir=Irtwelv/rcpm + sin2thet = (1-costhet*costhet) + sinthet=sqrt(sin2thet) + E1 = wdip*Irsecp*costhet+(wmodquad*Irfourp+wquad1*Irthrp)& + *sin2thet + E2 = -wquad1*Irthrp*wquad2+wvan1*(wvan2**12*Irtwelv-& + 2*wvan2**6*Irsistp) + ecation_prot = ecation_prot+E1+E2 + dE1dr = -2*costhet*wdip*Irthrp-& + (4*wmodquad*Irfiftp+3*wquad1*Irfourp)*sin2thet + dE2dr = 3*wquad1*wquad2*Irfourp- & + 12*wvan1*wvan2**6*(wvan2**6*Irthir-Irseven) + dEdcos = wdip*Irsecp-2*(wmodquad*Irfourp+wquad1*Irthrp)*costhet + do k=1,3 + drdpep(k) = -drcp_norm(k) + dcosdpep(k) = Ir*(costhet*drcp_norm(k)-myd_norm(k)) + dcosddci(k) = drcp_norm(k)/dcmag-costhet*myd_norm(k)/dcmag + dEdpep(k) = (dE1dr+dE2dr)*drdpep(k)+dEdcos*dcosdpep(k) + dEddci(k) = dEdcos*dcosddci(k) + enddo + do k=1,3 + gradpepcat(k,i)=gradpepcat(k,i)+0.5D0*dEdpep(k)-dEddci(k) + gradpepcat(k,i+1)=gradpepcat(k,i+1)+0.5D0*dEdpep(k)+dEddci(k) + gradpepcat(k,j)=gradpepcat(k,j)-dEdpep(k) + enddo + enddo ! j + enddo ! i +!------------------------------------------sidechains +! do i=1,nres_molec(1) + do i=ibond_start,ibond_end + if ((itype(i,1).eq.ntyp1)) cycle ! leave dummy atoms +! cycle +! print *,i,ecation_prot + xi=(c(1,i+nres)) + yi=(c(2,i+nres)) + zi=(c(3,i+nres)) + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize + do k=1,3 + cm1(k)=dc(k,i+nres) + enddo + cm1mag=sqrt(cm1(1)**2+cm1(2)**2+cm1(3)**2) + do j=itmp+1,itmp+nres_molec(5) + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + xj=dmod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=dmod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=dmod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif +! enddo +! enddo + if(itype(i,1).eq.15.or.itype(i,1).eq.16) then + if(itype(i,1).eq.16) then + inum=1 + else + inum=2 + endif + do k=1,6 + vcatprm(k)=catprm(k,inum) + enddo + dASGL=catprm(7,inum) + do k=1,3 + vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres) + valpha(k)=c(k,i) + vcat(k)=c(k,j) + enddo + do k=1,3 + dx(k) = vcat(k)-vcm(k) + enddo + do k=1,3 + v1(k)=(vcm(k)-valpha(k)) + v2(k)=(vcat(k)-valpha(k)) + enddo + v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2) + v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2) + v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3) + +! The weights of the energy function calculated from +!The quantum mechanical GAMESS simulations of calcium with ASP/GLU + wh2o=78 + wc = vcatprm(1) + wc=wc/wh2o + wdip =vcatprm(2) + wdip=wdip/wh2o + wquad1 =vcatprm(3) + wquad1=wquad1/wh2o + wquad2 = vcatprm(4) + wquad2=wquad2/wh2o + wquad2p = 1-wquad2 + wvan1 = vcatprm(5) + wvan2 =vcatprm(6) + opt = dx(1)**2+dx(2)**2 + rsecp = opt+dx(3)**2 + rs = sqrt(rsecp) + rthrp = rsecp*rs + rfourp = rthrp*rs + rsixp = rfourp*rsecp + reight=rsixp*rsecp + Ir = 1.0d0/rs + Irsecp = 1/rsecp + Irthrp = Irsecp/rs + Irfourp = Irthrp/rs + Irsixp = 1/rsixp + Ireight=1/reight + Irtw=Irsixp*Irsixp + Irthir=Irtw/rs + Irfourt=Irthir/rs + opt1 = (4*rs*dx(3)*wdip) + opt2 = 6*rsecp*wquad1*opt + opt3 = wquad1*wquad2p*Irsixp + opt4 = (wvan1*wvan2**12) + opt5 = opt4*12*Irfourt + opt6 = 2*wvan1*wvan2**6 + opt7 = 6*opt6*Ireight + opt8 = wdip/v1m + opt10 = wdip/v2m + opt11 = (rsecp*v2m)**2 + opt12 = (rsecp*v1m)**2 + opt14 = (v1m*v2m*rsecp)**2 + opt15 = -wquad1/v2m**2 + opt16 = (rthrp*(v1m*v2m)**2)**2 + opt17 = (v1m**2*rthrp)**2 + opt18 = -wquad1/rthrp + opt19 = (v1m**2*v2m**2)**2 + Ec = wc*Ir + do k=1,3 + dEcCat(k) = -(dx(k)*wc)*Irthrp + dEcCm(k)=(dx(k)*wc)*Irthrp + dEcCalp(k)=0.0d0 + enddo + Edip=opt8*(v1dpv2)/(rsecp*v2m) + do k=1,3 + dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m & + *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11 + dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m & + *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12 + dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m & + *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp) & + *v1dpv2)/opt14 + enddo + Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2) + do k=1,3 + dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp* & + (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2* & + v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16 + dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp* & + (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2* & + v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16 + dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* & + v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)* & + v1dpv2**2)/opt19 + enddo + Equad2=wquad1*wquad2p*Irthrp + do k=1,3 + dEquad2Cat(k)=-3*dx(k)*rs*opt3 + dEquad2Cm(k)=3*dx(k)*rs*opt3 + dEquad2Calp(k)=0.0d0 + enddo + Evan1=opt4*Irtw + do k=1,3 + dEvan1Cat(k)=-dx(k)*opt5 + dEvan1Cm(k)=dx(k)*opt5 + dEvan1Calp(k)=0.0d0 + enddo + Evan2=-opt6*Irsixp + do k=1,3 + dEvan2Cat(k)=dx(k)*opt7 + dEvan2Cm(k)=-dx(k)*opt7 + dEvan2Calp(k)=0.0d0 + enddo + ecation_prot=ecation_prot+Ec+Edip+Equad1+Equad2+Evan1+Evan2 +! print *,ecation_prot,Ec+Edip+Equad1+Equad2+Evan1+Evan2 + + do k=1,3 + dEtotalCat(k)=dEcCat(k)+dEdipCat(k)+dEquad1Cat(k)+ & + dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k) +!c write(*,*) 'dEtotalCat inside', (dEtotalCat(l),l=1,3) + dEtotalCm(k)=dEcCm(k)+dEdipCm(k)+dEquad1Cm(k)+ & + dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k) + dEtotalCalp(k)=dEcCalp(k)+dEdipCalp(k)+dEquad1Calp(k) & + +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k) + enddo + dscmag = 0.0d0 + do k=1,3 + dscvec(k) = dc(k,i+nres) + dscmag = dscmag+dscvec(k)*dscvec(k) + enddo + dscmag3 = dscmag + dscmag = sqrt(dscmag) + dscmag3 = dscmag3*dscmag + constA = 1.0d0+dASGL/dscmag + constB = 0.0d0 + do k=1,3 + constB = constB+dscvec(k)*dEtotalCm(k) + enddo + constB = constB*dASGL/dscmag3 + do k=1,3 + gg(k) = dEtotalCm(k)+dEtotalCalp(k) + gradpepcatx(k,i)=gradpepcatx(k,i)+ & + constA*dEtotalCm(k)-constB*dscvec(k) +! print *,j,constA,dEtotalCm(k),constB,dscvec(k) + gradpepcat(k,i)=gradpepcat(k,i)+gg(k) + gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k) + enddo + else if (itype(i,1).eq.13.or.itype(i,1).eq.14) then + if(itype(i,1).eq.14) then + inum=3 + else + inum=4 + endif + do k=1,6 + vcatprm(k)=catprm(k,inum) + enddo + dASGL=catprm(7,inum) + do k=1,3 + vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres) + valpha(k)=c(k,i) + vcat(k)=c(k,j) + enddo + + do k=1,3 + dx(k) = vcat(k)-vcm(k) + enddo + do k=1,3 + v1(k)=(vcm(k)-valpha(k)) + v2(k)=(vcat(k)-valpha(k)) + enddo + v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2) + v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2) + v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3) +! The weights of the energy function calculated from +!The quantum mechanical GAMESS simulations of ASN/GLN with calcium + wh2o=78 + wdip =vcatprm(2) + wdip=wdip/wh2o + wquad1 =vcatprm(3) + wquad1=wquad1/wh2o + wquad2 = vcatprm(4) + wquad2=wquad2/wh2o + wquad2p = 1-wquad2 + wvan1 = vcatprm(5) + wvan2 =vcatprm(6) + opt = dx(1)**2+dx(2)**2 + rsecp = opt+dx(3)**2 + rs = sqrt(rsecp) + rthrp = rsecp*rs + rfourp = rthrp*rs + rsixp = rfourp*rsecp + reight=rsixp*rsecp + Ir = 1.0d0/rs + Irsecp = 1/rsecp + Irthrp = Irsecp/rs + Irfourp = Irthrp/rs + Irsixp = 1/rsixp + Ireight=1/reight + Irtw=Irsixp*Irsixp + Irthir=Irtw/rs + Irfourt=Irthir/rs + opt1 = (4*rs*dx(3)*wdip) + opt2 = 6*rsecp*wquad1*opt + opt3 = wquad1*wquad2p*Irsixp + opt4 = (wvan1*wvan2**12) + opt5 = opt4*12*Irfourt + opt6 = 2*wvan1*wvan2**6 + opt7 = 6*opt6*Ireight + opt8 = wdip/v1m + opt10 = wdip/v2m + opt11 = (rsecp*v2m)**2 + opt12 = (rsecp*v1m)**2 + opt14 = (v1m*v2m*rsecp)**2 + opt15 = -wquad1/v2m**2 + opt16 = (rthrp*(v1m*v2m)**2)**2 + opt17 = (v1m**2*rthrp)**2 + opt18 = -wquad1/rthrp + opt19 = (v1m**2*v2m**2)**2 + Edip=opt8*(v1dpv2)/(rsecp*v2m) + do k=1,3 + dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m& + *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11 + dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m& + *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12 + dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m& + *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp)& + *v1dpv2)/opt14 + enddo + Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2) + do k=1,3 + dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp*& + (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2*& + v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16 + dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp*& + (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2*& + v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16 + dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* & + v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)*& + v1dpv2**2)/opt19 + enddo + Equad2=wquad1*wquad2p*Irthrp + do k=1,3 + dEquad2Cat(k)=-3*dx(k)*rs*opt3 + dEquad2Cm(k)=3*dx(k)*rs*opt3 + dEquad2Calp(k)=0.0d0 + enddo + Evan1=opt4*Irtw + do k=1,3 + dEvan1Cat(k)=-dx(k)*opt5 + dEvan1Cm(k)=dx(k)*opt5 + dEvan1Calp(k)=0.0d0 + enddo + Evan2=-opt6*Irsixp + do k=1,3 + dEvan2Cat(k)=dx(k)*opt7 + dEvan2Cm(k)=-dx(k)*opt7 + dEvan2Calp(k)=0.0d0 + enddo + ecation_prot = ecation_prot+Edip+Equad1+Equad2+Evan1+Evan2 + do k=1,3 + dEtotalCat(k)=dEdipCat(k)+dEquad1Cat(k)+ & + dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k) + dEtotalCm(k)=dEdipCm(k)+dEquad1Cm(k)+ & + dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k) + dEtotalCalp(k)=dEdipCalp(k)+dEquad1Calp(k) & + +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k) + enddo + dscmag = 0.0d0 + do k=1,3 + dscvec(k) = c(k,i+nres)-c(k,i) + dscmag = dscmag+dscvec(k)*dscvec(k) + enddo + dscmag3 = dscmag + dscmag = sqrt(dscmag) + dscmag3 = dscmag3*dscmag + constA = 1+dASGL/dscmag + constB = 0.0d0 + do k=1,3 + constB = constB+dscvec(k)*dEtotalCm(k) + enddo + constB = constB*dASGL/dscmag3 + do k=1,3 + gg(k) = dEtotalCm(k)+dEtotalCalp(k) + gradpepcatx(k,i)=gradpepcatx(k,i)+ & + constA*dEtotalCm(k)-constB*dscvec(k) + gradpepcat(k,i)=gradpepcat(k,i)+gg(k) + gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k) + enddo + else + rcal = 0.0d0 + do k=1,3 + r(k) = c(k,j)-c(k,i+nres) + rcal = rcal+r(k)*r(k) + enddo + ract=sqrt(rcal) + rocal=1.5 + epscalc=0.2 + r0p=0.5*(rocal+sig0(itype(i,1))) + r06 = r0p**6 + r012 = r06*r06 + Evan1=epscalc*(r012/rcal**6) + Evan2=epscalc*2*(r06/rcal**3) + r4 = rcal**4 + r7 = rcal**7 + do k=1,3 + dEvan1Cm(k) = 12*r(k)*epscalc*r012/r7 + dEvan2Cm(k) = 12*r(k)*epscalc*r06/r4 + enddo + do k=1,3 + dEtotalCm(k)=dEvan1Cm(k)+dEvan2Cm(k) + enddo + ecation_prot = ecation_prot+ Evan1+Evan2 + do k=1,3 + gradpepcatx(k,i)=gradpepcatx(k,i)+ & + dEtotalCm(k) + gradpepcat(k,i)=gradpepcat(k,i)+dEtotalCm(k) + gradpepcat(k,j)=gradpepcat(k,j)-dEtotalCm(k) + enddo + endif ! 13-16 residues + enddo !j + enddo !i + return + end subroutine ecat_prot + +!---------------------------------------------------------------------------- +!----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- + subroutine eprot_sc_base(escbase) + use calc_data +! 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' +! include 'COMMON.CONTROL' +! include 'COMMON.SBRIDGE' + logical :: lprn +!el local variables + integer :: iint,itypi,itypi1,itypj,subchap + real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi + real(kind=8) :: evdw,sig0ij + real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,& + dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, & + sslipi,sslipj,faclip + integer :: ii + real(kind=8) :: fracinbuf + real (kind=8) :: escbase + real (kind=8),dimension(4):: ener + real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out + real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,& + sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,& + Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,& + dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,& + r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,& + dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,& + sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1 + real(kind=8),dimension(3,2)::chead,erhead_tail + real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead + integer troll + eps_out=80.0d0 + escbase=0.0d0 +! do i=1,nres_molec(1) + do i=ibond_start,ibond_end + if (itype(i,1).eq.ntyp1_molec(1)) cycle + itypi = itype(i,1) + dxi = dc_norm(1,nres+i) + dyi = dc_norm(2,nres+i) + dzi = dc_norm(3,nres+i) + dsci_inv = vbld_inv(i+nres) + xi=c(1,nres+i) + yi=c(2,nres+i) + zi=c(3,nres+i) + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize + do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1) + itypj= itype(j,2) + if (itype(j,2).eq.ntyp1_molec(2))cycle + xj=c(1,j+nres) + yj=c(2,j+nres) + zj=c(3,j+nres) + xj=dmod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=dmod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=dmod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + dxj = dc_norm( 1, nres+j ) + dyj = dc_norm( 2, nres+j ) + dzj = dc_norm( 3, nres+j ) +! print *,i,j,itypi,itypj + d1i = dhead_scbasei(itypi,itypj) !this is shift of dipole/charge + d1j = dhead_scbasej(itypi,itypj) !this is shift of dipole/charge +! d1i=0.0d0 +! d1j=0.0d0 +! BetaT = 1.0d0 / (298.0d0 * Rb) +! Gay-berne var's + sig0ij = sigma_scbase( itypi,itypj ) + chi1 = chi_scbase( itypi, itypj,1 ) + chi2 = chi_scbase( itypi, itypj,2 ) +! chi1=0.0d0 +! chi2=0.0d0 + chi12 = chi1 * chi2 + chip1 = chipp_scbase( itypi, itypj,1 ) + chip2 = chipp_scbase( itypi, itypj,2 ) +! chip1=0.0d0 +! chip2=0.0d0 + chip12 = chip1 * chip2 +! not used by momo potential, but needed by sc_angular which is shared +! by all energy_potential subroutines + alf1 = 0.0d0 + alf2 = 0.0d0 + alf12 = 0.0d0 + a12sq = rborn_scbasei(itypi,itypj) * rborn_scbasej(itypi,itypj) +! a12sq = a12sq * a12sq +! charge of amino acid itypi is... + chis1 = chis_scbase(itypi,itypj,1) + chis2 = chis_scbase(itypi,itypj,2) + chis12 = chis1 * chis2 + sig1 = sigmap1_scbase(itypi,itypj) + sig2 = sigmap2_scbase(itypi,itypj) +! write (*,*) "sig1 = ", sig1 +! write (*,*) "sig2 = ", sig2 +! alpha factors from Fcav/Gcav + b1 = alphasur_scbase(1,itypi,itypj) +! b1=0.0d0 + b2 = alphasur_scbase(2,itypi,itypj) + b3 = alphasur_scbase(3,itypi,itypj) + b4 = alphasur_scbase(4,itypi,itypj) +! used to determine whether we want to do quadrupole calculations +! used by Fgb + eps_in = epsintab_scbase(itypi,itypj) + if (eps_in.eq.0.0) eps_in=1.0 + eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out)) +! write (*,*) "eps_inout_fac = ", eps_inout_fac +!------------------------------------------------------------------- +! tail location and distance calculations + DO k = 1,3 +! location of polar head is computed by taking hydrophobic centre +! and moving by a d1 * dc_norm vector +! see unres publications for very informative images + chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres) + chead(k,2) = c(k, j+nres) + d1j * dc_norm(k, j+nres) +! distance +! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres)) +! Rsc(k) = Rsc_distance(k) * Rsc_distance(k) + Rhead_distance(k) = chead(k,2) - chead(k,1) + END DO +! pitagoras (root of sum of squares) + Rhead = dsqrt( & + (Rhead_distance(1)*Rhead_distance(1)) & + + (Rhead_distance(2)*Rhead_distance(2)) & + + (Rhead_distance(3)*Rhead_distance(3))) +!------------------------------------------------------------------- +! zero everything that should be zero'ed + evdwij = 0.0d0 + ECL = 0.0d0 + Elj = 0.0d0 + Equad = 0.0d0 + Epol = 0.0d0 + Fcav=0.0d0 + eheadtail = 0.0d0 + dGCLdOM1 = 0.0d0 + dGCLdOM2 = 0.0d0 + dGCLdOM12 = 0.0d0 + dPOLdOM1 = 0.0d0 + dPOLdOM2 = 0.0d0 + Fcav = 0.0d0 + dFdR = 0.0d0 + dCAVdOM1 = 0.0d0 + dCAVdOM2 = 0.0d0 + dCAVdOM12 = 0.0d0 + dscj_inv = vbld_inv(j+nres) +! print *,i,j,dscj_inv,dsci_inv +! rij holds 1/(distance of Calpha atoms) + rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj) + rij = dsqrt(rrij) +!---------------------------- + CALL sc_angular +! this should be in elgrad_init but om's are calculated by sc_angular +! which in turn is used by older potentials +! om = omega, sqom = om^2 + sqom1 = om1 * om1 + sqom2 = om2 * om2 + sqom12 = om12 * om12 + +! now we calculate EGB - Gey-Berne +! It will be summed up in evdwij and saved in evdw + sigsq = 1.0D0 / sigsq + sig = sig0ij * dsqrt(sigsq) +! rij_shift = 1.0D0 / rij - sig + sig0ij + rij_shift = 1.0/rij - sig + sig0ij + IF (rij_shift.le.0.0D0) THEN + evdw = 1.0D20 + RETURN + END IF + sigder = -sig * sigsq + rij_shift = 1.0D0 / rij_shift + fac = rij_shift**expon + c1 = fac * fac * aa_scbase(itypi,itypj) +! c1 = 0.0d0 + c2 = fac * bb_scbase(itypi,itypj) +! c2 = 0.0d0 + evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 ) + eps2der = eps3rt * evdwij + eps3der = eps2rt * evdwij +! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij + evdwij = eps2rt * eps3rt * evdwij + c1 = c1 * eps1 * eps2rt**2 * eps3rt**2 + fac = -expon * (c1 + evdwij) * rij_shift + sigder = fac * sigder +! fac = rij * fac +! Calculate distance derivative + gg(1) = fac + gg(2) = fac + gg(3) = fac +! if (b2.gt.0.0) then + fac = chis1 * sqom1 + chis2 * sqom2 & + - 2.0d0 * chis12 * om1 * om2 * om12 +! we will use pom later in Gcav, so dont mess with it! + pom = 1.0d0 - chis1 * chis2 * sqom12 + Lambf = (1.0d0 - (fac / pom)) + Lambf = dsqrt(Lambf) + sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0) +! write (*,*) "sparrow = ", sparrow + Chif = 1.0d0/rij * sparrow + ChiLambf = Chif * Lambf + eagle = dsqrt(ChiLambf) + bat = ChiLambf ** 11.0d0 + top = b1 * ( eagle + b2 * ChiLambf - b3 ) + bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0) + botsq = bot * bot + Fcav = top / bot +! print *,i,j,Fcav + dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf)) + dbot = 12.0d0 * b4 * bat * Lambf + dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow +! dFdR = 0.0d0 +! write (*,*) "dFcav/dR = ", dFdR + dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif)) + dbot = 12.0d0 * b4 * bat * Chif + eagle = Lambf * pom + dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle) + dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle) + dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) & + * (chis2 * om2 * om12 - om1) / (eagle * pom) + + dFdL = ((dtop * bot - top * dbot) / botsq) +! dFdL = 0.0d0 + dCAVdOM1 = dFdL * ( dFdOM1 ) + dCAVdOM2 = dFdL * ( dFdOM2 ) + dCAVdOM12 = dFdL * ( dFdOM12 ) + + ertail(1) = xj*rij + ertail(2) = yj*rij + ertail(3) = zj*rij +! eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 +! eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 +! eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 & +! -2.0D0*alf12*eps3der+sigder*sigsq_om12 +! print *,"EOMY",eom1,eom2,eom12 +! erdxi = scalar( ertail(1), dC_norm(1,i+nres) ) +! erdxj = scalar( ertail(1), dC_norm(1,j+nres) ) +! here dtail=0.0 +! facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres) +! facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres) + DO k = 1, 3 +! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i) +! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j) + pom = ertail(k) +!-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres)) + gvdwx_scbase(k,i) = gvdwx_scbase(k,i) & + - (( dFdR + gg(k) ) * pom) +! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) & +! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv +! & - ( dFdR * pom ) + pom = ertail(k) +!-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres)) + gvdwx_scbase(k,j) = gvdwx_scbase(k,j) & + + (( dFdR + gg(k) ) * pom) +! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) & +! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv +!c! & + ( dFdR * pom ) + + gvdwc_scbase(k,i) = gvdwc_scbase(k,i) & + - (( dFdR + gg(k) ) * ertail(k)) +!c! & - ( dFdR * ertail(k)) + + gvdwc_scbase(k,j) = gvdwc_scbase(k,j) & + + (( dFdR + gg(k) ) * ertail(k)) +!c! & + ( dFdR * ertail(k)) + + gg(k) = 0.0d0 +!c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i) +!c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j) + END DO + +! else + +! endif +!Now dipole-dipole + if (wdipdip_scbase(2,itypi,itypj).gt.0.0d0) then + w1 = wdipdip_scbase(1,itypi,itypj) + w2 = -wdipdip_scbase(3,itypi,itypj)/2.0 + w3 = wdipdip_scbase(2,itypi,itypj) +!c!------------------------------------------------------------------- +!c! ECL + fac = (om12 - 3.0d0 * om1 * om2) + c1 = (w1 / (Rhead**3.0d0)) * fac + c2 = (w2 / Rhead ** 6.0d0) & + * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2)) + c3= (w3/ Rhead ** 6.0d0) & + * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2)) + ECL = c1 - c2 + c3 +!c! write (*,*) "w1 = ", w1 +!c! write (*,*) "w2 = ", w2 +!c! write (*,*) "om1 = ", om1 +!c! write (*,*) "om2 = ", om2 +!c! write (*,*) "om12 = ", om12 +!c! write (*,*) "fac = ", fac +!c! write (*,*) "c1 = ", c1 +!c! write (*,*) "c2 = ", c2 +!c! write (*,*) "Ecl = ", Ecl +!c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0) +!c! write (*,*) "c2_2 = ", +!c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2)) +!c!------------------------------------------------------------------- +!c! dervative of ECL is GCL... +!c! dECL/dr + c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0) + c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) & + * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2)) + c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) & + * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2)) + dGCLdR = c1 - c2 + c3 +!c! dECL/dom1 + c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0) + c2 = (-6.0d0 * w2) / (Rhead**6.0d0) & + * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 ) + c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2)) + dGCLdOM1 = c1 - c2 + c3 +!c! dECL/dom2 + c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0) + c2 = (-6.0d0 * w2) / (Rhead**6.0d0) & + * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 ) + c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1)) + dGCLdOM2 = c1 - c2 + c3 +!c! dECL/dom12 + c1 = w1 / (Rhead ** 3.0d0) + c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0 + c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac) + dGCLdOM12 = c1 - c2 + c3 + DO k= 1, 3 + erhead(k) = Rhead_distance(k)/Rhead + END DO + erdxi = scalar( erhead(1), dC_norm(1,i+nres) ) + erdxj = scalar( erhead(1), dC_norm(1,j+nres) ) + facd1 = d1i * vbld_inv(i+nres) + facd2 = d1j * vbld_inv(j+nres) + DO k = 1, 3 + + pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) + gvdwx_scbase(k,i) = gvdwx_scbase(k,i) & + - dGCLdR * pom + pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) + gvdwx_scbase(k,j) = gvdwx_scbase(k,j) & + + dGCLdR * pom + + gvdwc_scbase(k,i) = gvdwc_scbase(k,i) & + - dGCLdR * erhead(k) + gvdwc_scbase(k,j) = gvdwc_scbase(k,j) & + + dGCLdR * erhead(k) + END DO + endif +!now charge with dipole eg. ARG-dG + if (wqdip_scbase(2,itypi,itypj).gt.0.0d0) then + alphapol1 = alphapol_scbase(itypi,itypj) + w1 = wqdip_scbase(1,itypi,itypj) + w2 = wqdip_scbase(2,itypi,itypj) +! w1=0.0d0 +! w2=0.0d0 +! pis = sig0head_scbase(itypi,itypj) +! eps_head = epshead_scbase(itypi,itypj) +!c!------------------------------------------------------------------- +!c! R1 - distance between head of ith side chain and tail of jth sidechain + R1 = 0.0d0 + DO k = 1, 3 +!c! Calculate head-to-tail distances tail is center of side-chain + R1=R1+(c(k,j+nres)-chead(k,1))**2 + END DO +!c! Pitagoras + R1 = dsqrt(R1) + +!c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj) +!c! & +dhead(1,1,itypi,itypj))**2)) +!c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj) +!c! & +dhead(2,1,itypi,itypj))**2)) + +!c!------------------------------------------------------------------- +!c! ecl + sparrow = w1 * om1 + hawk = w2 * (1.0d0 - sqom2) + Ecl = sparrow / Rhead**2.0d0 & + - hawk / Rhead**4.0d0 +!c!------------------------------------------------------------------- +!c! derivative of ecl is Gcl +!c! dF/dr part + dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 & + + 4.0d0 * hawk / Rhead**5.0d0 +!c! dF/dom1 + dGCLdOM1 = (w1) / (Rhead**2.0d0) +!c! dF/dom2 + dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0) +!c-------------------------------------------------------------------- +!c Polarization energy +!c Epol + MomoFac1 = (1.0d0 - chi1 * sqom2) + RR1 = R1 * R1 / MomoFac1 + ee1 = exp(-( RR1 / (4.0d0 * a12sq) )) + fgb1 = sqrt( RR1 + a12sq * ee1) +! eps_inout_fac=0.0d0 + epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0) +! derivative of Epol is Gpol... + dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) & + / (fgb1 ** 5.0d0) + dFGBdR1 = ( (R1 / MomoFac1) & + * ( 2.0d0 - (0.5d0 * ee1) ) ) & + / ( 2.0d0 * fgb1 ) + dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) & + * (2.0d0 - 0.5d0 * ee1) ) & + / (2.0d0 * fgb1) + dPOLdR1 = dPOLdFGB1 * dFGBdR1 +! dPOLdR1 = 0.0d0 + dPOLdOM1 = 0.0d0 + dPOLdOM2 = dPOLdFGB1 * dFGBdOM2 + DO k = 1, 3 + erhead(k) = Rhead_distance(k)/Rhead + erhead_tail(k,1) = ((c(k,j+nres)-chead(k,1))/R1) + END DO + + erdxi = scalar( erhead(1), dC_norm(1,i+nres) ) + erdxj = scalar( erhead(1), dC_norm(1,j+nres) ) + bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) ) +! bat=0.0d0 + federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres)) + facd1 = d1i * vbld_inv(i+nres) + facd2 = d1j * vbld_inv(j+nres) +! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres) + + DO k = 1, 3 + hawk = (erhead_tail(k,1) + & + facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))) +! facd1=0.0d0 +! facd2=0.0d0 + pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) + gvdwx_scbase(k,i) = gvdwx_scbase(k,i) & + - dGCLdR * pom & + - dPOLdR1 * (erhead_tail(k,1)) +! & - dGLJdR * pom + + pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) + gvdwx_scbase(k,j) = gvdwx_scbase(k,j) & + + dGCLdR * pom & + + dPOLdR1 * (erhead_tail(k,1)) +! & + dGLJdR * pom + + + gvdwc_scbase(k,i) = gvdwc_scbase(k,i) & + - dGCLdR * erhead(k) & + - dPOLdR1 * erhead_tail(k,1) +! & - dGLJdR * erhead(k) + + gvdwc_scbase(k,j) = gvdwc_scbase(k,j) & + + dGCLdR * erhead(k) & + + dPOLdR1 * erhead_tail(k,1) +! & + dGLJdR * erhead(k) + + END DO + endif +! print *,i,j,evdwij,epol,Fcav,ECL + escbase=escbase+evdwij+epol+Fcav+ECL + call sc_grad_scbase + enddo + enddo + + return + end subroutine eprot_sc_base + SUBROUTINE sc_grad_scbase + use calc_data + + real (kind=8) :: dcosom1(3),dcosom2(3) + eom1 = & + eps2der * eps2rt_om1 & + - 2.0D0 * alf1 * eps3der & + + sigder * sigsq_om1 & + + dCAVdOM1 & + + dGCLdOM1 & + + dPOLdOM1 + + eom2 = & + eps2der * eps2rt_om2 & + + 2.0D0 * alf2 * eps3der & + + sigder * sigsq_om2 & + + dCAVdOM2 & + + dGCLdOM2 & + + dPOLdOM2 + + eom12 = & + evdwij * eps1_om12 & + + eps2der * eps2rt_om12 & + - 2.0D0 * alf12 * eps3der & + + sigder *sigsq_om12 & + + dCAVdOM12 & + + dGCLdOM12 + +! print *,eom1,eom2,eom12,i,j,"eom1,2,12",erij(1),erij(2),erij(3) +! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),& +! gg(1),gg(2),"rozne" + 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)) + gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k) + gvdwx_scbase(k,i)= gvdwx_scbase(k,i) - gg(k) & + + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) & + + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv + gvdwx_scbase(k,j)= gvdwx_scbase(k,j) + gg(k) & + + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) & + + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv + gvdwc_scbase(k,i)=gvdwc_scbase(k,i)-gg(k) + gvdwc_scbase(k,j)=gvdwc_scbase(k,j)+gg(k) + END DO + RETURN + END SUBROUTINE sc_grad_scbase + + + subroutine epep_sc_base(epepbase) + use calc_data + logical :: lprn +!el local variables + integer :: iint,itypi,itypi1,itypj,subchap + real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi + real(kind=8) :: evdw,sig0ij + real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,& + dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, & + sslipi,sslipj,faclip + integer :: ii + real(kind=8) :: fracinbuf + real (kind=8) :: epepbase + real (kind=8),dimension(4):: ener + real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out + real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,& + sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,& + Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,& + dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,& + r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,& + dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,& + sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1 + real(kind=8),dimension(3,2)::chead,erhead_tail + real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead + integer troll + eps_out=80.0d0 + epepbase=0.0d0 +! do i=1,nres_molec(1)-1 + do i=ibond_start,ibond_end + if (itype(i,1).eq.ntyp1_molec(1).or.itype(i+1,1).eq.ntyp1_molec(1)) cycle +!C itypi = itype(i,1) + dxi = dc_norm(1,i) + dyi = dc_norm(2,i) + dzi = dc_norm(3,i) +! print *,dxi,(-c(1,i)+c(1,i+1))*vbld_inv(i+1) + dsci_inv = vbld_inv(i+1)/2.0 + xi=(c(1,i)+c(1,i+1))/2.0 + yi=(c(2,i)+c(2,i+1))/2.0 + zi=(c(3,i)+c(3,i+1))/2.0 + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize + do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1) + itypj= itype(j,2) + if (itype(j,2).eq.ntyp1_molec(2))cycle + xj=c(1,j+nres) + yj=c(2,j+nres) + zj=c(3,j+nres) + xj=dmod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=dmod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=dmod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + dxj = dc_norm( 1, nres+j ) + dyj = dc_norm( 2, nres+j ) + dzj = dc_norm( 3, nres+j ) +! d1i = dhead_scbasei(itypi) !this is shift of dipole/charge +! d1j = dhead_scbasej(itypi) !this is shift of dipole/charge + +! Gay-berne var's + sig0ij = sigma_pepbase(itypj ) + chi1 = chi_pepbase(itypj,1 ) + chi2 = chi_pepbase(itypj,2 ) +! chi1=0.0d0 +! chi2=0.0d0 + chi12 = chi1 * chi2 + chip1 = chipp_pepbase(itypj,1 ) + chip2 = chipp_pepbase(itypj,2 ) +! chip1=0.0d0 +! chip2=0.0d0 + chip12 = chip1 * chip2 + chis1 = chis_pepbase(itypj,1) + chis2 = chis_pepbase(itypj,2) + chis12 = chis1 * chis2 + sig1 = sigmap1_pepbase(itypj) + sig2 = sigmap2_pepbase(itypj) +! write (*,*) "sig1 = ", sig1 +! write (*,*) "sig2 = ", sig2 + DO k = 1,3 +! location of polar head is computed by taking hydrophobic centre +! and moving by a d1 * dc_norm vector +! see unres publications for very informative images + chead(k,1) = (c(k,i)+c(k,i+1))/2.0 +! + d1i * dc_norm(k, i+nres) + chead(k,2) = c(k, j+nres) +! + d1j * dc_norm(k, j+nres) +! distance +! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres)) +! Rsc(k) = Rsc_distance(k) * Rsc_distance(k) + Rhead_distance(k) = chead(k,2) - chead(k,1) +! print *,gvdwc_pepbase(k,i) + + END DO + Rhead = dsqrt( & + (Rhead_distance(1)*Rhead_distance(1)) & + + (Rhead_distance(2)*Rhead_distance(2)) & + + (Rhead_distance(3)*Rhead_distance(3))) + +! alpha factors from Fcav/Gcav + b1 = alphasur_pepbase(1,itypj) +! b1=0.0d0 + b2 = alphasur_pepbase(2,itypj) + b3 = alphasur_pepbase(3,itypj) + b4 = alphasur_pepbase(4,itypj) + alf1 = 0.0d0 + alf2 = 0.0d0 + alf12 = 0.0d0 + rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj) +! print *,i,j,rrij + rij = dsqrt(rrij) +!---------------------------- + evdwij = 0.0d0 + ECL = 0.0d0 + Elj = 0.0d0 + Equad = 0.0d0 + Epol = 0.0d0 + Fcav=0.0d0 + eheadtail = 0.0d0 + dGCLdOM1 = 0.0d0 + dGCLdOM2 = 0.0d0 + dGCLdOM12 = 0.0d0 + dPOLdOM1 = 0.0d0 + dPOLdOM2 = 0.0d0 + Fcav = 0.0d0 + dFdR = 0.0d0 + dCAVdOM1 = 0.0d0 + dCAVdOM2 = 0.0d0 + dCAVdOM12 = 0.0d0 + dscj_inv = vbld_inv(j+nres) + CALL sc_angular +! this should be in elgrad_init but om's are calculated by sc_angular +! which in turn is used by older potentials +! om = omega, sqom = om^2 + sqom1 = om1 * om1 + sqom2 = om2 * om2 + sqom12 = om12 * om12 + +! now we calculate EGB - Gey-Berne +! It will be summed up in evdwij and saved in evdw + sigsq = 1.0D0 / sigsq + sig = sig0ij * dsqrt(sigsq) + rij_shift = 1.0/rij - sig + sig0ij + IF (rij_shift.le.0.0D0) THEN + evdw = 1.0D20 + RETURN + END IF + sigder = -sig * sigsq + rij_shift = 1.0D0 / rij_shift + fac = rij_shift**expon + c1 = fac * fac * aa_pepbase(itypj) +! c1 = 0.0d0 + c2 = fac * bb_pepbase(itypj) +! c2 = 0.0d0 + evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 ) + eps2der = eps3rt * evdwij + eps3der = eps2rt * evdwij +! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij + evdwij = eps2rt * eps3rt * evdwij + c1 = c1 * eps1 * eps2rt**2 * eps3rt**2 + fac = -expon * (c1 + evdwij) * rij_shift + sigder = fac * sigder +! fac = rij * fac +! Calculate distance derivative + gg(1) = fac + gg(2) = fac + gg(3) = fac + fac = chis1 * sqom1 + chis2 * sqom2 & + - 2.0d0 * chis12 * om1 * om2 * om12 +! we will use pom later in Gcav, so dont mess with it! + pom = 1.0d0 - chis1 * chis2 * sqom12 + Lambf = (1.0d0 - (fac / pom)) + Lambf = dsqrt(Lambf) + sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0) +! write (*,*) "sparrow = ", sparrow + Chif = 1.0d0/rij * sparrow + ChiLambf = Chif * Lambf + eagle = dsqrt(ChiLambf) + bat = ChiLambf ** 11.0d0 + top = b1 * ( eagle + b2 * ChiLambf - b3 ) + bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0) + botsq = bot * bot + Fcav = top / bot +! print *,i,j,Fcav + dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf)) + dbot = 12.0d0 * b4 * bat * Lambf + dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow +! dFdR = 0.0d0 +! write (*,*) "dFcav/dR = ", dFdR + dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif)) + dbot = 12.0d0 * b4 * bat * Chif + eagle = Lambf * pom + dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle) + dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle) + dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) & + * (chis2 * om2 * om12 - om1) / (eagle * pom) + + dFdL = ((dtop * bot - top * dbot) / botsq) +! dFdL = 0.0d0 + dCAVdOM1 = dFdL * ( dFdOM1 ) + dCAVdOM2 = dFdL * ( dFdOM2 ) + dCAVdOM12 = dFdL * ( dFdOM12 ) + + ertail(1) = xj*rij + ertail(2) = yj*rij + ertail(3) = zj*rij + DO k = 1, 3 +! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i) +! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j) + pom = ertail(k) +!-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres)) + gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) & + - (( dFdR + gg(k) ) * pom)/2.0 +! print *,gvdwc_pepbase(k,i),i,(( dFdR + gg(k) ) * pom)/2.0 +! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) & +! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv +! & - ( dFdR * pom ) + pom = ertail(k) +!-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres)) + gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) & + + (( dFdR + gg(k) ) * pom) +! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) & +! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv +!c! & + ( dFdR * pom ) + + gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) & + - (( dFdR + gg(k) ) * ertail(k))/2.0 +! print *,gvdwc_pepbase(k,i+1),i+1,(( dFdR + gg(k) ) * pom)/2.0 + +!c! & - ( dFdR * ertail(k)) + + gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) & + + (( dFdR + gg(k) ) * ertail(k)) +!c! & + ( dFdR * ertail(k)) + + gg(k) = 0.0d0 +!c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i) +!c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j) + END DO + + + w1 = wdipdip_pepbase(1,itypj) + w2 = -wdipdip_pepbase(3,itypj)/2.0 + w3 = wdipdip_pepbase(2,itypj) +! w1=0.0d0 +! w2=0.0d0 +!c!------------------------------------------------------------------- +!c! ECL +! w3=0.0d0 + fac = (om12 - 3.0d0 * om1 * om2) + c1 = (w1 / (Rhead**3.0d0)) * fac + c2 = (w2 / Rhead ** 6.0d0) & + * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2)) + c3= (w3/ Rhead ** 6.0d0) & + * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2)) + + ECL = c1 - c2 + c3 + + c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0) + c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) & + * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2)) + c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) & + * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2)) + + dGCLdR = c1 - c2 + c3 +!c! dECL/dom1 + c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0) + c2 = (-6.0d0 * w2) / (Rhead**6.0d0) & + * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 ) + c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2)) + dGCLdOM1 = c1 - c2 + c3 +!c! dECL/dom2 + c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0) + c2 = (-6.0d0 * w2) / (Rhead**6.0d0) & + * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 ) + c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1)) + + dGCLdOM2 = c1 - c2 + c3 +!c! dECL/dom12 + c1 = w1 / (Rhead ** 3.0d0) + c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0 + c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac) + dGCLdOM12 = c1 - c2 + c3 + DO k= 1, 3 + erhead(k) = Rhead_distance(k)/Rhead + END DO + erdxi = scalar( erhead(1), dC_norm(1,i+nres) ) + erdxj = scalar( erhead(1), dC_norm(1,j+nres) ) +! facd1 = d1 * vbld_inv(i+nres) +! facd2 = d2 * vbld_inv(j+nres) + DO k = 1, 3 + +! pom = erhead(k) +!+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) +! gvdwx_pepbase(k,i) = gvdwx_scbase(k,i) & +! - dGCLdR * pom + pom = erhead(k) +!+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) + gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) & + + dGCLdR * pom + + gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) & + - dGCLdR * erhead(k)/2.0d0 +! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0 + gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) & + - dGCLdR * erhead(k)/2.0d0 +! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0 + gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) & + + dGCLdR * erhead(k) + END DO +! print *,i,j,evdwij,Fcav,ECL,"vdw,cav,ecl" + epepbase=epepbase+evdwij+Fcav+ECL + call sc_grad_pepbase + enddo + enddo + END SUBROUTINE epep_sc_base + SUBROUTINE sc_grad_pepbase + use calc_data + + real (kind=8) :: dcosom1(3),dcosom2(3) + eom1 = & + eps2der * eps2rt_om1 & + - 2.0D0 * alf1 * eps3der & + + sigder * sigsq_om1 & + + dCAVdOM1 & + + dGCLdOM1 & + + dPOLdOM1 + + eom2 = & + eps2der * eps2rt_om2 & + + 2.0D0 * alf2 * eps3der & + + sigder * sigsq_om2 & + + dCAVdOM2 & + + dGCLdOM2 & + + dPOLdOM2 + + eom12 = & + evdwij * eps1_om12 & + + eps2der * eps2rt_om12 & + - 2.0D0 * alf12 * eps3der & + + sigder *sigsq_om12 & + + dCAVdOM12 & + + dGCLdOM12 +! om12=0.0 +! eom12=0.0 +! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3) +! if (i.eq.30) print *,gvdwc_pepbase(k,i),- gg(k),& +! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))& +! *dsci_inv*2.0 +! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),& +! gg(1),gg(2),"rozne" + DO k = 1, 3 + dcosom1(k) = rij * (dc_norm(k,i) - om1 * erij(k)) + dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k)) + gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k) + gvdwc_pepbase(k,i)= gvdwc_pepbase(k,i) +0.5*(- gg(k)) & + + (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))& + *dsci_inv*2.0 & + - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0 + gvdwc_pepbase(k,i+1)= gvdwc_pepbase(k,i+1) +0.5*(- gg(k)) & + - (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i))) & + *dsci_inv*2.0 & + + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0 +! print *,eom12,eom2,om12,om2 +!eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),& +! (eom2*(erij(k)-om2*dc_norm(k,nres+j))) + gvdwx_pepbase(k,j)= gvdwx_pepbase(k,j) + gg(k) & + + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))& + + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv + gvdwc_pepbase(k,j)=gvdwc_pepbase(k,j)+gg(k) + END DO + RETURN + END SUBROUTINE sc_grad_pepbase + subroutine eprot_sc_phosphate(escpho) + use calc_data +! 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' +! include 'COMMON.CONTROL' +! include 'COMMON.SBRIDGE' + logical :: lprn +!el local variables + integer :: iint,itypi,itypi1,itypj,subchap + real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi + real(kind=8) :: evdw,sig0ij + real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,& + dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, & + sslipi,sslipj,faclip,alpha_sco + integer :: ii + real(kind=8) :: fracinbuf + real (kind=8) :: escpho + real (kind=8),dimension(4):: ener + real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out + real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,& + sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,& + Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,& + dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,& + r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,& + dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,& + sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1 + real(kind=8),dimension(3,2)::chead,erhead_tail + real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead + integer troll + eps_out=80.0d0 + escpho=0.0d0 +! do i=1,nres_molec(1) + do i=ibond_start,ibond_end + if (itype(i,1).eq.ntyp1_molec(1)) cycle + itypi = itype(i,1) + dxi = dc_norm(1,nres+i) + dyi = dc_norm(2,nres+i) + dzi = dc_norm(3,nres+i) + dsci_inv = vbld_inv(i+nres) + xi=c(1,nres+i) + yi=c(2,nres+i) + zi=c(3,nres+i) + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize + do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1 + itypj= itype(j,2) + if ((itype(j,2).eq.ntyp1_molec(2)).or.& + (itype(j+1,2).eq.ntyp1_molec(2))) cycle + xj=(c(1,j)+c(1,j+1))/2.0 + yj=(c(2,j)+c(2,j+1))/2.0 + zj=(c(3,j)+c(3,j+1))/2.0 + xj=dmod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=dmod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=dmod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + dxj = dc_norm( 1,j ) + dyj = dc_norm( 2,j ) + dzj = dc_norm( 3,j ) + dscj_inv = vbld_inv(j+1) + +! Gay-berne var's + sig0ij = sigma_scpho(itypi ) + chi1 = chi_scpho(itypi,1 ) + chi2 = chi_scpho(itypi,2 ) +! chi1=0.0d0 +! chi2=0.0d0 + chi12 = chi1 * chi2 + chip1 = chipp_scpho(itypi,1 ) + chip2 = chipp_scpho(itypi,2 ) +! chip1=0.0d0 +! chip2=0.0d0 + chip12 = chip1 * chip2 + chis1 = chis_scpho(itypi,1) + chis2 = chis_scpho(itypi,2) + chis12 = chis1 * chis2 + sig1 = sigmap1_scpho(itypi) + sig2 = sigmap2_scpho(itypi) +! write (*,*) "sig1 = ", sig1 +! write (*,*) "sig1 = ", sig1 +! write (*,*) "sig2 = ", sig2 +! alpha factors from Fcav/Gcav + alf1 = 0.0d0 + alf2 = 0.0d0 + alf12 = 0.0d0 + a12sq = rborn_scphoi(itypi) * rborn_scphoj(itypi) + + b1 = alphasur_scpho(1,itypi) +! b1=0.0d0 + b2 = alphasur_scpho(2,itypi) + b3 = alphasur_scpho(3,itypi) + b4 = alphasur_scpho(4,itypi) +! used to determine whether we want to do quadrupole calculations +! used by Fgb + eps_in = epsintab_scpho(itypi) + if (eps_in.eq.0.0) eps_in=1.0 + eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out)) +! write (*,*) "eps_inout_fac = ", eps_inout_fac +!------------------------------------------------------------------- +! tail location and distance calculations + d1i = dhead_scphoi(itypi) !this is shift of dipole/charge + d1j = 0.0 + DO k = 1,3 +! location of polar head is computed by taking hydrophobic centre +! and moving by a d1 * dc_norm vector +! see unres publications for very informative images + chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres) + chead(k,2) = (c(k, j) + c(k, j+1))/2.0 +! distance +! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres)) +! Rsc(k) = Rsc_distance(k) * Rsc_distance(k) + Rhead_distance(k) = chead(k,2) - chead(k,1) + END DO +! pitagoras (root of sum of squares) + Rhead = dsqrt( & + (Rhead_distance(1)*Rhead_distance(1)) & + + (Rhead_distance(2)*Rhead_distance(2)) & + + (Rhead_distance(3)*Rhead_distance(3))) + Rhead_sq=Rhead**2.0 +!------------------------------------------------------------------- +! zero everything that should be zero'ed + evdwij = 0.0d0 + ECL = 0.0d0 + Elj = 0.0d0 + Equad = 0.0d0 + Epol = 0.0d0 + Fcav=0.0d0 + eheadtail = 0.0d0 + dGCLdR=0.0d0 + dGCLdOM1 = 0.0d0 + dGCLdOM2 = 0.0d0 + dGCLdOM12 = 0.0d0 + dPOLdOM1 = 0.0d0 + dPOLdOM2 = 0.0d0 + Fcav = 0.0d0 + dFdR = 0.0d0 + dCAVdOM1 = 0.0d0 + dCAVdOM2 = 0.0d0 + dCAVdOM12 = 0.0d0 + dscj_inv = vbld_inv(j+1)/2.0 +!dhead_scbasej(itypi,itypj) +! print *,i,j,dscj_inv,dsci_inv +! rij holds 1/(distance of Calpha atoms) + rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj) + rij = dsqrt(rrij) +!---------------------------- + CALL sc_angular +! this should be in elgrad_init but om's are calculated by sc_angular +! which in turn is used by older potentials +! om = omega, sqom = om^2 + sqom1 = om1 * om1 + sqom2 = om2 * om2 + sqom12 = om12 * om12 + +! now we calculate EGB - Gey-Berne +! It will be summed up in evdwij and saved in evdw + sigsq = 1.0D0 / sigsq + sig = sig0ij * dsqrt(sigsq) +! rij_shift = 1.0D0 / rij - sig + sig0ij + rij_shift = 1.0/rij - sig + sig0ij + IF (rij_shift.le.0.0D0) THEN + evdw = 1.0D20 + RETURN + END IF + sigder = -sig * sigsq + rij_shift = 1.0D0 / rij_shift + fac = rij_shift**expon + c1 = fac * fac * aa_scpho(itypi) +! c1 = 0.0d0 + c2 = fac * bb_scpho(itypi) +! c2 = 0.0d0 + evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 ) + eps2der = eps3rt * evdwij + eps3der = eps2rt * evdwij +! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij + evdwij = eps2rt * eps3rt * evdwij + c1 = c1 * eps1 * eps2rt**2 * eps3rt**2 + fac = -expon * (c1 + evdwij) * rij_shift + sigder = fac * sigder +! fac = rij * fac +! Calculate distance derivative + gg(1) = fac + gg(2) = fac + gg(3) = fac + fac = chis1 * sqom1 + chis2 * sqom2 & + - 2.0d0 * chis12 * om1 * om2 * om12 +! we will use pom later in Gcav, so dont mess with it! + pom = 1.0d0 - chis1 * chis2 * sqom12 + Lambf = (1.0d0 - (fac / pom)) + Lambf = dsqrt(Lambf) + sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0) +! write (*,*) "sparrow = ", sparrow + Chif = 1.0d0/rij * sparrow + ChiLambf = Chif * Lambf + eagle = dsqrt(ChiLambf) + bat = ChiLambf ** 11.0d0 + top = b1 * ( eagle + b2 * ChiLambf - b3 ) + bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0) + botsq = bot * bot + Fcav = top / bot + dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf)) + dbot = 12.0d0 * b4 * bat * Lambf + dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow +! dFdR = 0.0d0 +! write (*,*) "dFcav/dR = ", dFdR + dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif)) + dbot = 12.0d0 * b4 * bat * Chif + eagle = Lambf * pom + dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle) + dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle) + dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) & + * (chis2 * om2 * om12 - om1) / (eagle * pom) + + dFdL = ((dtop * bot - top * dbot) / botsq) +! dFdL = 0.0d0 + dCAVdOM1 = dFdL * ( dFdOM1 ) + dCAVdOM2 = dFdL * ( dFdOM2 ) + dCAVdOM12 = dFdL * ( dFdOM12 ) + + ertail(1) = xj*rij + ertail(2) = yj*rij + ertail(3) = zj*rij + DO k = 1, 3 +! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i) +! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j) +! if (i.eq.3) print *,'decl0',gvdwx_scpho(k,i),i + + pom = ertail(k) +! print *,pom,gg(k),dFdR +!-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres)) + gvdwx_scpho(k,i) = gvdwx_scpho(k,i) & + - (( dFdR + gg(k) ) * pom) +! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) & +! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv +! & - ( dFdR * pom ) +! pom = ertail(k) +!-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres)) +! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) & +! + (( dFdR + gg(k) ) * pom) +! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) & +! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv +!c! & + ( dFdR * pom ) + + gvdwc_scpho(k,i) = gvdwc_scpho(k,i) & + - (( dFdR + gg(k) ) * ertail(k)) +!c! & - ( dFdR * ertail(k)) + + gvdwc_scpho(k,j) = gvdwc_scpho(k,j) & + + (( dFdR + gg(k) ) * ertail(k))/2.0 + + gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) & + + (( dFdR + gg(k) ) * ertail(k))/2.0 + +!c! & + ( dFdR * ertail(k)) + + gg(k) = 0.0d0 + ENDDO +!c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i) +!c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j) +! alphapol1 = alphapol_scpho(itypi) + if (wqq_scpho(itypi).ne.0.0) then + Qij=wqq_scpho(itypi)/eps_in + alpha_sco=1.d0/alphi_scpho(itypi) +! Qij=0.0 + Ecl = (332.0d0 * Qij*dexp(-Rhead*alpha_sco)) / Rhead +!c! derivative of Ecl is Gcl... + dGCLdR = (-332.0d0 * Qij*dexp(-Rhead*alpha_sco)* & + (Rhead*alpha_sco+1) ) / Rhead_sq + if (energy_dec) write(iout,*) "ECL",ECL,Rhead,1.0/rij + else if (wqdip_scpho(2,itypi).gt.0.0d0) then + w1 = wqdip_scpho(1,itypi) + w2 = wqdip_scpho(2,itypi) +! w1=0.0d0 +! w2=0.0d0 +! pis = sig0head_scbase(itypi,itypj) +! eps_head = epshead_scbase(itypi,itypj) +!c!------------------------------------------------------------------- + +!c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj) +!c! & +dhead(1,1,itypi,itypj))**2)) +!c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj) +!c! & +dhead(2,1,itypi,itypj))**2)) + +!c!------------------------------------------------------------------- +!c! ecl + sparrow = w1 * om1 + hawk = w2 * (1.0d0 - sqom2) + Ecl = sparrow / Rhead**2.0d0 & + - hawk / Rhead**4.0d0 +!c!------------------------------------------------------------------- + if (energy_dec) write(iout,*) "ECLdipdip",ECL,Rhead,& + 1.0/rij,sparrow + +!c! derivative of ecl is Gcl +!c! dF/dr part + dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 & + + 4.0d0 * hawk / Rhead**5.0d0 +!c! dF/dom1 + dGCLdOM1 = (w1) / (Rhead**2.0d0) +!c! dF/dom2 + dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0) + endif + +!c-------------------------------------------------------------------- +!c Polarization energy +!c Epol + R1 = 0.0d0 + DO k = 1, 3 +!c! Calculate head-to-tail distances tail is center of side-chain + R1=R1+((c(k,j)+c(k,j+1))/2.0-chead(k,1))**2 + END DO +!c! Pitagoras + R1 = dsqrt(R1) + + alphapol1 = alphapol_scpho(itypi) +! alphapol1=0.0 + MomoFac1 = (1.0d0 - chi2 * sqom1) + RR1 = R1 * R1 / MomoFac1 + ee1 = exp(-( RR1 / (4.0d0 * a12sq) )) +! print *,"ee1",ee1,a12sq,alphapol1,eps_inout_fac + fgb1 = sqrt( RR1 + a12sq * ee1) +! eps_inout_fac=0.0d0 + epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0) +! derivative of Epol is Gpol... + dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) & + / (fgb1 ** 5.0d0) + dFGBdR1 = ( (R1 / MomoFac1) & + * ( 2.0d0 - (0.5d0 * ee1) ) ) & + / ( 2.0d0 * fgb1 ) + dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) & + * (2.0d0 - 0.5d0 * ee1) ) & + / (2.0d0 * fgb1) + dPOLdR1 = dPOLdFGB1 * dFGBdR1 +! dPOLdR1 = 0.0d0 +! dPOLdOM1 = 0.0d0 + dFGBdOM1 = (((R1 * R1 * chi2 * om1) / (MomoFac1 * MomoFac1)) & + * (2.0d0 - 0.5d0 * ee1) ) & + / (2.0d0 * fgb1) + + dPOLdOM1 = dPOLdFGB1 * dFGBdOM1 + dPOLdOM2 = 0.0 + DO k = 1, 3 + erhead(k) = Rhead_distance(k)/Rhead + erhead_tail(k,1) = (((c(k,j)+c(k,j+1))/2.0-chead(k,1))/R1) + END DO + + erdxi = scalar( erhead(1), dC_norm(1,i+nres) ) + erdxj = scalar( erhead(1), dC_norm(1,j) ) + bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) ) +! bat=0.0d0 + federmaus = scalar(erhead_tail(1,1),dC_norm(1,j)) + facd1 = d1i * vbld_inv(i+nres) + facd2 = d1j * vbld_inv(j) +! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres) + + DO k = 1, 3 + hawk = (erhead_tail(k,1) + & + facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))) +! facd1=0.0d0 +! facd2=0.0d0 +! if (i.eq.3) print *,'decl1',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i,& +! pom,(erhead_tail(k,1)) + +! print *,'decl',dGCLdR,dPOLdR1,gvdwc_scpho(k,i) + pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) + gvdwx_scpho(k,i) = gvdwx_scpho(k,i) & + - dGCLdR * pom & + - dPOLdR1 * (erhead_tail(k,1)) +! & - dGLJdR * pom + + pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j)) +! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) & +! + dGCLdR * pom & +! + dPOLdR1 * (erhead_tail(k,1)) +! & + dGLJdR * pom + + + gvdwc_scpho(k,i) = gvdwc_scpho(k,i) & + - dGCLdR * erhead(k) & + - dPOLdR1 * erhead_tail(k,1) +! & - dGLJdR * erhead(k) + + gvdwc_scpho(k,j) = gvdwc_scpho(k,j) & + + (dGCLdR * erhead(k) & + + dPOLdR1 * erhead_tail(k,1))/2.0 + gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) & + + (dGCLdR * erhead(k) & + + dPOLdR1 * erhead_tail(k,1))/2.0 + +! & + dGLJdR * erhead(k) +! if (i.eq.3) print *,'decl2',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i + + END DO +! if (i.eq.3) print *,i,j,evdwij,epol,Fcav,ECL + if (energy_dec) write (iout,'(a22,2i5,4f8.3,f16.3)'), & + "escpho:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,escpho + escpho=escpho+evdwij+epol+Fcav+ECL + call sc_grad_scpho + enddo + + enddo + + return + end subroutine eprot_sc_phosphate + SUBROUTINE sc_grad_scpho + use calc_data + + real (kind=8) :: dcosom1(3),dcosom2(3) + eom1 = & + eps2der * eps2rt_om1 & + - 2.0D0 * alf1 * eps3der & + + sigder * sigsq_om1 & + + dCAVdOM1 & + + dGCLdOM1 & + + dPOLdOM1 + + eom2 = & + eps2der * eps2rt_om2 & + + 2.0D0 * alf2 * eps3der & + + sigder * sigsq_om2 & + + dCAVdOM2 & + + dGCLdOM2 & + + dPOLdOM2 + + eom12 = & + evdwij * eps1_om12 & + + eps2der * eps2rt_om12 & + - 2.0D0 * alf12 * eps3der & + + sigder *sigsq_om12 & + + dCAVdOM12 & + + dGCLdOM12 +! om12=0.0 +! eom12=0.0 +! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3) +! if (i.eq.30) print *,gvdwc_scpho(k,i),- gg(k),& +! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))& +! *dsci_inv*2.0 +! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),& +! gg(1),gg(2),"rozne" + DO k = 1, 3 + dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k)) + dcosom2(k) = rij * (dc_norm(k,j) - om2 * erij(k)) + gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k) + gvdwc_scpho(k,j)= gvdwc_scpho(k,j) +0.5*( gg(k)) & + + (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)))& + *dscj_inv*2.0 & + - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0 + gvdwc_scpho(k,j+1)= gvdwc_scpho(k,j+1) +0.5*( gg(k)) & + - (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j))) & + *dscj_inv*2.0 & + + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0 + gvdwx_scpho(k,i)= gvdwx_scpho(k,i) - gg(k) & + + (eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) & + + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv + +! print *,eom12,eom2,om12,om2 +!eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),& +! (eom2*(erij(k)-om2*dc_norm(k,nres+j))) +! gvdwx_scpho(k,j)= gvdwx_scpho(k,j) + gg(k) & +! + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))& +! + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv + gvdwc_scpho(k,i)=gvdwc_scpho(k,i)-gg(k) + END DO + RETURN + END SUBROUTINE sc_grad_scpho + subroutine eprot_pep_phosphate(epeppho) + use calc_data +! 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' +! include 'COMMON.CONTROL' +! include 'COMMON.SBRIDGE' + logical :: lprn +!el local variables + integer :: iint,itypi,itypi1,itypj,subchap + real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi + real(kind=8) :: evdw,sig0ij + real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,& + dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, & + sslipi,sslipj,faclip + integer :: ii + real(kind=8) :: fracinbuf + real (kind=8) :: epeppho + real (kind=8),dimension(4):: ener + real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out + real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,& + sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,& + Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,& + dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,& + r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,& + dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,& + sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1 + real(kind=8),dimension(3,2)::chead,erhead_tail + real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead + integer troll + real (kind=8) :: dcosom1(3),dcosom2(3) + epeppho=0.0d0 +! do i=1,nres_molec(1) + do i=ibond_start,ibond_end + if (itype(i,1).eq.ntyp1_molec(1)) cycle + itypi = itype(i,1) + dsci_inv = vbld_inv(i+1)/2.0 + dxi = dc_norm(1,i) + dyi = dc_norm(2,i) + dzi = dc_norm(3,i) + xi=(c(1,i)+c(1,i+1))/2.0 + yi=(c(2,i)+c(2,i+1))/2.0 + zi=(c(3,i)+c(3,i+1))/2.0 + xi=mod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=mod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=mod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize + do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1 + itypj= itype(j,2) + if ((itype(j,2).eq.ntyp1_molec(2)).or.& + (itype(j+1,2).eq.ntyp1_molec(2))) cycle + xj=(c(1,j)+c(1,j+1))/2.0 + yj=(c(2,j)+c(2,j+1))/2.0 + zj=(c(3,j)+c(3,j+1))/2.0 + xj=dmod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=dmod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=dmod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj) + rij = dsqrt(rrij) + dxj = dc_norm( 1,j ) + dyj = dc_norm( 2,j ) + dzj = dc_norm( 3,j ) + dscj_inv = vbld_inv(j+1)/2.0 +! Gay-berne var's + sig0ij = sigma_peppho +! chi1=0.0d0 +! chi2=0.0d0 + chi12 = chi1 * chi2 +! chip1=0.0d0 +! chip2=0.0d0 + chip12 = chip1 * chip2 +! chis1 = 0.0d0 +! chis2 = 0.0d0 + chis12 = chis1 * chis2 + sig1 = sigmap1_peppho + sig2 = sigmap2_peppho +! write (*,*) "sig1 = ", sig1 +! write (*,*) "sig1 = ", sig1 +! write (*,*) "sig2 = ", sig2 +! alpha factors from Fcav/Gcav + alf1 = 0.0d0 + alf2 = 0.0d0 + alf12 = 0.0d0 + b1 = alphasur_peppho(1) +! b1=0.0d0 + b2 = alphasur_peppho(2) + b3 = alphasur_peppho(3) + b4 = alphasur_peppho(4) + CALL sc_angular + sqom1=om1*om1 + evdwij = 0.0d0 + ECL = 0.0d0 + Elj = 0.0d0 + Equad = 0.0d0 + Epol = 0.0d0 + Fcav=0.0d0 + eheadtail = 0.0d0 + dGCLdR=0.0d0 + dGCLdOM1 = 0.0d0 + dGCLdOM2 = 0.0d0 + dGCLdOM12 = 0.0d0 + dPOLdOM1 = 0.0d0 + dPOLdOM2 = 0.0d0 + Fcav = 0.0d0 + dFdR = 0.0d0 + dCAVdOM1 = 0.0d0 + dCAVdOM2 = 0.0d0 + dCAVdOM12 = 0.0d0 + rij_shift = rij + fac = rij_shift**expon + c1 = fac * fac * aa_peppho +! c1 = 0.0d0 + c2 = fac * bb_peppho +! c2 = 0.0d0 + evdwij = c1 + c2 +! Now cavity.................... + eagle = dsqrt(1.0/rij_shift) + top = b1 * ( eagle + b2 * 1.0/rij_shift - b3 ) + bot = 1.0d0 + b4 * (1.0/rij_shift ** 12.0d0) + botsq = bot * bot + Fcav = top / bot + dtop = b1 * ((1.0/ (2.0d0 * eagle)) + (b2)) + dbot = 12.0d0 * b4 * (1.0/rij_shift) ** 11.0d0 + dFdR = ((dtop * bot - top * dbot) / botsq) + w1 = wqdip_peppho(1) + w2 = wqdip_peppho(2) +! w1=0.0d0 +! w2=0.0d0 +! pis = sig0head_scbase(itypi,itypj) +! eps_head = epshead_scbase(itypi,itypj) +!c!------------------------------------------------------------------- + +!c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj) +!c! & +dhead(1,1,itypi,itypj))**2)) +!c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj) +!c! & +dhead(2,1,itypi,itypj))**2)) + +!c!------------------------------------------------------------------- +!c! ecl + sparrow = w1 * om1 + hawk = w2 * (1.0d0 - sqom1) + Ecl = sparrow * rij_shift**2.0d0 & + - hawk * rij_shift**4.0d0 +!c!------------------------------------------------------------------- +!c! derivative of ecl is Gcl +!c! dF/dr part +! rij_shift=5.0 + dGCLdR = - 2.0d0 * sparrow * rij_shift**3.0d0 & + + 4.0d0 * hawk * rij_shift**5.0d0 +!c! dF/dom1 + dGCLdOM1 = (w1) * (rij_shift**2.0d0) +!c! dF/dom2 + dGCLdOM2 = (2.0d0 * w2 * om1) * (rij_shift ** 4.0d0) + eom1 = dGCLdOM1+dGCLdOM2 + eom2 = 0.0 + + fac = -expon * (c1 + evdwij) * rij_shift+dFdR+dGCLdR +! fac=0.0 + gg(1) = fac*xj*rij + gg(2) = fac*yj*rij + gg(3) = fac*zj*rij + do k=1,3 + gvdwc_peppho(k,j) = gvdwc_peppho(k,j) +gg(k)/2.0 + gvdwc_peppho(k,j+1) = gvdwc_peppho(k,j+1) +gg(k)/2.0 + gvdwc_peppho(k,i) = gvdwc_peppho(k,i) -gg(k)/2.0 + gvdwc_peppho(k,i+1) = gvdwc_peppho(k,i+1) -gg(k)/2.0 + gg(k)=0.0 + enddo + + DO k = 1, 3 + dcosom1(k) = rij* (dc_norm(k,i) - om1 * erij(k)) + dcosom2(k) = rij* (dc_norm(k,j) - om2 * erij(k)) + gg(k) = gg(k) + eom1 * dcosom1(k)! + eom2 * dcosom2(k) + gvdwc_peppho(k,j)= gvdwc_peppho(k,j) +0.5*( gg(k)) !& +! - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0 + gvdwc_peppho(k,j+1)= gvdwc_peppho(k,j+1) +0.5*( gg(k)) !& +! + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0 + gvdwc_peppho(k,i)= gvdwc_peppho(k,i) -0.5*( gg(k)) & + - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0 + gvdwc_peppho(k,i+1)= gvdwc_peppho(k,i+1) - 0.5*( gg(k)) & + + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0 + enddo + epeppho=epeppho+evdwij+Fcav+ECL +! print *,i,j,evdwij,Fcav,ECL,rij_shift + enddo + enddo + end subroutine eprot_pep_phosphate +!!!!!!!!!!!!!!!!------------------------------------------------------------- + subroutine emomo(evdw) + use calc_data + use comm_momo +! 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' +! include 'COMMON.CONTROL' +! include 'COMMON.SBRIDGE' + logical :: lprn +!el local variables + integer :: iint,itypi1,subchap,isel + real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,e1,e2,sigm,epsi + real(kind=8) :: evdw + real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,& + dist_temp, dist_init,ssgradlipi,ssgradlipj, & + sslipi,sslipj,faclip,alpha_sco + integer :: ii + real(kind=8) :: fracinbuf + real (kind=8) :: escpho + real (kind=8),dimension(4):: ener + real(kind=8) :: b1,b2,egb + real(kind=8) :: Fisocav,ECL,Elj,Equad,Epol,eheadtail,& + Lambf,& + Chif,ChiLambf,Fcav,dFdR,dFdOM1,& + dFdOM2,dFdL,dFdOM12,& + federmaus,& + d1i,d1j +! real(kind=8),dimension(3,2)::erhead_tail +! real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead,Rtail_distance + real(kind=8) :: facd4, adler, Fgb, facd3 + integer troll,jj,istate + real (kind=8) :: dcosom1(3),dcosom2(3) + eps_out=80.0d0 + sss_ele_cut=1.0d0 +! print *,"EVDW KURW",evdw,nres + do i=iatsc_s,iatsc_e +! print *,"I am in EVDW",i + itypi=iabs(itype(i,1)) +! if (i.ne.47) cycle + if (itypi.eq.ntyp1) cycle + itypi1=iabs(itype(i+1,1)) + xi=c(1,nres+i) + yi=c(2,nres+i) + zi=c(3,nres+i) + xi=dmod(xi,boxxsize) + if (xi.lt.0) xi=xi+boxxsize + yi=dmod(yi,boxysize) + if (yi.lt.0) yi=yi+boxysize + zi=dmod(zi,boxzsize) + if (zi.lt.0) zi=zi+boxzsize + + if ((zi.gt.bordlipbot) & + .and.(zi.lt.bordliptop)) then +!C the energy transfer exist + if (zi.lt.buflipbot) then +!C what fraction I am in + fracinbuf=1.0d0- & + ((zi-bordlipbot)/lipbufthick) +!C lipbufthick is thickenes of lipid buffore + sslipi=sscalelip(fracinbuf) + ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick + elseif (zi.gt.bufliptop) then + fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick) + sslipi=sscalelip(fracinbuf) + ssgradlipi=sscagradlip(fracinbuf)/lipbufthick + else + sslipi=1.0d0 + ssgradlipi=0.0 + endif + else + sslipi=0.0d0 + ssgradlipi=0.0 + endif +! print *, sslipi,ssgradlipi + dxi=dc_norm(1,nres+i) + dyi=dc_norm(2,nres+i) + dzi=dc_norm(3,nres+i) +! dsci_inv=dsc_inv(itypi) + dsci_inv=vbld_inv(i+nres) +! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres) +! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi +! +! Calculate SC interaction energy. +! + do iint=1,nint_gr(i) + do j=istart(i,iint),iend(i,iint) +! print *,"JA PIER",i,j,iint,istart(i,iint),iend(i,iint) + IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN + call dyn_ssbond_ene(i,j,evdwij) + evdw=evdw+evdwij + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') & + 'evdw',i,j,evdwij,' ss' +! if (energy_dec) write (iout,*) & +! 'evdw',i,j,evdwij,' ss' + do k=j+1,iend(i,iint) +!C search over all next residues + if (dyn_ss_mask(k)) then +!C check if they are cysteins +!C write(iout,*) 'k=',k + +!c write(iout,*) "PRZED TRI", evdwij +! evdwij_przed_tri=evdwij + call triple_ssbond_ene(i,j,k,evdwij) +!c if(evdwij_przed_tri.ne.evdwij) then +!c write (iout,*) "TRI:", evdwij, evdwij_przed_tri +!c endif + +!c write(iout,*) "PO TRI", evdwij +!C call the energy function that removes the artifical triple disulfide +!C bond the soubroutine is located in ssMD.F + evdw=evdw+evdwij + if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') & + 'evdw',i,j,evdwij,'tss' + endif!dyn_ss_mask(k) + enddo! k + ELSE +!el ind=ind+1 + itypj=iabs(itype(j,1)) + if (itypj.eq.ntyp1) cycle + CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol) + +! if (j.ne.78) cycle +! dscj_inv=dsc_inv(itypj) + dscj_inv=vbld_inv(j+nres) + xj=c(1,j+nres) + yj=c(2,j+nres) + zj=c(3,j+nres) + xj=dmod(xj,boxxsize) + if (xj.lt.0) xj=xj+boxxsize + yj=dmod(yj,boxysize) + if (yj.lt.0) yj=yj+boxysize + zj=dmod(zj,boxzsize) + if (zj.lt.0) zj=zj+boxzsize + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + xj_safe=xj + yj_safe=yj + zj_safe=zj + subchap=0 + + do xshift=-1,1 + do yshift=-1,1 + do zshift=-1,1 + xj=xj_safe+xshift*boxxsize + yj=yj_safe+yshift*boxysize + zj=zj_safe+zshift*boxzsize + dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + if(dist_temp.lt.dist_init) then + dist_init=dist_temp + xj_temp=xj + yj_temp=yj + zj_temp=zj + subchap=1 + endif + enddo + enddo + enddo + if (subchap.eq.1) then + xj=xj_temp-xi + yj=yj_temp-yi + zj=zj_temp-zi + else + xj=xj_safe-xi + yj=yj_safe-yi + zj=zj_safe-zi + endif + dxj = dc_norm( 1, nres+j ) + dyj = dc_norm( 2, nres+j ) + dzj = dc_norm( 3, nres+j ) +! print *,i,j,itypi,itypj +! d1i=0.0d0 +! d1j=0.0d0 +! BetaT = 1.0d0 / (298.0d0 * Rb) +! Gay-berne var's +!1! sig0ij = sigma_scsc( itypi,itypj ) +! chi1=0.0d0 +! chi2=0.0d0 +! chip1=0.0d0 +! chip2=0.0d0 +! not used by momo potential, but needed by sc_angular which is shared +! by all energy_potential subroutines + alf1 = 0.0d0 + alf2 = 0.0d0 + alf12 = 0.0d0 + a12sq = rborn(itypi,itypj) * rborn(itypj,itypi) +! a12sq = a12sq * a12sq +! charge of amino acid itypi is... + chis1 = chis(itypi,itypj) + chis2 = chis(itypj,itypi) + chis12 = chis1 * chis2 + sig1 = sigmap1(itypi,itypj) + sig2 = sigmap2(itypi,itypj) +! write (*,*) "sig1 = ", sig1 +! chis1=0.0 +! chis2=0.0 +! chis12 = chis1 * chis2 +! sig1=0.0 +! sig2=0.0 +! write (*,*) "sig2 = ", sig2 +! alpha factors from Fcav/Gcav + b1cav = alphasur(1,itypi,itypj) +! b1cav=0.0d0 + b2cav = alphasur(2,itypi,itypj) + b3cav = alphasur(3,itypi,itypj) + b4cav = alphasur(4,itypi,itypj) +! used to determine whether we want to do quadrupole calculations + eps_in = epsintab(itypi,itypj) + if (eps_in.eq.0.0) eps_in=1.0 + + eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out)) + Rtail = 0.0d0 +! dtail(1,itypi,itypj)=0.0 +! dtail(2,itypi,itypj)=0.0 + + DO k = 1, 3 + ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i) + ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j) + END DO +!c! tail distances will be themselves usefull elswhere +!c1 (in Gcav, for example) + Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 ) + Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 ) + Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 ) + Rtail = dsqrt( & + (Rtail_distance(1)*Rtail_distance(1)) & + + (Rtail_distance(2)*Rtail_distance(2)) & + + (Rtail_distance(3)*Rtail_distance(3))) + +! write (*,*) "eps_inout_fac = ", eps_inout_fac +!------------------------------------------------------------------- +! tail location and distance calculations + d1 = dhead(1, 1, itypi, itypj) + d2 = dhead(2, 1, itypi, itypj) + + DO k = 1,3 +! location of polar head is computed by taking hydrophobic centre +! and moving by a d1 * dc_norm vector +! see unres publications for very informative images + chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres) + chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres) +! distance +! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres)) +! Rsc(k) = Rsc_distance(k) * Rsc_distance(k) + Rhead_distance(k) = chead(k,2) - chead(k,1) + END DO +! pitagoras (root of sum of squares) + Rhead = dsqrt( & + (Rhead_distance(1)*Rhead_distance(1)) & + + (Rhead_distance(2)*Rhead_distance(2)) & + + (Rhead_distance(3)*Rhead_distance(3))) +!------------------------------------------------------------------- +! zero everything that should be zero'ed + evdwij = 0.0d0 + ECL = 0.0d0 + Elj = 0.0d0 + Equad = 0.0d0 + Epol = 0.0d0 + Fcav=0.0d0 + eheadtail = 0.0d0 + dGCLdOM1 = 0.0d0 + dGCLdOM2 = 0.0d0 + dGCLdOM12 = 0.0d0 + dPOLdOM1 = 0.0d0 + dPOLdOM2 = 0.0d0 + Fcav = 0.0d0 + dFdR = 0.0d0 + dCAVdOM1 = 0.0d0 + dCAVdOM2 = 0.0d0 + dCAVdOM12 = 0.0d0 + dscj_inv = vbld_inv(j+nres) +! print *,i,j,dscj_inv,dsci_inv +! rij holds 1/(distance of Calpha atoms) + rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj) + rij = dsqrt(rrij) +!---------------------------- + CALL sc_angular +! this should be in elgrad_init but om's are calculated by sc_angular +! which in turn is used by older potentials +! om = omega, sqom = om^2 + sqom1 = om1 * om1 + sqom2 = om2 * om2 + sqom12 = om12 * om12 + +! now we calculate EGB - Gey-Berne +! It will be summed up in evdwij and saved in evdw + sigsq = 1.0D0 / sigsq + sig = sig0ij * dsqrt(sigsq) +! rij_shift = 1.0D0 / rij - sig + sig0ij + rij_shift = Rtail - sig + sig0ij + IF (rij_shift.le.0.0D0) THEN + evdw = 1.0D20 + RETURN + END IF + sigder = -sig * sigsq + rij_shift = 1.0D0 / rij_shift + fac = rij_shift**expon + c1 = fac * fac * aa_aq(itypi,itypj) +! print *,"ADAM",aa_aq(itypi,itypj) + +! c1 = 0.0d0 + c2 = fac * bb_aq(itypi,itypj) +! c2 = 0.0d0 + evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 ) + eps2der = eps3rt * evdwij + eps3der = eps2rt * evdwij +! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij + evdwij = eps2rt * eps3rt * evdwij +!#ifdef TSCSC +! IF (bb_aq(itypi,itypj).gt.0) THEN +! evdw_p = evdw_p + evdwij +! ELSE +! evdw_m = evdw_m + evdwij +! END IF +!#else + evdw = evdw & + + evdwij +!#endif + + c1 = c1 * eps1 * eps2rt**2 * eps3rt**2 + fac = -expon * (c1 + evdwij) * rij_shift + sigder = fac * sigder +! fac = rij * fac +! Calculate distance derivative + gg(1) = fac + gg(2) = fac + gg(3) = fac +! if (b2.gt.0.0) then + fac = chis1 * sqom1 + chis2 * sqom2 & + - 2.0d0 * chis12 * om1 * om2 * om12 +! we will use pom later in Gcav, so dont mess with it! + pom = 1.0d0 - chis1 * chis2 * sqom12 + Lambf = (1.0d0 - (fac / pom)) +! print *,"fac,pom",fac,pom,Lambf + Lambf = dsqrt(Lambf) + sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0) +! print *,"sig1,sig2",sig1,sig2,itypi,itypj +! write (*,*) "sparrow = ", sparrow + Chif = Rtail * sparrow +! print *,"rij,sparrow",rij , sparrow + ChiLambf = Chif * Lambf + eagle = dsqrt(ChiLambf) + bat = ChiLambf ** 11.0d0 + top = b1cav * ( eagle + b2cav * ChiLambf - b3cav ) + bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0) + botsq = bot * bot +! print *,top,bot,"bot,top",ChiLambf,Chif + Fcav = top / bot + + dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf)) + dbot = 12.0d0 * b4cav * bat * Lambf + dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow + + dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif)) + dbot = 12.0d0 * b4cav * bat * Chif + eagle = Lambf * pom + dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle) + dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle) + dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) & + * (chis2 * om2 * om12 - om1) / (eagle * pom) + + dFdL = ((dtop * bot - top * dbot) / botsq) +! dFdL = 0.0d0 + dCAVdOM1 = dFdL * ( dFdOM1 ) + dCAVdOM2 = dFdL * ( dFdOM2 ) + dCAVdOM12 = dFdL * ( dFdOM12 ) + + DO k= 1, 3 + ertail(k) = Rtail_distance(k)/Rtail + END DO + erdxi = scalar( ertail(1), dC_norm(1,i+nres) ) + erdxj = scalar( ertail(1), dC_norm(1,j+nres) ) + facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres) + facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres) + DO k = 1, 3 +!c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i) +!c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j) + pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres)) + gvdwx(k,i) = gvdwx(k,i) & + - (( dFdR + gg(k) ) * pom) +!c! & - ( dFdR * pom ) + pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres)) + gvdwx(k,j) = gvdwx(k,j) & + + (( dFdR + gg(k) ) * pom) +!c! & + ( dFdR * pom ) + + gvdwc(k,i) = gvdwc(k,i) & + - (( dFdR + gg(k) ) * ertail(k)) +!c! & - ( dFdR * ertail(k)) + + gvdwc(k,j) = gvdwc(k,j) & + + (( dFdR + gg(k) ) * ertail(k)) +!c! & + ( dFdR * ertail(k)) + + gg(k) = 0.0d0 +! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i) +! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j) + END DO + + +!c! Compute head-head and head-tail energies for each state + + isel = iabs(Qi) + iabs(Qj) +! isel=0 + IF (isel.eq.0) THEN +!c! No charges - do nothing + eheadtail = 0.0d0 + + ELSE IF (isel.eq.4) THEN +!c! Calculate dipole-dipole interactions + CALL edd(ecl) + eheadtail = ECL +! eheadtail = 0.0d0 + + ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN +!c! Charge-nonpolar interactions + CALL eqn(epol) + eheadtail = epol +! eheadtail = 0.0d0 + + ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN +!c! Nonpolar-charge interactions + CALL enq(epol) + eheadtail = epol +! eheadtail = 0.0d0 + + ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN +!c! Charge-dipole interactions + CALL eqd(ecl, elj, epol) + eheadtail = ECL + elj + epol +! eheadtail = 0.0d0 + + ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN +!c! Dipole-charge interactions + CALL edq(ecl, elj, epol) + eheadtail = ECL + elj + epol +! eheadtail = 0.0d0 + + ELSE IF ((isel.eq.2.and. & + iabs(Qi).eq.1).and. & + nstate(itypi,itypj).eq.1) THEN +!c! Same charge-charge interaction ( +/+ or -/- ) + CALL eqq(Ecl,Egb,Epol,Fisocav,Elj) + eheadtail = ECL + Egb + Epol + Fisocav + Elj +! eheadtail = 0.0d0 + + ELSE IF ((isel.eq.2.and. & + iabs(Qi).eq.1).and. & + nstate(itypi,itypj).ne.1) THEN +!c! Different charge-charge interaction ( +/- or -/+ ) + CALL energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad) + END IF + END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav + evdw = evdw + Fcav + eheadtail + + IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') & + restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,& + 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,& + Equad,evdwij+Fcav+eheadtail,evdw +! evdw = evdw + Fcav + eheadtail + + iF (nstate(itypi,itypj).eq.1) THEN + CALL sc_grad + END IF +!c!------------------------------------------------------------------- +!c! NAPISY KONCOWE + END DO ! j + END DO ! iint + END DO ! i +!c write (iout,*) "Number of loop steps in EGB:",ind +!c energy_dec=.false. +! print *,"EVDW KURW",evdw,nres + + RETURN + END SUBROUTINE emomo +!C------------------------------------------------------------------------------------ + SUBROUTINE eqq(Ecl,Egb,Epol,Fisocav,Elj) + use calc_data + use comm_momo + real (kind=8) :: facd3, facd4, federmaus, adler,& + Ecl,Egb,Epol,Fisocav,Elj,Fgb +! integer :: k +!c! Epol and Gpol analytical parameters + alphapol1 = alphapol(itypi,itypj) + alphapol2 = alphapol(itypj,itypi) +!c! Fisocav and Gisocav analytical parameters + al1 = alphiso(1,itypi,itypj) + al2 = alphiso(2,itypi,itypj) + al3 = alphiso(3,itypi,itypj) + al4 = alphiso(4,itypi,itypj) + csig = (1.0d0 & + / dsqrt(sigiso1(itypi, itypj)**2.0d0 & + + sigiso2(itypi,itypj)**2.0d0)) +!c! + pis = sig0head(itypi,itypj) + eps_head = epshead(itypi,itypj) + Rhead_sq = Rhead * Rhead +!c! R1 - distance between head of ith side chain and tail of jth sidechain +!c! R2 - distance between head of jth side chain and tail of ith sidechain + R1 = 0.0d0 + R2 = 0.0d0 + DO k = 1, 3 +!c! Calculate head-to-tail distances needed by Epol + R1=R1+(ctail(k,2)-chead(k,1))**2 + R2=R2+(chead(k,2)-ctail(k,1))**2 + END DO +!c! Pitagoras + R1 = dsqrt(R1) + R2 = dsqrt(R2) + +!c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj) +!c! & +dhead(1,1,itypi,itypj))**2)) +!c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj) +!c! & +dhead(2,1,itypi,itypj))**2)) + +!c!------------------------------------------------------------------- +!c! Coulomb electrostatic interaction + Ecl = (332.0d0 * Qij) / Rhead +!c! derivative of Ecl is Gcl... + dGCLdR = (-332.0d0 * Qij ) / Rhead_sq + dGCLdOM1 = 0.0d0 + dGCLdOM2 = 0.0d0 + dGCLdOM12 = 0.0d0 + ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq)) + Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0) + Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb +! print *,"EGB WTF",Qij,eps_inout_fac,Fgb,itypi,itypj,eps_in,eps_out +!c! Derivative of Egb is Ggb... + dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb) + dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )/ ( 2.0d0 * Fgb ) + dGGBdR = dGGBdFGB * dFGBdR +!c!------------------------------------------------------------------- +!c! Fisocav - isotropic cavity creation term +!c! or "how much energy it costs to put charged head in water" + pom = Rhead * csig + top = al1 * (dsqrt(pom) + al2 * pom - al3) + bot = (1.0d0 + al4 * pom**12.0d0) + botsq = bot * bot + FisoCav = top / bot +! write (*,*) "Rhead = ",Rhead +! write (*,*) "csig = ",csig +! write (*,*) "pom = ",pom +! write (*,*) "al1 = ",al1 +! write (*,*) "al2 = ",al2 +! write (*,*) "al3 = ",al3 +! write (*,*) "al4 = ",al4 +! write (*,*) "top = ",top +! write (*,*) "bot = ",bot +!c! Derivative of Fisocav is GCV... + dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2) + dbot = 12.0d0 * al4 * pom ** 11.0d0 + dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig +!c!------------------------------------------------------------------- +!c! Epol +!c! Polarization energy - charged heads polarize hydrophobic "neck" + MomoFac1 = (1.0d0 - chi1 * sqom2) + MomoFac2 = (1.0d0 - chi2 * sqom1) + RR1 = ( R1 * R1 ) / MomoFac1 + RR2 = ( R2 * R2 ) / MomoFac2 + ee1 = exp(-( RR1 / (4.0d0 * a12sq) )) + ee2 = exp(-( RR2 / (4.0d0 * a12sq) )) + fgb1 = sqrt( RR1 + a12sq * ee1 ) + fgb2 = sqrt( RR2 + a12sq * ee2 ) + epol = 332.0d0 * eps_inout_fac * ( & + (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 )) +!c! epol = 0.0d0 + dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)& + / (fgb1 ** 5.0d0) + dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)& + / (fgb2 ** 5.0d0) + dFGBdR1 = ( (R1 / MomoFac1)* ( 2.0d0 - (0.5d0 * ee1) ) )& + / ( 2.0d0 * fgb1 ) + dFGBdR2 = ( (R2 / MomoFac2)* ( 2.0d0 - (0.5d0 * ee2) ) )& + / ( 2.0d0 * fgb2 ) + dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))& + * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 ) + dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))& + * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 ) + dPOLdR1 = dPOLdFGB1 * dFGBdR1 +!c! dPOLdR1 = 0.0d0 + dPOLdR2 = dPOLdFGB2 * dFGBdR2 +!c! dPOLdR2 = 0.0d0 + dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 +!c! dPOLdOM1 = 0.0d0 + dPOLdOM2 = dPOLdFGB1 * dFGBdOM2 +!c! dPOLdOM2 = 0.0d0 +!c!------------------------------------------------------------------- +!c! Elj +!c! Lennard-Jones 6-12 interaction between heads + pom = (pis / Rhead)**6.0d0 + Elj = 4.0d0 * eps_head * pom * (pom-1.0d0) +!c! derivative of Elj is Glj + dGLJdR = 4.0d0 * eps_head*(((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))& + + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0))) +!c!------------------------------------------------------------------- +!c! Return the results +!c! These things do the dRdX derivatives, that is +!c! allow us to change what we see from function that changes with +!c! distance to function that changes with LOCATION (of the interaction +!c! site) + DO k = 1, 3 + erhead(k) = Rhead_distance(k)/Rhead + erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1) + erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2) + END DO + + erdxi = scalar( erhead(1), dC_norm(1,i+nres) ) + erdxj = scalar( erhead(1), dC_norm(1,j+nres) ) + bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) ) + federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres)) + eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) ) + adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) ) + facd1 = d1 * vbld_inv(i+nres) + facd2 = d2 * vbld_inv(j+nres) + facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres) + facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres) + +!c! Now we add appropriate partial derivatives (one in each dimension) + DO k = 1, 3 + hawk = (erhead_tail(k,1) + & + facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))) + condor = (erhead_tail(k,2) + & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))) + + pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) + gvdwx(k,i) = gvdwx(k,i) & + - dGCLdR * pom& + - dGGBdR * pom& + - dGCVdR * pom& + - dPOLdR1 * hawk& + - dPOLdR2 * (erhead_tail(k,2)& + -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))& + - dGLJdR * pom + + pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) + gvdwx(k,j) = gvdwx(k,j)+ dGCLdR * pom& + + dGGBdR * pom+ dGCVdR * pom& + + dPOLdR1 * (erhead_tail(k,1)& + -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))& + + dPOLdR2 * condor + dGLJdR * pom + + gvdwc(k,i) = gvdwc(k,i) & + - dGCLdR * erhead(k)& + - dGGBdR * erhead(k)& + - dGCVdR * erhead(k)& + - dPOLdR1 * erhead_tail(k,1)& + - dPOLdR2 * erhead_tail(k,2)& + - dGLJdR * erhead(k) + + gvdwc(k,j) = gvdwc(k,j) & + + dGCLdR * erhead(k) & + + dGGBdR * erhead(k) & + + dGCVdR * erhead(k) & + + dPOLdR1 * erhead_tail(k,1) & + + dPOLdR2 * erhead_tail(k,2)& + + dGLJdR * erhead(k) + + END DO + RETURN + END SUBROUTINE eqq +!c!------------------------------------------------------------------- + SUBROUTINE energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad) + use comm_momo + use calc_data + + double precision eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad + double precision ener(4) + double precision dcosom1(3),dcosom2(3) +!c! used in Epol derivatives + double precision facd3, facd4 + double precision federmaus, adler + integer istate,ii,jj + real (kind=8) :: Fgb +! print *,"CALLING EQUAD" +!c! Epol and Gpol analytical parameters + alphapol1 = alphapol(itypi,itypj) + alphapol2 = alphapol(itypj,itypi) +!c! Fisocav and Gisocav analytical parameters + al1 = alphiso(1,itypi,itypj) + al2 = alphiso(2,itypi,itypj) + al3 = alphiso(3,itypi,itypj) + al4 = alphiso(4,itypi,itypj) + csig = (1.0d0 / dsqrt(sigiso1(itypi, itypj)**2.0d0& + + sigiso2(itypi,itypj)**2.0d0)) +!c! + w1 = wqdip(1,itypi,itypj) + w2 = wqdip(2,itypi,itypj) + pis = sig0head(itypi,itypj) + eps_head = epshead(itypi,itypj) +!c! First things first: +!c! We need to do sc_grad's job with GB and Fcav + eom1 = eps2der * eps2rt_om1 & + - 2.0D0 * alf1 * eps3der& + + sigder * sigsq_om1& + + dCAVdOM1 + eom2 = eps2der * eps2rt_om2 & + + 2.0D0 * alf2 * eps3der& + + sigder * sigsq_om2& + + dCAVdOM2 + eom12 = evdwij * eps1_om12 & + + eps2der * eps2rt_om12 & + - 2.0D0 * alf12 * eps3der& + + sigder *sigsq_om12& + + dCAVdOM12 +!c! now some magical transformations to project gradient into +!c! three cartesian vectors + 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)) + gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k) +!c! this acts on hydrophobic center of interaction + gvdwx(k,i)= gvdwx(k,i) - gg(k) & + + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))& + + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv + gvdwx(k,j)= gvdwx(k,j) + gg(k) & + + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))& + + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv +!c! this acts on Calpha + gvdwc(k,i)=gvdwc(k,i)-gg(k) + gvdwc(k,j)=gvdwc(k,j)+gg(k) + END DO +!c! sc_grad is done, now we will compute + eheadtail = 0.0d0 + eom1 = 0.0d0 + eom2 = 0.0d0 + eom12 = 0.0d0 + DO istate = 1, nstate(itypi,itypj) +!c************************************************************* + IF (istate.ne.1) THEN + IF (istate.lt.3) THEN + ii = 1 + ELSE + ii = 2 + END IF + jj = istate/ii + d1 = dhead(1,ii,itypi,itypj) + d2 = dhead(2,jj,itypi,itypj) + DO k = 1,3 + chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres) + chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres) + Rhead_distance(k) = chead(k,2) - chead(k,1) + END DO +!c! pitagoras (root of sum of squares) + Rhead = dsqrt( & + (Rhead_distance(1)*Rhead_distance(1)) & + + (Rhead_distance(2)*Rhead_distance(2)) & + + (Rhead_distance(3)*Rhead_distance(3))) + END IF + Rhead_sq = Rhead * Rhead + +!c! R1 - distance between head of ith side chain and tail of jth sidechain +!c! R2 - distance between head of jth side chain and tail of ith sidechain + R1 = 0.0d0 + R2 = 0.0d0 + DO k = 1, 3 +!c! Calculate head-to-tail distances + R1=R1+(ctail(k,2)-chead(k,1))**2 + R2=R2+(chead(k,2)-ctail(k,1))**2 + END DO +!c! Pitagoras + R1 = dsqrt(R1) + R2 = dsqrt(R2) + Ecl = (332.0d0 * Qij) / (Rhead * eps_in) +!c! Ecl = 0.0d0 +!c! write (*,*) "Ecl = ", Ecl +!c! derivative of Ecl is Gcl... + dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in) +!c! dGCLdR = 0.0d0 + dGCLdOM1 = 0.0d0 + dGCLdOM2 = 0.0d0 + dGCLdOM12 = 0.0d0 +!c!------------------------------------------------------------------- +!c! Generalised Born Solvent Polarization + ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq)) + Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0) + Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb +!c! Egb = 0.0d0 +!c! write (*,*) "a1*a2 = ", a12sq +!c! write (*,*) "Rhead = ", Rhead +!c! write (*,*) "Rhead_sq = ", Rhead_sq +!c! write (*,*) "ee = ", ee +!c! write (*,*) "Fgb = ", Fgb +!c! write (*,*) "fac = ", eps_inout_fac +!c! write (*,*) "Qij = ", Qij +!c! write (*,*) "Egb = ", Egb +!c! Derivative of Egb is Ggb... +!c! dFGBdR is used by Quad's later... + dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb) + dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )& + / ( 2.0d0 * Fgb ) + dGGBdR = dGGBdFGB * dFGBdR +!c! dGGBdR = 0.0d0 +!c!------------------------------------------------------------------- +!c! Fisocav - isotropic cavity creation term + pom = Rhead * csig + top = al1 * (dsqrt(pom) + al2 * pom - al3) + bot = (1.0d0 + al4 * pom**12.0d0) + botsq = bot * bot + FisoCav = top / bot + dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2) + dbot = 12.0d0 * al4 * pom ** 11.0d0 + dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig +!c! dGCVdR = 0.0d0 +!c!------------------------------------------------------------------- +!c! Polarization energy +!c! Epol + MomoFac1 = (1.0d0 - chi1 * sqom2) + MomoFac2 = (1.0d0 - chi2 * sqom1) + RR1 = ( R1 * R1 ) / MomoFac1 + RR2 = ( R2 * R2 ) / MomoFac2 + ee1 = exp(-( RR1 / (4.0d0 * a12sq) )) + ee2 = exp(-( RR2 / (4.0d0 * a12sq) )) + fgb1 = sqrt( RR1 + a12sq * ee1 ) + fgb2 = sqrt( RR2 + a12sq * ee2 ) + epol = 332.0d0 * eps_inout_fac * (& + (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 )) +!c! epol = 0.0d0 +!c! derivative of Epol is Gpol... + dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)& + / (fgb1 ** 5.0d0) + dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)& + / (fgb2 ** 5.0d0) + dFGBdR1 = ( (R1 / MomoFac1) & + * ( 2.0d0 - (0.5d0 * ee1) ) )& + / ( 2.0d0 * fgb1 ) + dFGBdR2 = ( (R2 / MomoFac2) & + * ( 2.0d0 - (0.5d0 * ee2) ) ) & + / ( 2.0d0 * fgb2 ) + dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) & + * ( 2.0d0 - 0.5d0 * ee1) ) & + / ( 2.0d0 * fgb1 ) + dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) & + * ( 2.0d0 - 0.5d0 * ee2) ) & + / ( 2.0d0 * fgb2 ) + dPOLdR1 = dPOLdFGB1 * dFGBdR1 +!c! dPOLdR1 = 0.0d0 + dPOLdR2 = dPOLdFGB2 * dFGBdR2 +!c! dPOLdR2 = 0.0d0 + dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 +!c! dPOLdOM1 = 0.0d0 + dPOLdOM2 = dPOLdFGB1 * dFGBdOM2 + pom = (pis / Rhead)**6.0d0 + Elj = 4.0d0 * eps_head * pom * (pom-1.0d0) +!c! Elj = 0.0d0 +!c! derivative of Elj is Glj + dGLJdR = 4.0d0 * eps_head & + * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) & + + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0))) +!c! dGLJdR = 0.0d0 +!c!------------------------------------------------------------------- +!c! Equad + IF (Wqd.ne.0.0d0) THEN + Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0) & + - 37.5d0 * ( sqom1 + sqom2 ) & + + 157.5d0 * ( sqom1 * sqom2 ) & + - 45.0d0 * om1*om2*om12 + fac = -( Wqd / (2.0d0 * Fgb**5.0d0) ) + Equad = fac * Beta1 +!c! Equad = 0.0d0 +!c! derivative of Equad... + dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR +!c! dQUADdR = 0.0d0 + dQUADdOM1 = fac* (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12) +!c! dQUADdOM1 = 0.0d0 + dQUADdOM2 = fac* (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12) +!c! dQUADdOM2 = 0.0d0 + dQUADdOM12 = fac * ( 6.0d0*om12 - 45.0d0*om1*om2 ) + ELSE + Beta1 = 0.0d0 + Equad = 0.0d0 + END IF +!c!------------------------------------------------------------------- +!c! Return the results +!c! Angular stuff + eom1 = dPOLdOM1 + dQUADdOM1 + eom2 = dPOLdOM2 + dQUADdOM2 + eom12 = dQUADdOM12 +!c! now some magical transformations to project gradient into +!c! three cartesian vectors + 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)) + tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k) + END DO +!c! Radial stuff + DO k = 1, 3 + erhead(k) = Rhead_distance(k)/Rhead + erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1) + erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2) + END DO + erdxi = scalar( erhead(1), dC_norm(1,i+nres) ) + erdxj = scalar( erhead(1), dC_norm(1,j+nres) ) + bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) ) + federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres)) + eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) ) + adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) ) + facd1 = d1 * vbld_inv(i+nres) + facd2 = d2 * vbld_inv(j+nres) + facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres) + facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres) + DO k = 1, 3 + hawk = erhead_tail(k,1) + & + facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)) + condor = erhead_tail(k,2) + & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)) + + pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) +!c! this acts on hydrophobic center of interaction + gheadtail(k,1,1) = gheadtail(k,1,1) & + - dGCLdR * pom & + - dGGBdR * pom & + - dGCVdR * pom & + - dPOLdR1 * hawk & + - dPOLdR2 * (erhead_tail(k,2) & + -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))& + - dGLJdR * pom & + - dQUADdR * pom& + - tuna(k) & + + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))& + + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv + + pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) +!c! this acts on hydrophobic center of interaction + gheadtail(k,2,1) = gheadtail(k,2,1) & + + dGCLdR * pom & + + dGGBdR * pom & + + dGCVdR * pom & + + dPOLdR1 * (erhead_tail(k,1) & + -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) & + + dPOLdR2 * condor & + + dGLJdR * pom & + + dQUADdR * pom & + + tuna(k) & + + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) & + + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv + +!c! this acts on Calpha + gheadtail(k,3,1) = gheadtail(k,3,1) & + - dGCLdR * erhead(k)& + - dGGBdR * erhead(k)& + - dGCVdR * erhead(k)& + - dPOLdR1 * erhead_tail(k,1)& + - dPOLdR2 * erhead_tail(k,2)& + - dGLJdR * erhead(k) & + - dQUADdR * erhead(k)& + - tuna(k) +!c! this acts on Calpha + gheadtail(k,4,1) = gheadtail(k,4,1) & + + dGCLdR * erhead(k) & + + dGGBdR * erhead(k) & + + dGCVdR * erhead(k) & + + dPOLdR1 * erhead_tail(k,1) & + + dPOLdR2 * erhead_tail(k,2) & + + dGLJdR * erhead(k) & + + dQUADdR * erhead(k)& + + tuna(k) + END DO + ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad + eheadtail = eheadtail & + + wstate(istate, itypi, itypj) & + * dexp(-betaT * ener(istate)) +!c! foreach cartesian dimension + DO k = 1, 3 +!c! foreach of two gvdwx and gvdwc + DO l = 1, 4 + gheadtail(k,l,2) = gheadtail(k,l,2) & + + wstate( istate, itypi, itypj ) & + * dexp(-betaT * ener(istate)) & + * gheadtail(k,l,1) + gheadtail(k,l,1) = 0.0d0 + END DO + END DO + END DO +!c! Here ended the gigantic DO istate = 1, 4, which starts +!c! at the beggining of the subroutine + + DO k = 1, 3 + DO l = 1, 4 + gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail + END DO + gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2) + gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2) + gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2) + gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2) + DO l = 1, 4 + gheadtail(k,l,1) = 0.0d0 + gheadtail(k,l,2) = 0.0d0 + END DO + END DO + eheadtail = (-dlog(eheadtail)) / betaT + dPOLdOM1 = 0.0d0 + dPOLdOM2 = 0.0d0 + dQUADdOM1 = 0.0d0 + dQUADdOM2 = 0.0d0 + dQUADdOM12 = 0.0d0 + RETURN + END SUBROUTINE energy_quad +!!----------------------------------------------------------- + SUBROUTINE eqn(Epol) + use comm_momo + use calc_data + + double precision facd4, federmaus,epol + alphapol1 = alphapol(itypi,itypj) +!c! R1 - distance between head of ith side chain and tail of jth sidechain + R1 = 0.0d0 + DO k = 1, 3 +!c! Calculate head-to-tail distances + R1=R1+(ctail(k,2)-chead(k,1))**2 + END DO +!c! Pitagoras + R1 = dsqrt(R1) + +!c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj) +!c! & +dhead(1,1,itypi,itypj))**2)) +!c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj) +!c! & +dhead(2,1,itypi,itypj))**2)) +!c-------------------------------------------------------------------- +!c Polarization energy +!c Epol + MomoFac1 = (1.0d0 - chi1 * sqom2) + RR1 = R1 * R1 / MomoFac1 + ee1 = exp(-( RR1 / (4.0d0 * a12sq) )) + fgb1 = sqrt( RR1 + a12sq * ee1) + epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0) + dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) & + / (fgb1 ** 5.0d0) + dFGBdR1 = ( (R1 / MomoFac1) & + * ( 2.0d0 - (0.5d0 * ee1) ) ) & + / ( 2.0d0 * fgb1 ) + dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) & + * (2.0d0 - 0.5d0 * ee1) ) & + / (2.0d0 * fgb1) + dPOLdR1 = dPOLdFGB1 * dFGBdR1 +!c! dPOLdR1 = 0.0d0 + dPOLdOM1 = 0.0d0 + dPOLdOM2 = dPOLdFGB1 * dFGBdOM2 + DO k = 1, 3 + erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1) + END DO + bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) ) + federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres)) + facd1 = d1 * vbld_inv(i+nres) + facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres) + + DO k = 1, 3 + hawk = (erhead_tail(k,1) + & + facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))) + + gvdwx(k,i) = gvdwx(k,i) & + - dPOLdR1 * hawk + gvdwx(k,j) = gvdwx(k,j) & + + dPOLdR1 * (erhead_tail(k,1) & + -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) + + gvdwc(k,i) = gvdwc(k,i) - dPOLdR1 * erhead_tail(k,1) + gvdwc(k,j) = gvdwc(k,j) + dPOLdR1 * erhead_tail(k,1) + + END DO + RETURN + END SUBROUTINE eqn + SUBROUTINE enq(Epol) + use calc_data + use comm_momo + double precision facd3, adler,epol + alphapol2 = alphapol(itypj,itypi) +!c! R2 - distance between head of jth side chain and tail of ith sidechain + R2 = 0.0d0 + DO k = 1, 3 +!c! Calculate head-to-tail distances + R2=R2+(chead(k,2)-ctail(k,1))**2 + END DO +!c! Pitagoras + R2 = dsqrt(R2) + +!c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj) +!c! & +dhead(1,1,itypi,itypj))**2)) +!c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj) +!c! & +dhead(2,1,itypi,itypj))**2)) +!c------------------------------------------------------------------------ +!c Polarization energy + MomoFac2 = (1.0d0 - chi2 * sqom1) + RR2 = R2 * R2 / MomoFac2 + ee2 = exp(-(RR2 / (4.0d0 * a12sq))) + fgb2 = sqrt(RR2 + a12sq * ee2) + epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 ) + dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) & + / (fgb2 ** 5.0d0) + dFGBdR2 = ( (R2 / MomoFac2) & + * ( 2.0d0 - (0.5d0 * ee2) ) ) & + / (2.0d0 * fgb2) + dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) & + * (2.0d0 - 0.5d0 * ee2) ) & + / (2.0d0 * fgb2) + dPOLdR2 = dPOLdFGB2 * dFGBdR2 +!c! dPOLdR2 = 0.0d0 + dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 +!c! dPOLdOM1 = 0.0d0 + dPOLdOM2 = 0.0d0 +!c!------------------------------------------------------------------- +!c! Return the results +!c! (See comments in Eqq) + DO k = 1, 3 + erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2) + END DO + eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) ) + adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) ) + facd2 = d2 * vbld_inv(j+nres) + facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres) + DO k = 1, 3 + condor = (erhead_tail(k,2) & + + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))) + + gvdwx(k,i) = gvdwx(k,i) & + - dPOLdR2 * (erhead_tail(k,2) & + -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) + gvdwx(k,j) = gvdwx(k,j) & + + dPOLdR2 * condor + + gvdwc(k,i) = gvdwc(k,i) & + - dPOLdR2 * erhead_tail(k,2) + gvdwc(k,j) = gvdwc(k,j) & + + dPOLdR2 * erhead_tail(k,2) + + END DO + RETURN + END SUBROUTINE enq + SUBROUTINE eqd(Ecl,Elj,Epol) + use calc_data + use comm_momo + double precision facd4, federmaus,ecl,elj,epol + alphapol1 = alphapol(itypi,itypj) + w1 = wqdip(1,itypi,itypj) + w2 = wqdip(2,itypi,itypj) + pis = sig0head(itypi,itypj) + eps_head = epshead(itypi,itypj) +!c!------------------------------------------------------------------- +!c! R1 - distance between head of ith side chain and tail of jth sidechain + R1 = 0.0d0 + DO k = 1, 3 +!c! Calculate head-to-tail distances + R1=R1+(ctail(k,2)-chead(k,1))**2 + END DO +!c! Pitagoras + R1 = dsqrt(R1) + +!c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj) +!c! & +dhead(1,1,itypi,itypj))**2)) +!c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj) +!c! & +dhead(2,1,itypi,itypj))**2)) + +!c!------------------------------------------------------------------- +!c! ecl + sparrow = w1 * Qi * om1 + hawk = w2 * Qi * Qi * (1.0d0 - sqom2) + Ecl = sparrow / Rhead**2.0d0 & + - hawk / Rhead**4.0d0 + dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 & + + 4.0d0 * hawk / Rhead**5.0d0 +!c! dF/dom1 + dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0) +!c! dF/dom2 + dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0) +!c-------------------------------------------------------------------- +!c Polarization energy +!c Epol + MomoFac1 = (1.0d0 - chi1 * sqom2) + RR1 = R1 * R1 / MomoFac1 + ee1 = exp(-( RR1 / (4.0d0 * a12sq) )) + fgb1 = sqrt( RR1 + a12sq * ee1) + epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0) +!c! epol = 0.0d0 +!c!------------------------------------------------------------------ +!c! derivative of Epol is Gpol... + dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) & + / (fgb1 ** 5.0d0) + dFGBdR1 = ( (R1 / MomoFac1) & + * ( 2.0d0 - (0.5d0 * ee1) ) ) & + / ( 2.0d0 * fgb1 ) + dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) & + * (2.0d0 - 0.5d0 * ee1) ) & + / (2.0d0 * fgb1) + dPOLdR1 = dPOLdFGB1 * dFGBdR1 +!c! dPOLdR1 = 0.0d0 + dPOLdOM1 = 0.0d0 + dPOLdOM2 = dPOLdFGB1 * dFGBdOM2 +!c! dPOLdOM2 = 0.0d0 +!c!------------------------------------------------------------------- +!c! Elj + pom = (pis / Rhead)**6.0d0 + Elj = 4.0d0 * eps_head * pom * (pom-1.0d0) +!c! derivative of Elj is Glj + dGLJdR = 4.0d0 * eps_head & + * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) & + + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0))) + DO k = 1, 3 + erhead(k) = Rhead_distance(k)/Rhead + erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1) + END DO + + erdxi = scalar( erhead(1), dC_norm(1,i+nres) ) + erdxj = scalar( erhead(1), dC_norm(1,j+nres) ) + bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) ) + federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres)) + facd1 = d1 * vbld_inv(i+nres) + facd2 = d2 * vbld_inv(j+nres) + facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres) + + DO k = 1, 3 + hawk = (erhead_tail(k,1) + & + facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))) + + pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) + gvdwx(k,i) = gvdwx(k,i) & + - dGCLdR * pom& + - dPOLdR1 * hawk & + - dGLJdR * pom + + pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) + gvdwx(k,j) = gvdwx(k,j) & + + dGCLdR * pom & + + dPOLdR1 * (erhead_tail(k,1) & + -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) & + + dGLJdR * pom + + + gvdwc(k,i) = gvdwc(k,i) & + - dGCLdR * erhead(k) & + - dPOLdR1 * erhead_tail(k,1) & + - dGLJdR * erhead(k) + + gvdwc(k,j) = gvdwc(k,j) & + + dGCLdR * erhead(k) & + + dPOLdR1 * erhead_tail(k,1) & + + dGLJdR * erhead(k) + + END DO + RETURN + END SUBROUTINE eqd + SUBROUTINE edq(Ecl,Elj,Epol) +! IMPLICIT NONE + use comm_momo + use calc_data + + double precision facd3, adler,ecl,elj,epol + alphapol2 = alphapol(itypj,itypi) + w1 = wqdip(1,itypi,itypj) + w2 = wqdip(2,itypi,itypj) + pis = sig0head(itypi,itypj) + eps_head = epshead(itypi,itypj) +!c!------------------------------------------------------------------- +!c! R2 - distance between head of jth side chain and tail of ith sidechain + R2 = 0.0d0 + DO k = 1, 3 +!c! Calculate head-to-tail distances + R2=R2+(chead(k,2)-ctail(k,1))**2 + END DO +!c! Pitagoras + R2 = dsqrt(R2) + +!c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj) +!c! & +dhead(1,1,itypi,itypj))**2)) +!c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj) +!c! & +dhead(2,1,itypi,itypj))**2)) + + +!c!------------------------------------------------------------------- +!c! ecl + sparrow = w1 * Qi * om1 + hawk = w2 * Qi * Qi * (1.0d0 - sqom2) + ECL = sparrow / Rhead**2.0d0 & + - hawk / Rhead**4.0d0 +!c!------------------------------------------------------------------- +!c! derivative of ecl is Gcl +!c! dF/dr part + dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 & + + 4.0d0 * hawk / Rhead**5.0d0 +!c! dF/dom1 + dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0) +!c! dF/dom2 + dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0) +!c-------------------------------------------------------------------- +!c Polarization energy +!c Epol + MomoFac2 = (1.0d0 - chi2 * sqom1) + RR2 = R2 * R2 / MomoFac2 + ee2 = exp(-(RR2 / (4.0d0 * a12sq))) + fgb2 = sqrt(RR2 + a12sq * ee2) + epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 ) + dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) & + / (fgb2 ** 5.0d0) + dFGBdR2 = ( (R2 / MomoFac2) & + * ( 2.0d0 - (0.5d0 * ee2) ) ) & + / (2.0d0 * fgb2) + dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) & + * (2.0d0 - 0.5d0 * ee2) ) & + / (2.0d0 * fgb2) + dPOLdR2 = dPOLdFGB2 * dFGBdR2 +!c! dPOLdR2 = 0.0d0 + dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 +!c! dPOLdOM1 = 0.0d0 + dPOLdOM2 = 0.0d0 +!c!------------------------------------------------------------------- +!c! Elj + pom = (pis / Rhead)**6.0d0 + Elj = 4.0d0 * eps_head * pom * (pom-1.0d0) +!c! derivative of Elj is Glj + dGLJdR = 4.0d0 * eps_head & + * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) & + + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0))) +!c!------------------------------------------------------------------- +!c! Return the results +!c! (see comments in Eqq) + DO k = 1, 3 + erhead(k) = Rhead_distance(k)/Rhead + erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2) + END DO + erdxi = scalar( erhead(1), dC_norm(1,i+nres) ) + erdxj = scalar( erhead(1), dC_norm(1,j+nres) ) + eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) ) + adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) ) + facd1 = d1 * vbld_inv(i+nres) + facd2 = d2 * vbld_inv(j+nres) + facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres) + DO k = 1, 3 + condor = (erhead_tail(k,2) & + + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))) + + pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) + gvdwx(k,i) = gvdwx(k,i) & + - dGCLdR * pom & + - dPOLdR2 * (erhead_tail(k,2) & + -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) & + - dGLJdR * pom + + pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) + gvdwx(k,j) = gvdwx(k,j) & + + dGCLdR * pom & + + dPOLdR2 * condor & + + dGLJdR * pom + + + gvdwc(k,i) = gvdwc(k,i) & + - dGCLdR * erhead(k) & + - dPOLdR2 * erhead_tail(k,2) & + - dGLJdR * erhead(k) + + gvdwc(k,j) = gvdwc(k,j) & + + dGCLdR * erhead(k) & + + dPOLdR2 * erhead_tail(k,2) & + + dGLJdR * erhead(k) + + END DO + RETURN + END SUBROUTINE edq + SUBROUTINE edd(ECL) +! IMPLICIT NONE + use comm_momo + use calc_data + + double precision ecl +!c! csig = sigiso(itypi,itypj) + w1 = wqdip(1,itypi,itypj) + w2 = wqdip(2,itypi,itypj) +!c!------------------------------------------------------------------- +!c! ECL + fac = (om12 - 3.0d0 * om1 * om2) + c1 = (w1 / (Rhead**3.0d0)) * fac + c2 = (w2 / Rhead ** 6.0d0) & + * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2)) + ECL = c1 - c2 +!c! write (*,*) "w1 = ", w1 +!c! write (*,*) "w2 = ", w2 +!c! write (*,*) "om1 = ", om1 +!c! write (*,*) "om2 = ", om2 +!c! write (*,*) "om12 = ", om12 +!c! write (*,*) "fac = ", fac +!c! write (*,*) "c1 = ", c1 +!c! write (*,*) "c2 = ", c2 +!c! write (*,*) "Ecl = ", Ecl +!c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0) +!c! write (*,*) "c2_2 = ", +!c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2)) +!c!------------------------------------------------------------------- +!c! dervative of ECL is GCL... +!c! dECL/dr + c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0) + c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) & + * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2)) + dGCLdR = c1 - c2 +!c! dECL/dom1 + c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0) + c2 = (-6.0d0 * w2) / (Rhead**6.0d0) & + * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 ) + dGCLdOM1 = c1 - c2 +!c! dECL/dom2 + c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0) + c2 = (-6.0d0 * w2) / (Rhead**6.0d0) & + * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 ) + dGCLdOM2 = c1 - c2 +!c! dECL/dom12 + c1 = w1 / (Rhead ** 3.0d0) + c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0 + dGCLdOM12 = c1 - c2 +!c!------------------------------------------------------------------- +!c! Return the results +!c! (see comments in Eqq) + DO k= 1, 3 + erhead(k) = Rhead_distance(k)/Rhead + END DO + erdxi = scalar( erhead(1), dC_norm(1,i+nres) ) + erdxj = scalar( erhead(1), dC_norm(1,j+nres) ) + facd1 = d1 * vbld_inv(i+nres) + facd2 = d2 * vbld_inv(j+nres) + DO k = 1, 3 + + pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) + gvdwx(k,i) = gvdwx(k,i) - dGCLdR * pom + pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) + gvdwx(k,j) = gvdwx(k,j) + dGCLdR * pom + + gvdwc(k,i) = gvdwc(k,i) - dGCLdR * erhead(k) + gvdwc(k,j) = gvdwc(k,j) + dGCLdR * erhead(k) + END DO + RETURN + END SUBROUTINE edd + SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol) +! IMPLICIT NONE + use comm_momo + use calc_data + + real(kind=8) :: eheadtail,Egb,Ecl,Elj,Equad,Epol,Rb + eps_out=80.0d0 + itypi = itype(i,1) + itypj = itype(j,1) +!c! 1/(Gas Constant * Thermostate temperature) = BetaT +!c! ENABLE THIS LINE WHEN USING CHECKGRAD!!! +!c! t_bath = 300 +!c! BetaT = 1.0d0 / (t_bath * Rb)i + Rb=0.001986d0 + BetaT = 1.0d0 / (298.0d0 * Rb) +!c! Gay-berne var's + sig0ij = sigma( itypi,itypj ) + chi1 = chi( itypi, itypj ) + chi2 = chi( itypj, itypi ) + chi12 = chi1 * chi2 + chip1 = chipp( itypi, itypj ) + chip2 = chipp( itypj, itypi ) + chip12 = chip1 * chip2 +! chi1=0.0 +! chi2=0.0 +! chi12=0.0 +! chip1=0.0 +! chip2=0.0 +! chip12=0.0 +!c! not used by momo potential, but needed by sc_angular which is shared +!c! by all energy_potential subroutines + alf1 = 0.0d0 + alf2 = 0.0d0 + alf12 = 0.0d0 +!c! location, location, location +! 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 ) +!c! distance from center of chain(?) to polar/charged head +!c! write (*,*) "istate = ", 1 +!c! write (*,*) "ii = ", 1 +!c! write (*,*) "jj = ", 1 + d1 = dhead(1, 1, itypi, itypj) + d2 = dhead(2, 1, itypi, itypj) +!c! ai*aj from Fgb + a12sq = rborn(itypi,itypj) * rborn(itypj,itypi) +!c! a12sq = a12sq * a12sq +!c! charge of amino acid itypi is... + Qi = icharge(itypi) + Qj = icharge(itypj) + Qij = Qi * Qj +!c! chis1,2,12 + chis1 = chis(itypi,itypj) + chis2 = chis(itypj,itypi) + chis12 = chis1 * chis2 + sig1 = sigmap1(itypi,itypj) + sig2 = sigmap2(itypi,itypj) +!c! write (*,*) "sig1 = ", sig1 +!c! write (*,*) "sig2 = ", sig2 +!c! alpha factors from Fcav/Gcav + b1cav = alphasur(1,itypi,itypj) +! b1cav=0.0 + b2cav = alphasur(2,itypi,itypj) + b3cav = alphasur(3,itypi,itypj) + b4cav = alphasur(4,itypi,itypj) + wqd = wquad(itypi, itypj) +!c! used by Fgb + eps_in = epsintab(itypi,itypj) + eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out)) +!c! write (*,*) "eps_inout_fac = ", eps_inout_fac +!c!------------------------------------------------------------------- +!c! tail location and distance calculations + Rtail = 0.0d0 + DO k = 1, 3 + ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i) + ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j) + END DO +!c! tail distances will be themselves usefull elswhere +!c1 (in Gcav, for example) + Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 ) + Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 ) + Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 ) + Rtail = dsqrt( & + (Rtail_distance(1)*Rtail_distance(1)) & + + (Rtail_distance(2)*Rtail_distance(2)) & + + (Rtail_distance(3)*Rtail_distance(3))) +!c!------------------------------------------------------------------- +!c! Calculate location and distance between polar heads +!c! distance between heads +!c! for each one of our three dimensional space... + d1 = dhead(1, 1, itypi, itypj) + d2 = dhead(2, 1, itypi, itypj) + + DO k = 1,3 +!c! location of polar head is computed by taking hydrophobic centre +!c! and moving by a d1 * dc_norm vector +!c! see unres publications for very informative images + chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres) + chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres) +!c! distance +!c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres)) +!c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k) + Rhead_distance(k) = chead(k,2) - chead(k,1) + END DO +!c! pitagoras (root of sum of squares) + Rhead = dsqrt( & + (Rhead_distance(1)*Rhead_distance(1)) & + + (Rhead_distance(2)*Rhead_distance(2)) & + + (Rhead_distance(3)*Rhead_distance(3))) +!c!------------------------------------------------------------------- +!c! zero everything that should be zero'ed + Egb = 0.0d0 + ECL = 0.0d0 + Elj = 0.0d0 + Equad = 0.0d0 + Epol = 0.0d0 + eheadtail = 0.0d0 + dGCLdOM1 = 0.0d0 + dGCLdOM2 = 0.0d0 + dGCLdOM12 = 0.0d0 + dPOLdOM1 = 0.0d0 + dPOLdOM2 = 0.0d0 + RETURN + END SUBROUTINE elgrad_init end module energy