X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fenergy.F90;h=bb7d08d5afe704eb0f2bd1c4bc4afffc7d5f22aa;hb=refs%2Fheads%2FUCGM;hp=646d9a917627923a11d23be1c9cb1cc5649fc486;hpb=125df719a9c1c98b1007632dfc1765e710e19815;p=unres4.git diff --git a/source/unres/energy.F90 b/source/unres/energy.F90 index 646d9a9..bb7d08d 100644 --- a/source/unres/energy.F90 +++ b/source/unres/energy.F90 @@ -1,4 +1,4 @@ - module energy + module energy !----------------------------------------------------------------------------- use io_units use names @@ -137,9 +137,12 @@ gvdwc_peppho !------------------------------IONS GRADIENT real(kind=8),dimension(:,:),allocatable :: gradcatcat, & - gradpepcat,gradpepcatx + gradpepcat,gradpepcatx,gradnuclcat,gradnuclcatx,gradcattranx,& + gradcattranc,gradcatangc,gradcatangx ! real(kind=8),dimension(:,:),allocatable :: gloc,gloc_x !(maxvar,2) - +!---------------------------------------- + real(kind=8),dimension(:,:),allocatable ::gradlipelec,gradlipbond,& + gradlipang,gradliplj,gradpepmart, gradpepmartx real(kind=8),dimension(:,:),allocatable :: gel_loc,gel_loc_long,& gcorr3_turn,gcorr4_turn,gcorr6_turn,gradb,gradbx !(3,maxres) @@ -182,7 +185,7 @@ !----------------------------------------------------------------------------- ! common.sbridge ! common /dyn_ssbond/ - real(kind=8),dimension(:,:),allocatable :: dyn_ssbond_ij !(maxres,maxres) + real(kind=8),dimension(:),allocatable :: dyn_ssbond_ij !(maxres,maxres) !----------------------------------------------------------------------------- ! common.sccor ! Parameters of the SCCOR term @@ -198,7 +201,11 @@ ! common /przechowalnia/ real(kind=8),dimension(:,:,:),allocatable :: zapas real(kind=8),dimension(:,:,:,:),allocatable ::zapas2 !(max_dim,maxconts,max_fg_procs) +#ifdef FIVEDIAG + real(kind=8),dimension(:,:),allocatable :: fromto !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2) +#else real(kind=8),dimension(:,:,:),allocatable :: fromto !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2) +#endif !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- ! @@ -209,7 +216,7 @@ ! energy_p_new_barrier.F !----------------------------------------------------------------------------- subroutine etotal(energia) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' use MD_data #ifndef ISNAN @@ -241,31 +248,36 @@ real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,escloc,ees,eel_loc real(kind=8) :: eello_turn3,eello_turn4,estr,ebe,eliptran,etube, & Eafmforce,ethetacnstr - real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6 + real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6,ehomology_constr ! 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,ecations_prot_amber + real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber,& + ecation_nucl,ecat_prottran,ecation_protang ! energies for protein nucleic acid interaction real(kind=8) :: escbase,epepbase,escpho,epeppho +! energies for MARTINI + real(kind=8) :: elipbond,elipang,elipelec,eliplj,elipidprot #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_locbuf1(3*maxcontsshi*nres), & - grad_shield_sidebuf1(3*maxcontsshi*nres), & - grad_shield_locbuf2(3*maxcontsshi*nres), & - grad_shield_sidebuf2(3*maxcontsshi*nres), & - grad_shieldbuf1(3*nres), & - grad_shieldbuf2(3*nres) - - integer ishield_listbuf(-1:nres), & - shield_listbuf(maxcontsshi,-1:nres),k,j,i,iii,impishi,mojint,jjj + real(kind=8) :: fac_shieldbuf(nres_molec(1)), & + grad_shield_locbuf1(3*maxcontsshi*nres_molec(1)), & + grad_shield_sidebuf1(3*maxcontsshi*nres_molec(1)), & + grad_shield_locbuf2(3*maxcontsshi*nres_molec(1)), & + grad_shield_sidebuf2(3*maxcontsshi*nres_molec(1)), & + grad_shieldbuf1(3*nres_molec(1)), & + grad_shieldbuf2(3*nres_molec(1)) + + integer ishield_listbuf(-1:nres_molec(1)), & + shield_listbuf(maxcontsshi,-1:nres_molec(1)),k,j,i,iii,impishi,mojint,jjj + integer :: imatupdate2 ! print *,"I START ENERGY" imatupdate=100 + imatupdate2=100 ! if (mod(itime_mat,imatupdate).eq.0) call make_SCSC_inter_list ! real(kind=8), dimension(:),allocatable:: fac_shieldbuf ! real(kind=8), dimension(:,:,:),allocatable:: & @@ -284,7 +296,7 @@ ! allocate(ishield_listbuf(nres)) ! allocate(shield_listbuf(maxcontsshi,nres)) ! endif - +! print *,"wstrain check", wstrain ! print*,"ETOTAL Processor",fg_rank," absolute rank",myrank, ! & " nfgtasks",nfgtasks if (nfgtasks.gt.1) then @@ -333,6 +345,10 @@ weights_(47)=wpepbase weights_(48)=wscpho weights_(49)=wpeppho + weights_(50)=wcatnucl + weights_(56)=wcat_tran + weights_(58)=wlip_prot + weights_(52)=wmartini ! wcatcat= weights(41) ! wcatprot=weights(42) @@ -381,6 +397,10 @@ wpepbase=weights(47) wscpho=weights(48) wpeppho=weights(49) + wcatnucl=weights(50) + wmartini=weights(52) + wcat_tran=weights(56) + wlip_prot=weights(58) ! welpsb=weights(28)*fact(1) ! ! wcorr_nucl= weights(37)*fact(1) @@ -397,9 +417,32 @@ if (nfgtasks.gt.1) then call MPI_Bcast(itime_mat,1,MPI_INT,king,FG_COMM,IERROR) endif + if (nres_molec(1).gt.0) then if (mod(itime_mat,imatupdate).eq.0) call make_SCp_inter_list +! write (iout,*) "after make_SCp_inter_list" if (mod(itime_mat,imatupdate).eq.0) call make_SCSC_inter_list +! write (iout,*) "after make_SCSC_inter_list" + if (nres_molec(4).gt.0) then + if (mod(itime_mat,imatupdate).eq.0) call make_lip_pep_list + endif if (mod(itime_mat,imatupdate).eq.0) call make_pp_inter_list + if (nres_molec(5).gt.0) then + if (mod(itime_mat,imatupdate).eq.0) then +! print *,'Processor',myrank,' calling etotal ipot=',ipot + call make_cat_pep_list +! call make_cat_cat_list + endif + endif + endif + if (nres_molec(5).gt.0) then + if (mod(itime_mat,imatupdate2).eq.0) then +! print *, "before cat cat" +! print *,'Processor',myrank,' calling etotal ipot=',ipot +! call make_cat_pep_list + call make_cat_cat_list + endif + endif +! write (iout,*) "after make_pp_inter_list" ! print *,'Processor',myrank,' calling etotal ipot=',ipot ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct @@ -415,6 +458,7 @@ ! Compute the side-chain and electrostatic interaction energy ! print *, "Before EVDW" ! goto (101,102,103,104,105,106) ipot + if (nres_molec(1).gt.0) then select case(ipot) ! Lennard-Jones potential. ! 101 call elj(evdw) @@ -662,7 +706,7 @@ call escp_soft_sphere(evdw2,evdw2_14) endif ! write(iout,*) "in etotal before ebond",ipot - +! print *,"after escp" ! ! Calculate the bond-stretching energy ! @@ -674,7 +718,7 @@ ! Calculate the disulfide-bridge and other energy and the contributions ! from other distance constraints. ! print *,'Calling EHPB' - call edis(ehpb) +! call edis(ehpb) !elwrite(iout,*) "in etotal afer edis",ipot ! print *,'EHPB exitted succesfully.' ! @@ -699,6 +743,7 @@ ebe=0.0d0 endif ethetacnstr=0.0d0 +! write(iout,*) with_theta_constr,"with_theta_constr" if (with_theta_constr) call etheta_constr(ethetacnstr) ! write(iout,*) "in etotal afer ebe",ipot @@ -708,7 +753,7 @@ ! Calculate the SC local energy. ! call esc(escloc) -!elwrite(iout,*) "in etotal afer esc",ipot +! print *, "in etotal afer esc",wtor ! print *,"Processor",myrank," computed USC" ! ! Calculate the virtual-bond torsional energy. @@ -721,6 +766,7 @@ ! edihcnstr=0 ! endif if (wtor.gt.0.0d0) then +! print *,"WTOR",wtor,tor_mode if (tor_mode.eq.0) then call etor(etors) else @@ -735,12 +781,22 @@ if (ndih_constr.gt.0) call etor_constr(edihcnstr) !c print *,"Processor",myrank," computed Utor" +! print *, "constr_homol",constr_homology ! print *,"Processor",myrank," computed Utor" - + if (constr_homology.ge.1) then + call e_modeller(ehomology_constr) +! print *,'iset=',iset,'me=',me,ehomology_constr, +! & 'Processor',fg_rank,' CG group',kolor, +! & ' absolute rank',MyRank +! print *,"tu" + else + ehomology_constr=0.0d0 + endif + ! ! 6/23/01 Calculate double-torsional energy ! -!elwrite(iout,*) "in etotal",ipot +! print *, "before etor_d",wtor_d if (wtor_d.gt.0) then call etor_d(etors_d) else @@ -787,8 +843,8 @@ ! ! 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" + if((usampl).and.(totT.gt.eq_time)) then + write(iout,*) "usampl",usampl call EconstrQ !elwrite(iout,*) "afeter multibody hb" call Econstr_back @@ -806,6 +862,43 @@ else eliptran=0.0d0 endif + else + eliptran=0.0d0 + evdw=0.0d0 +#ifdef SCP14 + evdw2=0.0d0 + evdw2_14=0.0d0 +#else + evdw2=0.0d0 +#endif +#ifdef SPLITELE + ees=0.0d0 + evdw1=0.0d0 +#else + ees=0.0d0 + evdw1=0.0d0 +#endif + ecorr=0.0d0 + ecorr5=0.0d0 + ecorr6=0.0d0 + eel_loc=0.0d0 + eello_turn3=0.0d0 + eello_turn4=0.0d0 + eturn6=0.0d0 + ebe=0.0d0 + escloc=0.0d0 + etors=0.0d0 + etors_d=0.0d0 + ehpb=0.0d0 + edihcnstr=0.0d0 + estr=0.0d0 + Uconst=0.0d0 + esccor=0.0d0 + ehomology_constr=0.0d0 + ethetacnstr=0.0d0 + endif !nres_molec(1) +! write(iout,*) "TU JEST PRZED EHPB" +! call edis(ehpb) if (fg_rank.eq.0) then if (AFMlog.gt.0) then call AFMforce(Eafmforce) @@ -815,6 +908,7 @@ Eafmforce=0.0d0 endif endif +! print *,"before tubemode",tubemode if (tubemode.eq.1) then call calctube(etube) else if (tubemode.eq.2) then @@ -824,8 +918,11 @@ else etube=0.0d0 endif +! print *, "TU JEST PRZED EHPB" + call edis(ehpb) + !-------------------------------------------------------- -! write (iout,*) "NRES_MOLEC(2),",nres_molec(2) +! print *, "NRES_MOLEC(2),",nres_molec(2) ! print *,"before",ees,evdw1,ecorr ! write(iout,*) ecorr_nucl,"ecorr_nucl",nres_molec(2) if (nres_molec(2).gt.0) then @@ -837,6 +934,7 @@ call epsb(evdwpsb,eelpsb) call esb(esbloc) call multibody_hb_nucl(ecorr_nucl,ecorr3_nucl,n_corr,n_corr1) + call ecat_nucl(ecation_nucl) else etors_nucl=0.0d0 estr_nucl=0.0d0 @@ -851,26 +949,40 @@ evdwpp=0.0d0 eespp=0.0d0 etors_d_nucl=0.0d0 + ecation_nucl=0.0d0 endif ! write(iout,*) ecorr_nucl,"ecorr_nucl",nres_molec(2) ! print *,"before ecatcat",wcatcat if (nres_molec(5).gt.0) then - if (nfgtasks.gt.1) then - if (fg_rank.eq.0) then - call ecatcat(ecationcation) - endif - else - call ecatcat(ecationcation) - endif - if (oldion.gt.0) then - call ecat_prot(ecation_prot) - else - call ecats_prot_amber(ecation_prot) - endif + if (g_ilist_catsctran.gt.0) then + call ecat_prot_transition(ecat_prottran) + else + ecat_prottran=0.0d0 + endif + if (g_ilist_catscang.gt.0) then + call ecat_prot_ang(ecation_protang) + else + ecation_protang=0.0d0 + endif +! if (nfgtasks.gt.1) then +! if (fg_rank.eq.0) then + if (nres_molec(5).gt.1) call ecatcat(ecationcation) +! endif +! else +! if (nres_molec(5).gt.1) call ecatcat(ecationcation) +! endif + if (oldion.gt.0) then + if (g_ilist_catpnorm.gt.0) call ecat_prot(ecation_prot) + else + if (g_ilist_catpnorm.gt.0) call ecats_prot_amber(ecation_prot) + endif else ecationcation=0.0d0 ecation_prot=0.0d0 + ecation_protang=0.0d0 + ecat_prottran=0.0d0 endif + if (g_ilist_catscnorm.eq.0) ecation_prot=0.0d0 if ((nres_molec(2).gt.0).and.(nres_molec(1).gt.0)) then call eprot_sc_base(escbase) call epep_sc_base(epepbase) @@ -882,6 +994,30 @@ escpho=0.0 epeppho=0.0 endif +! MARTINI FORCE FIELD ENERGY TERMS + if (nres_molec(4).gt.0) then + if (nfgtasks.gt.1) then + if (fg_rank.eq.0) then + call lipid_bond(elipbond) + call lipid_angle(elipang) + endif + else + call lipid_bond(elipbond) + call lipid_angle(elipang) + endif + call lipid_LJ(eliplj) + call lipid_elec(elipelec) + if (nres_molec(1).gt.0) then + call elip_prot(elipidprot) + else + elipidprot=0.0d0 + endif + else + elipbond=0.0d0 + elipang=0.0d0 + eliplj=0.0d0 + elipelec=0.0d0 + endif ! call ecatcat(ecationcation) ! print *,"after ebend", wtor_nucl #ifdef TIMING @@ -954,6 +1090,19 @@ energia(48)=escpho energia(49)=epeppho ! energia(50)=ecations_prot_amber + energia(50)=ecation_nucl + energia(51)=ehomology_constr +! energia(51)=homology + energia(52)=elipbond + energia(53)=elipang + energia(54)=eliplj + energia(55)=elipelec + energia(56)=ecat_prottran + energia(57)=ecation_protang + energia(58)=elipidprot +! write(iout,*) elipelec,"elipelec" +! write(iout,*) elipang,"elipang" +! write(iout,*) eliplj,"eliplj" call sum_energy(energia,.true.) if (dyn_ss) call dyn_set_nss ! print *," Processor",myrank," left SUM_ENERGY" @@ -966,7 +1115,7 @@ end subroutine etotal !----------------------------------------------------------------------------- subroutine sum_energy(energia,reduce) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' #ifndef ISNAN external proc_proc @@ -995,10 +1144,12 @@ 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,ecations_prot_amber + ecorr3_nucl,ehomology_constr + real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber,& + ecation_nucl,ecat_prottran,ecation_protang real(kind=8) :: escbase,epepbase,escpho,epeppho integer :: i + real(kind=8) :: elipbond,elipang,eliplj,elipelec,elipidprot #ifdef MPI integer :: ierr real(kind=8) :: time00 @@ -1080,6 +1231,15 @@ epepbase=energia(47) escpho=energia(48) epeppho=energia(49) + ecation_nucl=energia(50) + ehomology_constr=energia(51) + elipbond=energia(52) + elipang=energia(53) + eliplj=energia(54) + elipelec=energia(55) + ecat_prottran=energia(56) + ecation_protang=energia(57) + elipidprot=energia(58) ! ecations_prot_amber=energia(50) ! energia(41)=ecation_prot @@ -1099,7 +1259,15 @@ +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 + +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho+wcatnucl*ecation_nucl& + +(elipbond+elipang+eliplj+elipelec)*wmartini& + +wcat_tran*ecat_prottran+ecation_protang& + +wlip_prot*elipidprot& +#ifdef WHAM_RUN + +0.0d0 +#else + +ehomology_constr +#endif #else etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) & +wang*ebe+wtor*etors+wscloc*escloc & @@ -1113,7 +1281,15 @@ +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 + +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho+wcatnucl*ecation_nucl& + +(elipbond+elipang+eliplj+elipelec)*wmartini& + +wcat_tran*ecat_prottran+ecation_protang& + +wlip_prot*elipidprot& +#ifdef WHAM_RUN + +0.0d0 +#else + +ehomology_constr +#endif #endif energia(0)=etot ! detecting NaNQ @@ -1141,7 +1317,7 @@ end subroutine sum_energy !----------------------------------------------------------------------------- subroutine rescale_weights(t_bath) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) #ifdef MPI include 'mpif.h' #endif @@ -1231,7 +1407,7 @@ end subroutine rescale_weights !----------------------------------------------------------------------------- subroutine enerprint(energia) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.FFIELD' @@ -1245,10 +1421,11 @@ 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,ecations_prot_amber + ecorr3_nucl,ehomology_constr + real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber,& + ecation_nucl,ecat_prottran,ecation_protang real(kind=8) :: escbase,epepbase,escpho,epeppho - + real(kind=8) :: elipbond,elipang,eliplj,elipelec,elipidprot etot=energia(0) evdw=energia(1) evdw2=energia(2) @@ -1300,6 +1477,15 @@ epepbase=energia(47) escpho=energia(48) epeppho=energia(49) + ecation_nucl=energia(50) + elipbond=energia(52) + elipang=energia(53) + eliplj=energia(54) + elipelec=energia(55) + ecat_prottran=energia(56) + ecation_protang=energia(57) + ehomology_constr=energia(51) + elipidprot=energia(58) ! ecations_prot_amber=energia(50) #ifdef SPLITELE write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,& @@ -1314,9 +1500,12 @@ 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, & + ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,& + ecat_prottran,wcat_tran,ecation_protang,wcat_ang,& + ecationcation,wcatcat, & escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,& - etot + ecation_nucl,wcatnucl,ehomology_constr,& + elipbond,elipang,eliplj,elipelec,elipidprot,wlip_prot,etot 10 format (/'Virtual-chain energies:'// & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ & @@ -1358,11 +1547,20 @@ '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)'/ & + 'ECATPTRAN=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot tran)'/ & + 'ECATPANG=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot angle)'/ & '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)'/& + 'ECATBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(cation nucl-base)'/& + 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/& + 'ELIPBOND=',1pE16.6,'(matrini bond energy)'/& + 'ELIPANG=',1pE16.6,'(matrini angle energy)'/& + 'ELIPLJ=',1pE16.6,'(matrini Lennard-Jones energy)'/& + 'ELIPELEC=',1pE16.6,'(matrini electrostatic energy)'/& + 'ELIPPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(lipid prot)'/ & 'ETOT= ',1pE16.6,' (total)') #else write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,& @@ -1372,14 +1570,14 @@ ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,& eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,& ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforce, & - etube,wtube, & + etube,wtube, ehomology_constr,& 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 + ecation_nucl,wcatnucl,ehomology_constr,elipidprot,wlip_prot,etot 10 format (/'Virtual-chain energies:'// & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ & @@ -1425,6 +1623,13 @@ '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)'/& + 'ECATBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(cation nucl-base)'/& + 'H_CONS=',1pE16.6,' (Homology model constraints energy)'/& + 'ELIPBOND=',1pE16.6,'(matrini bond energy)'/& + 'ELIPANG=',1pE16.6,'(matrini angle energy)'/& + 'ELIPLJ=',1pE16.6,'(matrini Lennard-Jones energy)'/& + 'ELIPELEC=',1pE16.6,'(matrini electrostatic energy)'/& + 'ELIPPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(lipid prot)'/ & 'ETOT= ',1pE16.6,' (total)') #endif return @@ -1435,7 +1640,7 @@ ! This subroutine calculates the interaction energy of nonbonded side chains ! assuming the LJ potential of interaction. ! -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' real(kind=8),parameter :: accur=1.0d-10 ! include 'COMMON.GEO' @@ -1616,7 +1821,7 @@ ! This subroutine calculates the interaction energy of nonbonded side chains ! assuming the LJK potential of interaction. ! -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -1720,7 +1925,7 @@ ! use comm_srutu use calc_data -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -1862,7 +2067,7 @@ ! assuming the Gay-Berne potential of interaction. ! use calc_data -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -1877,7 +2082,7 @@ ! include 'COMMON.SBRIDGE' logical :: lprn !el local variables - integer :: iint,itypi,itypi1,itypj,subchap,icont + integer :: iint,itypi,itypi1,itypj,subchap,icont,countss 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,& @@ -1890,6 +2095,7 @@ ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 lprn=.false. + countss=0 ! if (icall.eq.0) lprn=.false. !el ind=0 dCAVdOM2=0.0d0 @@ -1898,12 +2104,12 @@ dCAVdOM1=0.0d0 dGCLdOM1=0.0d0 dPOLdOM1=0.0d0 - - +! write (iout,*) "RWA", g_listscsc_start,g_listscsc_end,i,j + if (nres_molec(1).eq.0) return do icont=g_listscsc_start,g_listscsc_end i=newcontlisti(icont) j=newcontlistj(icont) - +! write (iout,*) "RWA", g_listscsc_start,g_listscsc_end,i,j ! do i=iatsc_s,iatsc_e !C print *,"I am in EVDW",i itypi=iabs(itype(i,1)) @@ -1929,13 +2135,14 @@ ! 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) + countss=countss+1 + call dyn_ssbond_ene(i,j,evdwij,countss) 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) + do k=j+1,nres !C search over all next residues if (dyn_ss_mask(k)) then !C check if they are cysteins @@ -1991,6 +2198,7 @@ zj=c(3,nres+j) call to_box(xj,yj,zj) call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) +! write (iout,*) "KWA2", itypi,itypj 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 & @@ -2060,7 +2268,7 @@ endif if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2e10.2,e11.3)')& - 'evdw',i,j,evdwij,xi,xj,rij !,"egb" + 'evdw',i,j,evdwij,1.0D0/rij,1.0D0/rij_shift,dabs(aa/bb)**(1.0D0/6.0D0)!,"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 @@ -2110,7 +2318,7 @@ ! use comm_srutu use calc_data -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -2257,7 +2465,7 @@ ! This subroutine calculates the interaction energy of nonbonded side chains ! assuming the LJ potential of interaction. ! -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' real(kind=8),parameter :: accur=1.0d-10 ! include 'COMMON.GEO' @@ -2340,7 +2548,7 @@ ! ! Soft-sphere potential of p-p interaction ! -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.CONTROL' ! include 'COMMON.IOUNITS' @@ -2440,7 +2648,7 @@ end subroutine eelec_soft_sphere !----------------------------------------------------------------------------- subroutine vec_and_deriv -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' #ifdef MPI include 'mpif.h' @@ -2627,7 +2835,7 @@ end subroutine vec_and_deriv !----------------------------------------------------------------------------- subroutine check_vecgrad -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.GEO' @@ -2715,7 +2923,7 @@ end subroutine check_vecgrad !----------------------------------------------------------------------------- subroutine set_matrices -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' #ifdef MPI include "mpif.h" @@ -2735,7 +2943,7 @@ ! include 'COMMON.VECTORS' ! include 'COMMON.FFIELD' real(kind=8) :: auxvec(2),auxmat(2,2) - integer :: i,iti1,iti,k,l + integer :: i,iti1,iti,k,l,ii,innt,inct real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2,cost1,sint1,& sint1sq,sint1cub,sint1cost1,b1k,b2k,aux ! print *,"in set matrices" @@ -2750,6 +2958,35 @@ #else do i=3,nres+1 #endif +#ifdef FIVEDIAG + ii=ireschain(i-2) +!c write (iout,*) "i",i,i-2," ii",ii + if (ii.eq.0) cycle + innt=chain_border(1,ii) + inct=chain_border(2,ii) +!c write (iout,*) "i",i,i-2," ii",ii," innt",innt," inct",inct +!c if (i.gt. nnt+2 .and. i.lt.nct+2) then + if (i.gt. innt+2 .and. i.lt.inct+2) then + if (itype(i-2,1).eq.0) then + iti = nloctyp + else + iti = itype2loc(itype(i-2,1)) + endif + else + iti=nloctyp + endif +!c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then + if (i.gt. innt+1 .and. i.lt.inct+1) then +! iti1 = itype2loc(itype(i-1)) + if (itype(i-1,1).eq.0) then + iti1 = nloctyp + else + iti1 = itype2loc(itype(i-1,1)) + endif + else + iti1=nloctyp + endif +#else if (i.gt. nnt+2 .and. i.lt.nct+2) then if (itype(i-2,1).eq.0) then iti = nloctyp @@ -2765,6 +3002,7 @@ else iti1=nloctyp endif +#endif ! print *,i,itype(i-2,1),iti #ifdef NEWCORR cost1=dcos(theta(i-1)) @@ -2852,7 +3090,7 @@ write (iout,*) 'theta=', theta(i-1) #endif #else - if (i.gt. nnt+2 .and. i.lt.nct+2) then + if (i.gt. innt+2 .and. i.lt.inct+2) then ! write(iout,*) "i,",molnum(i),nloctyp ! print *, "i,",molnum(i),i,itype(i-2,1) if (molnum(i).eq.1) then @@ -2909,7 +3147,8 @@ #endif ! print *,i,"i" - if (i .lt. nres+1) then + if (i .lt. nres+1 .and. (itype(i-1,1).lt.ntyp1).and.(itype(i-1,1).ne.0)) then +! if (i .lt. nres+1) then sin1=dsin(phi(i)) cos1=dcos(phi(i)) sintab(i-2)=sin1 @@ -2946,7 +3185,7 @@ Ug2(2,1,i-2)=0.0d0 Ug2(2,2,i-2)=0.0d0 endif - if (i .gt. 3 .and. i .lt. nres+1) then + if (i .gt. 3) then ! .and. i .lt. nres+1) then obrot_der(1,i-2)=-sin1 obrot_der(2,i-2)= cos1 Ugder(1,1,i-2)= sin1 @@ -3359,7 +3598,7 @@ ! the orientation of the CA-CA virtual bonds. ! use comm_locel -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) #ifdef MPI include 'mpif.h' #endif @@ -3431,6 +3670,7 @@ eel_loc=0.0d0 eello_turn3=0.0d0 eello_turn4=0.0d0 + if (nres_molec(1).eq.0) return ! if (icheckgrad.eq.1) then @@ -3590,7 +3830,7 @@ subroutine eelecij(i,j,ees,evdw1,eel_loc) use comm_locel -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' #ifdef MPI include "mpif.h" @@ -4651,7 +4891,7 @@ ! Third- and fourth-order contributions from turns use comm_locel -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.GEO' @@ -4682,36 +4922,14 @@ !el num_conti,j1,j2 !el local variables integer :: i,j,l,k,ilist,iresshield - real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield - + real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield,xj,yj + xj=0.0d0 + yj=0.0d0 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 + call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) a_temp(1,1)=a22 a_temp(1,2)=a23 @@ -4890,7 +5108,7 @@ ! Third- and fourth-order contributions from turns use comm_locel -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.GEO' @@ -4925,8 +5143,9 @@ !el local variables integer :: i,j,iti1,iti2,iti3,l,k,ilist,iresshield real(kind=8) :: eello_turn4,s1,s2,s3,zj,fracinbuf,eello_t4,& - rlocshield,gs23,gs32,gsE13,gs13,gs21,gsE31,gsEE1,gsEE2,gsEE3 - + rlocshield,gs23,gs32,gsE13,gs13,gs21,gsE31,gsEE1,gsEE2,gsEE3,xj,yj + xj=0.0d0 + yj=0.0d0 j=i+3 ! if (j.ne.20) return ! print *,i,j,gshieldc_t4(2,j),gshieldc_t4(2,j+1) @@ -4944,30 +5163,9 @@ !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 + call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + a_temp(1,1)=a22 a_temp(1,2)=a23 @@ -5086,14 +5284,19 @@ #ifdef NEWCORR gloc(nphi+i,icg)=gloc(nphi+i,icg)& -(gs13+gsE13+gsEE1)*wturn4& - *fac_shield(i)*fac_shield(j) + *fac_shield(i)*fac_shield(j) & + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) + gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)& -(gs23+gs21+gsEE2)*wturn4& - *fac_shield(i)*fac_shield(j) + *fac_shield(i)*fac_shield(j)& + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)& -(gs32+gsE31+gsEE3)*wturn4& - *fac_shield(i)*fac_shield(j) + *fac_shield(i)*fac_shield(j)& + *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) + !c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)- !c & gs2 @@ -5287,7 +5490,7 @@ ! peptide-group centers and side chains and its gradient in virtual-bond and ! side-chain vectors. ! -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -5394,7 +5597,7 @@ ! peptide-group centers and side chains and its gradient in virtual-bond and ! side-chain vectors. ! -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -5407,7 +5610,7 @@ ! include 'COMMON.CONTROL' real(kind=8),dimension(3) :: ggg !el local variables - integer :: i,iint,j,k,iteli,itypj,subchap,icont + integer :: i,iint,j,k,iteli,itypj,subchap,iconta real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,& e1,e2,evdwij,rij real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,& @@ -5419,16 +5622,18 @@ !d print '(a)','Enter ESCP' !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e ! do i=iatscp_s,iatscp_e - do icont=g_listscp_start,g_listscp_end - i=newcontlistscpi(icont) - j=newcontlistscpj(icont) + if (nres_molec(1).eq.0) return + do iconta=g_listscp_start,g_listscp_end +! print *,"icont",iconta,g_listscp_start,g_listscp_end + i=newcontlistscpi(iconta) + j=newcontlistscpj(iconta) 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)) call to_box(xi,yi,zi) - +! print *,itel(i),i,j ! do iint=1,nscp_gr(i) ! do j=iscpstart(i,iint),iscpend(i,iint) @@ -5445,12 +5650,6 @@ 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 call to_box(xj,yj,zj) xj=boxshift(xj-xi,boxxsize) @@ -5544,7 +5743,7 @@ ! ! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors. ! -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.SBRIDGE' ! include 'COMMON.CHAIN' @@ -5552,18 +5751,19 @@ ! include 'COMMON.VAR' ! include 'COMMON.INTERACT' ! include 'COMMON.IOUNITS' - real(kind=8),dimension(3) :: ggg + real(kind=8),dimension(3) :: ggg,vec !el local variables - integer :: i,j,ii,jj,iii,jjj,k - real(kind=8) :: fac,eij,rdis,ehpb,dd,waga + integer :: i,j,ii,jj,iii,jjj,k,mnumii,mnumjj + real(kind=8) :: fac,eij,rdis,ehpb,dd,waga,xi,yi,zi,zj,yj,xj ehpb=0.0D0 -!d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr -!d write(iout,*)'link_start=',link_start,' link_end=',link_end +! write(iout,*)'edis: nhpb=',nhpb!,' fbr=',fbr +! write(iout,*)'link_start=',link_start,' link_end=',link_end if (link_end.eq.0) return do i=link_start,link_end ! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a ! CA-CA distance used in regularization of structure. + ii=ihpb(i) jj=jhpb(i) ! iii and jjj point to the residues for which the distance is assigned. @@ -5574,6 +5774,14 @@ iii=ii jjj=jj endif + do j=1,3 + vec(j)=c(j,jj)-c(j,ii) + enddo + mnumii=molnum(iii) + mnumjj=molnum(jjj) + if (energy_dec) write(iout,*) i,ii,jj,mnumii,mnumjj,itype(jjj,mnumjj),itype(iii,mnumii) + if ((itype(iii,mnumii).gt.ntyp_molec(mnumii)).or.(itype(jjj,mnumjj).gt.ntyp_molec(mnumjj))) cycle + ! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj, ! & dhpb(i),dhpb1(i),forcon(i) ! 24/11/03 AL: SS bridges handled separately because of introducing a specific @@ -5586,7 +5794,7 @@ iabs(itype(jjj,1)).eq.1) then call ssbond_ene(iii,jjj,eij) ehpb=ehpb+2*eij -!d write (iout,*) "eij",eij +! write (iout,*) "eij",eij,iii,jjj endif else if (ii.gt.nres .and. jj.gt.nres) then !c Restraints from contact prediction @@ -5631,6 +5839,7 @@ enddo else dd=dist(ii,jj) + if (constr_dist.eq.11) then ehpb=ehpb+fordepth(i)**4.0d0 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i)) @@ -5645,11 +5854,29 @@ !c write (iout,*) "alph nmr", !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i)) else + xi=c(1,ii) + yi=c(2,ii) + zi=c(3,ii) + call to_box(xi,yi,zi) + xj=c(1,jj) + yj=c(2,jj) + zj=c(3,jj) + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) + vec(1)=xj + vec(2)=yj + vec(3)=zj + dd=sqrt(xj*xj+yj*yj+zj*zj) 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 + if (energy_dec) write (iout,'(a6,2i5,5f10.3)') "edis",ii,jj, & + ehpb,dd,dhpb(i),waga,rdis + !c write (iout,*) "alpha reg",dd,waga*rdis*rdis !C !C Evaluate gradient. @@ -5659,7 +5886,7 @@ endif do j=1,3 - ggg(j)=fac*(c(j,jj)-c(j,ii)) + ggg(j)=fac*vec(j) 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 @@ -5694,7 +5921,7 @@ ! ! A. Liwo and U. Kozlowska, 11/24/03 ! -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.SBRIDGE' ! include 'COMMON.CHAIN' @@ -5715,6 +5942,8 @@ xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + call to_box(xi,yi,zi) + dxi=dc_norm(1,nres+i) dyi=dc_norm(2,nres+i) dzi=dc_norm(3,nres+i) @@ -5723,9 +5952,13 @@ itypj=iabs(itype(j,1)) ! dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(nres+j) - 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) + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -5750,9 +5983,9 @@ eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) & +akct*deltad*deltat12 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr -! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth, -! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2, -! & " deltat12",deltat12," eij",eij +! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth, & +! " akct",akct," deltad",deltad," deltat",deltat1,deltat2, & +! " deltat12",deltat12," eij",eij ed=2*akcm*deltad+akct*deltat12 pom1=akct*deltad pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi @@ -5785,7 +6018,7 @@ ! ! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds ! -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.LOCAL' ! include 'COMMON.GEO' @@ -5810,6 +6043,10 @@ ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres) do i=ibondp_start,ibondp_end +#ifdef FIVEDIAG + if (itype(i-1,1).eq.ntyp1 .or. itype(i,1).eq.ntyp1) cycle + diff = vbld(i)-vbldp0 +#else 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) @@ -5823,6 +6060,7 @@ else diff = vbld(i)-vbldp0 endif +#endif if (energy_dec) write (iout,'(a7,i5,4f7.3)') & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff estr=estr+diff*diff @@ -5898,7 +6136,7 @@ ! angles gamma and its derivatives in consecutive thetas and gammas. ! use comm_calcthet -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.LOCAL' ! include 'COMMON.GEO' @@ -6039,7 +6277,7 @@ subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc) use comm_calcthet -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.LOCAL' ! include 'COMMON.IOUNITS' @@ -6134,7 +6372,7 @@ ! ab initio-derived potentials from ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203 ! -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.LOCAL' ! include 'COMMON.GEO' @@ -6345,7 +6583,7 @@ ! ALPHA and OMEGA. ! use comm_sccalc -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.LOCAL' @@ -6470,7 +6708,7 @@ subroutine enesc(x,escloci,dersc,ddersc,mixed) use comm_sccalc -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.LOCAL' @@ -6579,7 +6817,7 @@ subroutine enesc_bound(x,escloci,dersc,dersc12,mixed) use comm_sccalc -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.LOCAL' @@ -6660,7 +6898,7 @@ ! added by Urszula Kozlowska. 07/11/2007 ! use comm_sccalc -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.LOCAL' @@ -6678,11 +6916,11 @@ real(kind=8),dimension(65) :: 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 - real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t + real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t,gradene 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 !el local variables - integer :: i,j,k !el,it,nlobit + integer :: i,j,k,iti !el,it,nlobit real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta !el real(kind=8) :: time11,time12,time112,theti !el common /sccalc/ time11,time12,time112,theti,it,nlobit @@ -6701,6 +6939,9 @@ delta=0.02d0*pi escloc=0.0D0 do i=loc_start,loc_end + gscloc(:,i)=0.0d0 + gsclocx(:,i)=0.0d0 +! th_gsclocm1(:,i-1)=0.0d0 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)) @@ -6711,7 +6952,50 @@ sinfac2=0.5d0/(1.0d0-costtab(i+1)) sinfac=dsqrt(sinfac2) it=iabs(itype(i,1)) + iti=it + if (iti.eq.ntyp1 .or. iti.eq.10) cycle +!c AL 3/30/2022 handle the cases of an isolated-residue chain + if (i.eq.nnt .and. itype(i+1,1).eq.ntyp1) cycle + if (i.eq.nct .and. itype(i-1,1).eq.ntyp1) cycle +! costtab(i+1) =dcos(theta(i+1)) if (it.eq.10) goto 1 +#ifdef SC_END + if (i.eq.nct .or. itype(i+1,1).eq.ntyp1) then +!c AL 3/30/2022 handle a sidechain of a loose C-end + cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres)) + sumene=arotam_end(0,1,iti)+& + tschebyshev(1,nterm_scend(1,iti),arotam_end(1,1,iti),cossc1) + escloc=escloc+sumene + gradene=gradtschebyshev(0,nterm_scend(1,iti)-1,& + arotam_end(1,1,iti),cossc1) + gscloc(:,i-1)=gscloc(:,i-1)+& + vbld_inv(i)*(dC_norm(:,i+nres)-dC_norm(:,i-1)& + *cossc1)*gradene + gsclocx(:,i)=gsclocx(:,i)+vbld_inv(i+nres)*& + (dC_norm(:,i-1)-dC_norm(:,i+nres)*cossc1)*gradene +#ifdef ENERGY_DEC + if (energy_dec) write (2,'(2hC ,a3,i6,2(a,f10.5))')& + restyp(iti,1),i," angle",rad2deg*dacos(cossc1)," escloc",sumene +#endif + else if (i.eq.nnt .or. itype(i-1,1).eq.ntyp1) then +!c AL 3/30/2022 handle a sidechain of a loose N-end + cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres)) + sumene=arotam_end(0,2,iti)+& + tschebyshev(1,nterm_scend(2,iti),arotam_end(1,2,iti),cossc) + escloc=escloc+sumene + gradene=gradtschebyshev(0,nterm_scend(2,iti)-1,& + arotam_end(1,2,iti),cossc) + gscloc(:,i)=gscloc(:,i)+& + vbld_inv(i+1)*(dC_norm(:,i+nres)-dC_norm(:,i)& + *cossc)*gradene + gsclocx(:,i)=gsclocx(:,i)+vbld_inv(i+nres)*& + (dC_norm(:,i)-dC_norm(:,i+nres)*cossc)*gradene +#ifdef ENERGY_DEC + if (energy_dec) write (2,'(2hN ,a3,i6,2(a,f10.5))') + & restyp(iti),i," angle",rad2deg*dacos(cossc)," escloc",sumene +#endif + else +#endif ! ! Compute the axes of tghe local cartesian coordinates system; store in ! x_prime, y_prime and z_prime @@ -6990,7 +7274,9 @@ ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3) ! to check gradient call subroutine check_grad - +#ifdef SC_END + endif +#endif 1 continue enddo return @@ -7071,7 +7357,7 @@ end subroutine gcont !----------------------------------------------------------------------------- subroutine splinthet(theti,delta,ss,ssder) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.VAR' ! include 'COMMON.GEO' @@ -7120,7 +7406,7 @@ #ifdef CRYST_TOR !----------------------------------------------------------------------------- subroutine etor(etors,edihcnstr) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.VAR' ! include 'COMMON.GEO' @@ -7221,10 +7507,19 @@ etors_d=0.0d0 return end subroutine etor_d +!----------------------------------------------------------------------------- +!c LICZENIE WIEZOW Z ROWNANIA ENERGII MODELLERA + subroutine e_modeller(ehomology_constr) + real(kind=8) :: ehomology_constr + ehomology_constr=0.0d0 + write (iout,*) "!!!!!UWAGA, JESTEM W DZIWNEJ PETLI, TEST!!!!!" + return + end subroutine e_modeller +C !!!!!!!! NIE CZYTANE !!!!!!!!!!! #else !----------------------------------------------------------------------------- subroutine etor(etors) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.VAR' ! include 'COMMON.GEO' @@ -7317,7 +7612,7 @@ gradvalst2,etori logical lprn integer :: i,j,itori,itori1,nval,k,l - +! lprn=.true. if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode etors=0.0D0 do i=iphi_start,iphi_end @@ -7480,7 +7775,7 @@ !----------------------------------------------------------------------------- subroutine etor_d(etors_d) ! 6/23/01 Compute double torsional energy -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.VAR' ! include 'COMMON.GEO' @@ -7567,60 +7862,704 @@ return end subroutine etor_d #endif +!---------------------------------------------------------------------------- +!---------------------------------------------------------------------------- + subroutine e_modeller(ehomology_constr) +! implicit none +! include 'DIMENSIONS' + use MD_data, only: iset + real(kind=8) :: ehomology_constr + integer nnn,i,ii,j,k,ijk,jik,ki,kk,nexl,irec,l + integer katy, odleglosci, test7 + real(kind=8) :: odleg, odleg2, odleg3, kat, kat2, kat3 + real(kind=8) :: Eval,Erot,min_odl + real(kind=8),dimension(constr_homology) :: distance,distancek,godl,dih_diff,gdih, & + gtheta,dscdiff, & + uscdiffk,guscdiff2,guscdiff3,& + theta_diff + + +! +! FP - 30/10/2014 Temporary specifications for homology restraints +! + real(kind=8) :: utheta_i,gutheta_i,sum_gtheta,sum_sgtheta,& + sgtheta + real(kind=8), dimension (nres) :: guscdiff,usc_diff + real(kind=8) :: sum_godl,sgodl,grad_odl3,ggodl,sum_gdih,& + sum_guscdiff,sum_sgdih,sgdih,grad_dih3,usc_diff_i,dxx,dyy,dzz,& + betai,sum_sgodl,dij,max_template +! real(kind=8) :: dist,pinorm +! +! include 'COMMON.SBRIDGE' +! include 'COMMON.CHAIN' +! include 'COMMON.GEO' +! include 'COMMON.DERIV' +! include 'COMMON.LOCAL' +! include 'COMMON.INTERACT' +! include 'COMMON.VAR' +! include 'COMMON.IOUNITS' +! include 'COMMON.MD' +! include 'COMMON.CONTROL' +! include 'COMMON.HOMOLOGY' +! include 'COMMON.QRESTR' +! +! From subroutine Econstr_back +! +! include 'COMMON.NAMES' +! include 'COMMON.TIME1' +! - subroutine ebend_kcc(etheta) - logical lprn - double precision thybt1(maxang_kcc),etheta - integer :: i,iti,j,ihelp - real (kind=8) :: sinthet,costhet,sumth1thyb,gradthybt1 -!C Set lprn=.true. for debugging - lprn=energy_dec -!c lprn=.true. -!C print *,"wchodze kcc" - if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode - etheta=0.0D0 - do i=ithet_start,ithet_end -!c print *,i,itype(i-1),itype(i),itype(i-2) - if ((itype(i-1,1).eq.ntyp1).or.itype(i-2,1).eq.ntyp1 & - .or.itype(i,1).eq.ntyp1) cycle - iti=iabs(itortyp(itype(i-1,1))) - sinthet=dsin(theta(i)) - costhet=dcos(theta(i)) - do j=1,nbend_kcc_Tb(iti) - thybt1(j)=v1bend_chyb(j,iti) - enddo - sumth1thyb=v1bend_chyb(0,iti)+ & - tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet) - if (lprn) write (iout,*) i-1,itype(i-1,1),iti,theta(i)*rad2deg,& - sumth1thyb - ihelp=nbend_kcc_Tb(iti)-1 - gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet) - etheta=etheta+sumth1thyb -!C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0) - gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet + + do i=1,max_template + distancek(i)=9999999.9 enddo - return - end subroutine ebend_kcc -!c------------ -!c------------------------------------------------------------------------------------- - subroutine etheta_constr(ethetacnstr) - real (kind=8) :: ethetacnstr,thetiii,difi - integer :: i,itheta - ethetacnstr=0.0d0 -!C 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) & + + + odleg=0.0d0 + +! Pseudo-energy and gradient from homology restraints (MODELLER-like +! function) +! AL 5/2/14 - Introduce list of restraints +! write(iout,*) "waga_theta",waga_theta,"waga_d",waga_d +#ifdef DEBUG + write(iout,*) "------- dist restrs start -------" +#endif + do ii = link_start_homo,link_end_homo + i = ires_homo(ii) + j = jres_homo(ii) + dij=dist(i,j) +! write (iout,*) "dij(",i,j,") =",dij + nexl=0 + do k=1,constr_homology +! write(iout,*) ii,k,i,j,l_homo(k,ii),dij,odl(k,ii) + if(.not.l_homo(k,ii)) then + nexl=nexl+1 + cycle + endif + distance(k)=odl(k,ii)-dij +! write (iout,*) "distance(",k,") =",distance(k) +! +! For Gaussian-type Urestr +! + distancek(k)=0.5d0*distance(k)**2*sigma_odl(k,ii) ! waga_dist rmvd from Gaussian argument +! write (iout,*) "sigma_odl(",k,ii,") =",sigma_odl(k,ii) +! write (iout,*) "distancek(",k,") =",distancek(k) +! distancek(k)=0.5d0*waga_dist*distance(k)**2*sigma_odl(k,ii) +! +! For Lorentzian-type Urestr +! + if (waga_dist.lt.0.0d0) then + sigma_odlir(k,ii)=dsqrt(1/sigma_odl(k,ii)) + distancek(k)=distance(k)**2/(sigma_odlir(k,ii)* & + (distance(k)**2+sigma_odlir(k,ii)**2)) + endif + enddo + +! min_odl=minval(distancek) + if (nexl.gt.0) then + min_odl=0.0d0 + else + do kk=1,constr_homology + if(l_homo(kk,ii)) then + min_odl=distancek(kk) + exit + endif + enddo + do kk=1,constr_homology + if (l_homo(kk,ii) .and. distancek(kk).lt.min_odl) & + min_odl=distancek(kk) + enddo + endif + +! write (iout,* )"min_odl",min_odl +#ifdef DEBUG + write (iout,*) "ij dij",i,j,dij + write (iout,*) "distance",(distance(k),k=1,constr_homology) + write (iout,*) "distancek",(distancek(k),k=1,constr_homology) + write (iout,* )"min_odl",min_odl +#endif +#ifdef OLDRESTR + odleg2=0.0d0 +#else + if (waga_dist.ge.0.0d0) then + odleg2=nexl + else + odleg2=0.0d0 + endif +#endif + do k=1,constr_homology +! Nie wiem po co to liczycie jeszcze raz! +! odleg3=-waga_dist(iset)*((distance(i,j,k)**2)/ +! & (2*(sigma_odl(i,j,k))**2)) + if(.not.l_homo(k,ii)) cycle + if (waga_dist.ge.0.0d0) then +! +! For Gaussian-type Urestr +! + godl(k)=dexp(-distancek(k)+min_odl) + odleg2=odleg2+godl(k) +! +! For Lorentzian-type Urestr +! + else + odleg2=odleg2+distancek(k) + endif + +!cc write(iout,779) i,j,k, "odleg2=",odleg2, "odleg3=", odleg3, +!cc & "dEXP(odleg3)=", dEXP(odleg3),"distance(i,j,k)^2=", +!cc & distance(i,j,k)**2, "dist(i+1,j+1)=", dist(i+1,j+1), +!cc & "sigma_odl(i,j,k)=", sigma_odl(i,j,k) + + enddo +! write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents +! write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps +#ifdef DEBUG + write (iout,*) "godl",(godl(k),k=1,constr_homology) ! exponents + write (iout,*) "ii i j",ii,i,j," odleg2",odleg2 ! sum of exps +#endif + if (waga_dist.ge.0.0d0) then +! +! For Gaussian-type Urestr +! + odleg=odleg-dLOG(odleg2/constr_homology)+min_odl +! +! For Lorentzian-type Urestr +! + else + odleg=odleg+odleg2/constr_homology + endif +! +! write (iout,*) "odleg",odleg ! sum of -ln-s +! Gradient +! +! For Gaussian-type Urestr +! + if (waga_dist.ge.0.0d0) sum_godl=odleg2 + sum_sgodl=0.0d0 + do k=1,constr_homology +! godl=dexp(((-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2)) +! & *waga_dist)+min_odl +! sgodl=-godl(k)*distance(k)*sigma_odl(k,ii)*waga_dist +! + if(.not.l_homo(k,ii)) cycle + if (waga_dist.ge.0.0d0) then +! For Gaussian-type Urestr +! + sgodl=-godl(k)*distance(k)*sigma_odl(k,ii) ! waga_dist rmvd +! +! For Lorentzian-type Urestr +! + else + sgodl=-2*sigma_odlir(k,ii)*(distance(k)/(distance(k)**2+ & + sigma_odlir(k,ii)**2)**2) + endif + sum_sgodl=sum_sgodl+sgodl + +! sgodl2=sgodl2+sgodl +! write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE1" +! write(iout,*) "constr_homology=",constr_homology +! write(iout,*) i, j, k, "TEST K" + enddo +! print *, "ok",iset + if (waga_dist.ge.0.0d0) then +! +! For Gaussian-type Urestr +! + grad_odl3=waga_homology(iset)*waga_dist & + *sum_sgodl/(sum_godl*dij) +! print *, "ok" +! +! For Lorentzian-type Urestr +! + else +! Original grad expr modified by analogy w Gaussian-type Urestr grad +! grad_odl3=-waga_homology(iset)*waga_dist*sum_sgodl + grad_odl3=-waga_homology(iset)*waga_dist* & + sum_sgodl/(constr_homology*dij) +! print *, "ok2" + endif +! +! grad_odl3=sum_sgodl/(sum_godl*dij) + + +! write(iout,*) i, j, k, distance(i,j,k), "W GRADIENCIE2" +! write(iout,*) (distance(i,j,k)**2), (2*(sigma_odl(i,j,k))**2), +! & (-(distance(i,j,k)**2)/(2*(sigma_odl(i,j,k))**2)) + +!cc write(iout,*) godl, sgodl, grad_odl3 + +! grad_odl=grad_odl+grad_odl3 + + do jik=1,3 + ggodl=grad_odl3*(c(jik,i)-c(jik,j)) +!cc write(iout,*) c(jik,i+1), c(jik,j+1), (c(jik,i+1)-c(jik,j+1)) +!cc write(iout,746) "GRAD_ODL_1", i, j, jik, ggodl, +!cc & ghpbc(jik,i+1), ghpbc(jik,j+1) + ghpbc(jik,i)=ghpbc(jik,i)+ggodl + ghpbc(jik,j)=ghpbc(jik,j)-ggodl +!cc write(iout,746) "GRAD_ODL_2", i, j, jik, ggodl, +!cc & ghpbc(jik,i+1), ghpbc(jik,j+1) +! if (i.eq.25.and.j.eq.27) then +! write(iout,*) "jik",jik,"i",i,"j",j +! write(iout,*) "sum_sgodl",sum_sgodl,"sgodl",sgodl +! write(iout,*) "grad_odl3",grad_odl3 +! write(iout,*) "c(",jik,i,")",c(jik,i),"c(",jik,j,")",c(jik,j) +! write(iout,*) "ggodl",ggodl +! write(iout,*) "ghpbc(",jik,i,")", +! & ghpbc(jik,i),"ghpbc(",jik,j,")", +! & ghpbc(jik,j) +! endif + enddo +!cc write(iout,778)"TEST: odleg2=", odleg2, "DLOG(odleg2)=", +!cc & dLOG(odleg2),"-odleg=", -odleg + + enddo ! ii-loop for dist +#ifdef DEBUG + write(iout,*) "------- dist restrs end -------" +! if (waga_angle.eq.1.0d0 .or. waga_theta.eq.1.0d0 .or. +! & waga_d.eq.1.0d0) call sum_gradient +#endif +! Pseudo-energy and gradient from dihedral-angle restraints from +! homology templates +! write (iout,*) "End of distance loop" +! call flush(iout) + kat=0.0d0 +! write (iout,*) idihconstr_start_homo,idihconstr_end_homo +#ifdef DEBUG + write(iout,*) "------- dih restrs start -------" + do i=idihconstr_start_homo,idihconstr_end_homo + write (iout,*) "gloc_init(",i,icg,")",gloc(i,icg) + enddo +#endif + do i=idihconstr_start_homo,idihconstr_end_homo + kat2=0.0d0 +! betai=beta(i,i+1,i+2,i+3) + betai = phi(i) +! write (iout,*) "betai =",betai + do k=1,constr_homology + dih_diff(k)=pinorm(dih(k,i)-betai) +!d write (iout,'(a8,2i4,2f15.8)') "dih_diff",i,k,dih_diff(k) +!d & ,sigma_dih(k,i) +! if (dih_diff(i,k).gt.3.14159) dih_diff(i,k)= +! & -(6.28318-dih_diff(i,k)) +! if (dih_diff(i,k).lt.-3.14159) dih_diff(i,k)= +! & 6.28318+dih_diff(i,k) +#ifdef OLD_DIHED + kat3=-0.5d0*dih_diff(k)**2*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument +#else + kat3=(dcos(dih_diff(k))-1)*sigma_dih(k,i) ! waga_angle rmvd from Gaussian argument +#endif +! kat3=-0.5d0*waga_angle*dih_diff(k)**2*sigma_dih(k,i) + gdih(k)=dexp(kat3) + kat2=kat2+gdih(k) +! write(iout,*) "kat2=", kat2, "exp(kat3)=", exp(kat3) +! write(*,*)"" + enddo +! write (iout,*) "gdih",(gdih(k),k=1,constr_homology) ! exps +! write (iout,*) "i",i," betai",betai," kat2",kat2 ! sum of exps +#ifdef DEBUG + write (iout,*) "i",i," betai",betai," kat2",kat2 + write (iout,*) "gdih",(gdih(k),k=1,constr_homology) +#endif + if (kat2.le.1.0d-14) cycle + kat=kat-dLOG(kat2/constr_homology) +! write (iout,*) "kat",kat ! sum of -ln-s + +!cc write(iout,778)"TEST: kat2=", kat2, "DLOG(kat2)=", +!cc & dLOG(kat2), "-kat=", -kat + +! ---------------------------------------------------------------------- +! Gradient +! ---------------------------------------------------------------------- + + sum_gdih=kat2 + sum_sgdih=0.0d0 + do k=1,constr_homology +#ifdef OLD_DIHED + sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i) ! waga_angle rmvd +#else + sgdih=-gdih(k)*dsin(dih_diff(k))*sigma_dih(k,i) ! waga_angle rmvd +#endif +! sgdih=-gdih(k)*dih_diff(k)*sigma_dih(k,i)*waga_angle + sum_sgdih=sum_sgdih+sgdih + enddo +! grad_dih3=sum_sgdih/sum_gdih + grad_dih3=waga_homology(iset)*waga_angle*sum_sgdih/sum_gdih +! print *, "ok3" + +! write(iout,*)i,k,gdih,sgdih,beta(i+1,i+2,i+3,i+4),grad_dih3 +!cc write(iout,747) "GRAD_KAT_1", i, nphi, icg, grad_dih3, +!cc & gloc(nphi+i-3,icg) + gloc(i-3,icg)=gloc(i-3,icg)+grad_dih3 +! if (i.eq.25) then +! write(iout,*) "i",i,"icg",icg,"gloc(",i,icg,")",gloc(i,icg) +! endif +!cc write(iout,747) "GRAD_KAT_2", i, nphi, icg, grad_dih3, +!cc & gloc(nphi+i-3,icg) + + enddo ! i-loop for dih +#ifdef DEBUG + write(iout,*) "------- dih restrs end -------" +#endif + +! Pseudo-energy and gradient for theta angle restraints from +! homology templates +! FP 01/15 - inserted from econstr_local_test.F, loop structure +! adapted + +! +! For constr_homology reference structures (FP) +! +! Uconst_back_tot=0.0d0 + Eval=0.0d0 + Erot=0.0d0 +! Econstr_back legacy + do i=1,nres +! do i=ithet_start,ithet_end + dutheta(i)=0.0d0 + enddo +! do i=loc_start,loc_end + do i=-1,nres + do j=1,3 + duscdiff(j,i)=0.0d0 + duscdiffx(j,i)=0.0d0 + enddo + enddo +! +! do iref=1,nref +! write (iout,*) "ithet_start =",ithet_start,"ithet_end =",ithet_end +! write (iout,*) "waga_theta",waga_theta + if (waga_theta.gt.0.0d0) then +#ifdef DEBUG + write (iout,*) "usampl",usampl + write(iout,*) "------- theta restrs start -------" +! do i=ithet_start,ithet_end +! write (iout,*) "gloc_init(",nphi+i,icg,")",gloc(nphi+i,icg) +! enddo +#endif +! write (iout,*) "maxres",maxres,"nres",nres + + do i=ithet_start,ithet_end +! +! do i=1,nfrag_back +! ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset) +! +! Deviation of theta angles wrt constr_homology ref structures +! + utheta_i=0.0d0 ! argument of Gaussian for single k + gutheta_i=0.0d0 ! Sum of Gaussians over constr_homology ref structures +! do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset) ! original loop +! over residues in a fragment +! write (iout,*) "theta(",i,")=",theta(i) + do k=1,constr_homology +! +! dtheta_i=theta(j)-thetaref(j,iref) +! dtheta_i=thetaref(k,i)-theta(i) ! original form without indexing + theta_diff(k)=thetatpl(k,i)-theta(i) +!d write (iout,'(a8,2i4,2f15.8)') "theta_diff",i,k,theta_diff(k) +!d & ,sigma_theta(k,i) + +! + utheta_i=-0.5d0*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta rmvd from Gaussian argument +! utheta_i=-0.5d0*waga_theta*theta_diff(k)**2*sigma_theta(k,i) ! waga_theta? + gtheta(k)=dexp(utheta_i) ! + min_utheta_i? + gutheta_i=gutheta_i+gtheta(k) ! Sum of Gaussians (pk) +! Gradient for single Gaussian restraint in subr Econstr_back +! dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1) +! + enddo +! write (iout,*) "gtheta",(gtheta(k),k=1,constr_homology) ! exps +! write (iout,*) "i",i," gutheta_i",gutheta_i ! sum of exps + +! +! Gradient for multiple Gaussian restraint + sum_gtheta=gutheta_i + sum_sgtheta=0.0d0 + do k=1,constr_homology +! New generalized expr for multiple Gaussian from Econstr_back + sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i) ! waga_theta rmvd +! +! sgtheta=-gtheta(k)*theta_diff(k)*sigma_theta(k,i)*waga_theta ! right functional form? + sum_sgtheta=sum_sgtheta+sgtheta ! cum variable + enddo +! Final value of gradient using same var as in Econstr_back + gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg) & + +sum_sgtheta/sum_gtheta*waga_theta & + *waga_homology(iset) +! print *, "ok4" + +! dutheta(i-2)=sum_sgtheta/sum_gtheta*waga_theta +! & *waga_homology(iset) +! dutheta(i)=sum_sgtheta/sum_gtheta +! +! Uconst_back=Uconst_back+waga_theta*utheta(i) ! waga_theta added as weight + Eval=Eval-dLOG(gutheta_i/constr_homology) +! write (iout,*) "utheta(",i,")=",utheta(i) ! -ln of sum of exps +! write (iout,*) "Uconst_back",Uconst_back ! sum of -ln-s +! Uconst_back=Uconst_back+utheta(i) + enddo ! (i-loop for theta) +#ifdef DEBUG + write(iout,*) "------- theta restrs end -------" +#endif + endif +! +! Deviation of local SC geometry +! +! Separation of two i-loops (instructed by AL - 11/3/2014) +! +! write (iout,*) "loc_start =",loc_start,"loc_end =",loc_end +! write (iout,*) "waga_d",waga_d + +#ifdef DEBUG + write(iout,*) "------- SC restrs start -------" + write (iout,*) "Initial duscdiff,duscdiffx" + do i=loc_start,loc_end + write (iout,*) i,(duscdiff(jik,i),jik=1,3), & + (duscdiffx(jik,i),jik=1,3) + enddo +#endif + do i=loc_start,loc_end + usc_diff_i=0.0d0 ! argument of Gaussian for single k + guscdiff(i)=0.0d0 ! Sum of Gaussians over constr_homology ref structures +! do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1 ! Econstr_back legacy +! write(iout,*) "xxtab, yytab, zztab" +! write(iout,'(i5,3f8.2)') i,xxtab(i),yytab(i),zztab(i) + do k=1,constr_homology +! + dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str? +! Original sign inverted for calc of gradients (s. Econstr_back) + dyy=-yytpl(k,i)+yytab(i) ! ibid y + dzz=-zztpl(k,i)+zztab(i) ! ibid z +! write(iout,*) "dxx, dyy, dzz" +!d write(iout,'(2i5,4f8.2)') k,i,dxx,dyy,dzz,sigma_d(k,i) +! + usc_diff_i=-0.5d0*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d rmvd from Gaussian argument +! usc_diff(i)=-0.5d0*waga_d*(dxx**2+dyy**2+dzz**2)*sigma_d(k,i) ! waga_d? +! uscdiffk(k)=usc_diff(i) + guscdiff2(k)=dexp(usc_diff_i) ! without min_scdiff +! write(iout,*) "i",i," k",k," sigma_d",sigma_d(k,i), +! & " guscdiff2",guscdiff2(k) + guscdiff(i)=guscdiff(i)+guscdiff2(k) !Sum of Gaussians (pk) +! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j), +! & xxref(j),yyref(j),zzref(j) + enddo +! +! Gradient +! +! Generalized expression for multiple Gaussian acc to that for a single +! Gaussian in Econstr_back as instructed by AL (FP - 03/11/2014) +! +! Original implementation +! sum_guscdiff=guscdiff(i) +! +! sum_sguscdiff=0.0d0 +! do k=1,constr_homology +! sguscdiff=-guscdiff2(k)*dscdiff(k)*sigma_d(k,i)*waga_d !waga_d? +! sguscdiff=-guscdiff3(k)*dscdiff(k)*sigma_d(k,i)*waga_d ! w min_uscdiff +! sum_sguscdiff=sum_sguscdiff+sguscdiff +! enddo +! +! Implementation of new expressions for gradient (Jan. 2015) +! +! grad_uscdiff=sum_sguscdiff/(sum_guscdiff*dtab) !? + do k=1,constr_homology +! +! New calculation of dxx, dyy, and dzz corrected by AL (07/11), was missing and wrong +! before. Now the drivatives should be correct +! + dxx=-xxtpl(k,i)+xxtab(i) ! Diff b/w x component of ith SC vector in model and kth ref str? +! Original sign inverted for calc of gradients (s. Econstr_back) + dyy=-yytpl(k,i)+yytab(i) ! ibid y + dzz=-zztpl(k,i)+zztab(i) ! ibid z + sum_guscdiff=guscdiff2(k)* &!(dsqrt(dxx*dxx+dyy*dyy+dzz*dzz))* -> wrong! + sigma_d(k,i) ! for the grad wrt r' +! sum_sguscdiff=sum_sguscdiff+sum_guscdiff + +! +! New implementation + sum_guscdiff = waga_homology(iset)*waga_d*sum_guscdiff + do jik=1,3 + duscdiff(jik,i-1)=duscdiff(jik,i-1)+ & + sum_guscdiff*(dXX_C1tab(jik,i)*dxx+ & + dYY_C1tab(jik,i)*dyy+dZZ_C1tab(jik,i)*dzz)/guscdiff(i) + duscdiff(jik,i)=duscdiff(jik,i)+ & + sum_guscdiff*(dXX_Ctab(jik,i)*dxx+ & + dYY_Ctab(jik,i)*dyy+dZZ_Ctab(jik,i)*dzz)/guscdiff(i) + duscdiffx(jik,i)=duscdiffx(jik,i)+ & + sum_guscdiff*(dXX_XYZtab(jik,i)*dxx+ & + dYY_XYZtab(jik,i)*dyy+dZZ_XYZtab(jik,i)*dzz)/guscdiff(i) +! print *, "ok5" +! +#ifdef DEBUG +! write(iout,*) "jik",jik,"i",i + write(iout,*) "dxx, dyy, dzz" + write(iout,'(2i5,3f8.2)') k,i,dxx,dyy,dzz + write(iout,*) "guscdiff2(",k,")",guscdiff2(k) + write(iout,*) "sum_sguscdiff",sum_guscdiff,waga_homology(iset),waga_d + write(iout,*) "dXX_Ctab(",jik,i,")",dXX_Ctab(jik,i) + write(iout,*) "dYY_Ctab(",jik,i,")",dYY_Ctab(jik,i) + write(iout,*) "dZZ_Ctab(",jik,i,")",dZZ_Ctab(jik,i) + write(iout,*) "dXX_C1tab(",jik,i,")",dXX_C1tab(jik,i) + write(iout,*) "dYY_C1tab(",jik,i,")",dYY_C1tab(jik,i) + write(iout,*) "dZZ_C1tab(",jik,i,")",dZZ_C1tab(jik,i) + write(iout,*) "dXX_XYZtab(",jik,i,")",dXX_XYZtab(jik,i) + write(iout,*) "dYY_XYZtab(",jik,i,")",dYY_XYZtab(jik,i) + write(iout,*) "dZZ_XYZtab(",jik,i,")",dZZ_XYZtab(jik,i) + write(iout,*) "duscdiff(",jik,i-1,")",duscdiff(jik,i-1) + write(iout,*) "duscdiff(",jik,i,")",duscdiff(jik,i) + write(iout,*) "duscdiffx(",jik,i,")",duscdiffx(jik,i) +! endif +#endif + enddo + enddo +! print *, "ok6" +! +! uscdiff(i)=-dLOG(guscdiff(i)/(ii-1)) ! Weighting by (ii-1) required? +! usc_diff(i)=-dLOG(guscdiff(i)/constr_homology) ! + min_uscdiff ? +! +! write (iout,*) i," uscdiff",uscdiff(i) +! +! Put together deviations from local geometry + +! Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ +! & wfrag_back(3,i,iset)*uscdiff(i) + Erot=Erot-dLOG(guscdiff(i)/constr_homology) +! write (iout,*) "usc_diff(",i,")=",usc_diff(i) ! -ln of sum of exps +! write (iout,*) "Uconst_back",Uconst_back ! cum sum of -ln-s +! Uconst_back=Uconst_back+usc_diff(i) +! +! Gradient of multiple Gaussian restraint (FP - 04/11/2014 - right?) +! +! New implment: multiplied by sum_sguscdiff +! + + enddo ! (i-loop for dscdiff) + +! endif + +#ifdef DEBUG + write(iout,*) "------- SC restrs end -------" + write (iout,*) "------ After SC loop in e_modeller ------" + do i=loc_start,loc_end + write (iout,*) "i",i," gradc",(gradc(j,i,icg),j=1,3) + write (iout,*) "i",i," gradx",(gradx(j,i,icg),j=1,3) + enddo + if (waga_theta.eq.1.0d0) then + write (iout,*) "in e_modeller after SC restr end: dutheta" + do i=ithet_start,ithet_end + write (iout,*) i,dutheta(i) + enddo + endif + if (waga_d.eq.1.0d0) then + write (iout,*) "e_modeller after SC loop: duscdiff/x" + do i=1,nres + write (iout,*) i,(duscdiff(j,i),j=1,3) + write (iout,*) i,(duscdiffx(j,i),j=1,3) + enddo + endif +#endif + +! Total energy from homology restraints +#ifdef DEBUG + write (iout,*) "odleg",odleg," kat",kat +#endif +! +! Addition of energy of theta angle and SC local geom over constr_homologs ref strs +! +! ehomology_constr=odleg+kat +! +! For Lorentzian-type Urestr +! + + if (waga_dist.ge.0.0d0) then +! +! For Gaussian-type Urestr +! + ehomology_constr=(waga_dist*odleg+waga_angle*kat+ & + waga_theta*Eval+waga_d*Erot)*waga_homology(iset) +! write (iout,*) "ehomology_constr=",ehomology_constr +! print *, "ok7" + else +! +! For Lorentzian-type Urestr +! + ehomology_constr=(-waga_dist*odleg+waga_angle*kat+ & + waga_theta*Eval+waga_d*Erot)*waga_homology(iset) +! write (iout,*) "ehomology_constr=",ehomology_constr + print *, "ok8" + endif +#ifdef DEBUG + write (iout,*) "odleg",waga_dist,odleg," kat",waga_angle,kat, & + "Eval",waga_theta,eval, & + "Erot",waga_d,Erot + write (iout,*) "ehomology_constr",ehomology_constr +#endif + return +! +! FP 01/15 end +! + 748 format(a8,f12.3,a6,f12.3,a7,f12.3) + 747 format(a12,i4,i4,i4,f8.3,f8.3) + 746 format(a12,i4,i4,i4,f8.3,f8.3,f8.3) + 778 format(a7,1X,f10.3,1X,a4,1X,f10.3,1X,a5,1X,f10.3) + 779 format(i3,1X,i3,1X,i2,1X,a7,1X,f7.3,1X,a7,1X,f7.3,1X,a13,1X, & + f7.3,1X,a17,1X,f9.3,1X,a10,1X,f8.3,1X,a10,1X,f8.3) + end subroutine e_modeller + +!---------------------------------------------------------------------------- + subroutine ebend_kcc(etheta) + logical lprn + double precision thybt1(maxang_kcc),etheta + integer :: i,iti,j,ihelp + real (kind=8) :: sinthet,costhet,sumth1thyb,gradthybt1 +!C Set lprn=.true. for debugging + lprn=energy_dec +!c lprn=.true. +!C print *,"wchodze kcc" + if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode + etheta=0.0D0 + do i=ithet_start,ithet_end +!c print *,i,itype(i-1),itype(i),itype(i-2) + if ((itype(i-1,1).eq.ntyp1).or.itype(i-2,1).eq.ntyp1 & + .or.itype(i,1).eq.ntyp1) cycle + iti=iabs(itortyp(itype(i-1,1))) + sinthet=dsin(theta(i)) + costhet=dcos(theta(i)) + do j=1,nbend_kcc_Tb(iti) + thybt1(j)=v1bend_chyb(j,iti) + enddo + sumth1thyb=v1bend_chyb(0,iti)+ & + tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet) + if (lprn) write (iout,*) i-1,itype(i-1,1),iti,theta(i)*rad2deg,& + sumth1thyb + ihelp=nbend_kcc_Tb(iti)-1 + gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet) + etheta=etheta+sumth1thyb +!C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0) + gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet + enddo + return + end subroutine ebend_kcc +!c------------ +!c------------------------------------------------------------------------------------- + subroutine etheta_constr(ethetacnstr) + real (kind=8) :: ethetacnstr,thetiii,difi + integer :: i,itheta + ethetacnstr=0.0d0 +!C 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 @@ -7644,7 +8583,7 @@ ! residues) and the torsional potentials dependent on all 20 types ! of residues computed from AM1 energy surfaces of terminally-blocked ! amino-acid residues. -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.VAR' ! include 'COMMON.GEO' @@ -7725,7 +8664,7 @@ ! the idea of Skolnick et al. If side chains I and J make a contact and ! at the same time side chains I+1 and J+1 make a contact, an extra ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added. -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.DERIV' @@ -7783,7 +8722,7 @@ end subroutine multibody !----------------------------------------------------------------------------- real(kind=8) function esccorr(i,j,k,l,jj,kk) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.DERIV' @@ -7825,7 +8764,7 @@ !----------------------------------------------------------------------------- subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1) ! This subroutine calculates multi-body contributions to hydrogen-bonding -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' #ifdef MPI @@ -8138,7 +9077,7 @@ end subroutine multibody_hb !----------------------------------------------------------------------------- subroutine add_hb_contact(ii,jj,itask) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include "DIMENSIONS" ! include "COMMON.IOUNITS" ! include "COMMON.CONTACTS" @@ -8195,7 +9134,7 @@ !----------------------------------------------------------------------------- subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1) ! This subroutine calculates multi-body contributions to hydrogen-bonding -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' integer,parameter :: max_dim=70 @@ -8589,7 +9528,7 @@ end subroutine multibody_eello !----------------------------------------------------------------------------- subroutine add_hb_contact_eello(ii,jj,itask) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include "DIMENSIONS" ! include "COMMON.IOUNITS" ! include "COMMON.CONTACTS" @@ -8644,7 +9583,7 @@ end subroutine add_hb_contact_eello !----------------------------------------------------------------------------- real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.DERIV' @@ -8811,7 +9750,7 @@ #ifdef MOMENT !----------------------------------------------------------------------------- subroutine dipole(i,j,jj) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.CHAIN' @@ -8884,7 +9823,7 @@ ! the fourth-, fifth-, and sixth-order local-electrostatic terms. ! use comm_kut -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.CHAIN' @@ -9265,7 +10204,7 @@ end subroutine kernel !----------------------------------------------------------------------------- real(kind=8) function eello4(i,j,k,l,jj,kk) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.CHAIN' @@ -9380,7 +10319,7 @@ end function eello4 !----------------------------------------------------------------------------- real(kind=8) function eello5(i,j,k,l,jj,kk) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.CHAIN' @@ -9788,7 +10727,7 @@ end function eello5 !----------------------------------------------------------------------------- real(kind=8) function eello6(i,j,k,l,jj,kk) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.CHAIN' @@ -9933,7 +10872,7 @@ !----------------------------------------------------------------------------- real(kind=8) function eello6_graph1(i,j,k,l,imat,swap) use comm_kut -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.CHAIN' @@ -10041,7 +10980,7 @@ !----------------------------------------------------------------------------- real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap) use comm_kut -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.CHAIN' @@ -10228,7 +11167,7 @@ end function eello6_graph2 !----------------------------------------------------------------------------- real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.CHAIN' @@ -10346,7 +11285,7 @@ end function eello6_graph3 !----------------------------------------------------------------------------- real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.CHAIN' @@ -10593,7 +11532,7 @@ end function eello6_graph4 !----------------------------------------------------------------------------- real(kind=8) function eello_turn6(i,jj,kk) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.CHAIN' @@ -10929,7 +11868,7 @@ #ifndef OSF !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2 #endif -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' real(kind=8),dimension(2) :: V1,V2 real(kind=8),dimension(2,2) :: A1 @@ -10952,7 +11891,7 @@ #ifndef OSF !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2 #endif -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' real(kind=8),dimension(2,2) :: A1,A2,A3 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22 @@ -11064,7 +12003,7 @@ ! energy_p_new_barrier.F !----------------------------------------------------------------------------- subroutine sum_gradient -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) use io_base, only: pdbout ! include 'DIMENSIONS' #ifndef ISNAN @@ -11184,7 +12123,11 @@ wscbase*gvdwc_scbase(j,i)+ & wpepbase*gvdwc_pepbase(j,i)+& wscpho*gvdwc_scpho(j,i)+ & - wpeppho*gvdwc_peppho(j,i) + wpeppho*gvdwc_peppho(j,i)+wcatnucl*gradnuclcat(j,i)+ & + wmartini*(gradlipbond(j,i)+gradlipang(j,i)+gradliplj(j,i)+gradlipelec(j,i))+& + wcat_tran*gradcattranc(j,i)+gradcatangc(j,i)+& + wlip_prot*gradpepmart(j,i) + @@ -11222,7 +12165,11 @@ wscbase*gvdwc_scbase(j,i)+ & wpepbase*gvdwc_pepbase(j,i)+& wscpho*gvdwc_scpho(j,i)+& - wpeppho*gvdwc_peppho(j,i) + wpeppho*gvdwc_peppho(j,i)+wcatnucl*gradnuclcat(j,i)+& + wmartini*(gradlipbond(j,i)+gradlipang(j,i)+gradliplj(j,i)+gradlipelec(j,i))+& + wcat_tran*gradcattranc(j,i)+gradcatangc(j,i)+& + wlip_prot*gradpepmart(j,i) + enddo @@ -11383,7 +12330,8 @@ +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) + +wbond_nucl*gradb_nucl(j,i)+wsbloc*gsbloc(j,i)!& +! + gradcattranc(j,i) ! if (i.eq.21) then ! print *,"in sum",gradc(j,i,icg),wturn4*gcorr4_turn(j,i),& ! wturn4*gshieldc_t4(j,i), & @@ -11463,7 +12411,8 @@ +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) + +wsbloc*gsbloc(j,i)+wcatnucl*gradnuclcat(j,i)!& +! + gradcattranc(j,i) @@ -11490,12 +12439,25 @@ +wcatprot* gradpepcatx(j,i)& +wscbase*gvdwx_scbase(j,i) & +wpepbase*gvdwx_pepbase(j,i)& - +wscpho*gvdwx_scpho(j,i) + +wscpho*gvdwx_scpho(j,i)+wcatnucl*gradnuclcatx(j,i)& + +wcat_tran*gradcattranx(j,i)+gradcatangx(j,i)& + +wlip_prot*gradpepmartx(j,i) + ! if (i.eq.3) print *,"tu?", wscpho,gvdwx_scpho(j,i) enddo enddo -!#define DEBUG +! write(iout,*), "const_homol",constr_homology + if (constr_homology.gt.0) then + do i=1,nct + do j=1,3 + gradc(j,i,icg)=gradc(j,i,icg)+duscdiff(j,i) +! write(iout,*) "duscdiff",duscdiff(j,i) + gradx(j,i,icg)=gradx(j,i,icg)+duscdiffx(j,i) + enddo + enddo + endif +!#define DEBUG #ifdef DEBUG write (iout,*) "gloc before adding corr" do i=1,4*nres @@ -11695,7 +12657,7 @@ end subroutine sum_gradient !----------------------------------------------------------------------------- subroutine sc_grad -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) use calc_data ! include 'DIMENSIONS' ! include 'COMMON.CHAIN' @@ -11786,14 +12748,14 @@ enddo do k=1,3 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)) -!C print *,'gg',k,gg(k) +! 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 - gradpepcatx(k,i)=gradpepcatx(k,i)-gg(k) & + gradpepcatx(k,i)=gradpepcatx(k,i)-gg(k)*sss_ele_cut & +(eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) & - +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv + +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss_ele_cut ! gradpepcatx(k,j)=gradpepcatx(k,j)+gg(k) & ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)) & @@ -11808,8 +12770,8 @@ ! Calculate the components of the gradient in DC and X ! do l=1,3 - gradpepcat(l,i)=gradpepcat(l,i)-gg(l) - gradpepcat(l,j)=gradpepcat(l,j)+gg(l) + gradpepcat(l,i)=gradpepcat(l,i)-gg(l)*sss_ele_cut + gradpepcat(l,j)=gradpepcat(l,j)+gg(l)*sss_ele_cut enddo end subroutine sc_grad_cat @@ -11829,20 +12791,21 @@ ! eom2=0.0d0 ! eom12=evdwij*eps1_om12 ! end diagnostics +! write (iout,*) "gg",(gg(k),k=1,3) 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)) & + gradpepcat(k,i)= gradpepcat(k,i) +sss_ele_cut*(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)) & + - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0) + gradpepcat(k,i+1)= gradpepcat(k,i+1) +sss_ele_cut*(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 - gradpepcat(k,j)=gradpepcat(k,j)+gg(k) + + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0) + gradpepcat(k,j)=gradpepcat(k,j)+gg(k)*sss_ele_cut enddo end subroutine sc_grad_cat_pep @@ -11851,7 +12814,7 @@ subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t) use comm_calcthet -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.LOCAL' ! include 'COMMON.IOUNITS' @@ -11928,7 +12891,7 @@ ! Version of March '95, based on an early version of November '91. ! !********************************************************************** -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.VAR' ! include 'COMMON.CHAIN' @@ -11947,7 +12910,11 @@ sint2,xp,yp,xxp,yyp,zzp,dj ! common /przechowalnia/ fromto +#ifdef FIVEDIAG + if(.not. allocated(fromto)) allocate(fromto(3,3)) +#else if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim)) +#endif ! get the position of the jth ijth fragment of the chain coordinate system ! in the fromto array. ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1 @@ -11986,6 +12953,7 @@ ! ! generate the matrix products of type r(i)t(i)...r(j)t(j) ! +#ifndef FIVEDIAG do i=2,nres-2 ind=indmat(i,i+1) do k=1,3 @@ -11998,6 +12966,7 @@ fromto(k,l,ind)=temp(k,l) enddo enddo + do j=i+1,nres-2 ind=indmat(i,j+1) do k=1,3 @@ -12017,6 +12986,7 @@ enddo enddo enddo +#endif ! ! Calculate derivatives. ! @@ -12114,6 +13084,19 @@ ind1=ind1+1 ind=indmat(i+1,j+1) !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1 +#ifdef FIVEDIAG + call build_fromto(i+1,j+1,fromto) +!c write(iout,'(7hfromto 9f10.5)')((fromto(k,l),l=1,3),k=1,3) + do k=1,3 + do l=1,3 + tempkl=0.0D0 + do m=1,2 + tempkl=tempkl+prordt(k,m,i)*fromto(m,l) + enddo + temp(k,l)=tempkl + enddo + enddo +#else do k=1,3 do l=1,3 tempkl=0.0D0 @@ -12123,6 +13106,7 @@ temp(k,l)=tempkl enddo enddo +#endif !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3) !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3) !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3) @@ -12142,6 +13126,17 @@ ! !--- Calculate the derivatives in phi ! +#ifdef FIVEDIAG + do k=1,3 + do l=1,3 + tempkl=0.0D0 + do m=1,3 + tempkl=tempkl+prodrt(k,m,i)*fromto(m,l) + enddo + temp(k,l)=tempkl + enddo + enddo +#else do k=1,3 do l=1,3 tempkl=0.0D0 @@ -12151,6 +13146,9 @@ temp(k,l)=tempkl enddo enddo +#endif + + do k=1,3 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1) enddo @@ -12215,12 +13213,64 @@ enddo return end subroutine cartder +#ifdef FIVEDIAG + subroutine build_fromto(i,j,fromto) + implicit none + integer i,j,jj,k,l,m + double precision fromto(3,3),temp(3,3),dp(3,3) + double precision dpkl + save temp +! +! generate the matrix products of type r(i)t(i)...r(j)t(j) on the fly +! +! write (iout,*) "temp on entry" +! write (iout,'(3f10.5)') ((temp(k,l),l=1,3),k=1,3) +! do i=2,nres-2 +! ind=indmat(i,i+1) + if (j.eq.i+1) then + do k=1,3 + do l=1,3 + temp(k,l)=rt(k,l,i) + enddo + enddo + do k=1,3 + do l=1,3 + fromto(k,l)=temp(k,l) + enddo + enddo + else +! do j=i+1,nres-2 +! ind=indmat(i,j+1) + do k=1,3 + do l=1,3 + dpkl=0.0d0 + do m=1,3 + dpkl=dpkl+temp(k,m)*rt(m,l,j-1) + enddo + dp(k,l)=dpkl + fromto(k,l)=dpkl + enddo + enddo + do k=1,3 + do l=1,3 + temp(k,l)=dp(k,l) + enddo + enddo + endif +! write (iout,*) "temp upon exit" +! write (iout,'(3f10.5)') ((temp(k,l),l=1,3),k=1,3) +! enddo +! enddo + return + end subroutine build_fromto +#endif + !----------------------------------------------------------------------------- ! checkder_p.F !----------------------------------------------------------------------------- subroutine check_cartgrad ! Check the gradient of Cartesian coordinates in internal coordinates. -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.VAR' @@ -12396,7 +13446,7 @@ !----------------------------------------------------------------------------- subroutine check_ecart ! Check the gradient of the energy in Cartesian coordinates. -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.CHAIN' ! include 'COMMON.DERIV' @@ -12404,8 +13454,12 @@ ! include 'COMMON.VAR' ! include 'COMMON.CONTACTS' use comm_srutu +!#ifdef LBFGS +! use minimm, only: funcgrad +!#endif !el integer :: icall !el common /srutu/ icall +! real(kind=8) :: funcgrad real(kind=8),dimension(6) :: ggg real(kind=8),dimension(3) :: cc,xx,ddc,ddx real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres) @@ -12415,7 +13469,7 @@ real(kind=8) :: urparm(1) !EL external fdum integer :: nf,i,j,k - real(kind=8) :: aincr,etot,etot1 + real(kind=8) :: aincr,etot,etot1,ff icg=1 nf=0 nfl=0 @@ -12427,8 +13481,12 @@ call geom_to_var(nvar,x) call etotal(energia) etot=energia(0) +#ifdef LBFGS + ff=funcgrad(x,g) +#else !el call enerprint(energia) call gradient(nvar,x,nf,g,uiparm,urparm,fdum) +#endif icall =1 do i=1,nres write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3) @@ -12483,6 +13541,7 @@ subroutine check_ecartint ! Check the gradient of the energy in Cartesian coordinates. use io_base, only: intout + use MD_data, only: iset ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.CONTROL' @@ -12515,12 +13574,13 @@ icg=1 nf=0 nfl=0 + if (iset.eq.0) iset=1 call intout ! call intcartderiv ! call checkintcartgrad call zerograd - aincr=1.0D-5 - write(iout,*) 'Calling CHECK_ECARTINT.' + aincr=graddelta + write(iout,*) 'Calling CHECK_ECARTINT.,kupa' nf=0 icall=0 call geom_to_var(nvar,x) @@ -12531,6 +13591,9 @@ call etotal(energia) etot=energia(0) call cartgrad +#ifdef FIVEDIAG + call grad_transform +#endif icall =1 do i=1,nres write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3) @@ -12542,14 +13605,24 @@ do j=1,3 grad_s(j,i)=gcart(j,i) grad_s(j+3,i)=gxcart(j,i) + write(iout,*) "before movement analytical gradient" + enddo enddo + 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 + else !- split gradient check call zerograd call etotal_long(energia) !el call enerprint(energia) call cartgrad +#ifdef FIVEDIAG + call grad_transform +#endif icall =1 do i=1,nres write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),& @@ -12568,6 +13641,10 @@ call etotal_short(energia) call enerprint(energia) call cartgrad +#ifdef FIVEDIAG + call grad_transform +#endif + icall =1 do i=1,nres write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),& @@ -12584,8 +13661,11 @@ enddo endif write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors' -! do i=1,nres +#ifdef FIVEDIAG + do i=1,nres +#else do i=nnt,nct +#endif do j=1,3 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) @@ -12607,7 +13687,7 @@ call zerograd call etotal(energia1) etot1=energia1(0) - write (iout,*) "ij",i,j," etot1",etot1 +! write (iout,*) "ij",i,j," etot1",etot1 else !- split gradient call etotal_long(energia1) @@ -12628,7 +13708,7 @@ call zerograd call etotal(energia1) etot2=energia1(0) - write (iout,*) "ij",i,j," etot2",etot2 +! write (iout,*) "ij",i,j," etot2",etot2 ggg(j)=(etot1-etot2)/(2*aincr) else !- split gradient @@ -12710,6 +13790,7 @@ subroutine check_ecartint ! Check the gradient of the energy in Cartesian coordinates. use io_base, only: intout + use MD_data, only: iset ! implicit real*8 (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.CONTROL' @@ -12742,6 +13823,7 @@ icg=1 nf=0 nfl=0 + if (iset.eq.0) iset=1 call intout ! call intcartderiv ! call checkintcartgrad @@ -12754,7 +13836,7 @@ if (.not.split_ene) then call etotal(energia) etot=energia(0) -!el call enerprint(energia) +! call enerprint(energia) call cartgrad icall =1 do i=1,nres @@ -12762,16 +13844,20 @@ enddo do j=1,3 grad_s(j,0)=gcart(j,0) + grad_s(j+3,0)=gxcart(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 + write(iout,*) "before movement analytical gradient" + 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 + else !- split gradient check call zerograd @@ -12853,6 +13939,7 @@ if (.not.split_ene) then call zerograd call etotal(energia1) +! call enerprint(energia1) etot2=energia1(0) ggg(j)=(etot1-etot2)/(2*aincr) else @@ -12884,7 +13971,9 @@ if (.not.split_ene) then call zerograd call etotal(energia1) +! call enerprint(energia1) etot1=energia1(0) +! print *,"ene",energia1(0),energia1(57) else !- split gradient call etotal_long(energia1) @@ -12908,6 +13997,8 @@ call zerograd call etotal(energia1) etot2=energia1(0) +! call enerprint(energia1) +! print *,"ene",energia1(0),energia1(57) ggg(j+3)=(etot1-etot2)/(2*aincr) else !- split gradient @@ -12940,7 +14031,7 @@ !----------------------------------------------------------------------------- subroutine check_eint ! Check the gradient of energy in internal coordinates. -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.CHAIN' ! include 'COMMON.DERIV' @@ -12948,8 +14039,12 @@ ! include 'COMMON.VAR' ! include 'COMMON.GEO' use comm_srutu +!#ifdef LBFGS +! use minimm, only : funcgrad +!#endif !el integer :: icall !el common /srutu/ icall +! real(kind=8) :: funcgrad real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres) integer :: uiparm(1) real(kind=8) :: urparm(1) @@ -12957,7 +14052,7 @@ character(len=6) :: key !EL external fdum integer :: i,ii,nf - real(kind=8) :: xi,aincr,etot,etot1,etot2 + real(kind=8) :: xi,aincr,etot,etot1,etot2,ff call zerograd aincr=1.0D-7 print '(a)','Calling CHECK_INT.' @@ -12983,9 +14078,14 @@ #endif nf=1 nfl=3 +#ifdef LBFGS + ff=funcgrad(x,gana) +#else + !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar) call gradient(nvar,x,nf,gana,uiparm,urparm,fdum) !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp +#endif icall=1 do i=1,nvar xi=x(i) @@ -13030,7 +14130,7 @@ !----------------------------------------------------------------------------- subroutine Econstr_back ! MD with umbrella_sampling using Wolyne's distance measure as a constraint -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.CONTROL' ! include 'COMMON.VAR' @@ -13156,6 +14256,66 @@ endif return end function sscale_grad +!SCALINING MARTINI + real(kind=8) function sscale_martini(r) +! include "COMMON.SPLITELE" + real(kind=8) :: r,gamm +! print *,"here2",r_cut_mart,r + if(r.lt.r_cut_mart-rlamb_mart) then + sscale_martini=1.0d0 + else if(r.le.r_cut_mart.and.r.ge.r_cut_mart-rlamb_mart) then + gamm=(r-(r_cut_mart-rlamb_mart))/rlamb_mart + sscale_martini=1.0d0+gamm*gamm*(2*gamm-3.0d0) + else + sscale_martini=0.0d0 + endif + return + end function sscale_martini + real(kind=8) function sscale_grad_martini(r) +! include "COMMON.SPLITELE" + real(kind=8) :: r,gamm + if(r.lt.r_cut_mart-rlamb_mart) then + sscale_grad_martini=0.0d0 + else if(r.le.r_cut_mart.and.r.ge.r_cut_mart-rlamb_mart) then + gamm=(r-(r_cut_mart-rlamb_mart))/rlamb_mart + sscale_grad_martini=gamm*(6*gamm-6.0d0)/rlamb_mart + else + sscale_grad_martini=0.0d0 + endif + return + end function sscale_grad_martini + real(kind=8) function sscale_martini_angle(r) +! include "COMMON.SPLITELE" + real(kind=8) :: r,gamm,r_cut_angle,rlamb_angle +! print *,"here2",r_cut_angle,r + r_cut_angle=3.12d0 + rlamb_angle=0.1d0 + if(r.lt.r_cut_angle-rlamb_angle) then + sscale_martini_angle=1.0d0 + else if(r.le.r_cut_angle.and.r.ge.r_cut_angle-rlamb_angle) then + gamm=(r-(r_cut_angle-rlamb_angle))/rlamb_angle + sscale_martini_angle=1.0d0+gamm*gamm*(2*gamm-3.0d0) + else + sscale_martini_angle=0.0d0 + endif + return + end function sscale_martini_angle + real(kind=8) function sscale_grad_martini_angle(r) +! include "COMMON.SPLITELE" + real(kind=8) :: r,gamm,r_cut_angle,rlamb_angle + r_cut_angle=3.12d0 + rlamb_angle=0.1d0 + if(r.lt.r_cut_angle-rlamb_angle) then + sscale_grad_martini_angle=0.0d0 + else if(r.le.r_cut_angle.and.r.ge.r_cut_angle-rlamb_angle) then + gamm=(r-(r_cut_angle-rlamb_angle))/rlamb_angle + sscale_grad_martini_angle=gamm*(6*gamm-6.0d0)/rlamb_angle + else + sscale_grad_martini_angle=0.0d0 + endif + return + end function sscale_grad_martini_angle + !!!!!!!!!! PBCSCALE real(kind=8) function sscale_ele(r) @@ -13185,6 +14345,35 @@ endif return end function sscagrad_ele +!!!!!!!!!! PBCSCALE + real(kind=8) function sscale2(r,r_cc,r_ll) +! include "COMMON.SPLITELE" + real(kind=8) :: r,gamm,r_cc,r_ll + if(r.lt.r_cc-r_ll) then + sscale2=1.0d0 + else if(r.le.r_cc.and.r.ge.r_cc-r_ll) then + gamm=(r-(r_cc-r_ll))/r_ll + sscale2=1.0d0+gamm*gamm*(2*gamm-3.0d0) + else + sscale2=0d0 + endif + return + end function sscale2 + + real(kind=8) function sscagrad2(r,r_cc,r_ll) + real(kind=8) :: r,gamm,r_cc,r_ll +! include "COMMON.SPLITELE" + if(r.lt.r_cc-r_ll) then + sscagrad2=0.0d0 + else if(r.le.r_cc.and.r.ge.r_cc-r_ll) then + gamm=(r-(r_cc-r_ll))/r_ll + sscagrad2=gamm*(6*gamm-6.0d0)/r_ll + else + sscagrad2=0.0d0 + endif + return + end function sscagrad2 + real(kind=8) function sscalelip(r) real(kind=8) r,gamm sscalelip=1.0d0+r*r*(2.0d0*r-3.0d0) @@ -13204,7 +14393,7 @@ ! This subroutine calculates the interaction energy of nonbonded side chains ! assuming the LJ potential of interaction. ! -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -13306,7 +14495,7 @@ ! This subroutine calculates the interaction energy of nonbonded side chains ! assuming the LJ potential of interaction. ! -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -13402,7 +14591,7 @@ ! This subroutine calculates the interaction energy of nonbonded side chains ! assuming the LJK potential of interaction. ! -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -13427,6 +14616,8 @@ xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + call to_box(xi,yi,zi) + ! ! Calculate SC interaction energy. ! @@ -13437,6 +14628,11 @@ xj=c(1,nres+j)-xi yj=c(2,nres+j)-yi zj=c(3,nres+j)-zi + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) + rrij=1.0D0/(xj*xj+yj*yj+zj*zj) fac_augm=rrij**expon e_augm=augm(itypi,itypj)*fac_augm @@ -13489,7 +14685,7 @@ ! This subroutine calculates the interaction energy of nonbonded side chains ! assuming the LJK potential of interaction. ! -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -13588,7 +14784,7 @@ ! assuming the Berne-Pechukas potential of interaction. ! use calc_data -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -13642,10 +14838,10 @@ if (itypj.eq.ntyp1) cycle ! dscj_inv=dsc_inv(itypj) dscj_inv=vbld_inv(j+nres) -chi1=chi(itypi,itypj) -chi2=chi(itypj,itypi) -chi12=chi1*chi2 -chip1=chip(itypi) +!chi1=chi(itypi,itypj) +!chi2=chi(itypj,itypi) +!chi12=chi1*chi2 +!chip1=chip(itypi) alf1=alp(itypi) alf2=alp(itypj) alf12=0.5D0*(alf1+alf2) @@ -13718,7 +14914,7 @@ chip1=chip(itypi) ! assuming the Berne-Pechukas potential of interaction. ! use calc_data -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -13851,7 +15047,7 @@ chip1=chip(itypi) ! assuming the Gay-Berne potential of interaction. ! use calc_data -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -14050,7 +15246,7 @@ chip1=chip(itypi) ! assuming the Gay-Berne potential of interaction. ! use calc_data -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -14064,7 +15260,7 @@ chip1=chip(itypi) ! include 'COMMON.CONTROL' logical :: lprn !el local variables - integer :: iint,itypi,itypi1,itypj,subchap + integer :: iint,itypi,itypi1,itypj,subchap,countss real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig 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,& @@ -14075,6 +15271,7 @@ chip1=chip(itypi) ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon evdw=0.0D0 lprn=.false. + countss=0 ! if (icall.eq.0) lprn=.false. !el ind=0 do i=iatsc_s,iatsc_e @@ -14101,7 +15298,8 @@ chip1=chip(itypi) 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) + countss=countss+1 + call dyn_ssbond_ene(i,j,evdwij,countss) evdw=evdw+evdwij if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') & 'evdw',i,j,evdwij,' ss' @@ -14252,7 +15450,7 @@ chip1=chip(itypi) ! assuming the Gay-Berne-Vorobjev potential of interaction. ! use calc_data -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -14394,7 +15592,7 @@ chip1=chip(itypi) ! assuming the Gay-Berne-Vorobjev potential of interaction. ! use calc_data -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -14537,7 +15735,7 @@ chip1=chip(itypi) ! The potential depends both on the distance of peptide-group centers and on ! the orientation of the CA-CA virtual bonds. ! -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) use comm_locel #ifdef MPI @@ -14616,7 +15814,7 @@ chip1=chip(itypi) #endif ! print *, "before set matrices" call set_matrices -! print *,"after set martices" +! print *,"after set catices" #ifdef TIMING time_mat=time_mat+MPI_Wtime()-time01 #endif @@ -14733,7 +15931,7 @@ chip1=chip(itypi) end subroutine eelec_scale !----------------------------------------------------------------------------- subroutine eelecij_scale(i,j,ees,evdw1,eel_loc) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) use comm_locel ! include 'DIMENSIONS' @@ -15508,7 +16706,7 @@ chip1=chip(itypi) ! ! Compute Evdwpp ! -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.CONTROL' ! include 'COMMON.IOUNITS' @@ -15639,7 +16837,7 @@ chip1=chip(itypi) ! peptide-group centers and side chains and its gradient in virtual-bond and ! side-chain vectors. ! -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -15759,7 +16957,7 @@ chip1=chip(itypi) ! peptide-group centers and side chains and its gradient in virtual-bond and ! side-chain vectors. ! -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -15881,7 +17079,7 @@ chip1=chip(itypi) ! energy_p_new-sep_barrier.F !----------------------------------------------------------------------------- subroutine sc_grad_scale(scalfac) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) use calc_data ! include 'DIMENSIONS' ! include 'COMMON.CHAIN' @@ -15945,7 +17143,7 @@ chip1=chip(itypi) ! ! Compute the long-range slow-varying contributions to the energy ! -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' use MD_data, only: totT,usampl,eq_time #ifndef ISNAN @@ -15973,7 +17171,7 @@ chip1=chip(itypi) integer :: i,n_corr,n_corr1,ierror,ierr real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,& evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,& - ecorr,ecorr5,ecorr6,eturn6,time00 + ecorr,ecorr5,ecorr6,eturn6,time00, ehomology_constr ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot !elwrite(iout,*)"in etotal long" @@ -15985,7 +17183,7 @@ chip1=chip(itypi) #endif endif !elwrite(iout,*)"in etotal long" - + ehomology_constr=0.0d0 #ifdef MPI ! write(iout,*) "ETOTAL_LONG Processor",fg_rank, ! & " absolute rank",myrank," nfgtasks",nfgtasks @@ -16183,6 +17381,7 @@ chip1=chip(itypi) energia(9)=eello_turn4 energia(10)=eturn6 energia(20)=Uconst+Uconst_back + energia(51)=ehomology_constr call sum_energy(energia,.true.) ! write (iout,*) "Exit ETOTAL_LONG" call flush(iout) @@ -16193,7 +17392,7 @@ chip1=chip(itypi) ! ! Compute the short-range fast-varying contributions to the energy ! -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' #ifndef ISNAN external proc_proc @@ -16220,7 +17419,8 @@ chip1=chip(itypi) !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,ethetacnstr + real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr, & + ehomology_constr nres6=6*nres ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot @@ -16362,7 +17562,7 @@ chip1=chip(itypi) ! Calculate the short-range part of ESCp ! if (ipot.lt.6) then - call escp_short(evdw2,evdw2_14) + call escp_short(evdw2,evdw2_14) endif ! ! Calculate the bond-stretching energy @@ -16371,7 +17571,7 @@ chip1=chip(itypi) ! ! Calculate the disulfide-bridge and other energy and the contributions ! from other distance constraints. - call edis(ehpb) +! call edis(ehpb) ! ! Calculate the virtual-bond-angle energy. ! @@ -16382,14 +17582,14 @@ chip1=chip(itypi) ! if (wang.gt.0d0) then if (tor_mode.eq.0) then - call ebend(ebe) + call ebend(ebe) else !C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the !C energy function - call ebend_kcc(ebe) + call ebend_kcc(ebe) endif else - ebe=0.0d0 + ebe=0.0d0 endif ethetacnstr=0.0d0 if (with_theta_constr) call etheta_constr(ethetacnstr) @@ -16416,13 +17616,13 @@ chip1=chip(itypi) if (wtor.gt.0.0d0) then if (tor_mode.eq.0) then call etor(etors) - else + else !C etor kcc is Kubo cumulant clustered rigorous attemp to derive the !C energy function - call etor_kcc(etors) + call etor_kcc(etors) endif else - etors=0.0d0 + etors=0.0d0 endif edihcnstr=0.0d0 if (ndih_constr.gt.0) call etor_constr(edihcnstr) @@ -16436,18 +17636,28 @@ chip1=chip(itypi) call etor_d(etors_d) endif ! +! Homology restraints +! + if (constr_homology.ge.1) then + call e_modeller(ehomology_constr) +! print *,"tu" + else + ehomology_constr=0.0d0 + endif + +! ! 21/5/07 Calculate local sicdechain correlation energy ! if (wsccor.gt.0.0d0) then - call eback_sc_corr(esccor) + call eback_sc_corr(esccor) else - esccor=0.0d0 + esccor=0.0d0 endif ! ! Put energy components into an array ! do i=1,n_ene - energia(i)=0.0d0 + energia(i)=0.0d0 enddo energia(1)=evdw #ifdef SCP14 @@ -16470,6 +17680,7 @@ chip1=chip(itypi) energia(17)=estr energia(19)=edihcnstr energia(21)=esccor + energia(51)=ehomology_constr ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY" call flush(iout) call sum_energy(energia,.true.) @@ -16487,9 +17698,9 @@ chip1=chip(itypi) if (y.lt.ymin) then gnmr1=(ymin-y)**wykl/wykl else if (y.gt.ymax) then - gnmr1=(y-ymax)**wykl/wykl + gnmr1=(y-ymax)**wykl/wykl else - gnmr1=0.0d0 + gnmr1=0.0d0 endif return end function gnmr1 @@ -16499,11 +17710,11 @@ chip1=chip(itypi) real(kind=8) :: y,ymin,ymax real(kind=8) :: wykl=4.0d0 if (y.lt.ymin) then - gnmr1prim=-(ymin-y)**(wykl-1) + gnmr1prim=-(ymin-y)**(wykl-1) else if (y.gt.ymax) then - gnmr1prim=(y-ymax)**(wykl-1) + gnmr1prim=(y-ymax)**(wykl-1) else - gnmr1prim=0.0d0 + gnmr1prim=0.0d0 endif return end function gnmr1prim @@ -16514,7 +17725,7 @@ chip1=chip(itypi) 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) + rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl) else rlornmr1=0.0d0 endif @@ -16528,10 +17739,10 @@ chip1=chip(itypi) 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/ & + rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ & ((y-ymax)**wykl+sigma**wykl)**2 else - rlornmr1prim=0.0d0 + rlornmr1prim=0.0d0 endif return end function rlornmr1prim @@ -16553,10 +17764,11 @@ chip1=chip(itypi) !----------------------------------------------------------------------------- ! gradient_p.F !----------------------------------------------------------------------------- +#ifndef LBFGS subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm) use io_base, only:intout,briefout -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.CHAIN' ! include 'COMMON.DERIV' @@ -16606,18 +17818,18 @@ chip1=chip(itypi) gthetai=0.0D0 gphii=0.0D0 do j=i+1,nres-1 - ind=ind+1 + ind=ind+1 ! ind=indmat(i,j) ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind - 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) - enddo + 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) + enddo + enddo do j=i+1,nres-1 - ind1=ind1+1 + ind1=ind1+1 ! ind1=indmat(i,j) ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1 do k=1,3 @@ -16658,11 +17870,12 @@ chip1=chip(itypi) !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n) return end subroutine gradient +#endif !----------------------------------------------------------------------------- subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F use comm_chu -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.DERIV' ! include 'COMMON.IOUNITS' @@ -16698,7 +17911,7 @@ chip1=chip(itypi) end subroutine func !----------------------------------------------------------------------------- subroutine cartgrad -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' use energy_data use MD_data, only: totT,usampl,eq_time @@ -16715,12 +17928,13 @@ chip1=chip(itypi) ! include 'COMMON.TIME1' ! integer :: i,j + real(kind=8) :: time00,time01 ! This subrouting calculates total Cartesian coordinate gradient. ! The subroutine chainbuild_cart and energy MUST be called beforehand. ! !#define DEBUG -#ifdef TIMING +#ifdef TIMINGtime01 time00=MPI_Wtime() #endif icg=1 @@ -16774,8 +17988,8 @@ chip1=chip(itypi) ! 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),& - (gxcart(j,i),j=1,3),gloc(i,icg) + write (iout,'(i5,2(3f10.5,5x),4f10.5)') i,(gcart(j,i),j=1,3),& + (gxcart(j,i),j=1,3),gloc(i,icg),(gloc_sc(j,i,icg),j=1,3) #endif enddo #ifdef TIMING @@ -16792,7 +18006,7 @@ chip1=chip(itypi) 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) + (gxcart(j,i),j=1,3) enddo #endif !#undef DEBUG @@ -16800,37 +18014,95 @@ chip1=chip(itypi) #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) +! 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 +! 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 +! 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 +! 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 +! call grad_transform #endif #ifdef TIMING - time_cartgrad=time_cartgrad+MPI_Wtime()-time00 + time_cartgrad=time_cartgrad+MPI_Wtime()-time00 #endif !#undef DEBUG - return - end subroutine cartgrad + return + end subroutine cartgrad + +#ifdef FIVEDIAG + subroutine grad_transform + implicit none +#ifdef MPI + include 'mpif.h' +#endif + integer i,j,kk,mnum +#ifdef DEBUG + write (iout,*)"Converting virtual-bond gradient to CA/SC gradient" + write (iout,*) "dC/dX gradient" + do i=0,nres + write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), + & (gxcart(j,i),j=1,3) + enddo +#endif + do i=nres,1,-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 + do i=2,nres + mnum=molnum(i) + if (itype(i-1,mnum).eq.ntyp1_molec(mnum) .and.& + itype(i,mnum).ne.ntyp1_molec(mnum)) then + gcart(:,i)=gcart(:,i)+gcart(:,i-1) + else if (itype(i-1,mnum).ne.ntyp1_molec(mnum).and.& + itype(i,mnum).eq.ntyp1_molec(mnum)) then + gcart(:,i-1)=gcart(:,i-1)+gcart(:,i) + endif + enddo +! if (nnt.gt.1) then +! do j=1,3 +! 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 +#ifdef DEBUG + write (iout,*) "CA/SC gradient" + 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 +#endif + return + end subroutine grad_transform +#endif + !----------------------------------------------------------------------------- - subroutine zerograd - ! implicit real*8 (a-h,o-z) + subroutine zerograd + ! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.DERIV' ! include 'COMMON.CHAIN' @@ -16839,7 +18111,7 @@ chip1=chip(itypi) ! include 'COMMON.SCCOR' ! !el local variables - integer :: i,j,intertyp,k + integer :: i,j,intertyp,k ! Initialize Cartesian-coordinate gradient ! ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2) @@ -16873,114 +18145,128 @@ chip1=chip(itypi) ! 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 + 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 + gradnuclcatx(j,i)=0.0d0 + gradnuclcat(j,i)=0.0d0 + gradlipbond(j,i)=0.0d0 + gradlipang(j,i)=0.0d0 + gradliplj(j,i)=0.0d0 + gradlipelec(j,i)=0.0d0 + gradcattranc(j,i)=0.0d0 + gradcattranx(j,i)=0.0d0 + gradcatangx(j,i)=0.0d0 + gradcatangc(j,i)=0.0d0 + gradpepmart(j,i)=0.0d0 + gradpepmartx(j,i)=0.0d0 + duscdiff(j,i)=0.0d0 + duscdiffx(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 - do i=1,nres - do j=1,maxcontsshi - shield_list(j,i)=0 - do k=1,3 + 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 + grad_shield_side(k,j,i)=0.0d0 + grad_shield_loc(k,j,i)=0.0d0 + enddo + enddo + ishield_list(i)=0 + enddo ! ! Initialize the gradient of local energy terms. @@ -16993,42 +18279,42 @@ chip1=chip(itypi) ! 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 + 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 + 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) + subroutine intcartderiv + ! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' #ifdef MPI - include 'mpif.h' + include 'mpif.h' #endif ! include 'COMMON.SETUP' ! include 'COMMON.CHAIN' @@ -17039,19 +18325,19 @@ chip1=chip(itypi) ! 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 + 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,IERROR + 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 @@ -17067,545 +18353,608 @@ chip1=chip(itypi) #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) ! 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 - dcosomicron(j,1,1,i)=0.0d0 - dcosomicron(j,1,2,i)=0.0d0 - dcosomicron(j,2,1,i)=0.0d0 - dcosomicron(j,2,2,i)=0.0d0 - enddo - enddo + 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 + dcosomicron(j,1,1,i)=0.0d0 + dcosomicron(j,1,2,i)=0.0d0 + dcosomicron(j,2,1,i)=0.0d0 + dcosomicron(j,2,2,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 + 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,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 + 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).and.(sint.ne.0.0d0))) & + 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).and.(sint.ne.0.0d0))& + 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 + do i=max0(ithet_start-1,3),ithet_end #else - do i=3,nres + do i=3,nres #endif - if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1).and.molnum(i).ne.5) 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 + if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1).and.molnum(i).lt.4) 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) + 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) + 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 + 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 + 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) + 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)) + if ((sint*sint1).eq.0.0d0) then + fac0=0.0d0 + else + fac0=1.0d0/(sint1*sint) + endif + fac1=cost*fac0 + fac2=cost1*fac0 + if (sint1.ne.0.0d0) then + fac3=cosg*cost1/(sint1*sint1) + else + fac3=0.0d0 + endif + if (sint.ne.0.0d0) then + fac4=cosg*cost/(sint*sint) + else + fac4=0.0d0 + endif ! 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) + 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 + if (sint.ne.0.0d0) then + ctgt=cost/sint + else + ctgt=0.0d0 + endif + if (sint1.ne.0.0d0) then + ctgt1=cost1/sint1 + else + ctgt1=0.0d0 + endif + 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 + dphi(j,3,i)=cosg_inv*dsinphi(j,3,i) +! endif +! write(iout,*) "just after,close to pi",dphi(j,3,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) + ! Bug fixed 3/24/05 (AL) - enddo + 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) + 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) + write(iout,*) "just after",dphi(j,3,i),sing,dcosphi(j,3,i) #endif !#undef DEBUG - endif - enddo - endif - enddo +! 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 + 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)) 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)) + 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 + 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) + 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 + enddo + scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1)) + ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac + if ((sint*sint1).eq.0.0d0) then + fac0=0.0d0 + else + fac0=1.0d0/(sint1*sint) + endif + fac1=cost*fac0 + fac2=cost1*fac0 + if (sint1.ne.0.0d0) then + fac3=cosg*cost1/(sint1*sint1) + else + fac3=0.0d0 + endif + if (sint.ne.0.0d0) then + fac4=cosg*cost/(sint*sint) + else + fac4=0.0d0 + endif + ! 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) + 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) + 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) + 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 + 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) + 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 + enddo + endif ! do k=1,3 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3) ! enddo - 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,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 + 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)) + 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) + scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres)) + if ((sint*sint1).eq.0.0d0) then + fac0=0.0d0 + else + fac0=1.0d0/(sint1*sint) + endif + fac1=cost*fac0 + fac2=cost1*fac0 + if (sint1.ne.0.0d0) then + fac3=cosg*cost1/(sint1*sint1) + else + fac3=0.0d0 + endif + if (sint.ne.0.0d0) then + fac4=cosg*cost/(sint*sint) + else + fac4=0.0d0 + endif ! 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) + 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) + 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) + 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) + 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 + 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) + 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 + enddo + endif + enddo !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,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) + 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) + enddo + scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres)) + if ((sint*sint1).eq.0.0d0) then + fac0=0.0d0 + else + fac0=1.0d0/(sint1*sint) + endif + fac1=cost*fac0 + fac2=cost1*fac0 + if (sint1.ne.0.0d0) then + fac3=cosg*cost1/(sint1*sint1) + else + fac3=0.0d0 + endif + if (sint.ne.0.0d0) then + fac4=cosg*cost/(sint*sint) + else + fac4=0.0d0 + endif ! 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) + 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) + 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 + 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) + 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 + enddo + endif + enddo #ifdef CRYST_SC ! 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,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)) + 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 + 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 + 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 - do k=1,3 - dalpha(k,j,i)=0.0d0 - domega(k,j,i)=0.0d0 - enddo - enddo - endif - enddo + 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 #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 + 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 + 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 !#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) + 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) + 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(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 !#undef DEBUG - return - end subroutine intcartderiv + return + end subroutine intcartderiv !----------------------------------------------------------------------------- - subroutine checkintcartgrad - ! implicit real*8 (a-h,o-z) + subroutine checkintcartgrad + ! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' #ifdef MPI - include 'mpif.h' + include 'mpif.h' #endif ! include 'COMMON.CHAIN' ! include 'COMMON.VAR' @@ -17614,37 +18963,37 @@ chip1=chip(itypi) ! 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 + 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 - dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr - dc(j,i-1)=dcji - enddo + 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 + dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr + dc(j,i-1)=dcji + enddo !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),& !el (dtheta(j,2,i),j=1,3) !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),& @@ -17658,23 +19007,23 @@ chip1=chip(itypi) write (iout,*) & "Analytical (upper) and numerical (lower) gradient of gamma" do i=4,nres - do j=1,3 - dcji=dc(j,i-3) - dc(j,i-3)=dcji+aincr - call chainbuild_cart - dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr - dc(j,i-3)=dcji - dcji=dc(j,i-2) - dc(j,i-2)=dcji+aincr - call chainbuild_cart - dphinum(j,2,i)=(phi(i)-phi_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 - dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr - dc(j,i-1)=dcji - enddo + do j=1,3 + dcji=dc(j,i-3) + dc(j,i-3)=dcji+aincr + call chainbuild_cart + dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr + dc(j,i-3)=dcji + dcji=dc(j,i-2) + dc(j,i-2)=dcji+aincr + call chainbuild_cart + dphinum(j,2,i)=(phi(i)-phi_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 + dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr + dc(j,i-1)=dcji + enddo !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),& !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3) !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),& @@ -17690,27 +19039,27 @@ chip1=chip(itypi) "Analytical (upper) and numerical (lower) gradient of alpha" do i=2,nres-1 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 - dcji=dc(j,i) - dc(j,i)=dcji+aincr - call chainbuild_cart - dalphanum(j,2,i)=(alph(i)-alph_s(i)) & - /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 - dc(j,i+nres)=dcji - enddo - endif + 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 + dcji=dc(j,i) + dc(j,i)=dcji+aincr + call chainbuild_cart + dalphanum(j,2,i)=(alph(i)-alph_s(i)) & + /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 + dc(j,i+nres)=dcji + enddo + 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),& @@ -17726,27 +19075,27 @@ chip1=chip(itypi) "Analytical (upper) and numerical (lower) gradient of omega" do i=2,nres-1 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 - dcji=dc(j,i) - dc(j,i)=dcji+aincr - call chainbuild_cart - domeganum(j,2,i)=(omeg(i)-omeg_s(i)) & - /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 - dc(j,i+nres)=dcji - enddo - endif + 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 + dcji=dc(j,i) + dc(j,i)=dcji+aincr + call chainbuild_cart + domeganum(j,2,i)=(omeg(i)-omeg_s(i)) & + /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 + dc(j,i+nres)=dcji + enddo + 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),& @@ -17763,7 +19112,7 @@ chip1=chip(itypi) ! q_measure.F !----------------------------------------------------------------------------- real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.CHAIN' @@ -17783,53 +19132,53 @@ chip1=chip(itypi) qq = 0.0d0 nl=0 if(flag) then - do il=seg1+nsep,seg2 - do jl=seg1,il-nsep + do il=seg1+nsep,seg2 + do jl=seg1,il-nsep + nl=nl+1 + d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + & + (cref(2,jl,kkk)-cref(2,il,kkk))**2 + & + (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,1).ne.10 .or. itype(jl,1).ne.10) then nl=nl+1 - d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + & - (cref(2,jl,kkk)-cref(2,il,kkk))**2 + & - (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,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+ & - (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ & - (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2) - dijCM=dist(il+nres,jl+nres) - qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2) - endif - qq = qq+qqij+qqijCM - enddo - enddo - qq = qq/nl + d0ijCM=dsqrt( & + (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ & + (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ & + (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2) + dijCM=dist(il+nres,jl+nres) + qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2) + endif + qq = qq+qqij+qqijCM + enddo + enddo + qq = qq/nl else do il=seg1,seg2 - if((seg3-il).lt.3) then - secseg=il+3 - else - secseg=seg3 - endif - do jl=secseg,seg4 + if((seg3-il).lt.3) then + secseg=il+3 + else + secseg=seg3 + endif + do jl=secseg,seg4 + nl=nl+1 + d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ & + (cref(2,jl,kkk)-cref(2,il,kkk))**2+ & + (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,1).ne.10 .or. itype(jl,1).ne.10) then nl=nl+1 - d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ & - (cref(2,jl,kkk)-cref(2,il,kkk))**2+ & - (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,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+ & - (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ & - (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2) - dijCM=dist(il+nres,jl+nres) - qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2) - endif - qq = qq+qqij+qqijCM - enddo + d0ijCM=dsqrt( & + (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ & + (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ & + (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2) + dijCM=dist(il+nres,jl+nres) + qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2) + endif + qq = qq+qqij+qqijCM enddo + enddo qq = qq/nl endif if (qqmax.le.qq) qqmax=qq @@ -17839,7 +19188,7 @@ chip1=chip(itypi) end function qwolynes !----------------------------------------------------------------------------- subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.CHAIN' @@ -17856,103 +19205,103 @@ chip1=chip(itypi) !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 - enddo + do j=1,3 + dqwol(j,i)=0.0d0 + dxqwol(j,i)=0.0d0 + enddo enddo nl=0 if(flag) then - do il=seg1+nsep,seg2 - do jl=seg1,il-nsep + do il=seg1+nsep,seg2 + do jl=seg1,il-nsep + nl=nl+1 + d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ & + (cref(2,jl,kkk)-cref(2,il,kkk))**2+ & + (cref(3,jl,kkk)-cref(3,il,kkk))**2) + dij=dist(il,jl) + sim = 1.0d0/sigm(d0ij) + sim = sim*sim + dd0 = dij-d0ij + fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim) + 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,1).ne.10 .or. itype(jl,1).ne.10) then nl=nl+1 - d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ & - (cref(2,jl,kkk)-cref(2,il,kkk))**2+ & - (cref(3,jl,kkk)-cref(3,il,kkk))**2) - dij=dist(il,jl) - sim = 1.0d0/sigm(d0ij) + d0ijCM=dsqrt( & + (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ & + (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ & + (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2) + dijCM=dist(il+nres,jl+nres) + sim = 1.0d0/sigm(d0ijCM) sim = sim*sim - dd0 = dij-d0ij - fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim) - 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 + dd0=dijCM-d0ijCM + fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim) + do k=1,3 + ddqij = (c(k,il+nres)-c(k,jl+nres))*fac + dxqwol(k,il)=dxqwol(k,il)+ddqij + dxqwol(k,jl)=dxqwol(k,jl)-ddqij enddo - - 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+ & - (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ & - (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2) - dijCM=dist(il+nres,jl+nres) - sim = 1.0d0/sigm(d0ijCM) - sim = sim*sim - dd0=dijCM-d0ijCM - fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim) - do k=1,3 - ddqij = (c(k,il+nres)-c(k,jl+nres))*fac - dxqwol(k,il)=dxqwol(k,il)+ddqij - dxqwol(k,jl)=dxqwol(k,jl)-ddqij - enddo - endif - enddo - enddo + endif + enddo + enddo else - do il=seg1,seg2 - if((seg3-il).lt.3) then - secseg=il+3 - else - secseg=seg3 - endif - do jl=secseg,seg4 + do il=seg1,seg2 + if((seg3-il).lt.3) then + secseg=il+3 + else + secseg=seg3 + endif + do jl=secseg,seg4 + nl=nl+1 + d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ & + (cref(2,jl,kkk)-cref(2,il,kkk))**2+ & + (cref(3,jl,kkk)-cref(3,il,kkk))**2) + dij=dist(il,jl) + sim = 1.0d0/sigm(d0ij) + sim = sim*sim + dd0 = dij-d0ij + fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim) + 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,1).ne.10 .or. itype(jl,1).ne.10) then nl=nl+1 - d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ & - (cref(2,jl,kkk)-cref(2,il,kkk))**2+ & - (cref(3,jl,kkk)-cref(3,il,kkk))**2) - dij=dist(il,jl) - sim = 1.0d0/sigm(d0ij) - sim = sim*sim - dd0 = dij-d0ij - fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim) + d0ijCM=dsqrt( & + (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ & + (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ & + (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2) + dijCM=dist(il+nres,jl+nres) + sim = 1.0d0/sigm(d0ijCM) + sim=sim*sim + dd0 = dijCM-d0ijCM + fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim) 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 + ddqij = (c(k,il+nres)-c(k,jl+nres))*fac + dxqwol(k,il)=dxqwol(k,il)+ddqij + dxqwol(k,jl)=dxqwol(k,jl)-ddqij enddo - 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+ & - (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ & - (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2) - dijCM=dist(il+nres,jl+nres) - sim = 1.0d0/sigm(d0ijCM) - sim=sim*sim - dd0 = dijCM-d0ijCM - fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim) - do k=1,3 - ddqij = (c(k,il+nres)-c(k,jl+nres))*fac - dxqwol(k,il)=dxqwol(k,il)+ddqij - dxqwol(k,jl)=dxqwol(k,jl)-ddqij - enddo - endif - enddo - enddo + endif + enddo + enddo endif enddo do i=0,nres - do j=1,3 - dqwol(j,i)=dqwol(j,i)/nl - dxqwol(j,i)=dxqwol(j,i)/nl - enddo + do j=1,3 + dqwol(j,i)=dqwol(j,i)/nl + dxqwol(j,i)=dxqwol(j,i)/nl + enddo enddo return end subroutine qwolynes_prim !----------------------------------------------------------------------------- subroutine qwol_num(seg1,seg2,flag,seg3,seg4) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.CHAIN' @@ -17967,24 +19316,24 @@ chip1=chip(itypi) integer :: i,j do i=0,nres - do j=1,3 - q1=qwolynes(seg1,seg2,flag,seg3,seg4) - cdummy(j,i)=c(j,i) - c(j,i)=c(j,i)+delta - q2=qwolynes(seg1,seg2,flag,seg3,seg4) - qwolan(j,i)=(q2-q1)/delta - c(j,i)=cdummy(j,i) - enddo + do j=1,3 + q1=qwolynes(seg1,seg2,flag,seg3,seg4) + cdummy(j,i)=c(j,i) + c(j,i)=c(j,i)+delta + q2=qwolynes(seg1,seg2,flag,seg3,seg4) + qwolan(j,i)=(q2-q1)/delta + c(j,i)=cdummy(j,i) + enddo enddo do i=0,nres - do j=1,3 - q1=qwolynes(seg1,seg2,flag,seg3,seg4) - cdummy(j,i+nres)=c(j,i+nres) - c(j,i+nres)=c(j,i+nres)+delta - q2=qwolynes(seg1,seg2,flag,seg3,seg4) - qwolxan(j,i)=(q2-q1)/delta - c(j,i+nres)=cdummy(j,i+nres) - enddo + do j=1,3 + q1=qwolynes(seg1,seg2,flag,seg3,seg4) + cdummy(j,i+nres)=c(j,i+nres) + c(j,i+nres)=c(j,i+nres)+delta + q2=qwolynes(seg1,seg2,flag,seg3,seg4) + qwolxan(j,i)=(q2-q1)/delta + c(j,i+nres)=cdummy(j,i+nres) + enddo enddo ! write(iout,*) "Numerical Q carteisan gradients backbone: " ! do i=0,nct @@ -17999,7 +19348,7 @@ chip1=chip(itypi) !----------------------------------------------------------------------------- subroutine EconstrQ ! MD with umbrella_sampling using Wolyne's distance measure as a constraint -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.CONTROL' ! include 'COMMON.VAR' @@ -18020,26 +19369,26 @@ chip1=chip(itypi) ! include 'COMMON.TIME1' real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,& - duconst,duxconst + duconst,duxconst integer :: kstart,kend,lstart,lend,idummy real(kind=8) :: delta=1.0d-7 integer :: i,j,k,ii do i=0,nres - do j=1,3 - duconst(j,i)=0.0d0 - dudconst(j,i)=0.0d0 - duxconst(j,i)=0.0d0 - dudxconst(j,i)=0.0d0 - enddo + do j=1,3 + duconst(j,i)=0.0d0 + dudconst(j,i)=0.0d0 + duxconst(j,i)=0.0d0 + dudxconst(j,i)=0.0d0 + enddo enddo Uconst=0.0d0 do i=1,nfrag - qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,& - idummy,idummy) - Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset)) + qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,& + idummy,idummy) + Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset)) ! Calculating the derivatives of Constraint energy with respect to Q - Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),& - qinfrag(i,iset)) + 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 @@ -18047,8 +19396,8 @@ chip1=chip(itypi) ! & qinfrag(i,iset)) ! 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) + call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,& + idummy,idummy) ! write(iout,*) "dqwol " ! do ii=1,nres ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3) @@ -18061,22 +19410,22 @@ chip1=chip(itypi) ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true. ! & ,idummy,idummy) ! The gradients of Uconst in Cs - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii) - enddo - enddo + do ii=0,nres + do j=1,3 + duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii) + dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii) + enddo + enddo enddo do i=1,npair - kstart=ifrag(1,ipair(1,i,iset),iset) - kend=ifrag(2,ipair(1,i,iset),iset) - lstart=ifrag(1,ipair(2,i,iset),iset) - lend=ifrag(2,ipair(2,i,iset),iset) - qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend) - Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset)) + kstart=ifrag(1,ipair(1,i,iset),iset) + kend=ifrag(2,ipair(1,i,iset),iset) + lstart=ifrag(1,ipair(2,i,iset),iset) + lend=ifrag(2,ipair(2,i,iset),iset) + qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend) + Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset)) ! Calculating dU/dQ - Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset)) + 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 @@ -18084,8 +19433,8 @@ chip1=chip(itypi) ! & qinpair(i,iset)) ! write(iout,*) "harmonicnum pair ", hmnum ! Calculating dQ/dXi - call qwolynes_prim(kstart,kend,.false.,& - lstart,lend) + call qwolynes_prim(kstart,kend,.false.,& + lstart,lend) ! write(iout,*) "dqwol " ! do ii=1,nres ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3) @@ -18098,27 +19447,27 @@ chip1=chip(itypi) ! call qwol_num(kstart,kend,.false. ! & ,lstart,lend) ! The gradients of Uconst in Cs - do ii=0,nres - do j=1,3 - duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii) - dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii) - enddo - enddo + do ii=0,nres + do j=1,3 + duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii) + dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii) + enddo + enddo enddo ! write(iout,*) "Uconst inside subroutine ", Uconst ! Transforming the gradients from Cs to dCs for the backbone do i=0,nres - do j=i+1,nres - do k=1,3 - dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j) - enddo + do j=i+1,nres + do k=1,3 + dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j) enddo + enddo enddo ! Transforming the gradients from Cs to dCs for the side chains do i=1,nres - do j=1,3 - dudxconst(j,i)=duxconst(j,i) - enddo + do j=1,3 + dudxconst(j,i)=duxconst(j,i) + enddo enddo ! write(iout,*) "dU/ddc backbone " ! do ii=0,nres @@ -18135,7 +19484,7 @@ chip1=chip(itypi) !----------------------------------------------------------------------------- subroutine dEconstrQ_num ! Calculating numerical dUconst/ddc and dUconst/ddx -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.CONTROL' ! include 'COMMON.VAR' @@ -18163,95 +19512,95 @@ chip1=chip(itypi) ! real(kind=8) :: ! For the backbone do i=0,nres-1 - do j=1,3 - dUcartan(j,i)=0.0d0 - cdummy(j,i)=dc(j,i) - dc(j,i)=dc(j,i)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,& - idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),& - qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),& - qinpair(ii,iset)) - enddo - dc(j,i)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,& - idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),& - qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),& - qinpair(ii,iset)) - enddo - ducartan(j,i)=(uzap2-uzap1)/(delta) - enddo + do j=1,3 + dUcartan(j,i)=0.0d0 + cdummy(j,i)=dc(j,i) + dc(j,i)=dc(j,i)+delta + call chainbuild_cart + uzap2=0.0d0 + do ii=1,nfrag + qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,& + idummy,idummy) + uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),& + qinfrag(ii,iset)) + enddo + do ii=1,npair + kstart=ifrag(1,ipair(1,ii,iset),iset) + kend=ifrag(2,ipair(1,ii,iset),iset) + lstart=ifrag(1,ipair(2,ii,iset),iset) + lend=ifrag(2,ipair(2,ii,iset),iset) + qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) + uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),& + qinpair(ii,iset)) + enddo + dc(j,i)=cdummy(j,i) + call chainbuild_cart + uzap1=0.0d0 + do ii=1,nfrag + qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,& + idummy,idummy) + uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),& + qinfrag(ii,iset)) + enddo + do ii=1,npair + kstart=ifrag(1,ipair(1,ii,iset),iset) + kend=ifrag(2,ipair(1,ii,iset),iset) + lstart=ifrag(1,ipair(2,ii,iset),iset) + lend=ifrag(2,ipair(2,ii,iset),iset) + qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) + uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),& + qinpair(ii,iset)) + enddo + ducartan(j,i)=(uzap2-uzap1)/(delta) + enddo enddo ! Calculating numerical gradients for dU/ddx do i=0,nres-1 - duxcartan(j,i)=0.0d0 - do j=1,3 - cdummy(j,i)=dc(j,i+nres) - dc(j,i+nres)=dc(j,i+nres)+delta - call chainbuild_cart - uzap2=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,& - idummy,idummy) - uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),& - qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),& - qinpair(ii,iset)) - enddo - dc(j,i+nres)=cdummy(j,i) - call chainbuild_cart - uzap1=0.0d0 - do ii=1,nfrag - qfrag(ii)=qwolynes(ifrag(1,ii,iset),& - ifrag(2,ii,iset),.true.,idummy,idummy) - uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),& - qinfrag(ii,iset)) - enddo - do ii=1,npair - kstart=ifrag(1,ipair(1,ii,iset),iset) - kend=ifrag(2,ipair(1,ii,iset),iset) - lstart=ifrag(1,ipair(2,ii,iset),iset) - lend=ifrag(2,ipair(2,ii,iset),iset) - qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) - uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),& - qinpair(ii,iset)) - enddo - duxcartan(j,i)=(uzap2-uzap1)/(delta) - enddo + duxcartan(j,i)=0.0d0 + do j=1,3 + cdummy(j,i)=dc(j,i+nres) + dc(j,i+nres)=dc(j,i+nres)+delta + call chainbuild_cart + uzap2=0.0d0 + do ii=1,nfrag + qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,& + idummy,idummy) + uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),& + qinfrag(ii,iset)) + enddo + do ii=1,npair + kstart=ifrag(1,ipair(1,ii,iset),iset) + kend=ifrag(2,ipair(1,ii,iset),iset) + lstart=ifrag(1,ipair(2,ii,iset),iset) + lend=ifrag(2,ipair(2,ii,iset),iset) + qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) + uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),& + qinpair(ii,iset)) + enddo + dc(j,i+nres)=cdummy(j,i) + call chainbuild_cart + uzap1=0.0d0 + do ii=1,nfrag + qfrag(ii)=qwolynes(ifrag(1,ii,iset),& + ifrag(2,ii,iset),.true.,idummy,idummy) + uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),& + qinfrag(ii,iset)) + enddo + do ii=1,npair + kstart=ifrag(1,ipair(1,ii,iset),iset) + kend=ifrag(2,ipair(1,ii,iset),iset) + lstart=ifrag(1,ipair(2,ii,iset),iset) + lend=ifrag(2,ipair(2,ii,iset),iset) + qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend) + uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),& + qinpair(ii,iset)) + enddo + duxcartan(j,i)=(uzap2-uzap1)/(delta) + enddo enddo write(iout,*) "Numerical dUconst/ddc backbone " do ii=0,nres - write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3) + write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3) enddo ! write(iout,*) "Numerical dUconst/ddx side-chain " ! do ii=1,nres @@ -18281,14 +19630,14 @@ chip1=chip(itypi) !EL external ran_number ! Local variables - integer :: i,j,k,l,lmax,p,pmax + integer :: i,j,k,l,lmax,p,pmax,countss real(kind=8) :: rmin,rmax real(kind=8) :: eij real(kind=8) :: d real(kind=8) :: wi,rij,tj,pj ! return - + countss=1 i=5 j=14 @@ -18300,10 +19649,10 @@ chip1=chip(itypi) pmax=1 do k=1,3 - c(k,i)=0.0D0 - c(k,j)=0.0D0 - c(k,nres+i)=0.0D0 - c(k,nres+j)=0.0D0 + c(k,i)=0.0D0 + c(k,j)=0.0D0 + c(k,nres+i)=0.0D0 + c(k,nres+j)=0.0D0 enddo do l=1,lmax @@ -18316,33 +19665,33 @@ chip1=chip(itypi) ! pj=ran_number(0.0D0,pi/6.0D0) ! pj=0.0D0 - do p=1,pmax + do p=1,pmax !t rij=ran_number(rmin,rmax) - c(1,j)=d*sin(pj)*cos(tj) - c(2,j)=d*sin(pj)*sin(tj) - c(3,j)=d*cos(pj) + c(1,j)=d*sin(pj)*cos(tj) + c(2,j)=d*sin(pj)*sin(tj) + c(3,j)=d*cos(pj) - c(3,nres+i)=-rij + c(3,nres+i)=-rij - c(1,i)=d*sin(wi) - c(3,i)=-rij-d*cos(wi) + c(1,i)=d*sin(wi) + c(3,i)=-rij-d*cos(wi) - do k=1,3 - dc(k,nres+i)=c(k,nres+i)-c(k,i) - dc_norm(k,nres+i)=dc(k,nres+i)/d - dc(k,nres+j)=c(k,nres+j)-c(k,j) - dc_norm(k,nres+j)=dc(k,nres+j)/d - enddo + do k=1,3 + dc(k,nres+i)=c(k,nres+i)-c(k,i) + dc_norm(k,nres+i)=dc(k,nres+i)/d + dc(k,nres+j)=c(k,nres+j)-c(k,j) + dc_norm(k,nres+j)=dc(k,nres+j)/d + enddo - call dyn_ssbond_ene(i,j,eij) - enddo + call dyn_ssbond_ene(i,j,eij,countss) + enddo enddo call exit(1) return end subroutine check_energies !----------------------------------------------------------------------------- - subroutine dyn_ssbond_ene(resi,resj,eij) + subroutine dyn_ssbond_ene(resi,resj,eij,countss) ! implicit none ! Includes use calc_data @@ -18375,7 +19724,7 @@ chip1=chip(itypi) ! Local variables logical :: havebond - integer itypi,itypj + integer itypi,itypj,countss real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2 real(kind=8),dimension(3) :: dcosom1,dcosom2 @@ -18466,8 +19815,8 @@ chip1=chip(itypi) ssA=akcm ssB=akct*deltat12 ssC=ss_depth & - +akth*(deltat1*deltat1+deltat2*deltat2) & - +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi + +akth*(deltat1*deltat1+deltat2*deltat2) & + +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi ssxm=ssXs-0.5D0*ssB/ssA !-------TESTING CODE @@ -18489,119 +19838,119 @@ chip1=chip(itypi) !-------TESTING CODE ! 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_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 - njcheck=1 - deps=0.5d-7 - else - checkstop=.false. - endif + ssm=ssC-0.25D0*ssB*ssB/ssA + 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 + njcheck=1 + deps=0.5d-7 + else + checkstop=.false. + endif endif if (.not.checkstop) then - nicheck=0 - njcheck=-1 + nicheck=0 + njcheck=-1 endif do icheck=0,nicheck do jcheck=-1,njcheck if (checkstop) rij=(ssxm-1.0d0)+ & - ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps + ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps !-------END TESTING CODE if (rij.gt.ljxm) then - havebond=.false. - ljd=rij-ljXs - fac=(1.0D0/ljd)**expon - 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 - eij=eij*eps2rt*eps3rt - - sigder=-sig/sigsq - e1=e1*eps1*eps2rt**2*eps3rt**2 - ed=-expon*(e1+eij)/ljd - sigder=ed*sigder - eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 - eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 - eom12=eij*eps1_om12+eps2der*eps2rt_om12 & - -2.0D0*alf12*eps3der+sigder*sigsq_om12 + havebond=.false. + ljd=rij-ljXs + fac=(1.0D0/ljd)**expon + 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 + eij=eij*eps2rt*eps3rt + + sigder=-sig/sigsq + e1=e1*eps1*eps2rt**2*eps3rt**2 + ed=-expon*(e1+eij)/ljd + sigder=ed*sigder + eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 + eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 + eom12=eij*eps1_om12+eps2der*eps2rt_om12 & + -2.0D0*alf12*eps3der+sigder*sigsq_om12 else if (rij.lt.ssxm) then - havebond=.true. - ssd=rij-ssXs - eij=ssA*ssd*ssd+ssB*ssd+ssC - - ed=2*akcm*ssd+akct*deltat12 - pom1=akct*ssd - pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi - eom1=-2*akth*deltat1-pom1-om2*pom2 - eom2= 2*akth*deltat2+pom1-om1*pom2 - eom12=pom2 + havebond=.true. + ssd=rij-ssXs + eij=ssA*ssd*ssd+ssB*ssd+ssC + + ed=2*akcm*ssd+akct*deltat12 + pom1=akct*ssd + pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi + eom1=-2*akth*deltat1-pom1-om2*pom2 + eom2= 2*akth*deltat2+pom1-om1*pom2 + eom12=pom2 else - omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi + omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi - d_ssxm(1)=0.5D0*akct/ssA - d_ssxm(2)=-d_ssxm(1) - d_ssxm(3)=0.0D0 + d_ssxm(1)=0.5D0*akct/ssA + d_ssxm(2)=-d_ssxm(1) + d_ssxm(3)=0.0D0 - d_ljxm(1)=sig0ij/sqrt(sigsq**3) - d_ljxm(2)=d_ljxm(1)*sigsq_om2 - d_ljxm(3)=d_ljxm(1)*sigsq_om12 - d_ljxm(1)=d_ljxm(1)*sigsq_om1 + d_ljxm(1)=sig0ij/sqrt(sigsq**3) + d_ljxm(2)=d_ljxm(1)*sigsq_om2 + d_ljxm(3)=d_ljxm(1)*sigsq_om12 + d_ljxm(1)=d_ljxm(1)*sigsq_om1 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE - xm=0.5d0*(ssxm+ljxm) - do k=1,3 - d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k)) - enddo - if (rij.lt.xm) then - havebond=.true. - ssm=ssC-0.25D0*ssB*ssB/ssA - d_ssm(1)=0.5D0*akct*ssB/ssA - d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1) - d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1) - d_ssm(3)=omega - f1=(rij-xm)/(ssxm-xm) - f2=(rij-ssxm)/(xm-ssxm) - h1=h_base(f1,hd1) - h2=h_base(f2,hd2) - eij=ssm*h1+Ht*h2 - delta_inv=1.0d0/(xm-ssxm) - deltasq_inv=delta_inv*delta_inv - fac=ssm*hd1-Ht*hd2 - fac1=deltasq_inv*fac*(xm-rij) - fac2=deltasq_inv*fac*(rij-ssxm) - ed=delta_inv*(Ht*hd2-ssm*hd1) - eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1) - eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2) - eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3) - else - havebond=.false. - 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) - d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt) - f1=(rij-ljxm)/(xm-ljxm) - f2=(rij-xm)/(ljxm-xm) - h1=h_base(f1,hd1) - h2=h_base(f2,hd2) - eij=Ht*h1+ljm*h2 - delta_inv=1.0d0/(ljxm-xm) - deltasq_inv=delta_inv*delta_inv - fac=Ht*hd1-ljm*hd2 - fac1=deltasq_inv*fac*(ljxm-rij) - fac2=deltasq_inv*fac*(rij-xm) - ed=delta_inv*(ljm*hd2-Ht*hd1) - eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1) - eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2) - eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3) - endif + xm=0.5d0*(ssxm+ljxm) + do k=1,3 + d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k)) + enddo + if (rij.lt.xm) then + havebond=.true. + ssm=ssC-0.25D0*ssB*ssB/ssA + d_ssm(1)=0.5D0*akct*ssB/ssA + d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1) + d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1) + d_ssm(3)=omega + f1=(rij-xm)/(ssxm-xm) + f2=(rij-ssxm)/(xm-ssxm) + h1=h_base(f1,hd1) + h2=h_base(f2,hd2) + eij=ssm*h1+Ht*h2 + delta_inv=1.0d0/(xm-ssxm) + deltasq_inv=delta_inv*delta_inv + fac=ssm*hd1-Ht*hd2 + fac1=deltasq_inv*fac*(xm-rij) + fac2=deltasq_inv*fac*(rij-ssxm) + ed=delta_inv*(Ht*hd2-ssm*hd1) + eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1) + eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2) + eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3) + else + havebond=.false. + 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) + d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt) + f1=(rij-ljxm)/(xm-ljxm) + f2=(rij-xm)/(ljxm-xm) + h1=h_base(f1,hd1) + h2=h_base(f2,hd2) + eij=Ht*h1+ljm*h2 + delta_inv=1.0d0/(ljxm-xm) + deltasq_inv=delta_inv*delta_inv + fac=Ht*hd1-ljm*hd2 + fac1=deltasq_inv*fac*(ljxm-rij) + fac2=deltasq_inv*fac*(rij-xm) + ed=delta_inv*(ljm*hd2-Ht*hd1) + eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1) + eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2) + eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3) + endif !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE @@ -18673,9 +20022,9 @@ chip1=chip(itypi) ! 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 + dyn_ssbond_ij(countss)=eij + else if (.not.havebond .and. dyn_ssbond_ij(countss).lt.1.0d300) then + dyn_ssbond_ij(countss)=1.0d300 !#ifndef CLUST !#ifndef WHAM ! write(iout,'(a15,f12.2,f8.1,2i5)') @@ -18686,35 +20035,35 @@ chip1=chip(itypi) !-------TESTING CODE !el if (checkstop) then - if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') & - "CHECKSTOP",rij,eij,ed - echeck(jcheck)=eij + if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') & + "CHECKSTOP",rij,eij,ed + echeck(jcheck)=eij !el endif enddo if (checkstop) then - write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps + write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps endif enddo if (checkstop) then - transgrad=.true. - checkstop=.false. + transgrad=.true. + checkstop=.false. endif !-------END TESTING CODE do k=1,3 - dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij - dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij + dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij + dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij enddo do k=1,3 - gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k) + gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k) enddo 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 - 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 + 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 enddo !grad do k=i,j-1 !grad do l=1,3 @@ -18723,14 +20072,14 @@ chip1=chip(itypi) !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) + gvdwc(l,j)=gvdwc(l,j)+gg(l) enddo return end subroutine dyn_ssbond_ene !-------------------------------------------------------------------------- - subroutine triple_ssbond_ene(resi,resj,resk,eij) + subroutine triple_ssbond_ene(resi,resj,resk,eij) ! implicit none ! Includes use calc_data @@ -18788,11 +20137,12 @@ chip1=chip(itypi) xi=c(1,nres+i) yi=c(2,nres+i) zi=c(3,nres+i) + call to_box(xi,yi,zi) itypj=itype(j,1) xj=c(1,nres+j) yj=c(2,nres+j) zj=c(3,nres+j) - + call to_box(xj,yj,zj) dxj=dc_norm(1,nres+j) dyj=dc_norm(2,nres+j) dzj=dc_norm(3,nres+j) @@ -18801,7 +20151,7 @@ chip1=chip(itypi) xk=c(1,nres+k) yk=c(2,nres+k) zk=c(3,nres+k) - + call to_box(xk,yk,zk) dxk=dc_norm(1,nres+k) dyk=dc_norm(2,nres+k) dzk=dc_norm(3,nres+k) @@ -18852,47 +20202,47 @@ chip1=chip(itypi) !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 + 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) + 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) + 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 + 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) + 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) + 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 + 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) + 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) + gvdwc(l,j)=gvdwc(l,j)-gg(l) + gvdwc(l,k)=gvdwc(l,k)+gg(l) enddo return end subroutine triple_ssbond_ene @@ -18955,10 +20305,10 @@ chip1=chip(itypi) ! include 'COMMON.MD' ! Local variables real(kind=8) :: emin - integer :: i,j,imin,ierr + integer :: i,j,imin,ierr,k integer :: diff,allnss,newnss integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2) - newihpb,newjhpb + newihpb,newjhpb,aliass logical :: found integer,dimension(0:nfgtasks) :: i_newnss integer,dimension(0:nfgtasks) :: displ @@ -18966,79 +20316,84 @@ chip1=chip(itypi) integer :: g_newnss allnss=0 + k=0 do i=1,nres-1 - do j=i+1,nres - if (dyn_ssbond_ij(i,j).lt.1.0d300) then - allnss=allnss+1 - allflag(allnss)=0 - allihpb(allnss)=i - alljhpb(allnss)=j - endif - enddo + do j=i+1,nres + if ((itype(i,1).eq.1).and.(itype(j,1).eq.1)) then + k=k+1 + if (dyn_ssbond_ij(k).lt.1.0d300) then + allnss=allnss+1 + allflag(allnss)=0 + allihpb(allnss)=i + alljhpb(allnss)=j + aliass(allnss)=k + endif + endif + enddo enddo !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss) 1 emin=1.0d300 do i=1,allnss + if (allflag(i).eq.0 .and. & + dyn_ssbond_ij(aliass(allnss)).lt.emin) then + emin=dyn_ssbond_ij(aliass(allnss)) + imin=i + endif + enddo + if (emin.lt.1.0d300) then + allflag(imin)=1 + do i=1,allnss if (allflag(i).eq.0 .and. & - dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then - emin=dyn_ssbond_ij(allihpb(i),alljhpb(i)) - imin=i + (allihpb(i).eq.allihpb(imin) .or. & + alljhpb(i).eq.allihpb(imin) .or. & + allihpb(i).eq.alljhpb(imin) .or. & + alljhpb(i).eq.alljhpb(imin))) then + allflag(i)=-1 endif enddo - if (emin.lt.1.0d300) then - allflag(imin)=1 - do i=1,allnss - if (allflag(i).eq.0 .and. & - (allihpb(i).eq.allihpb(imin) .or. & - alljhpb(i).eq.allihpb(imin) .or. & - allihpb(i).eq.alljhpb(imin) .or. & - alljhpb(i).eq.alljhpb(imin))) then - allflag(i)=-1 - endif - enddo - goto 1 + goto 1 endif !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss) newnss=0 do i=1,allnss - if (allflag(i).eq.1) then - newnss=newnss+1 - newihpb(newnss)=allihpb(i) - newjhpb(newnss)=alljhpb(i) - endif + if (allflag(i).eq.1) then + newnss=newnss+1 + newihpb(newnss)=allihpb(i) + newjhpb(newnss)=alljhpb(i) + endif enddo #ifdef MPI if (nfgtasks.gt.1)then - call MPI_Reduce(newnss,g_newnss,1,& - MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) - call MPI_Gather(newnss,1,MPI_INTEGER,& - i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR) - displ(0)=0 - do i=1,nfgtasks-1,1 - displ(i)=i_newnss(i-1)+displ(i-1) - enddo - call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,& - g_newihpb,i_newnss,displ,MPI_INTEGER,& - king,FG_COMM,IERR) - call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,& - g_newjhpb,i_newnss,displ,MPI_INTEGER,& - king,FG_COMM,IERR) - if(fg_rank.eq.0) then + call MPI_Reduce(newnss,g_newnss,1,& + MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) + call MPI_Gather(newnss,1,MPI_INTEGER,& + i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR) + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_newnss(i-1)+displ(i-1) + enddo + call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,& + g_newihpb,i_newnss,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,& + g_newjhpb,i_newnss,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + if(fg_rank.eq.0) then ! print *,'g_newnss',g_newnss ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss) ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss) - newnss=g_newnss - do i=1,newnss - newihpb(i)=g_newihpb(i) - newjhpb(i)=g_newjhpb(i) - enddo - endif + newnss=g_newnss + do i=1,newnss + newihpb(i)=g_newihpb(i) + newjhpb(i)=g_newjhpb(i) + enddo + endif endif #endif @@ -19047,45 +20402,44 @@ chip1=chip(itypi) !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss) ! print *,newnss,nss,maxdim do i=1,nss - found=.false. + found=.false. ! print *,newnss - do j=1,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 + if (idssb(i).eq.newihpb(j) .and. & + jdssb(i).eq.newjhpb(j)) found=.true. + enddo +#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER) ! 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) -#endif + 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) #endif enddo do i=1,newnss - found=.false. - do j=1,nss + 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 + if (newihpb(i).eq.idssb(j) .and. & + newjhpb(i).eq.jdssb(j)) found=.true. + enddo +#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER) ! 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) -#endif + 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) #endif enddo - +!#if .not. defined(WHAM_RUN) && .not. defined(CLUSTER) nss=newnss do i=1,nss - idssb(i)=newihpb(i) - jdssb(i)=newjhpb(i) + idssb(i)=newihpb(i) + jdssb(i)=newjhpb(i) enddo +!#else +! nss=0 +!#endif return end subroutine dyn_set_nss @@ -19106,45 +20460,45 @@ chip1=chip(itypi) ! 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 + 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 + 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 + if (positi.lt.buflipbot) then !C what fraction I am in - fracinbuf=1.0d0- & - ((positi-bordlipbot)/lipbufthick) + 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 + 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 + 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 + else + eliptran=eliptran+pepliptran !C print *,"I am in true lipid" - endif + endif !C else !C eliptran=elpitran+0.0 ! I am in water endif @@ -19152,9 +20506,9 @@ chip1=chip(itypi) 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 + 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) @@ -19162,37 +20516,37 @@ chip1=chip(itypi) 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) + 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) & + 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) & + 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- & + 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) & + 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) & + 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)) + else + eliptran=eliptran+liptranene(itype(i,1)) !C print *,"I am in true lipid" - endif - endif ! if in lipid or buffor + 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 + if (energy_dec) write(iout,*) i,"eliptran=",eliptran enddo return end subroutine Eliptransfer @@ -19216,8 +20570,8 @@ chip1=chip(itypi) integer :: i,j,iti Etube=0.0d0 do i=itube_start,itube_end - enetube(i)=0.0d0 - enetube(i+nres)=0.0d0 + enetube(i)=0.0d0 + enetube(i+nres)=0.0d0 enddo !C first we calculate the distance from tube center !C for UNRES @@ -19228,22 +20582,22 @@ chip1=chip(itypi) 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 + 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) @@ -19271,46 +20625,46 @@ chip1=chip(itypi) !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 + 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 + 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) + iti=itype(i,1) !C lets ommit dummy atoms for now - if ((iti.eq.ntyp1) & + if ((iti.eq.ntyp1) & !C in UNRES uncomment the line below as GLY has no side-chain... !C .or.(iti.eq.10) - ) cycle + ) 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 + 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), @@ -19336,19 +20690,19 @@ chip1=chip(itypi) 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 + 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 + 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 + 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) @@ -19370,15 +20724,15 @@ chip1=chip(itypi) !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),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 + 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 @@ -19394,23 +20748,23 @@ chip1=chip(itypi) !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 + 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) @@ -19432,140 +20786,140 @@ chip1=chip(itypi) !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 + 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 + .and.(positi.lt.bordtubetop)) then !C the energy transfer exist - if (positi.lt.buftubebot) then - fracinbuf=1.0d0- & - ((positi-bordtubebot)/tubebufthick) + 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 + sstube=sscalelip(fracinbuf) + ssgradtube=-sscagradlip(fracinbuf)/tubebufthick !C print *,ssgradtube, sstube,tubetranene(itype(i,1)) - enetube(i)=enetube(i)+sstube*tubetranenepep + 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 + 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 + else + sstube=1.0d0 + ssgradtube=0.0d0 + enetube(i)=enetube(i)+sstube*tubetranenepep !C print *,"I am in true lipid" - endif - else + endif + else !C sstube=0.0d0 !C ssgradtube=0.0d0 - cycle - endif ! if in lipid or buffor + 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) + (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 + 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) & + 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) & + gg_tube(3,i-1)= gg_tube(3,i-1) & +ssgradtube*enetube(i)/sstube/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 + do i=itube_start,itube_end !C Lets not jump over memory as we use many times iti - iti=itype(i,1) + iti=itype(i,1) !C lets ommit dummy atoms for now - if ((iti.eq.ntyp1) & + 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 + .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 + 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 + .and.(positi.lt.bordtubetop)) then !C the energy transfer exist - if (positi.lt.buftubebot) then - fracinbuf=1.0d0- & - ((positi-bordtubebot)/tubebufthick) + 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 + 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)) + 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) + 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)) + 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)) + 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 + endif + else !C sstube=0.0d0 !C ssgradtube=0.0d0 - cycle - endif ! if in lipid or buffor + 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 @@ -19583,42 +20937,46 @@ chip1=chip(itypi) 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) + *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 + 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) & + 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) & + 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 + enddo + do i=itube_start,itube_end + Etube=Etube+enetube(i)+enetube(i+nres) + enddo !C print *,"ETUBE", etube - return - end subroutine calctube2 + return + end subroutine calctube2 !===================================================================================================================================== subroutine calcnano(Etube) - real(kind=8),dimension(3) :: vectube + use MD_data, only:totTafm + real(kind=8),dimension(3) :: vectube,cm 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 - + sc_aa_tube,sc_bb_tube,zmin,ztemp,zminact,tubezcenter,xi,yi,zi!,& +! vecsim,vectrue + real(kind=8) :: eps,sig,aa_tub_lip,bb_tub_lip + integer:: i,j,iti,r,ilol,ityp +! totTafm=2.0 Etube=0.0d0 + call to_box(tubecenter(1),tubecenter(2),tubecenter(3)) ! print *,itube_start,itube_end,"poczatek" do i=itube_start,itube_end - enetube(i)=0.0d0 - enetube(i+nres)=0.0d0 + 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 @@ -19627,43 +20985,17 @@ chip1=chip(itypi) !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 +! do j=-1,1 + xi=(c(1,i)+c(1,i+1))/2.0d0 + yi=(c(2,i)+c(2,i+1))/2.0d0 + zi=((c(3,i)+c(3,i+1))/2.0d0) + call to_box(xi,yi,zi) +! tubezcenter=totTafm*velNANOconst+tubecenter(3) - vectube(1)=vectube(1)-tubecenter(1) - vectube(2)=vectube(2)-tubecenter(2) - vectube(3)=vectube(3)-tubecenter(3) + vectube(1)=boxshift(xi-tubecenter(1),boxxsize) + vectube(2)=boxshift(yi-tubecenter(2),boxysize) + vectube(3)=boxshift(zi-tubecenter(3),boxzsize) !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) @@ -19687,81 +21019,54 @@ chip1=chip(itypi) !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 + 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 + 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 + 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 + endif + if (energy_dec) write(iout,*),"ETUBE_PEP",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 + enecavtube(i)=0.0d0 !C Lets not jump over memory as we use many times iti - iti=itype(i,1) + iti=itype(i,1) !C lets ommit dummy atoms for now - if ((iti.eq.ntyp1) & + 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 + ) cycle + xi=c(1,i+nres) + yi=c(2,i+nres) + zi=c(3,i+nres) + call to_box(xi,yi,zi) + tubezcenter=totTafm*velNANOconst+tubecenter(3) + + vectube(1)=boxshift(xi-tubecenter(1),boxxsize) + vectube(2)=boxshift(yi-tubecenter(2),boxysize) + vectube(3)=boxshift(zi-tubecenter(3),boxzsize) + -!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 @@ -19780,53 +21085,130 @@ chip1=chip(itypi) !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 + 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 + 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 + 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 + 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 + fac=fac+faccav !C 667 continue - endif + 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 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,*),"ETUBE",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=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) + do i=ilipbond_start_tub,ilipbond_end_tub + ityp=itype(i,4) +! print *,"ilipbond_start",ilipbond_start,i,ityp + if (ityp.gt.ntyp_molec(4)) cycle +!C now calculate distance from center of tube and direction vectors + eps=lip_sig(ityp,18)*4.0d0 + sig=lip_sig(ityp,18) + aa_tub_lip=eps/(sig**12) + bb_tub_lip=eps/(sig**6) +! do j=-1,1 + xi=c(1,i) + yi=c(2,i) + zi=c(3,i) + call to_box(xi,yi,zi) +! tubezcenter=totTafm*velNANOconst+tubecenter(3) + + vectube(1)=boxshift(xi-tubecenter(1),boxxsize) + vectube(2)=boxshift(yi-tubecenter(2),boxysize) + vectube(3)=boxshift(zi-tubecenter(3),boxzsize) + +!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)=aa_tub_lip/rdiff6**2.0d0+bb_tub_lip/rdiff6 + Etube=Etube+enetube(i) +!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*aa_tub_lip/rdiff6- & + 6.0d0*bb_tub_lip)/rdiff6/rdiff + do j=1,3 + gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac + enddo + if (energy_dec) write(iout,*) "ETUBLIP",i,rdiff,enetube(i+nres) + enddo + + +!----------------------------------------------------------------------- + if (fg_rank.eq.0) then + if (velNANOconst.ne.0) then + do j=1,3 + cm(j)=0.0d0 + enddo + do i=1,inanomove + ilol=inanotab(i) + do j=1,3 + cm(j)=cm(j)+c(j,ilol) + enddo + enddo + do j=1,3 + cm(j)=cm(j)/inanomove + enddo + vecsim=velNANOconst*totTafm+distnanoinit + vectrue=cm(3)-tubecenter(3) + etube=etube+0.5d0*forcenanoconst*( vectrue-vecsim)**2 + fac=forcenanoconst*(vectrue-vecsim)/inanomove + do i=1,inanomove + ilol=inanotab(i) + gg_tube(3,ilol-1)=gg_tube(3,ilol-1)+fac + enddo + endif + endif +! 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)= & @@ -19838,8 +21220,8 @@ chip1=chip(itypi) ! print *,"end",i,"a" ! enddo !C print *,"ETUBE", etube - return - end subroutine calcnano + return + end subroutine calcnano !=============================================== !-------------------------------------------------------------------------------- @@ -19847,24 +21229,24 @@ chip1=chip(itypi) subroutine set_shield_fac2 real(kind=8) :: div77_81=0.974996043d0, & - div4_81=0.2222222222d0 + 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 + 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 + 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 - ishield_list(i)=0 - do j=1,3 - grad_shield(j,i)=0.0d0 - enddo + fac_shield(i)=0.0d0 + ishield_list(i)=0 + do j=1,3 + grad_shield(j,i)=0.0d0 + enddo enddo do i=ivec_start,ivec_end !C do i=1,nres-1 @@ -19895,40 +21277,40 @@ chip1=chip(itypi) 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 + 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 + 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 + 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 + 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) + 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 + 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)) @@ -19943,7 +21325,7 @@ chip1=chip(itypi) !C & -short/dist_pep_side**2/costhet) !C costhet_fac=0.0d0 do j=1,3 - costhet_grad(j)=costhet_fac*pep_side(j) + 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 ! @@ -19965,17 +21347,17 @@ chip1=chip(itypi) !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) + dist_pep_side**2) !C sinphi=0.8 do j=1,3 - cosphi_grad_long(j)=cosphi_fac*pep_side(j) & + 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) & + 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)- & @@ -19984,37 +21366,37 @@ chip1=chip(itypi) enddo !C print *,sinphi,sinthet VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) & - /VSolvSphere_div + /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 & + +(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 + +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*& + (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 + 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*& + scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*& (1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(& - sinthet/sinphi*cosphi*cosphi_grad_loc(j)& - ))& - *wshield + sinthet/sinphi*cosphi*cosphi_grad_loc(j)& + ))& + *wshield ! print *,grad_shield_loc(j,ishield_list(i),i) enddo VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist @@ -20029,17 +21411,40 @@ chip1=chip(itypi) ! SOUBROUTINE FOR AFM subroutine AFMvel(Eafmforce) use MD_data, only:totTafm - real(kind=8),dimension(3) :: diffafm + real(kind=8),dimension(3) :: diffafm,cbeg,cend real(kind=8) :: afmdist,Eafmforce - integer :: i + integer :: i,j !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 + cbeg=0.0d0 + cend=0.0d0 + if (afmbeg.eq.-1) then + do i=1,nbegafmmat + do j=1,3 + cbeg(j)=cbeg(j)+c(j,afmbegcentr(i))/nbegafmmat + enddo + enddo + else + do j=1,3 + cbeg(j)=c(j,afmend) + enddo + endif + if (afmend.eq.-1) then + do i=1,nendafmmat + do j=1,3 + cend(j)=cend(j)+c(j,afmendcentr(i))/nendafmmat + enddo + enddo + else + cend(j)=c(j,afmend) + endif + do i=1,3 - diffafm(i)=c(i,afmend)-c(i,afmbeg) + diffafm(i)=cend(i)-cbeg(i) afmdist=afmdist+diffafm(i)**2 enddo afmdist=dsqrt(afmdist) @@ -20047,14 +21452,36 @@ chip1=chip(itypi) Eafmforce=0.5d0*forceAFMconst & *(distafminit+totTafm*velAFMconst-afmdist)**2 !C Eafmforce=-forceAFMconst*(dist-distafminit) + if (afmend.eq.-1) then + do i=1,nendafmmat + do j=1,3 + gradafm(j,afmendcentr(i)-1)=-forceAFMconst* & + (distafminit+totTafm*velAFMconst-afmdist) & + *diffafm(j)/afmdist/nendafmmat + enddo + enddo + else do i=1,3 gradafm(i,afmend-1)=-forceAFMconst* & (distafminit+totTafm*velAFMconst-afmdist) & *diffafm(i)/afmdist + enddo + endif + if (afmbeg.eq.-1) then + do i=1,nbegafmmat + do j=1,3 + gradafm(i,afmbegcentr(i)-1)=forceAFMconst* & + (distafminit+totTafm*velAFMconst-afmdist) & + *diffafm(i)/afmdist + enddo + enddo + else + do i=1,3 gradafm(i,afmbeg-1)=forceAFMconst* & (distafminit+totTafm*velAFMconst-afmdist) & *diffafm(i)/afmdist enddo + endif ! print *,'AFM',Eafmforce,totTafm*velAFMconst,afmdist return end subroutine AFMvel @@ -20095,9 +21522,9 @@ chip1=chip(itypi) 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)) + call card_concat(controlcard,.true.) + read(controlcard,*) & + dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0)) enddo return @@ -20108,16 +21535,16 @@ chip1=chip(itypi) !el ! get the position of the jth ijth fragment of the chain coordinate system ! in the fromto array. - integer :: i,j + integer :: i,j - indmat=((2*(nres-2)-i)*(i-1))/2+j-1 + indmat=((2*(nres-2)-i)*(i-1))/2+j-1 return end function indmat !----------------------------------------------------------------------------- real(kind=8) function sigm(x) !el real(kind=8) :: x - sigm=0.25d0*x + sigm=0.25d0*x return end function sigm !----------------------------------------------------------------------------- @@ -20129,13 +21556,13 @@ chip1=chip(itypi) integer :: i,j if(nres.lt.100) then - maxconts=10*nres + maxconts=10*nres elseif(nres.lt.200) then - maxconts=10*nres ! Max. number of contacts per residue + maxconts=10*nres ! Max. number of contacts per residue else - maxconts=10*nres ! (maxconts=maxres/4) + maxconts=10*nres ! (maxconts=maxres/4) endif - maxcont=12*nres ! Max. number of SC contacts + maxcont=100*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 @@ -20184,6 +21611,7 @@ chip1=chip(itypi) ! common /contacts1/ allocate(num_cont(0:nres+4)) !(maxres) +#ifndef NEWCORR allocate(jcont(maxconts,nres)) !(maxconts,maxres) allocate(facont(maxconts,nres)) @@ -20199,7 +21627,7 @@ chip1=chip(itypi) allocate(gacontm_hb3(3,maxconts,nres)) allocate(gacont_hbr(3,maxconts,nres)) allocate(grij_hb_cont(3,maxconts,nres)) -!(3,maxconts,maxres) + !(3,maxconts,maxres) allocate(facont_hb(maxconts,nres)) allocate(ees0p(maxconts,nres)) @@ -20208,9 +21636,10 @@ chip1=chip(itypi) allocate(ees0plist(maxconts,nres)) !(maxconts,maxres) - allocate(num_cont_hb(nres)) !(maxres) allocate(jcont_hb(maxconts,nres)) +#endif + allocate(num_cont_hb(nres)) !(maxconts,maxres) ! common /rotat/ allocate(Ug(2,2,nres)) @@ -20285,9 +21714,9 @@ chip1=chip(itypi) allocate(sintab2(nres)) !(maxres) ! common /dipmat/ - allocate(a_chuj(2,2,maxconts,nres)) +! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)(maxconts=maxres/4) - allocate(a_chuj_der(2,2,3,5,maxconts,nres)) +! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4) ! common /contdistrib/ allocate(ncont_sent(nres)) @@ -20295,8 +21724,12 @@ chip1=chip(itypi) allocate(iat_sent(nres)) !(maxres) +#ifndef NEWCORR + print *,"before iint_sent allocate" allocate(iint_sent(4,nres,nres)) allocate(iint_sent_local(4,nres,nres)) + print *,"after iint_sent allocate" +#endif !(4,maxres,maxres) allocate(iturn3_sent(4,0:nres+4)) allocate(iturn4_sent(4,0:nres+4)) @@ -20312,8 +21745,15 @@ chip1=chip(itypi) !---------------------- ! commom.deriv; ! common /derivat/ +#ifdef NEWCORR + print *,"before dcdv allocate" + allocate(dcdv(6,nres+2)) + allocate(dxdv(6,nres+2)) +#else + print *,"before dcdv allocate" allocate(dcdv(6,maxdim)) allocate(dxdv(6,maxdim)) +#endif !(6,maxdim) allocate(dxds(6,nres)) !(6,maxres) @@ -20378,7 +21818,19 @@ chip1=chip(itypi) allocate(gvdwpp_nucl(3,-1:nres)) allocate(gradpepcat(3,-1:nres)) allocate(gradpepcatx(3,-1:nres)) + allocate(gradpepmart(3,-1:nres)) + allocate(gradpepmartx(3,-1:nres)) allocate(gradcatcat(3,-1:nres)) + allocate(gradnuclcat(3,-1:nres)) + allocate(gradnuclcatx(3,-1:nres)) + allocate(gradlipbond(3,-1:nres)) + allocate(gradlipang(3,-1:nres)) + allocate(gradliplj(3,-1:nres)) + allocate(gradlipelec(3,-1:nres)) + allocate(gradcattranc(3,-1:nres)) + allocate(gradcattranx(3,-1:nres)) + allocate(gradcatangx(3,-1:nres)) + allocate(gradcatangc(3,-1:nres)) !(3,maxres) allocate(grad_shield_side(3,maxcontsshi,-1:nres)) allocate(grad_shield_loc(3,maxcontsshi,-1:nres)) @@ -20471,8 +21923,8 @@ chip1=chip(itypi) allocate(dutheta(nres)) allocate(dugamma(nres)) !(maxres) - allocate(duscdiff(3,nres)) - allocate(duscdiffx(3,nres)) + allocate(duscdiff(3,-1:nres)) + allocate(duscdiffx(3,-1:nres)) !(3,maxres) !el i io:read_fragments ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20) @@ -20498,16 +21950,16 @@ chip1=chip(itypi) !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)) + allocate(dyn_ssbond_ij(10000)) !(maxres,maxres) ! do i=1,nres ! do j=i+1,nres - dyn_ssbond_ij(:,:)=1.0d300 + dyn_ssbond_ij(:)=1.0d300 ! enddo ! enddo ! if (nss.gt.0) then - allocate(idssb(maxdim),jdssb(maxdim)) + allocate(idssb(maxdim),jdssb(maxdim)) ! allocate(newihpb(nss),newjhpb(nss)) !(maxdim) ! endif @@ -20561,13 +22013,40 @@ chip1=chip(itypi) allocate(uygrad(3,3,2,nres)) allocate(uzgrad(3,3,2,nres)) !(3,3,2,maxres) + print *,"before all 300" ! allocateion of lists JPRDLA - allocate(newcontlistppi(200*nres)) - allocate(newcontlistscpi(200*nres)) - allocate(newcontlisti(200*nres)) - allocate(newcontlistppj(200*nres)) - allocate(newcontlistscpj(200*nres)) - allocate(newcontlistj(200*nres)) + allocate(newcontlistppi(300*nres)) + allocate(newcontlistscpi(350*nres)) + allocate(newcontlisti(300*nres)) + allocate(newcontlistppj(300*nres)) + allocate(newcontlistscpj(350*nres)) + allocate(newcontlistj(300*nres)) + allocate(newcontlistmartpi(300*nres)) + allocate(newcontlistmartpj(300*nres)) + allocate(newcontlistmartsci(300*nres)) + allocate(newcontlistmartscj(300*nres)) + + allocate(newcontlistcatsctrani(300*nres)) + allocate(newcontlistcatsctranj(300*nres)) + allocate(newcontlistcatptrani(300*nres)) + allocate(newcontlistcatptranj(300*nres)) + allocate(newcontlistcatscnormi(300*nres)) + allocate(newcontlistcatscnormj(300*nres)) + allocate(newcontlistcatpnormi(300*nres)) + allocate(newcontlistcatpnormj(300*nres)) + allocate(newcontlistcatcatnormi(900*nres)) + allocate(newcontlistcatcatnormj(900*nres)) + + allocate(newcontlistcatscangi(300*nres)) + allocate(newcontlistcatscangj(300*nres)) + allocate(newcontlistcatscangfi(300*nres)) + allocate(newcontlistcatscangfj(300*nres)) + allocate(newcontlistcatscangfk(300*nres)) + allocate(newcontlistcatscangti(300*nres)) + allocate(newcontlistcatscangtj(300*nres)) + allocate(newcontlistcatscangtk(300*nres)) + allocate(newcontlistcatscangtl(300*nres)) + return end subroutine alloc_ener_arrays @@ -20587,8 +22066,22 @@ chip1=chip(itypi) 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 + + if (itype(i-1,2).eq.ntyp1_molec(2)& + .and.itype(i,2).eq.ntyp1_molec(2)) cycle + if (itype(i-1,2).eq.ntyp1_molec(2)& + .or. itype(i,2).eq.ntyp1_molec(2)) 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_nucl + endif ! estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax) ! do j=1,3 ! gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) @@ -20598,14 +22091,13 @@ chip1=chip(itypi) ! & "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 + 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 + 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 @@ -20617,50 +22109,50 @@ chip1=chip(itypi) 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) + 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 (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 + 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) + 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 - endif + 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 @@ -20682,174 +22174,174 @@ chip1=chip(itypi) 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 + 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 + phii=phi(i) + if (phii.ne.phii) phii=150.0 #else - phii=phi(i) + 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 + 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 + 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) + phii1=phi(i+1) + if (phii1.ne.phii1) phii1=150.0 + phii1=pinorm(phii1) #else - phii1=phi(i+1) + 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 + ityp3=ithetyp_nucl(itype(i,2)) + do k=1,nsingle_nucl + cosph2(k)=dcos(k*phii1) + sinph2(k)=dsin(k*phii1) 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) + else + phii1=0.0d0 + ityp3=nthetyp_nucl+1 + do k=1,nsingle_nucl + cosph2(k)=0.0d0 + sinph2(k)=0.0d0 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 + 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 - if (lprn) then - write (iout,*) "cosph and sinph" + 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 - write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k) + 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 - write (iout,*) "cosph1ph2 and sinph2ph2" + enddo + if (lprn) & + write(iout,*) "ethetai",ethetai + do m=1,ntheterm3_nucl 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) + 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*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 + 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 + 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 + 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) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.VAR' ! include 'COMMON.GEO' @@ -20868,61 +22360,61 @@ chip1=chip(itypi) !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 + 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) + 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 + 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 + 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 + 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) & + 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 + gloc(i-3,icg)=gloc(i-3,icg)+wtor_nucl*gloci !c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg) enddo return @@ -20937,12 +22429,13 @@ chip1=chip(itypi) !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) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbbi,sslipi,ssgradlipi, & + sslipj,ssgradlipj,faclipij2 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 + 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 + 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 @@ -20957,124 +22450,87 @@ chip1=chip(itypi) !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) + 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 + call to_box(xmedi,ymedi,zmedi) + call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi) + + 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 + xj=c(1,j)+0.5D0*dxj + yj=c(2,j)+0.5D0*dyj + zj=c(3,j)+0.5D0*dzj + call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) + faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0 + xj=boxshift(xj-xmedi,boxxsize) + yj=boxshift(yj-ymedi,boxysize) + zj=boxshift(zj-zmedi,boxzsize) + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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) + 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 + 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 @@ -21091,9 +22547,9 @@ chip1=chip(itypi) 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 + 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 + dist_temp, dist_init integer xshift,yshift,zshift !cd print '(a)','Enter ESCP' @@ -21102,23 +22558,18 @@ chip1=chip(itypi) 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 + 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)) + call to_box(xi,yi,zi) - do iint=1,nscp_gr_nucl(i) + 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 + 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 @@ -21127,79 +22578,48 @@ chip1=chip(itypi) ! 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 + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) - 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" + dist_init=xj**2+yj**2+zj**2 + + 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 + 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 ! 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 + do j=1,3 + gvdwpsb(j,i)=expon*gvdwpsb(j,i) + gvdwpsb1(j,i)=expon*gvdwpsb1(j,i) + enddo enddo return end subroutine epsb @@ -21212,7 +22632,7 @@ chip1=chip(itypi) 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 + dist_temp, dist_init,aa,bb,faclip,sig0ij integer :: ii logical lprn evdw=0.0D0 @@ -21223,160 +22643,127 @@ chip1=chip(itypi) 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) + 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) + 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) + call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) + 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) + 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 + 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 + 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) + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + call to_box(xj,yj,zj) +! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) +! 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 + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) + + 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 + 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 + 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) + 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 + 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" + 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 + 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 + 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 + 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. @@ -21389,7 +22776,7 @@ chip1=chip(itypi) 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 + 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 @@ -21398,13 +22785,13 @@ chip1=chip(itypi) 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 + 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) @@ -21428,13 +22815,13 @@ chip1=chip(itypi) !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 + 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 + cosa=om12 + cosb=om1 + cosg=om2 endif r3ij=rij*rrij r6ij=r3ij*r3ij @@ -21456,12 +22843,12 @@ chip1=chip(itypi) 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 + 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 @@ -21479,10 +22866,10 @@ chip1=chip(itypi) 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) + 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 @@ -21497,123 +22884,123 @@ chip1=chip(itypi) 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) + 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) + 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) + 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.maxcont) THEN + num_conti.le.maxcont) 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_nucl(itypi,itypj) + r0ij=2.20D0*sigma_nucl(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) + 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 (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.',maxconts - else - jcont_hb(num_conti,i)=j + if (num_conti.gt.maxconts) then + write (iout,*) 'WARNING - max. # of contacts exceeded;',& + ' will skip next contacts for this conf.',maxconts + 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 + 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) + 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 + 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 + 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 + 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 + 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 @@ -21626,26 +23013,26 @@ chip1=chip(itypi) 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)) + 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) + 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 + 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) + gvdwsbc(l,i)=gvdwsbc(l,i)-gg(l) + gvdwsbc(l,j)=gvdwsbc(l,j)+gg(l) enddo return end subroutine sc_grad_nucl @@ -21670,126 +23057,126 @@ chip1=chip(itypi) 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 + 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 + 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) + 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 + 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 + 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 + 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 + 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)) + 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,*) "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) + 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 + 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 + 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 + 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)) @@ -21797,45 +23184,45 @@ chip1=chip(itypi) 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) + 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_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)) + 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) + 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) + 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", @@ -21846,12 +23233,12 @@ chip1=chip(itypi) !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) + 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), @@ -21874,8 +23261,8 @@ chip1=chip(itypi) !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 + + 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 @@ -21907,12 +23294,12 @@ chip1=chip(itypi) 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 + 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! @@ -21920,9 +23307,9 @@ chip1=chip(itypi) CorrelID=fg_rank+1 ldone=.false. do i=1,max_cont - do j=1,max_dim - buffer(i,j)=0.0D0 - enddo + do j=1,max_dim + buffer(i,j)=0.0D0 + enddo enddo mm=mod(fg_rank,2) !c write (*,*) 'MyRank',MyRank,' mm',mm @@ -21931,33 +23318,33 @@ chip1=chip(itypi) !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) + 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) + 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) + 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 + 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 + 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 @@ -21972,24 +23359,24 @@ chip1=chip(itypi) !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 + 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 + 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 + 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 @@ -21997,18 +23384,18 @@ chip1=chip(itypi) !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,*) & + 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 (*,*) & + write (*,*) & 'ERROR!!!! message length changed while processing correlations.' - call MPI_Abort(MPI_COMM_WORLD,Error,IERROR) - endif ! msglen.eq.msglen1 + call MPI_Abort(MPI_COMM_WORLD,Error,IERROR) + endif ! msglen.eq.msglen1 endif ! fg_rank.lt.nfgtasks-1 if (ldone) goto 30 ldone=.true. @@ -22016,12 +23403,12 @@ chip1=chip(itypi) 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 + 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 @@ -22037,17 +23424,17 @@ chip1=chip(itypi) ! 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) + 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) + 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 + 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. @@ -22055,11 +23442,11 @@ chip1=chip(itypi) !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 + 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. @@ -22069,26 +23456,26 @@ chip1=chip(itypi) !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) + 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 + 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 + 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) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.DERIV' @@ -22099,9 +23486,9 @@ chip1=chip(itypi) !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 + ees0mkl,ees,coeffpees0pij,coeffmees0mij,& + coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, & + rlocshield lprn=.false. eij=facont_hb(jj,i) @@ -22130,32 +23517,32 @@ chip1=chip(itypi) coeffpees0pkl=coeffp*ees0pkl coeffmees0mkl=coeffm*ees0mkl do ll=1,3 - gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i) & + 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 + 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 @@ -22163,7 +23550,7 @@ chip1=chip(itypi) !------------------------------------------------------------------------- real(kind=8) function ehbcorr3_nucl(i,j,k,l,jj,kk,coeffp,coeffm) -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.IOUNITS' ! include 'COMMON.DERIV' @@ -22174,9 +23561,9 @@ chip1=chip(itypi) !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 + ees0mkl,ees,coeffpees0pij,coeffmees0mij,& + coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, & + rlocshield lprn=.false. eij=facont_hb(jj,i) @@ -22204,32 +23591,32 @@ chip1=chip(itypi) coeffpees0pkl=coeffp*ees0pkl coeffmees0mkl=coeffm*ees0mkl do ll=1,3 - gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i) & + 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 + 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 @@ -22240,16 +23627,16 @@ chip1=chip(itypi) 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)) + 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 @@ -22267,135 +23654,141 @@ chip1=chip(itypi) 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) + 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,itypi,itypj - 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 + use MD_data, only: t_bath + integer :: i,j,itmp,xshift,yshift,zshift,subchap,k,itypi,itypj,irdiff,& + ii + real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,& + r7,r4,ecationcation,k0,rcal,aa,bb,sslipi,ssgradlipi,sslipj,ssgradlipj + 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) :: awat,bwat,cwat,dwat,sss2min2,sss2mingrad2,rdiff,ewater + real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,& + gg,r + + ecationcation=0.0d0 + if (nres_molec(5).le.1) 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) + itmp=0 + +! do i=1,4 +! itmp=itmp+nres_molec(i) +! enddo +! write(iout,*) "itmp",g_listcatcatnorm_start, g_listcatcatnorm_end +! do i=itmp+1,itmp+nres_molec(5)-1 + do ii=g_listcatcatnorm_start, g_listcatcatnorm_end + i=newcontlistcatcatnormi(ii) + j=newcontlistcatcatnormj(ii) + + xi=c(1,i) + yi=c(2,i) + zi=c(3,i) ! write (iout,*) i,"TUTUT",c(1,i) - itypi=itype(i,5) - 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) - itypj=itype(j,5) + itypi=itype(i,5) + call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) +! do j=i+1,itmp+nres_molec(5) + itypj=itype(j,5) ! print *,i,j,itypi,itypj - k0 = 332.0*(ichargecat(itypi)*ichargecat(itypj))/80.0 + k0 = 332.0*(ichargecat(itypi)*ichargecat(itypj))/80.0 ! 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 + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + call to_box(xj,yj,zj) +! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) +! 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 + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) rcal =xj**2+yj**2+zj**2 - ract=sqrt(rcal) + ract=sqrt(rcal) + if ((itypi.gt.1).or.(itypj.gt.1)) then + if (sss2min2.eq.0.0d0) cycle + sss2min2=sscale2(ract,12.0d0,1.0d0) + sss2mingrad2=sscagrad2(ract,12.0d0,1.0d0) ! 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 - if (energy_dec) write (iout,*) i,j,Evan1cat,Evan2cat,Eeleccat,& - r012,rcal**6,ichargecat(itypi)*ichargecat(itypj) + 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)*sss2min2+(Evan1cat+Evan2cat+Eeleccat)*sss2mingrad2) + gradcatcat(k,j)=gradcatcat(k,j)+gg(k)*sss2min2+(Evan1cat+Evan2cat+Eeleccat)*sss2mingrad2 + enddo + if (energy_dec) write (iout,*) "ecatcat",i,j,Evan1cat,Evan2cat,Eeleccat,& + r012,rcal**6,ichargecat(itypi)*ichargecat(itypj) ! write(iout,*) "ecatcat",i,j, ecationcation,xj,yj,zj - ecationcation=ecationcation+Evan1cat+Evan2cat+Eeleccat - enddo + ecationcation=ecationcation+(Evan1cat+Evan2cat+Eeleccat)*sss2min2 + else !this is water part and other non standard molecules + + sss2min2=sscale2(ract,10.0d0,1.0d0)! cutoff for water interaction is 15A + if (sss2min2.eq.0.0d0) cycle + sss2mingrad2=sscagrad2(ract,10.0d0,1.0d0) + irdiff=int((ract-2.06d0)*50.0d0)+1 + + rdiff=ract-((irdiff-1)*0.02d0+2.06d0) + if (irdiff.le.0) then + irdiff=0 + rdiff=ract + endif +! print *,rdiff,ract,irdiff,sss2mingrad2 + awat=awaterenta(irdiff)-awaterentro(irdiff)*t_bath/1000.0d0 + bwat=bwaterenta(irdiff)-bwaterentro(irdiff)*t_bath/1000.0d0 + cwat=cwaterenta(irdiff)-cwaterentro(irdiff)*t_bath/1000.0d0 + dwat=dwaterenta(irdiff)-dwaterentro(irdiff)*t_bath/1000.0d0 + r(1)=xj + r(2)=yj + r(3)=zj + + ewater=awat+bwat*rdiff+cwat*rdiff*rdiff+dwat*rdiff*rdiff*rdiff + ecationcation=ecationcation+ewater*sss2min2 + do k=1,3 + gg(k)=(bwat+2.0d0*cwat*rdiff+dwat*3.0d0*rdiff*rdiff)*r(k)/ract + gradcatcat(k,i)=gradcatcat(k,i)-gg(k)*sss2min2-sss2mingrad2*ewater*r(k)/ract + gradcatcat(k,j)=gradcatcat(k,j)+gg(k)*sss2min2+sss2mingrad2*ewater*r(k)/ract + enddo + if (energy_dec) write(iout,'(2f8.2,f10.2,2i5)') rdiff,ract,ecationcation,i,j + endif ! end water enddo +! enddo return end subroutine ecatcat !--------------------------------------------------------------------------- @@ -22409,11 +23802,11 @@ chip1=chip(itypi) !el local variables integer :: iint,itypi1,subchap,isel,itmp real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,e1,e2,sigm,epsi - real(kind=8) :: evdw + real(kind=8) :: evdw,aa,bb 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 + dist_temp, dist_init,ssgradlipi,ssgradlipj, & + sslipi,sslipj,faclip,alpha_sco + integer :: ii,ki real(kind=8) :: fracinbuf real (kind=8) :: escpho real (kind=8),dimension(4):: ener @@ -22429,120 +23822,107 @@ chip1=chip(itypi) real(kind=8) :: facd4, adler, Fgb, facd3 integer troll,jj,istate real (kind=8) :: dcosom1(3),dcosom2(3) + real(kind=8) ::locbox(3) + locbox(1)=boxxsize + locbox(2)=boxysize + locbox(3)=boxzsize evdw=0.0D0 if (nres_molec(5).eq.0) return eps_out=80.0d0 ! sss_ele_cut=1.0d0 - itmp=0 - do i=1,4 - itmp=itmp+nres_molec(i) - enddo + itmp=0 + do i=1,4 + itmp=itmp+nres_molec(i) + enddo ! go to 17 ! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization - do i=ibond_start,ibond_end +! do i=ibond_start,ibond_end + do ki=g_listcatscnorm_start,g_listcatscnorm_end + i=newcontlistcatscnormi(ki) + j=newcontlistcatscnormj(ki) ! print *,"I am in EVDW",i - itypi=iabs(itype(i,1)) + itypi=iabs(itype(i,1)) ! if (i.ne.47) cycle - if ((itypi.eq.ntyp1).or.(itypi.eq.10)) 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 - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) - dsci_inv=vbld_inv(i+nres) - do j=itmp+1,itmp+nres_molec(5) + if ((itypi.eq.ntyp1).or.(itypi.eq.10)) cycle + itypi1=iabs(itype(i+1,1)) + xi=c(1,nres+i) + yi=c(2,nres+i) + zi=c(3,nres+i) + call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) + dxi=dc_norm(1,nres+i) + dyi=dc_norm(2,nres+i) + dzi=dc_norm(3,nres+i) + dsci_inv=vbld_inv(i+nres) +! do j=itmp+1,itmp+nres_molec(5) ! Calculate SC interaction energy. - itypj=iabs(itype(j,5)) - if ((itypj.eq.ntyp1)) cycle - CALL elgrad_init_cat(eheadtail,Egb,Ecl,Elj,Equad,Epol) - - dscj_inv=0.0 - 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 - + itypj=iabs(itype(j,5)) + if ((itypj.eq.ntyp1)) cycle + CALL elgrad_init_cat(eheadtail,Egb,Ecl,Elj,Equad,Epol) + + dscj_inv=0.0 + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + + call to_box(xj,yj,zj) +! write(iout,*) "xi,yi,zi,xj,yj,zj", xi,yi,zi,xj,yj,zj + +! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) +! 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 + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) +! write(iout,*) "xj,yj,zj", xj,yj,zj,boxxsize + + dxj=0.0 + dyj=0.0 + dzj=0.0 ! dxj = dc_norm( 1, nres+j ) ! dyj = dc_norm( 2, nres+j ) ! dzj = dc_norm( 3, nres+j ) - itypi = itype(i,1) - itypj = itype(j,5) + itypi = itype(i,1) + itypj = itype(j,5) ! Parameters from fitting the analitical expressions to the PMF obtained by umbrella ! sampling performed with amber package ! alf1 = 0.0d0 ! alf2 = 0.0d0 ! alf12 = 0.0d0 ! a12sq = rborn(itypi,itypj) * rborn(itypj,itypi) - chi1 = chi1cat(itypi,itypj) - chis1 = chis1cat(itypi,itypj) - chip1 = chipp1cat(itypi,itypj) + chi1 = chi1cat(itypi,itypj) + chis1 = chis1cat(itypi,itypj) + chip1 = chipp1cat(itypi,itypj) ! chi1=0.0d0 ! chis1=0.0d0 ! chip1=0.0d0 - chi2=0.0 - chip2=0.0 - chis2=0.0 + chi2=0.0 + chip2=0.0 + chis2=0.0 ! chis2 = chis(itypj,itypi) - chis12 = chis1 * chis2 - sig1 = sigmap1cat(itypi,itypj) + chis12 = chis1 * chis2 + sig1 = sigmap1cat(itypi,itypj) + sig2=0.0d0 ! sig2 = sigmap2(itypi,itypj) ! alpha factors from Fcav/Gcav - b1cav = alphasurcat(1,itypi,itypj) - b2cav = alphasurcat(2,itypi,itypj) - b3cav = alphasurcat(3,itypi,itypj) - b4cav = alphasurcat(4,itypi,itypj) - + b1cav = alphasurcat(1,itypi,itypj) + b2cav = alphasurcat(2,itypi,itypj) + b3cav = alphasurcat(3,itypi,itypj) + b4cav = alphasurcat(4,itypi,itypj) + +! b1cav=0.0d0 +! b2cav=0.0d0 +! b3cav=0.0d0 +! b4cav=0.0d0 + ! used to determine whether we want to do quadrupole calculations eps_in = epsintabcat(itypi,itypj) if (eps_in.eq.0.0) eps_in=1.0 @@ -22551,18 +23931,20 @@ chip1=chip(itypi) ! Rtail = 0.0d0 DO k = 1, 3 - ctail(k,1)=c(k,i+nres) - ctail(k,2)=c(k,j) + ctail(k,1)=c(k,i+nres) + ctail(k,2)=c(k,j) END DO + call to_box(ctail(1,1),ctail(2,1),ctail(3,1)) + call to_box(ctail(1,2),ctail(2,2),ctail(3,2)) !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 ) + do k=1,3 + Rtail_distance(k) = boxshift(ctail(k,2) - ctail(k,1),locbox(k)) + enddo Rtail = dsqrt( & - (Rtail_distance(1)*Rtail_distance(1)) & - + (Rtail_distance(2)*Rtail_distance(2)) & - + (Rtail_distance(3)*Rtail_distance(3))) + (Rtail_distance(1)*Rtail_distance(1)) & + + (Rtail_distance(2)*Rtail_distance(2)) & + + (Rtail_distance(3)*Rtail_distance(3))) ! tail location and distance calculations ! dhead1 d1 = dheadcat(1, 1, itypi, itypj) @@ -22571,18 +23953,23 @@ chip1=chip(itypi) ! 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) + chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres) + chead(k,2) = c(k, j) + enddo + call to_box(chead(1,1),chead(2,1),chead(3,1)) + call to_box(chead(1,2),chead(2,2),chead(3,2)) +! write(iout,*) "TEST",chead(1,1),chead(2,1),chead(3,1),dc_norm(k, i+nres),d1 ! 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) +! Rsc(k) = Rsc_distance(k) * Rsc_distance(k) + do k=1,3 + Rhead_distance(k) = boxshift(chead(k,2) - chead(k,1),locbox(k)) 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_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 @@ -22597,48 +23984,64 @@ chip1=chip(itypi) 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) + Fcav = 0.0d0 + Fisocav=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 + rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj) + rij = dsqrt(rrij) + sss_ele_cut=sscale_ele(1.0d0/(rij)) + sss_ele_grad=sscagrad_ele(1.0d0/(rij)) +! print *,sss_ele_cut,sss_ele_grad,& +! 1.0d0/(rij),r_cut_ele,rlamb_ele + if (sss_ele_cut.le.0.0) cycle + 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 + 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) + 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_cat(itypi,itypj) + rij_shift = Rtail - sig + sig0ij + IF (rij_shift.le.0.0D0) THEN + evdw = 1.0D20 + if (evdw.gt.1.0d6) then + write (*,'(2(1x,a3,i3),7f7.2)') & + restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,& + 1.0d0/rij,Rtail,Rhead,rij_shift, sig, sig0ij,sigsq + write(*,*) facsig,faceps1_inv,om1,chiom1,chi1 + write(*,*) "ANISO?!",chi1 +!evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,& +! Equad,evdwij+Fcav+eheadtail,evdw + endif + + RETURN + END IF + sigder = -sig * sigsq + rij_shift = 1.0D0 / rij_shift + fac = rij_shift**expon + c1 = fac * fac * aa_aq_cat(itypi,itypj) ! print *,"ADAM",aa_aq(itypi,itypj) ! c1 = 0.0d0 - c2 = fac * bb_aq_cat(itypi,itypj) + c2 = fac * bb_aq_cat(itypi,itypj) ! c2 = 0.0d0 - evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 ) - eps2der = eps3rt * evdwij - eps3der = eps2rt * evdwij + evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 ) + eps2der = eps3rt * evdwij + eps3der = eps2rt * evdwij ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij - evdwij = eps2rt * eps3rt * evdwij + evdwij = eps2rt * eps3rt * evdwij !#ifdef TSCSC ! IF (bb_aq(itypi,itypj).gt.0) THEN ! evdw_p = evdw_p + evdwij @@ -22646,259 +24049,220 @@ chip1=chip(itypi) ! evdw_m = evdw_m + evdwij ! END IF !#else - evdw = evdw & - + evdwij + evdw = evdw & + + evdwij*sss_ele_cut !#endif - c1 = c1 * eps1 * eps2rt**2 * eps3rt**2 - fac = -expon * (c1 + evdwij) * rij_shift - sigder = fac * sigder + c1 = c1 * eps1 * eps2rt**2 * eps3rt**2 + fac = -expon * (c1 + evdwij) * rij_shift + sigder = fac * sigder ! Calculate distance derivative - gg(1) = fac - gg(2) = fac - gg(3) = fac - - fac = chis1 * sqom1 + chis2 * sqom2 & - - 2.0d0 * chis12 * om1 * om2 * om12 - pom = 1.0d0 - chis1 * chis2 * sqom12 - Lambf = (1.0d0 - (fac / pom)) - Lambf = dsqrt(Lambf) - sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0) - Chif = Rtail * 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 - Fcav = top / bot + gg(1) = fac*sss_ele_cut+evdwij*sss_ele_grad + gg(2) = fac*sss_ele_cut+evdwij*sss_ele_grad + gg(3) = fac*sss_ele_cut+evdwij*sss_ele_grad +! print *,"GG(1),distance grad",gg(1) + fac = chis1 * sqom1 + chis2 * sqom2 & + - 2.0d0 * chis12 * om1 * om2 * om12 + pom = 1.0d0 - chis1 * chis2 * sqom12 + Lambf = (1.0d0 - (fac / pom)) + Lambf = dsqrt(Lambf) + sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0) + Chif = Rtail * 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 + 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) - dCAVdOM1 = dFdL * ( dFdOM1 ) - dCAVdOM2 = dFdL * ( dFdOM2 ) - dCAVdOM12 = dFdL * ( dFdOM12 ) + dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow*sss_ele_cut+& + Fcav*sss_ele_grad + Fcav=Fcav*sss_ele_cut + 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) + dCAVdOM1 = dFdL * ( dFdOM1 ) + dCAVdOM2 = dFdL * ( dFdOM2 ) + dCAVdOM12 = dFdL * ( dFdOM12 ) DO k= 1, 3 - ertail(k) = Rtail_distance(k)/Rtail + 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) ) facd1 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres) - facd2 = dtailcat(2,itypi,itypj) * vbld_inv(j+nres) + facd2 = dtailcat(2,itypi,itypj) * vbld_inv(j) DO k = 1, 3 - pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres)) - gradpepcatx(k,i) = gradpepcatx(k,i) & - - (( dFdR + gg(k) ) * pom) - pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres)) + pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres)) + gradpepcatx(k,i) = gradpepcatx(k,i) & + - (( dFdR + gg(k) ) * pom) + pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j)) ! gvdwx(k,j) = gvdwx(k,j) & ! + (( dFdR + gg(k) ) * pom) - gradpepcat(k,i) = gradpepcat(k,i) & - - (( dFdR + gg(k) ) * ertail(k)) - gradpepcat(k,j) = gradpepcat(k,j) & - + (( dFdR + gg(k) ) * ertail(k)) - gg(k) = 0.0d0 + gradpepcat(k,i) = gradpepcat(k,i) & + - (( dFdR + gg(k) ) * ertail(k)) + gradpepcat(k,j) = gradpepcat(k,j) & + + (( dFdR + gg(k) ) * ertail(k)) + gg(k) = 0.0d0 ENDDO !c! Compute head-head and head-tail energies for each state - isel = iabs(Qi) + 1 ! ion is always charged so iabs(Qj) - IF (isel.eq.0) THEN -!c! No charges - do nothing - eheadtail = 0.0d0 - - ELSE IF (isel.eq.1) THEN -!c! Nonpolar-charge interactions - if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then - Qi=Qi*2 - Qij=Qij*2 - endif - if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then - Qj=Qj*2 - Qij=Qij*2 - endif - - CALL enq_cat(epol) - eheadtail = epol -! eheadtail = 0.0d0 - - ELSE IF (isel.eq.3) THEN -!c! Dipole-charge interactions - if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then - Qi=Qi*2 - Qij=Qij*2 - endif - if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then - Qj=Qj*2 - Qij=Qij*2 - endif - write(iout,*) "KURWA0",d1 - - CALL edq_cat(ecl, elj, epol) - eheadtail = ECL + elj + epol -! eheadtail = 0.0d0 - - ELSE IF ((isel.eq.2)) THEN - -!c! Same charge-charge interaction ( +/+ or -/- ) - if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then - Qi=Qi*2 - Qij=Qij*2 - endif - if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then - Qj=Qj*2 - Qij=Qij*2 - endif - - CALL eqq_cat(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 -/+ ) -! if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then -! Qi=Qi*2 -! Qij=Qij*2 -! endif -! if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then -! Qj=Qj*2 -! Qij=Qij*2 -! endif -! -! CALL energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad) +!! if (.false.) then ! turn off electrostatic + if (itype(j,5).gt.0) then ! the normal cation case + isel = iabs(Qi) + 1 ! ion is always charged so iabs(Qj) +! print *,i,itype(i,1),isel + IF (isel.eq.0) THEN + eheadtail = 0.0d0 + ELSE IF (isel.eq.1) THEN + if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then + Qi=Qi*2 + Qij=Qij*2 + endif + CALL enq_cat(epol) + eheadtail = epol + ELSE IF (isel.eq.3) THEN + if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then + Qi=Qi*2 + Qij=Qij*2 + endif + CALL edq_cat(ecl, elj, epol) + eheadtail = ECL + elj + epol + ELSE IF ((isel.eq.2)) THEN + if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then + Qi=Qi*2 + Qij=Qij*2 + endif + CALL eqq_cat(Ecl,Egb,Epol,Fisocav,Elj) + eheadtail = ECL + Egb + Epol + Fisocav + Elj END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav - evdw = evdw + Fcav + eheadtail + else ! here is water and other molecules + isel = iabs(Qi)+2 +! isel=2 +! if (isel.eq.4) isel=2 + if (isel.eq.2) then + eheadtail = 0.0d0 + else if (isel.eq.3) then + if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then + Qi=Qi*2 + Qij=Qij*2 + endif + call eqd_cat(ecl,elj,epol) + eheadtail = ECL + elj + epol + else if (isel.eq.4) then + call edd_cat(ecl) + eheadtail = ECL + endif +! write(iout,*) "not yet implemented",j,itype(j,5) + endif +!! endif ! turn off electrostatic + evdw = evdw + Fcav + eheadtail +! if (evdw.gt.1.0d6) then +! write (*,'(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 +! endif 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 + 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 (energy_dec) write(iout,*) "FCAV", & + sig1,sig2,b1cav,b2cav,b3cav,b4cav +! print *,"before sc_grad_cat", i,j, gradpepcat(1,j) ! iF (nstate(itypi,itypj).eq.1) THEN - CALL sc_grad_cat + CALL sc_grad_cat +! print *,"after sc_grad_cat", i,j, gradpepcat(1,j) + ! END IF !c!------------------------------------------------------------------- !c! NAPISY KONCOWE - END DO ! j - END DO ! i + END DO ! j +! END DO ! i !c write (iout,*) "Number of loop steps in EGB:",ind !c energy_dec=.false. ! print *,"EVDW KURW",evdw,nres !!! return 17 continue - do i=ibond_start,ibond_end +! go to 23 +! do i=ibond_start,ibond_end + + do ki=g_listcatpnorm_start,g_listcatpnorm_end + i=newcontlistcatpnormi(ki) + j=newcontlistcatpnormj(ki) ! print *,"I am in EVDW",i - itypi=10 ! the peptide group parameters are for glicine + itypi=10 ! the peptide group parameters are for glicine ! if (i.ne.47) cycle - if ((itype(i,1).eq.ntyp1).or.itype(i+1,1).eq.ntyp1) cycle - itypi1=iabs(itype(i+1,1)) - 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=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,i) - dyi=dc_norm(2,i) - dzi=dc_norm(3,i) - dsci_inv=vbld_inv(i+1)/2.0 - do j=itmp+1,itmp+nres_molec(5) + if ((itype(i,1).eq.ntyp1).or.itype(i+1,1).eq.ntyp1) cycle + itypi1=iabs(itype(i+1,1)) + 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 + call to_box(xi,yi,zi) + dxi=dc_norm(1,i) + dyi=dc_norm(2,i) + dzi=dc_norm(3,i) + dsci_inv=vbld_inv(i+1)/2.0 +! do j=itmp+1,itmp+nres_molec(5) ! Calculate SC interaction energy. - itypj=iabs(itype(j,5)) - if ((itypj.eq.ntyp1)) cycle - CALL elgrad_init_cat_pep(eheadtail,Egb,Ecl,Elj,Equad,Epol) - - dscj_inv=0.0 - 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 + itypj=iabs(itype(j,5)) + if ((itypj.eq.ntyp1)) cycle + CALL elgrad_init_cat_pep(eheadtail,Egb,Ecl,Elj,Equad,Epol) + + dscj_inv=0.0 + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) + + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 - dxj = 0.0d0! dc_norm( 1, nres+j ) - dyj = 0.0d0!dc_norm( 2, nres+j ) - dzj = 0.0d0! dc_norm( 3, nres+j ) + dxj = 0.0d0! dc_norm( 1, nres+j ) + dyj = 0.0d0!dc_norm( 2, nres+j ) + dzj = 0.0d0! dc_norm( 3, nres+j ) - itypi = 10 - itypj = itype(j,5) + itypi = 10 + itypj = itype(j,5) ! Parameters from fitting the analitical expressions to the PMF obtained by umbrella ! sampling performed with amber package ! alf1 = 0.0d0 ! alf2 = 0.0d0 ! alf12 = 0.0d0 ! a12sq = rborn(itypi,itypj) * rborn(itypj,itypi) - chi1 = chi1cat(itypi,itypj) - chis1 = chis1cat(itypi,itypj) - chip1 = chipp1cat(itypi,itypj) + chi1 = chi1cat(itypi,itypj) + chis1 = chis1cat(itypi,itypj) + chip1 = chipp1cat(itypi,itypj) ! chi1=0.0d0 ! chis1=0.0d0 ! chip1=0.0d0 - chi2=0.0 - chip2=0.0 - chis2=0.0 + chi2=0.0 + chip2=0.0 + chis2=0.0 ! chis2 = chis(itypj,itypi) - chis12 = chis1 * chis2 - sig1 = sigmap1cat(itypi,itypj) + chis12 = chis1 * chis2 + sig1 = sigmap1cat(itypi,itypj) + sig2=0.0 ! sig2 = sigmap2(itypi,itypj) ! alpha factors from Fcav/Gcav - b1cav = alphasurcat(1,itypi,itypj) - b2cav = alphasurcat(2,itypi,itypj) - b3cav = alphasurcat(3,itypi,itypj) - b4cav = alphasurcat(4,itypi,itypj) - + b1cav = alphasurcat(1,itypi,itypj) + b2cav = alphasurcat(2,itypi,itypj) + b3cav = alphasurcat(3,itypi,itypj) + b4cav = alphasurcat(4,itypi,itypj) + ! used to determine whether we want to do quadrupole calculations eps_in = epsintabcat(itypi,itypj) if (eps_in.eq.0.0) eps_in=1.0 @@ -22907,20 +24271,25 @@ chip1=chip(itypi) ! Rtail = 0.0d0 DO k = 1, 3 - ctail(k,1)=(c(k,i)+c(k,i+1))/2.0 - ctail(k,2)=c(k,j) + ctail(k,1)=(c(k,i)+c(k,i+1))/2.0 + ctail(k,2)=c(k,j) END DO + call to_box(ctail(1,1),ctail(2,1),ctail(3,1)) + call to_box(ctail(1,2),ctail(2,2),ctail(3,2)) !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))) -! tail location and distance calculations -! dhead1 + do k=1,3 + Rtail_distance(k) = boxshift(ctail(k,2) - ctail(k,1),locbox(k)) + enddo + +!c! tail distances will be themselves usefull elswhere +!c1 (in Gcav, for example) + Rtail = dsqrt( & + (Rtail_distance(1)*Rtail_distance(1)) & + + (Rtail_distance(2)*Rtail_distance(2)) & + + (Rtail_distance(3)*Rtail_distance(3))) +! tail location and distance calculations +! dhead1 d1 = dheadcat(1, 1, itypi, itypj) ! print *,"d1",d1 ! d1=0.0d0 @@ -22929,18 +24298,27 @@ chip1=chip(itypi) ! 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 + d1 * dc_norm(k, i) - chead(k,2) = c(k, j) + chead(k,1) = (c(k, i)+c(k,i+1))/2.0 + d1 * dc_norm(k, i) + chead(k,2) = c(k, j) + ENDDO ! 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) + call to_box(chead(1,1),chead(2,1),chead(3,1)) + call to_box(chead(1,2),chead(2,2),chead(3,2)) + +! distance +! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres)) +! Rsc(k) = Rsc_distance(k) * Rsc_distance(k) + do k=1,3 + Rhead_distance(k) = boxshift(chead(k,2) - chead(k,1),locbox(k)) 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_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 @@ -22955,48 +24333,62 @@ chip1=chip(itypi) 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) + Fcav = 0.0d0 + dFdR = 0.0d0 + dCAVdOM1 = 0.0d0 + dCAVdOM2 = 0.0d0 + dCAVdOM12 = 0.0d0 + dscj_inv = 0.0d0 ! 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 + rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj) + rij = dsqrt(rrij) + sss_ele_cut=sscale_ele(1.0d0/(rij)) + sss_ele_grad=sscagrad_ele(1.0d0/(rij)) +! print *,sss_ele_cut,sss_ele_grad,& +! 1.0d0/(rij),r_cut_ele,rlamb_ele + if (sss_ele_cut.le.0.0) cycle + 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 + om2=0.0d0 + om12=0.0d0 + 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) + 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_cat(itypi,itypj) + rij_shift = Rtail - sig + sig0ij + IF (rij_shift.le.0.0D0) THEN + evdw = 1.0D20 +! if (evdw.gt.1.0d6) then +! write (*,'(2(1x,a3,i3),6f6.2)') & +! restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,& +! 1.0d0/rij,Rtail,Rhead,rij_shift, sig, sig0ij +!evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,& +! Equad,evdwij+Fcav+eheadtail,evdw +! endif + RETURN + END IF + sigder = -sig * sigsq + rij_shift = 1.0D0 / rij_shift + fac = rij_shift**expon + c1 = fac * fac * aa_aq_cat(itypi,itypj) ! print *,"ADAM",aa_aq(itypi,itypj) ! c1 = 0.0d0 - c2 = fac * bb_aq_cat(itypi,itypj) + c2 = fac * bb_aq_cat(itypi,itypj) ! c2 = 0.0d0 - evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 ) - eps2der = eps3rt * evdwij - eps3der = eps2rt * evdwij + evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 ) + eps2der = eps3rt * evdwij + eps3der = eps2rt * evdwij ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij - evdwij = eps2rt * eps3rt * evdwij + evdwij = eps2rt * eps3rt * evdwij !#ifdef TSCSC ! IF (bb_aq(itypi,itypj).gt.0) THEN ! evdw_p = evdw_p + evdwij @@ -23004,109 +24396,119 @@ chip1=chip(itypi) ! evdw_m = evdw_m + evdwij ! END IF !#else - evdw = evdw & - + evdwij + evdw = evdw & + + evdwij*sss_ele_cut !#endif - c1 = c1 * eps1 * eps2rt**2 * eps3rt**2 - fac = -expon * (c1 + evdwij) * rij_shift - sigder = fac * sigder + c1 = c1 * eps1 * eps2rt**2 * eps3rt**2 + fac = -expon * (c1 + evdwij) * rij_shift + sigder = fac * sigder ! Calculate distance derivative - gg(1) = fac - gg(2) = fac - gg(3) = fac + gg(1) = fac*sss_ele_cut+evdwij*sss_ele_grad + gg(2) = fac*sss_ele_cut+evdwij*sss_ele_grad + gg(3) = fac*sss_ele_cut+evdwij*sss_ele_grad - fac = chis1 * sqom1 + chis2 * sqom2 & - - 2.0d0 * chis12 * om1 * om2 * om12 - - pom = 1.0d0 - chis1 * chis2 * sqom12 + fac = chis1 * sqom1 + chis2 * sqom2 & + - 2.0d0 * chis12 * om1 * om2 * om12 + + pom = 1.0d0 - chis1 * chis2 * sqom12 ! print *,"TUT2",fac,chis1,sqom1,pom - Lambf = (1.0d0 - (fac / pom)) - Lambf = dsqrt(Lambf) - sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0) - Chif = Rtail * 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 - Fcav = top / bot + Lambf = (1.0d0 - (fac / pom)) + Lambf = dsqrt(Lambf) + sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0) + Chif = Rtail * 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 + 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) - dCAVdOM1 = dFdL * ( dFdOM1 ) - dCAVdOM2 = dFdL * ( dFdOM2 ) - dCAVdOM12 = dFdL * ( dFdOM12 ) + dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow*sss_ele_cut+& + Fcav*sss_ele_grad + Fcav=Fcav*sss_ele_cut + 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) + dCAVdOM1 = dFdL * ( dFdOM1 ) +! dCAVdOM2 = dFdL * ( dFdOM2 ) +! dCAVdOM12 = dFdL * ( dFdOM12 ) + dCAVdOM2=0.0d0 + dCAVdOM12=0.0d0 DO k= 1, 3 - ertail(k) = Rtail_distance(k)/Rtail + ertail(k) = Rtail_distance(k)/Rtail END DO erdxi = scalar( ertail(1), dC_norm(1,i) ) erdxj = scalar( ertail(1), dC_norm(1,j) ) facd1 = dtailcat(1,itypi,itypj) * vbld_inv(i) facd2 = dtailcat(2,itypi,itypj) * vbld_inv(j+nres) DO k = 1, 3 - pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i)) + pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i)) ! gradpepcatx(k,i) = gradpepcatx(k,i) & ! - (( dFdR + gg(k) ) * pom) - pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres)) + pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres)) ! gvdwx(k,j) = gvdwx(k,j) & ! + (( dFdR + gg(k) ) * pom) - gradpepcat(k,i) = gradpepcat(k,i) & - - (( dFdR + gg(k) ) * ertail(k))/2.0d0 - gradpepcat(k,i+1) = gradpepcat(k,i+1) & - - (( dFdR + gg(k) ) * ertail(k))/2.0d0 - - gradpepcat(k,j) = gradpepcat(k,j) & - + (( dFdR + gg(k) ) * ertail(k)) - gg(k) = 0.0d0 + gradpepcat(k,i) = gradpepcat(k,i) & + - (( dFdR + gg(k) ) * ertail(k))/2.0d0 + gradpepcat(k,i+1) = gradpepcat(k,i+1) & + - (( dFdR + gg(k) ) * ertail(k))/2.0d0 + + gradpepcat(k,j) = gradpepcat(k,j) & + + (( dFdR + gg(k) ) * ertail(k)) + gg(k) = 0.0d0 ENDDO + if (itype(j,5).gt.0) then !c! Compute head-head and head-tail energies for each state - isel = 3 + isel = 3 !c! Dipole-charge interactions - if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then - Qi=Qi*2 - Qij=Qij*2 - endif - if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then - Qj=Qj*2 - Qij=Qij*2 - endif - CALL edq_cat_pep(ecl, elj, epol) - eheadtail = ECL + elj + epol + CALL edq_cat_pep(ecl, elj, epol) + eheadtail = ECL + elj + epol ! print *,"i,",i,eheadtail ! eheadtail = 0.0d0 - - evdw = evdw + Fcav + eheadtail - + else +!HERE WATER and other types of molecules solvents will be added +! write(iout,*) "not yet implemented" + CALL edd_cat_pep(ecl) + eheadtail=ecl +! CALL edd_cat_pep +! eheadtail=0.0d0 + endif + evdw = evdw + Fcav + eheadtail +! if (evdw.gt.1.0d6) then +! write (*,'(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 +! endif 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 + 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_cat_pep + CALL sc_grad_cat_pep ! END IF !c!------------------------------------------------------------------- !c! NAPISY KONCOWE - END DO ! j - END DO ! i + END DO ! j +! END DO ! i !c write (iout,*) "Number of loop steps in EGB:",ind !c energy_dec=.false. ! print *,"EVDW KURW",evdw,nres - + 23 continue +! print *,"before leave sc_grad_cat", i,j, gradpepcat(1,nres-1) return end subroutine ecats_prot_amber @@ -23117,109 +24519,70 @@ chip1=chip(itypi) ! use calc_data ! use comm_momo 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,& - ndiv,ndivi - 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 + real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,& + r7,r4 + 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,& + ndiv,ndivi + 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 - itmp=0 - do i=1,4 - itmp=itmp+nres_molec(i) - enddo + if (nres_molec(5).eq.0) return + 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 + 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) + + 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)) + call to_box(xi,yi,zi) + + do j=itmp+1,itmp+nres_molec(5) ! print *,"WTF",itmp,j,i ! all parameters were for Ca2+ to approximate single charge divide by two - ndiv=1.0 - if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0 - wconst=78*ndiv - 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 + ndiv=1.0 + if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0 + wconst=78*ndiv + 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 - 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 + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + call to_box(xj,yj,zj) 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) @@ -23232,503 +24595,683 @@ chip1=chip(itypi) enddo dcmag=dsqrt(dcmag) do k=1,3 - myd_norm(k)=dc(k,i)/dcmag + 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 + 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 ! print *,"ecatprot",i,j,ecation_prot,rcpm - 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 + 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 + 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) - ndiv=1.0 - if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0 - - 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 + xi=(c(1,i+nres)) + yi=(c(2,i+nres)) + zi=(c(3,i+nres)) + call to_box(xi,yi,zi) + 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) + ndiv=1.0 + if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0 + + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + call to_box(xj,yj,zj) 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 ! 15- Glu 16-Asp - if((itype(i,1).eq.15.or.itype(i,1).eq.16).or.& - ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.& - (itype(i,1).eq.25))) 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) + if((itype(i,1).eq.15.or.itype(i,1).eq.16).or.& + ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.& + (itype(i,1).eq.25))) 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) - vcm(1)=(cm1(1)/cm1mag)*dASGL+xi - vcm(2)=(cm1(2)/cm1mag)*dASGL+yi - vcm(3)=(cm1(3)/cm1mag)*dASGL+zi + vcm(1)=(cm1(1)/cm1mag)*dASGL+xi + vcm(2)=(cm1(2)/cm1mag)*dASGL+yi + vcm(3)=(cm1(3)/cm1mag)*dASGL+zi ! valpha(k)=c(k,i) ! vcat(k)=c(k,j) - if (subchap.eq.1) then - vcat(1)=xj_temp - vcat(2)=yj_temp - vcat(3)=zj_temp - else - vcat(1)=xj_safe - vcat(2)=yj_safe - vcat(3)=zj_safe - endif - valpha(1)=xi-c(1,i+nres)+c(1,i) - valpha(2)=yi-c(2,i+nres)+c(2,i) - valpha(3)=zi-c(3,i+nres)+c(3,i) + if (subchap.eq.1) then + vcat(1)=xj_temp + vcat(2)=yj_temp + vcat(3)=zj_temp + else + vcat(1)=xj_safe + vcat(2)=yj_safe + vcat(3)=zj_safe + endif + valpha(1)=xi-c(1,i+nres)+c(1,i) + valpha(2)=yi-c(2,i+nres)+c(2,i) + valpha(3)=zi-c(3,i+nres)+c(3,i) ! 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) + 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 - if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then - ndivi=0.5 - else - ndivi=1.0 - endif - ndiv=1.0 - if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0 - - wh2o=78*ndivi*ndiv - 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.0d0-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.0d0/rsecp - Irthrp = Irsecp/rs - Irfourp = Irthrp/rs - Irsixp = 1.0d0/rsixp - Ireight=1.0d0/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 + if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then + ndivi=0.5 + else + ndivi=1.0 + endif + ndiv=1.0 + if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0 + + wh2o=78*ndivi*ndiv + 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.0d0-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.0d0/rsecp + Irthrp = Irsecp/rs + Irfourp = Irthrp/rs + Irsixp = 1.0d0/rsixp + Ireight=1.0d0/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) + + 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) + 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) + 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 - vcm(1)=(cm1(1)/cm1mag)*dASGL+xi - vcm(2)=(cm1(2)/cm1mag)*dASGL+yi - vcm(3)=(cm1(3)/cm1mag)*dASGL+zi - if (subchap.eq.1) then - vcat(1)=xj_temp - vcat(2)=yj_temp - vcat(3)=zj_temp - else - vcat(1)=xj_safe - vcat(2)=yj_safe - vcat(3)=zj_safe - endif - valpha(1)=xi-c(1,i+nres)+c(1,i) - valpha(2)=yi-c(2,i+nres)+c(2,i) - valpha(3)=zi-c(3,i+nres)+c(3,i) + vcm(1)=(cm1(1)/cm1mag)*dASGL+xi + vcm(2)=(cm1(2)/cm1mag)*dASGL+yi + vcm(3)=(cm1(3)/cm1mag)*dASGL+zi + if (subchap.eq.1) then + vcat(1)=xj_temp + vcat(2)=yj_temp + vcat(3)=zj_temp + else + vcat(1)=xj_safe + vcat(2)=yj_safe + vcat(3)=zj_safe + endif + valpha(1)=xi-c(1,i+nres)+c(1,i) + valpha(2)=yi-c(2,i+nres)+c(2,i) + valpha(3)=zi-c(3,i+nres)+c(3,i) - 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) + 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 - ndiv=1.0 - if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0 - - wh2o=78*ndiv - 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) + ndiv=1.0 + if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0 + + wh2o=78*ndiv + 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) ! TU SPRAWDZ??? ! dscvec(1) = xj ! dscvec(2) = yj ! dscvec(3) = zj - 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 + 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) - r(1) = xj - r(2) = yj - r(3) = zj - 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 + r(1) = xj + r(2) = yj + r(3) = zj + 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 ecat_nucl(ecation_nucl) + integer i,j,k,subchap,itmp,inum,itypi,itypj + real(kind=8) :: xi,yi,zi,xj,yj,zj + real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, & + dist_init,dist_temp,ecation_nucl,Evan1,Evan2,Ecav,Egb,wdip1,wdip2, & + wvan1,wvan2,wgbsig,wgbeps,wgbchi,wgbchip,wcav1,wcav2,wcav3,wcav4, & + wcavsig,wcavchi,v1m,v1dpdx,wh2o,wc,Edip,rcs2,invrcs6,invrcs8,invrcs12, & + invrcs14,rcb,rcb2,invrcb,invrcb2,invrcb4,invrcb6,cosinus,cos2,dcosdcatconst, & + dcosdcalpconst,dcosdcmconst,rcav,rcav11,rcav12,constcav1,constcav2, & + constgb1,constgb2,constdvan1,constdvan2,sgb,sgb6,sgb7,sgb12,sgb13, & + cavnum,cavdenom,invcavdenom2,dcavnumdcos,dcavnumdr,dcavdenomdcos, & + dcavdenomdr,sslipi,ssgradlipi,sslipj,ssgradlipj,aa,bb + real(kind=8),dimension(3) ::gg,r,dEtotalCm,dEtotalCalp,dEvan1Cm,& + dEvan2Cm,cm1,cm,vcat,vsug,v1,v2,dx,vcm,dEdipCm,dEdipCalp, & + dEvan1Calp,dEvan2Cat,dEvan2Calp,dEtotalCat,dEdipCat,dEvan1Cat,dcosdcat, & + dcosdcalp,dcosdcm,dEgbdCat,dEgbdCalp,dEgbdCm,dEcavdCat,dEcavdCalp, & + dEcavdCm,boxik + real(kind=8),dimension(14) :: vcatnuclprm + ecation_nucl=0.0d0 + boxik(1)=boxxsize + boxik(2)=boxysize + boxik(3)=boxzsize + + if (nres_molec(5).eq.0) return + itmp=0 + do i=1,4 + itmp=itmp+nres_molec(i) + enddo +! print *,nres_molec(2),"nres2" + do i=ibond_nucl_start,ibond_nucl_end +! do i=iatsc_s_nucl,iatsc_e_nucl + if ((itype(i,2).eq.ntyp1_molec(2))) cycle ! leave dummy atoms + xi=(c(1,i+nres)) + yi=(c(2,i+nres)) + zi=(c(3,i+nres)) + call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) + do k=1,3 + cm1(k)=dc(k,i+nres) + enddo + do j=itmp+1,itmp+nres_molec(5) + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + call to_box(xj,yj,zj) +! print *,i,j,itmp +! write(iout,*) "xi,yi,zi,xj,yj,zj", xi,yi,zi,xj,yj,zj +! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) +! 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 + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) +! write(iout,*) 'after shift', xj,yj,zj + dist_init=xj**2+yj**2+zj**2 + + itypi=itype(i,2) + itypj=itype(j,5) + do k=1,13 + vcatnuclprm(k)=catnuclprm(k,itypi,itypj) + enddo + do k=1,3 + vcm(k)=c(k,i+nres) + vsug(k)=c(k,i) + vcat(k)=c(k,j) + enddo + call to_box(vcm(1),vcm(2),vcm(3)) + call to_box(vsug(1),vsug(2),vsug(3)) + call to_box(vcat(1),vcat(2),vcat(3)) + do k=1,3 +! dx(k) = vcat(k)-vcm(k) +! enddo + dx(k)=boxshift(vcat(k)-vcm(k),boxik(k)) +! do k=1,3 + v1(k)=dc(k,i+nres) + v2(k)=boxshift(vcat(k)-vsug(k),boxik(k)) + enddo + v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2) + v1dpdx = v1(1)*dx(1)+v1(2)*dx(2)+v1(3)*dx(3) +! The weights of the energy function calculated from +!The quantum mechanical Gaussian simulations of potassium and sodium with deoxynucleosides + wh2o=78 + wdip1 = vcatnuclprm(1) + wdip1 = wdip1/wh2o !w1 + wdip2 = vcatnuclprm(2) + wdip2 = wdip2/wh2o !w2 + wvan1 = vcatnuclprm(3) + wvan2 = vcatnuclprm(4) !pis1 + wgbsig = vcatnuclprm(5) !sigma0 + wgbeps = vcatnuclprm(6) !epsi0 + wgbchi = vcatnuclprm(7) !chi1 + wgbchip = vcatnuclprm(8) !chip1 + wcavsig = vcatnuclprm(9) !sig + wcav1 = vcatnuclprm(10) !b1 + wcav2 = vcatnuclprm(11) !b2 + wcav3 = vcatnuclprm(12) !b3 + wcav4 = vcatnuclprm(13) !b4 + wcavchi = vcatnuclprm(14) !chis1 + rcs2 = v2(1)**2+v2(2)**2+v2(3)**2 + invrcs6 = 1/rcs2**3 + invrcs8 = invrcs6/rcs2 + invrcs12 = invrcs6**2 + invrcs14 = invrcs12/rcs2 + rcb2 = dx(1)**2+dx(2)**2+dx(3)**2 + rcb = sqrt(rcb2) + invrcb = 1/rcb + invrcb2 = invrcb**2 + invrcb4 = invrcb2**2 + invrcb6 = invrcb4*invrcb2 + cosinus = v1dpdx/(v1m*rcb) + cos2 = cosinus**2 + dcosdcatconst = invrcb2/v1m + dcosdcalpconst = invrcb/v1m**2 + dcosdcmconst = invrcb2/v1m**2 + do k=1,3 + dcosdcat(k) = (v1(k)*rcb-dx(k)*v1m*cosinus)*dcosdcatconst + dcosdcalp(k) = (v1(k)*rcb*cosinus-dx(k)*v1m)*dcosdcalpconst + dcosdcm(k) = ((dx(k)-v1(k))*v1m*rcb+ & + cosinus*(dx(k)*v1m**2-v1(k)*rcb2))*dcosdcmconst + enddo + rcav = rcb/wcavsig + rcav11 = rcav**11 + rcav12 = rcav11*rcav + constcav1 = 1-wcavchi*cos2 + constcav2 = sqrt(constcav1) + constgb1 = 1/sqrt(1-wgbchi*cos2) + constgb2 = wgbeps*(1-wgbchip*cos2)**2 + constdvan1 = 12*wvan1*wvan2**12*invrcs14 + constdvan2 = 6*wvan1*wvan2**6*invrcs8 +!---------------------------------------------------------------------------- +!Gay-Berne term +!--------------------------------------------------------------------------- + sgb = 1/(1-constgb1+(rcb/wgbsig)) + sgb6 = sgb**6 + sgb7 = sgb6*sgb + sgb12 = sgb6**2 + sgb13 = sgb12*sgb + Egb = constgb2*(sgb12-sgb6) + do k=1,3 + dEgbdCat(k) = -constgb2/wgbsig*(12*sgb13-6*sgb7)*invrcb*dx(k) & + +(constgb1**3*constgb2*wgbchi*cosinus*(12*sgb13-6*sgb7) & + -4*wgbeps*wgbchip*cosinus*(1-wgbchip*cos2)*(sgb12-sgb6))*dcosdcat(k) + dEgbdCm(k) = constgb2/wgbsig*(12*sgb13-6*sgb7)*invrcb*dx(k) & + +(constgb1**3*constgb2*wgbchi*cosinus*(12*sgb13-6*sgb7) & + -4*wgbeps*wgbchip*cosinus*(1-wgbchip*cos2)*(sgb12-sgb6))*dcosdcm(k) + dEgbdCalp(k) = (constgb1**3*constgb2*wgbchi*cosinus & + *(12*sgb13-6*sgb7) & + -4*wgbeps*wgbchip*cosinus*(1-wgbchip*cos2)*(sgb12-sgb6))*dcosdcalp(k) + enddo +!---------------------------------------------------------------------------- +!cavity term +!--------------------------------------------------------------------------- + cavnum = sqrt(rcav*constcav2)+wcav2*rcav*constcav2-wcav3 + cavdenom = 1+wcav4*rcav12*constcav1**6 + Ecav = wcav1*cavnum/cavdenom + invcavdenom2 = 1/cavdenom**2 + dcavnumdcos = -wcavchi*cosinus/constcav2 & + *(sqrt(rcav/constcav2)/2+wcav2*rcav) + dcavnumdr = (0.5*sqrt(constcav2/rcav)+wcav2*constcav2)/wcavsig + dcavdenomdcos = -12*wcav4*wcavchi*rcav12*constcav1**5*cosinus + dcavdenomdr = 12*wcav4/wcavsig*rcav11*constcav1**6 + do k=1,3 + dEcavdCat(k) = ((dcavnumdcos*cavdenom-dcavdenomdcos*cavnum) & + *dcosdcat(k)+(dcavnumdr*cavdenom-dcavdenomdr*cavnum)/rcb*dx(k))*wcav1*invcavdenom2 + dEcavdCm(k) = ((dcavnumdcos*cavdenom-dcavdenomdcos*cavnum) & + *dcosdcm(k)-(dcavnumdr*cavdenom-dcavdenomdr*cavnum)/rcb*dx(k))*wcav1*invcavdenom2 + dEcavdCalp(k) = (dcavnumdcos*cavdenom-dcavdenomdcos*cavnum) & + *dcosdcalp(k)*wcav1*invcavdenom2 + enddo +!---------------------------------------------------------------------------- +!van der Waals and dipole-charge interaction energy +!--------------------------------------------------------------------------- + Evan1 = wvan1*wvan2**12*invrcs12 + do k=1,3 + dEvan1Cat(k) = -v2(k)*constdvan1 + dEvan1Cm(k) = 0.0d0 + dEvan1Calp(k) = v2(k)*constdvan1 + enddo + Evan2 = -wvan1*wvan2**6*invrcs6 + do k=1,3 + dEvan2Cat(k) = v2(k)*constdvan2 + dEvan2Cm(k) = 0.0d0 + dEvan2Calp(k) = -v2(k)*constdvan2 + enddo + Edip = wdip1*cosinus*invrcb2-wdip2*(1-cos2)*invrcb4 + do k=1,3 + dEdipCat(k) = (-2*wdip1*cosinus*invrcb4 & + +4*wdip2*(1-cos2)*invrcb6)*dx(k) & + +dcosdcat(k)*(wdip1*invrcb2+2*wdip2*cosinus*invrcb4) + dEdipCm(k) = (2*wdip1*cosinus*invrcb4 & + -4*wdip2*(1-cos2)*invrcb6)*dx(k) & + +dcosdcm(k)*(wdip1*invrcb2+2*wdip2*cosinus*invrcb4) + dEdipCalp(k) = dcosdcalp(k)*(wdip1*invrcb2 & + +2*wdip2*cosinus*invrcb4) + enddo + if (energy_dec) write (iout,'(2i5,4(a6,f7.3))') i,j, & + ' E GB ',Egb,' ECav ',Ecav,' Evdw ',Evan1+Evan2,' Edip ',Edip + ecation_nucl=ecation_nucl+Ecav+Egb+Edip+Evan1+Evan2 + do k=1,3 + dEtotalCat(k) = dEcavdCat(k)+dEvan1Cat(k)+dEvan2Cat(k) & + +dEgbdCat(k)+dEdipCat(k) + dEtotalCm(k) = dEcavdCm(k)+dEvan1Cm(k)+dEvan2Cm(k) & + +dEgbdCm(k)+dEdipCm(k) + dEtotalCalp(k) = dEcavdCalp(k)+dEgbdCalp(k)+dEvan1Calp(k) & + +dEdipCalp(k)+dEvan2Calp(k) + enddo + do k=1,3 + gg(k) = dEtotalCm(k)+dEtotalCalp(k) + gradnuclcatx(k,i)=gradnuclcatx(k,i)+dEtotalCm(k) + gradnuclcat(k,i)=gradnuclcat(k,i)+gg(k) + gradnuclcat(k,j)=gradnuclcat(k,j)+dEtotalCat(k) + enddo + enddo !j + enddo !i + return + end subroutine ecat_nucl + !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- subroutine eprot_sc_base(escbase) use calc_data -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -23747,128 +25290,97 @@ chip1=chip(itypi) 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 + 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 + 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 ) + 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) + call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) + 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) + call to_box(xj,yj,zj) +! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) +! 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 + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) + + 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 = 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 ) + sig0ij = sigma_scbase( itypi,itypj ) + if (sig0ij.lt.0.2) print *,"KURWA",sig0ij,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 ) + chi12 = chi1 * chi2 + chip1 = chipp_scbase( itypi, itypj,1 ) + chip2 = chipp_scbase( itypi, itypj,2 ) ! chip1=0.0d0 ! chip2=0.0d0 - chip12 = chip1 * chip2 + 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) + 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) + 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 = 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) + 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) @@ -23881,18 +25393,18 @@ chip1=chip(itypi) ! 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) + 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) + 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_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 @@ -23907,95 +25419,97 @@ chip1=chip(itypi) 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) + 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) + rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj) + rij = dsqrt(rrij) !---------------------------- - CALL sc_angular + 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 + 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) + 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) + 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 = fac * bb_scbase(itypi,itypj) ! c2 = 0.0d0 - evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 ) - eps2der = eps3rt * evdwij - eps3der = eps2rt * evdwij + 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 + 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 + 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 + 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 + pom = 1.0d0 - chis1 * chis2 * sqom12 + Lambf = (1.0d0 - (fac / pom)) + Lambf = dsqrt(Lambf) + sparrow=dsqrt(sig1**2.0d0 + sig2**2.0d0) + if (b1.eq.0.0d0) sparrow=1.0d0 + sparrow = 1.0d0 / sparrow +! write (*,*) "sparrow = ", sparrow,sig1,sig2,b1 + 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 + 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) + 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 + 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 & @@ -24009,30 +25523,30 @@ chip1=chip(itypi) DO k = 1, 3 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i) ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j) - pom = ertail(k) + pom = ertail(k) !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres)) - gvdwx_scbase(k,i) = gvdwx_scbase(k,i) & - - (( dFdR + gg(k) ) * pom) + 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) + pom = ertail(k) !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres)) - gvdwx_scbase(k,j) = gvdwx_scbase(k,j) & - + (( dFdR + gg(k) ) * pom) + 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)) + 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)) + gvdwc_scbase(k,j) = gvdwc_scbase(k,j) & + + (( dFdR + gg(k) ) * ertail(k)) !c! & + ( dFdR * ertail(k)) - gg(k) = 0.0d0 + gg(k) = 0.0d0 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i) !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j) END DO @@ -24041,7 +25555,7 @@ chip1=chip(itypi) ! endif !Now dipole-dipole - if (wdipdip_scbase(2,itypi,itypj).gt.0.0d0) then + 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) @@ -24050,9 +25564,9 @@ chip1=chip(itypi) 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)) + * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2)) c3= (w3/ Rhead ** 6.0d0) & - * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2)) + * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2)) ECL = c1 - c2 + c3 !c! write (*,*) "w1 = ", w1 !c! write (*,*) "w2 = ", w2 @@ -24071,20 +25585,20 @@ chip1=chip(itypi) !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)) + * (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)) + * (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 ) + * ( 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 ) + * ( 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 @@ -24093,7 +25607,7 @@ chip1=chip(itypi) c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac) dGCLdOM12 = c1 - c2 + c3 DO k= 1, 3 - erhead(k) = Rhead_distance(k)/Rhead + 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) ) @@ -24101,17 +25615,17 @@ chip1=chip(itypi) 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) + 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 @@ -24128,7 +25642,7 @@ chip1=chip(itypi) 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 + R1=R1+(c(k,j+nres)-chead(k,1))**2 END DO !c! Pitagoras R1 = dsqrt(R1) @@ -24143,12 +25657,12 @@ chip1=chip(itypi) sparrow = w1 * om1 hawk = w2 * (1.0d0 - sqom2) Ecl = sparrow / Rhead**2.0d0 & - - hawk / Rhead**4.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 + + 4.0d0 * hawk / Rhead**5.0d0 !c! dF/dom1 dGCLdOM1 = (w1) / (Rhead**2.0d0) !c! dF/dom2 @@ -24164,20 +25678,20 @@ chip1=chip(itypi) 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) + / (fgb1 ** 5.0d0) dFGBdR1 = ( (R1 / MomoFac1) & - * ( 2.0d0 - (0.5d0 * ee1) ) ) & - / ( 2.0d0 * fgb1 ) + * ( 2.0d0 - (0.5d0 * ee1) ) ) & + / ( 2.0d0 * fgb1 ) dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) & - * (2.0d0 - 0.5d0 * ee1) ) & - / (2.0d0 * fgb1) + * (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) + 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) ) @@ -24190,39 +25704,42 @@ chip1=chip(itypi) ! 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))) + 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)) + 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)) + 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) + 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) + 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 + if (energy_dec) write (iout,'(a22,2i5,4f8.3,f16.3)'), & + "escbase:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,escbase + if (energy_dec) write (iout,*) "evdwij,", evdwij, 1.0/rij, sig, sig0ij call sc_grad_scbase - enddo + enddo enddo return @@ -24232,45 +25749,46 @@ chip1=chip(itypi) real (kind=8) :: dcosom1(3),dcosom2(3) eom1 = & - eps2der * eps2rt_om1 & - - 2.0D0 * alf1 * eps3der & - + sigder * sigsq_om1 & - + dCAVdOM1 & - + dGCLdOM1 & - + dPOLdOM1 + 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 + 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 + 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) + 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 @@ -24283,144 +25801,106 @@ chip1=chip(itypi) 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 + 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 + 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 + 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) + 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 ) + 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 + call to_box(xi,yi,zi) + 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) + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) + dist_init=xj**2+yj**2+zj**2 + 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 ) + 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 ) + 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) + 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 + 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) + 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) + 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))) + (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 = 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) + 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) + rij = dsqrt(rrij) !---------------------------- evdwij = 0.0d0 ECL = 0.0d0 @@ -24434,118 +25914,118 @@ chip1=chip(itypi) 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 + 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 + 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) + 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 = fac * bb_pepbase(itypj) ! c2 = 0.0d0 - evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 ) - eps2der = eps3rt * evdwij - eps3der = eps2rt * evdwij + 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 + 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 + 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) + 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 + 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 + 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) + 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 ) + dCAVdOM1 = dFdL * ( dFdOM1 ) + dCAVdOM2 = dFdL * ( dFdOM2 ) + dCAVdOM12 = dFdL * ( dFdOM12 ) - ertail(1) = xj*rij - ertail(2) = yj*rij - ertail(3) = zj*rij + 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) + 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 + 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) + pom = ertail(k) !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres)) - gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) & - + (( dFdR + gg(k) ) * pom) + 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 + 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)) + gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) & + + (( dFdR + gg(k) ) * ertail(k)) !c! & + ( dFdR * ertail(k)) - gg(k) = 0.0d0 + gg(k) = 0.0d0 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i) !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j) END DO @@ -24562,29 +26042,29 @@ chip1=chip(itypi) 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)) + * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2)) c3= (w3/ Rhead ** 6.0d0) & - * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2)) + * (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)) + * (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)) + * (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 ) + * ( 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 ) + * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 ) c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1)) dGCLdOM2 = c1 - c2 + c3 @@ -24594,7 +26074,7 @@ chip1=chip(itypi) c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac) dGCLdOM12 = c1 - c2 + c3 DO k= 1, 3 - erhead(k) = Rhead_distance(k)/Rhead + 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) ) @@ -24606,22 +26086,24 @@ chip1=chip(itypi) !+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) ! gvdwx_pepbase(k,i) = gvdwx_scbase(k,i) & ! - dGCLdR * pom - pom = erhead(k) + pom = erhead(k) !+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) - gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) & - + dGCLdR * pom + gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) & + + dGCLdR * pom - gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) & - - dGCLdR * erhead(k)/2.0d0 + 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 + 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) + 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 + if (energy_dec) write (iout,'(a22,2i5,4f8.3,f16.3)'), & + "epepbase:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,epepbase call sc_grad_pepbase enddo enddo @@ -24631,28 +26113,28 @@ chip1=chip(itypi) real (kind=8) :: dcosom1(3),dcosom2(3) eom1 = & - eps2der * eps2rt_om1 & - - 2.0D0 * alf1 * eps3der & - + sigder * sigsq_om1 & - + dCAVdOM1 & - + dGCLdOM1 & - + dPOLdOM1 + 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 + 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 + 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) @@ -24662,30 +26144,30 @@ chip1=chip(itypi) ! 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 + 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) + 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) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -24702,124 +26184,92 @@ chip1=chip(itypi) !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) :: evdw,sig0ij,aa,bb 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 + 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,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 + 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 + 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) + call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) + 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 + call to_box(xj,yj,zj) +! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) +! 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 + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) dxj = dc_norm( 1,j ) - dyj = dc_norm( 2,j ) - dzj = dc_norm( 3,j ) - dscj_inv = vbld_inv(j+1) + 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 ) + 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 ) + 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) + 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) + alf1 = 0.0d0 + alf2 = 0.0d0 + alf12 = 0.0d0 + a12sq = rborn_scphoi(itypi) * rborn_scphoj(itypi) - b1 = alphasur_scpho(1,itypi) + b1 = alphasur_scpho(1,itypi) ! b1=0.0d0 - b2 = alphasur_scpho(2,itypi) - b3 = alphasur_scpho(3,itypi) - b4 = alphasur_scpho(4,itypi) + 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) @@ -24828,24 +26278,24 @@ chip1=chip(itypi) ! 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 + 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 + 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) + 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_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 @@ -24862,104 +26312,104 @@ chip1=chip(itypi) 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 + 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) + rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj) + rij = dsqrt(rrij) !---------------------------- - CALL sc_angular + 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 + 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) + 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) + 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 = fac * bb_scpho(itypi) ! c2 = 0.0d0 - evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 ) - eps2der = eps3rt * evdwij - eps3der = eps2rt * evdwij + 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 + 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 + 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) + 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 + 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) + 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 ) + dCAVdOM1 = dFdL * ( dFdOM1 ) + dCAVdOM2 = dFdL * ( dFdOM2 ) + dCAVdOM12 = dFdL * ( dFdOM12 ) - ertail(1) = xj*rij - ertail(2) = yj*rij - ertail(3) = zj*rij + 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) + 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) + 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 ) @@ -24971,20 +26421,20 @@ chip1=chip(itypi) ! +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)) + 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) = 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 + 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 + 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) @@ -24995,7 +26445,7 @@ chip1=chip(itypi) 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 + (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) @@ -25016,15 +26466,15 @@ chip1=chip(itypi) sparrow = w1 * om1 hawk = w2 * (1.0d0 - sqom2) Ecl = sparrow / Rhead**2.0d0 & - - hawk / Rhead**4.0d0 + - hawk / Rhead**4.0d0 !c!------------------------------------------------------------------- if (energy_dec) write(iout,*) "ECLdipdip",ECL,Rhead,& - 1.0/rij,sparrow + 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 + + 4.0d0 * hawk / Rhead**5.0d0 !c! dF/dom1 dGCLdOM1 = (w1) / (Rhead**2.0d0) !c! dF/dom2 @@ -25037,7 +26487,7 @@ chip1=chip(itypi) 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 + R1=R1+((c(k,j)+c(k,j+1))/2.0-chead(k,1))**2 END DO !c! Pitagoras R1 = dsqrt(R1) @@ -25053,25 +26503,25 @@ chip1=chip(itypi) 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) + / (fgb1 ** 5.0d0) dFGBdR1 = ( (R1 / MomoFac1) & - * ( 2.0d0 - (0.5d0 * ee1) ) ) & - / ( 2.0d0 * fgb1 ) + * ( 2.0d0 - (0.5d0 * ee1) ) ) & + / ( 2.0d0 * fgb1 ) dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) & - * (2.0d0 - 0.5d0 * ee1) ) & - / (2.0d0 * fgb1) + * (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) + * (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) + 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) ) @@ -25084,38 +26534,38 @@ chip1=chip(itypi) ! 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))) + 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)) + 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)) + 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) + 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 + 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 @@ -25123,10 +26573,10 @@ chip1=chip(itypi) 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:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,escpho escpho=escpho+evdwij+epol+Fcav+ECL call sc_grad_scpho - enddo + enddo enddo @@ -25137,28 +26587,28 @@ chip1=chip(itypi) real (kind=8) :: dcosom1(3),dcosom2(3) eom1 = & - eps2der * eps2rt_om1 & - - 2.0D0 * alf1 * eps3der & - + sigder * sigsq_om1 & - + dCAVdOM1 & - + dGCLdOM1 & - + dPOLdOM1 + 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 + 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 + 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) @@ -25168,20 +26618,20 @@ chip1=chip(itypi) ! 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 + 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)),& @@ -25189,13 +26639,13 @@ chip1=chip(itypi) ! 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) + 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) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -25214,118 +26664,83 @@ chip1=chip(itypi) 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 + 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 + 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 + 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 + call to_box(xi,yi,zi) + + 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 + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) + + dist_init=xj**2+yj**2+zj**2 + 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 + sig0ij = sigma_peppho ! chi1=0.0d0 ! chi2=0.0d0 - chi12 = chi1 * chi2 + chi12 = chi1 * chi2 ! chip1=0.0d0 ! chip2=0.0d0 - chip12 = chip1 * chip2 + chip12 = chip1 * chip2 ! chis1 = 0.0d0 ! chis2 = 0.0d0 - chis12 = chis1 * chis2 - sig1 = sigmap1_peppho - sig2 = sigmap2_peppho + 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) + 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 + b2 = alphasur_peppho(2) + b3 = alphasur_peppho(3) + b4 = alphasur_peppho(4) + CALL sc_angular sqom1=om1*om1 evdwij = 0.0d0 ECL = 0.0d0 @@ -25340,27 +26755,27 @@ chip1=chip(itypi) 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 + 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 = fac * bb_peppho ! c2 = 0.0d0 - evdwij = c1 + c2 + 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) + 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 @@ -25379,13 +26794,13 @@ chip1=chip(itypi) sparrow = w1 * om1 hawk = w2 * (1.0d0 - sqom1) Ecl = sparrow * rij_shift**2.0d0 & - - hawk * rij_shift**4.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 + + 4.0d0 * hawk * rij_shift**5.0d0 !c! dF/dom1 dGCLdOM1 = (w1) * (rij_shift**2.0d0) !c! dF/dom2 @@ -25393,32 +26808,35 @@ chip1=chip(itypi) eom1 = dGCLdOM1+dGCLdOM2 eom2 = 0.0 - fac = -expon * (c1 + evdwij) * rij_shift+dFdR+dGCLdR + 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 + 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)) !& + 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)) !& + 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 + 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 + if (energy_dec) write (iout,'(a22,2i5,4f8.3,f16.3)'), & + "epeppho:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,epeppho + epeppho=epeppho+evdwij+Fcav+ECL ! print *,i,j,evdwij,Fcav,ECL,rij_shift enddo @@ -25428,7 +26846,7 @@ chip1=chip(itypi) subroutine emomo(evdw) use calc_data use comm_momo -! implicit real*8 (a-h,o-z) +! implicit real(kind=8) (a-h,o-z) ! include 'DIMENSIONS' ! include 'COMMON.GEO' ! include 'COMMON.VAR' @@ -25443,99 +26861,79 @@ chip1=chip(itypi) ! include 'COMMON.SBRIDGE' logical :: lprn !el local variables - integer :: iint,itypi1,subchap,isel + integer :: iint,itypi1,subchap,isel,countss real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,e1,e2,sigm,epsi - real(kind=8) :: evdw + real(kind=8) :: evdw,aa,bb 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 + dist_temp, dist_init,ssgradlipi,ssgradlipj, & + sslipi,sslipj,faclip,alpha_sco + integer :: ii,icont 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 + 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) + evdw=0.0d0 eps_out=80.0d0 sss_ele_cut=1.0d0 + countss=0 ! print *,"EVDW KURW",evdw,nres - do i=iatsc_s,iatsc_e +! do i=iatsc_s,iatsc_e ! print *,"I am in EVDW",i - itypi=iabs(itype(i,1)) + do icont=g_listscsc_start,g_listscsc_end + i=newcontlisti(icont) + j=newcontlistj(icont) + + 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 + 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) + call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) +! endif ! print *, sslipi,ssgradlipi - dxi=dc_norm(1,nres+i) - dyi=dc_norm(2,nres+i) - dzi=dc_norm(3,nres+i) + dxi=dc_norm(1,nres+i) + dyi=dc_norm(2,nres+i) + dzi=dc_norm(3,nres+i) ! dsci_inv=dsc_inv(itypi) - dsci_inv=vbld_inv(i+nres) + 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) +! 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 (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN + call dyn_ssbond_ene(i,j,evdwij,countss) + 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) + do k=j+1,iend(i,iint) !C search over all next residues - if (dyn_ss_mask(k)) then + 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) + 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 @@ -25543,64 +26941,39 @@ chip1=chip(itypi) !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 + 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) + 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 ) + dscj_inv=vbld_inv(j+nres) + xj=c(1,j+nres) + yj=c(2,j+nres) + zj=c(3,j+nres) + call to_box(xj,yj,zj) + call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) +! write(iout,*) "KRUWA", i,j + 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 + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) + Rreal(1)=xj + Rreal(2)=yj + Rreal(3)=zj + 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 @@ -25613,17 +26986,17 @@ chip1=chip(itypi) ! 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) + 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) + 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 @@ -25632,33 +27005,36 @@ chip1=chip(itypi) ! sig2=0.0 ! write (*,*) "sig2 = ", sig2 ! alpha factors from Fcav/Gcav - b1cav = alphasur(1,itypi,itypj) + b1cav = alphasur(1,itypi,itypj) ! b1cav=0.0d0 - b2cav = alphasur(2,itypi,itypj) - b3cav = alphasur(3,itypi,itypj) - b4cav = alphasur(4,itypi,itypj) + 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) + 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 + call to_box (ctail(1,1),ctail(2,1),ctail(3,1)) + call to_box (ctail(1,2),ctail(2,2),ctail(3,2)) + !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_distance(1)=boxshift(ctail( 1, 2 ) - ctail( 1,1 ),boxxsize) + Rtail_distance(2)=boxshift(ctail( 2, 2 ) - ctail( 2,1 ),boxysize) + Rtail_distance(3)=boxshift(ctail( 3, 2 ) - ctail( 3,1 ),boxzsize) Rtail = dsqrt( & - (Rtail_distance(1)*Rtail_distance(1)) & - + (Rtail_distance(2)*Rtail_distance(2)) & - + (Rtail_distance(3)*Rtail_distance(3))) + (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 !------------------------------------------------------------------- @@ -25670,18 +27046,33 @@ chip1=chip(itypi) ! 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 + 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 + enddo + if (energy_dec) write(iout,*) "before",chead(1,1),chead(2,1),chead(3,1) + if (energy_dec) write(iout,*) "before",chead(1,2),chead(2,2),chead(3,2) + call to_box (chead(1,1),chead(2,1),chead(3,1)) + call to_box (chead(1,2),chead(2,2),chead(3,2)) + +!c! head distances will be themselves usefull elswhere +!c1 (in Gcav, for example) + if (energy_dec) write(iout,*) "after",chead(1,1),chead(2,1),chead(3,1) + if (energy_dec) write(iout,*) "after",chead(1,2),chead(2,2),chead(3,2) + + Rhead_distance(1)=boxshift(chead( 1, 2 ) - chead( 1,1 ),boxxsize) + Rhead_distance(2)=boxshift(chead( 2, 2 ) - chead( 2,1 ),boxysize) + Rhead_distance(3)=boxshift(chead( 3, 2 ) - chead( 3,1 ),boxzsize) + if (energy_dec) write(iout,*) "after,rdi",(Rhead_distance(k),k=1,3) ! 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 +! 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_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 @@ -25696,49 +27087,57 @@ chip1=chip(itypi) 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) + 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) + rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj) + rij = dsqrt(rrij) + sss_ele_cut=sscale_ele(1.0d0/(rij)) + sss_ele_grad=sscagrad_ele(1.0d0/(rij)) +! sss_ele_cut=1.0d0 +! sss_ele_grad=0.0d0 +! print *,sss_ele_cut,sss_ele_grad,& +! 1.0d0/(rij),r_cut_ele,rlamb_ele + if (sss_ele_cut.le.0.0) cycle + !---------------------------- - CALL sc_angular + 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 + 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) + 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) + 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 = fac * bb_aq(itypi,itypj) ! c2 = 0.0d0 - evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 ) - eps2der = eps3rt * evdwij - eps3der = eps2rt * evdwij + evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 ) + eps2der = eps3rt * evdwij + eps3der = eps2rt * evdwij ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij - evdwij = eps2rt * eps3rt * evdwij + evdwij = eps2rt * eps3rt * evdwij !#ifdef TSCSC ! IF (bb_aq(itypi,itypj).gt.0) THEN ! evdw_p = evdw_p + evdwij @@ -25746,60 +27145,59 @@ chip1=chip(itypi) ! evdw_m = evdw_m + evdwij ! END IF !#else - evdw = evdw & - + evdwij + evdw = evdw & + + evdwij*sss_ele_cut !#endif - c1 = c1 * eps1 * eps2rt**2 * eps3rt**2 - fac = -expon * (c1 + evdwij) * rij_shift - sigder = fac * sigder + 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 + gg(1) = fac*sss_ele_cut + gg(2) = fac*sss_ele_cut + gg(3) = fac*sss_ele_cut ! if (b2.gt.0.0) then - fac = chis1 * sqom1 + chis2 * sqom2 & - - 2.0d0 * chis12 * om1 * om2 * om12 + 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)) + 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) + 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 + 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 + 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 + 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) + dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow*sss_ele_cut + 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 ) + dCAVdOM1 = dFdL * ( dFdOM1 ) + dCAVdOM2 = dFdL * ( dFdOM2 ) + dCAVdOM12 = dFdL * ( dFdOM12 ) DO k= 1, 3 - ertail(k) = Rtail_distance(k)/Rtail + 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) ) @@ -25808,32 +27206,39 @@ chip1=chip(itypi) 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) + pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres)) + gvdwx(k,i) = gvdwx(k,i) & + - (( dFdR + gg(k) ) * pom)& + -sss_ele_grad*Rreal(k)*rij*(Fcav+evdwij) !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) + pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres)) + gvdwx(k,j) = gvdwx(k,j) & + + (( dFdR + gg(k) ) * pom) & + +sss_ele_grad*Rreal(k)*rij*(Fcav+evdwij) + !c! & + ( dFdR * pom ) - gvdwc(k,i) = gvdwc(k,i) & - - (( dFdR + gg(k) ) * ertail(k)) + gvdwc(k,i) = gvdwc(k,i) & + - (( dFdR + gg(k) ) * ertail(k)) & + -sss_ele_grad*Rreal(k)*rij*(Fcav+evdwij) + !c! & - ( dFdR * ertail(k)) - gvdwc(k,j) = gvdwc(k,j) & - + (( dFdR + gg(k) ) * ertail(k)) + gvdwc(k,j) = gvdwc(k,j) & + + (( dFdR + gg(k) ) * ertail(k)) & + +sss_ele_grad*Rreal(k)*rij*(Fcav+evdwij) + !c! & + ( dFdR * ertail(k)) - gg(k) = 0.0d0 + 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 = iabs(Qi) + iabs(Qj) ! double charge for Phophorylated! itype - 25,27,27 ! if ((itype(i).eq.27).or.(itype(i).eq.26).or.(itype(i).eq.25)) then ! Qi=Qi*2 @@ -25845,123 +27250,127 @@ chip1=chip(itypi) ! endif ! isel=0 - IF (isel.eq.0) THEN +! if (isel.eq.2) isel=0 +! if (isel.eq.3) isel=0 +! if (iabs(Qj).eq.1) isel=0 +! nstate(itypi,itypj)=1 + IF (isel.eq.0) THEN !c! No charges - do nothing - eheadtail = 0.0d0 + eheadtail = 0.0d0 - ELSE IF (isel.eq.4) THEN + ELSE IF (isel.eq.4) THEN !c! Calculate dipole-dipole interactions - CALL edd(ecl) - eheadtail = ECL + CALL edd(ecl) + eheadtail = ECL ! eheadtail = 0.0d0 - ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN + ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN !c! Charge-nonpolar interactions - if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then - Qi=Qi*2 - Qij=Qij*2 - endif - if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then - Qj=Qj*2 - Qij=Qij*2 - endif + if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then + Qi=Qi*2 + Qij=Qij*2 + endif + if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then + Qj=Qj*2 + Qij=Qij*2 + endif - CALL eqn(epol) - eheadtail = epol + CALL eqn(epol) + eheadtail = epol ! eheadtail = 0.0d0 - ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN + ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN !c! Nonpolar-charge interactions - if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then - Qi=Qi*2 - Qij=Qij*2 - endif - if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then - Qj=Qj*2 - Qij=Qij*2 - endif + if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then + Qi=Qi*2 + Qij=Qij*2 + endif + if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then + Qj=Qj*2 + Qij=Qij*2 + endif - CALL enq(epol) - eheadtail = epol + CALL enq(epol) + eheadtail = epol ! eheadtail = 0.0d0 - ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN + ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN !c! Charge-dipole interactions - if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then - Qi=Qi*2 - Qij=Qij*2 - endif - if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then - Qj=Qj*2 - Qij=Qij*2 - endif + if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then + Qi=Qi*2 + Qij=Qij*2 + endif + if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then + Qj=Qj*2 + Qij=Qij*2 + endif - CALL eqd(ecl, elj, epol) - eheadtail = ECL + elj + epol + CALL eqd(ecl, elj, epol) + eheadtail = ECL + elj + epol ! eheadtail = 0.0d0 - ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN + ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN !c! Dipole-charge interactions - if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then - Qi=Qi*2 - Qij=Qij*2 - endif - if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then - Qj=Qj*2 - Qij=Qij*2 - endif - CALL edq(ecl, elj, epol) - eheadtail = ECL + elj + epol + if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then + Qi=Qi*2 + Qij=Qij*2 + endif + if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then + Qj=Qj*2 + Qij=Qij*2 + endif + 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 + ELSE IF ((isel.eq.2.and. & + iabs(Qi).eq.1).and. & + nstate(itypi,itypj).eq.1) THEN !c! Same charge-charge interaction ( +/+ or -/- ) - if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then - Qi=Qi*2 - Qij=Qij*2 - endif - if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then - Qj=Qj*2 - Qij=Qij*2 - endif + if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then + Qi=Qi*2 + Qij=Qij*2 + endif + if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then + Qj=Qj*2 + Qij=Qij*2 + endif - CALL eqq(Ecl,Egb,Epol,Fisocav,Elj) - eheadtail = ECL + Egb + Epol + Fisocav + Elj + 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 + ELSE IF ((isel.eq.2.and. & + iabs(Qi).eq.1).and. & + nstate(itypi,itypj).ne.1) THEN !c! Different charge-charge interaction ( +/- or -/+ ) - if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then - Qi=Qi*2 - Qij=Qij*2 - endif - if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then - Qj=Qj*2 - Qij=Qij*2 - endif + if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then + Qi=Qi*2 + Qij=Qij*2 + endif + if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then + Qj=Qj*2 + Qij=Qij*2 + endif - CALL energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad) - END IF + 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 + evdw = evdw + Fcav*sss_ele_cut + eheadtail*sss_ele_cut 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 + 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 + iF (nstate(itypi,itypj).eq.1) THEN + CALL sc_grad END IF !c!------------------------------------------------------------------- !c! NAPISY KONCOWE - END DO ! j - END DO ! iint + ! END DO ! j + !END DO ! iint END DO ! i !c write (iout,*) "Number of loop steps in EGB:",ind !c energy_dec=.false. @@ -25974,7 +27383,7 @@ chip1=chip(itypi) use calc_data use comm_momo real (kind=8) :: facd3, facd4, federmaus, adler,& - Ecl,Egb,Epol,Fisocav,Elj,Fgb,debkap + Ecl,Egb,Epol,Fisocav,Elj,Fgb,debkap,sgrad ! integer :: k !c! Epol and Gpol analytical parameters alphapol1 = alphapol(itypi,itypj) @@ -25985,8 +27394,8 @@ chip1=chip(itypi) al3 = alphiso(3,itypi,itypj) al4 = alphiso(4,itypi,itypj) csig = (1.0d0 & - / dsqrt(sigiso1(itypi, itypj)**2.0d0 & - + sigiso2(itypi,itypj)**2.0d0)) + / dsqrt(sigiso1(itypi, itypj)**2.0d0 & + + sigiso2(itypi,itypj)**2.0d0)) !c! pis = sig0head(itypi,itypj) eps_head = epshead(itypi,itypj) @@ -25997,8 +27406,8 @@ chip1=chip(itypi) 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 + 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) @@ -26013,7 +27422,7 @@ chip1=chip(itypi) !c! Coulomb electrostatic interaction Ecl = (332.0d0 * Qij) / Rhead !c! derivative of Ecl is Gcl... - dGCLdR = (-332.0d0 * Qij ) / Rhead_sq + dGCLdR = (-332.0d0 * Qij ) / Rhead_sq*sss_ele_cut dGCLdOM1 = 0.0d0 dGCLdOM2 = 0.0d0 dGCLdOM12 = 0.0d0 @@ -26021,15 +27430,15 @@ chip1=chip(itypi) Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0) debkap=debaykap(itypi,itypj) Egb = -(332.0d0 * Qij *& - (1.0/eps_in-dexp(-debkap*Fgb)/eps_out)) / Fgb + (1.0/eps_in-dexp(-debkap*Fgb)/eps_out)) / 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 * & (1.0/eps_in-dexp(-debkap*Fgb)/eps_out))/(Fgb*Fgb)& -(332.0d0 * Qij *& - (dexp(-debkap*Fgb)*debkap/eps_out))/ Fgb + (dexp(-debkap*Fgb)*debkap/eps_out))/ Fgb dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )/ ( 2.0d0 * Fgb ) - dGGBdR = dGGBdFGB * dFGBdR + dGGBdR = dGGBdFGB * dFGBdR*sss_ele_cut !c!------------------------------------------------------------------- !c! Fisocav - isotropic cavity creation term !c! or "how much energy it costs to put charged head in water" @@ -26050,7 +27459,7 @@ chip1=chip(itypi) !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 + dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig*sss_ele_cut !c!------------------------------------------------------------------- !c! Epol !c! Polarization energy - charged heads polarize hydrophobic "neck" @@ -26066,20 +27475,20 @@ chip1=chip(itypi) (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 )) !c! epol = 0.0d0 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)& - / (fgb1 ** 5.0d0) + / (fgb1 ** 5.0d0) dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)& - / (fgb2 ** 5.0d0) + / (fgb2 ** 5.0d0) dFGBdR1 = ( (R1 / MomoFac1)* ( 2.0d0 - (0.5d0 * ee1) ) )& - / ( 2.0d0 * fgb1 ) + / ( 2.0d0 * fgb1 ) dFGBdR2 = ( (R2 / MomoFac2)* ( 2.0d0 - (0.5d0 * ee2) ) )& - / ( 2.0d0 * fgb2 ) + / ( 2.0d0 * fgb2 ) dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))& - * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 ) + * ( 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 + * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 ) + dPOLdR1 = dPOLdFGB1 * dFGBdR1*sss_ele_cut !c! dPOLdR1 = 0.0d0 - dPOLdR2 = dPOLdFGB2 * dFGBdR2 + dPOLdR2 = dPOLdFGB2 * dFGBdR2*sss_ele_cut !c! dPOLdR2 = 0.0d0 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 !c! dPOLdOM1 = 0.0d0 @@ -26092,7 +27501,7 @@ chip1=chip(itypi) 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))) + + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))*sss_ele_cut !c!------------------------------------------------------------------- !c! Return the results !c! These things do the dRdX derivatives, that is @@ -26100,9 +27509,9 @@ chip1=chip(itypi) !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) + 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) ) @@ -26118,43 +27527,43 @@ chip1=chip(itypi) !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)& + 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))) + sgrad=(Ecl+Egb+Epol+Fisocav+Elj)*sss_ele_grad*rreal(k)*rij + 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 + - dGLJdR * pom-sgrad - 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)& + 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) + + dPOLdR2 * condor + dGLJdR * pom+sgrad + + 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)-sgrad + + 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)+sgrad END DO RETURN @@ -26164,19 +27573,19 @@ chip1=chip(itypi) use calc_data use comm_momo real (kind=8) :: facd3, facd4, federmaus, adler,& - Ecl,Egb,Epol,Fisocav,Elj,Fgb,debkap + Ecl,Egb,Epol,Fisocav,Elj,Fgb,debkap ! integer :: k !c! Epol and Gpol analytical parameters alphapol1 = alphapolcat(itypi,itypj) - alphapol2 = alphapolcat(itypj,itypi) + alphapol2 = alphapolcat2(itypj,itypi) !c! Fisocav and Gisocav analytical parameters al1 = alphisocat(1,itypi,itypj) al2 = alphisocat(2,itypi,itypj) al3 = alphisocat(3,itypi,itypj) al4 = alphisocat(4,itypi,itypj) csig = (1.0d0 & - / dsqrt(sigiso1cat(itypi, itypj)**2.0d0 & - + sigiso2cat(itypi,itypj)**2.0d0)) + / dsqrt(sigiso1cat(itypi, itypj)**2.0d0 & + + sigiso2cat(itypi,itypj)**2.0d0)) !c! pis = sig0headcat(itypi,itypj) eps_head = epsheadcat(itypi,itypj) @@ -26187,8 +27596,8 @@ chip1=chip(itypi) 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 + 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) @@ -26203,23 +27612,27 @@ chip1=chip(itypi) !c! Coulomb electrostatic interaction Ecl = (332.0d0 * Qij) / Rhead !c! derivative of Ecl is Gcl... - dGCLdR = (-332.0d0 * Qij ) / Rhead_sq + dGCLdR = (-332.0d0 * Qij ) / Rhead_sq*sss_ele_cut+ECL*sss_ele_grad + ECL=ECL*sss_ele_cut dGCLdOM1 = 0.0d0 dGCLdOM2 = 0.0d0 dGCLdOM12 = 0.0d0 + ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq)) Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0) debkap=debaykapcat(itypi,itypj) + if (energy_dec) write(iout,*) "egb",Qij,debkap,Fgb,a12sq,ee0 Egb = -(332.0d0 * Qij *& - (1.0/eps_in-dexp(-debkap*Fgb)/eps_out)) / Fgb + (1.0/eps_in-dexp(-debkap*Fgb)/eps_out)) / 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 * & (1.0/eps_in-dexp(-debkap*Fgb)/eps_out))/(Fgb*Fgb)& -(332.0d0 * Qij *& - (dexp(-debkap*Fgb)*debkap/eps_out))/ Fgb + (dexp(-debkap*Fgb)*debkap/eps_out))/ Fgb dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )/ ( 2.0d0 * Fgb ) - dGGBdR = dGGBdFGB * dFGBdR + dGGBdR = dGGBdFGB * dFGBdR*sss_ele_cut+Egb*sss_ele_grad + Egb=Egb*sss_ele_grad !c!------------------------------------------------------------------- !c! Fisocav - isotropic cavity creation term !c! or "how much energy it costs to put charged head in water" @@ -26240,7 +27653,9 @@ chip1=chip(itypi) !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 + dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig*sss_ele_cut& + +FisoCav*sss_ele_grad + FisoCav=FisoCav*sss_ele_cut !c!------------------------------------------------------------------- !c! Epol !c! Polarization energy - charged heads polarize hydrophobic "neck" @@ -26256,24 +27671,25 @@ chip1=chip(itypi) (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 )) !c! epol = 0.0d0 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)& - / (fgb1 ** 5.0d0) + / (fgb1 ** 5.0d0) dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)& - / (fgb2 ** 5.0d0) + / (fgb2 ** 5.0d0) dFGBdR1 = ( (R1 / MomoFac1)* ( 2.0d0 - (0.5d0 * ee1) ) )& - / ( 2.0d0 * fgb1 ) + / ( 2.0d0 * fgb1 ) dFGBdR2 = ( (R2 / MomoFac2)* ( 2.0d0 - (0.5d0 * ee2) ) )& - / ( 2.0d0 * fgb2 ) + / ( 2.0d0 * fgb2 ) dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))& - * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 ) + * ( 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 + * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 ) + dPOLdR1 = dPOLdFGB1 * dFGBdR1!*sss_ele_cut+epol*sss_ele_grad !c! dPOLdR1 = 0.0d0 - dPOLdR2 = dPOLdFGB2 * dFGBdR2 + dPOLdR2 = dPOLdFGB2 * dFGBdR2!*sss_ele_cut+epol*sss_ele_grad !c! dPOLdR2 = 0.0d0 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 !c! dPOLdOM1 = 0.0d0 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2 +! epol=epol*sss_ele_cut !c! dPOLdOM2 = 0.0d0 !c!------------------------------------------------------------------- !c! Elj @@ -26282,7 +27698,10 @@ chip1=chip(itypi) 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))) + + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))*sss_ele_cut& + +(Elj+epol)*sss_ele_grad + Elj=Elj*sss_ele_cut + epol=epol*sss_ele_cut !c!------------------------------------------------------------------- !c! Return the results !c! These things do the dRdX derivatives, that is @@ -26290,9 +27709,9 @@ chip1=chip(itypi) !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) + 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) ) @@ -26308,43 +27727,43 @@ chip1=chip(itypi) !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))) - - pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) - gradpepcatx(k,i) = gradpepcatx(k,i) & - - dGCLdR * pom& - - dGGBdR * pom& - - dGCVdR * pom& - - dPOLdR1 * hawk& - - dPOLdR2 * (erhead_tail(k,2)& + 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))) + + pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) + gradpepcatx(k,i) = gradpepcatx(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 + - dGLJdR * pom - pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j)) + pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j)) ! gradpepcatx(k,j) = gradpepcatx(k,j)+ dGCLdR * pom& ! + dGGBdR * pom+ dGCVdR * pom& ! + dPOLdR1 * (erhead_tail(k,1)& ! -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j)))& ! + dPOLdR2 * condor + dGLJdR * pom - gradpepcat(k,i) = gradpepcat(k,i) & - - dGCLdR * erhead(k)& - - dGGBdR * erhead(k)& - - dGCVdR * erhead(k)& - - dPOLdR1 * erhead_tail(k,1)& - - dPOLdR2 * erhead_tail(k,2)& - - dGLJdR * erhead(k) - - gradpepcat(k,j) = gradpepcat(k,j) & - + dGCLdR * erhead(k) & - + dGGBdR * erhead(k) & - + dGCVdR * erhead(k) & - + dPOLdR1 * erhead_tail(k,1) & - + dPOLdR2 * erhead_tail(k,2)& - + dGLJdR * erhead(k) + gradpepcat(k,i) = gradpepcat(k,i) & + - dGCLdR * erhead(k)& + - dGGBdR * erhead(k)& + - dGCVdR * erhead(k)& + - dPOLdR1 * erhead_tail(k,1)& + - dPOLdR2 * erhead_tail(k,2)& + - dGLJdR * erhead(k) + + gradpepcat(k,j) = gradpepcat(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 @@ -26359,7 +27778,7 @@ chip1=chip(itypi) double precision dcosom1(3),dcosom2(3) !c! used in Epol derivatives double precision facd3, facd4 - double precision federmaus, adler + double precision federmaus, adler,sgrad integer istate,ii,jj real (kind=8) :: Fgb ! print *,"CALLING EQUAD" @@ -26372,7 +27791,7 @@ chip1=chip(itypi) al3 = alphiso(3,itypi,itypj) al4 = alphiso(4,itypi,itypj) csig = (1.0d0 / dsqrt(sigiso1(itypi, itypj)**2.0d0& - + sigiso2(itypi,itypj)**2.0d0)) + + sigiso2(itypi,itypj)**2.0d0)) !c! w1 = wqdip(1,itypi,itypj) w2 = wqdip(2,itypi,itypj) @@ -26381,34 +27800,34 @@ chip1=chip(itypi) !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 + - 2.0D0 * alf1 * eps3der& + + sigder * sigsq_om1& + + dCAVdOM1 eom2 = eps2der * eps2rt_om2 & - + 2.0D0 * alf2 * eps3der& - + sigder * sigsq_om2& - + dCAVdOM2 + + 2.0D0 * alf2 * eps3der& + + sigder * sigsq_om2& + + dCAVdOM2 eom12 = evdwij * eps1_om12 & - + eps2der * eps2rt_om12 & - - 2.0D0 * alf12 * eps3der& - + sigder *sigsq_om12& - + dCAVdOM12 + + 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) + 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 + gvdwx(k,i)= gvdwx(k,i) - gg(k)*sss_ele_cut & + + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))& + + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss_ele_cut + gvdwx(k,j)= gvdwx(k,j) + gg(k)*sss_ele_cut & + + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))& + + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss_ele_cut !c! this acts on Calpha - gvdwc(k,i)=gvdwc(k,i)-gg(k) - gvdwc(k,j)=gvdwc(k,j)+gg(k) + gvdwc(k,i)=gvdwc(k,i)-gg(k)*sss_ele_cut + gvdwc(k,j)=gvdwc(k,j)+gg(k)*sss_ele_cut END DO !c! sc_grad is done, now we will compute eheadtail = 0.0d0 @@ -26417,54 +27836,78 @@ chip1=chip(itypi) 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 + 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) +! distance + enddo + call to_box (chead(1,1),chead(2,1),chead(3,1)) + call to_box (chead(1,2),chead(2,2),chead(3,2)) + +!c! head distances will be themselves usefull elswhere +!c1 (in Gcav, for example) + + Rhead_distance(1)=boxshift(chead( 1, 2 ) - chead( 1,1 ),boxxsize) + Rhead_distance(2)=boxshift(chead( 2, 2 ) - chead( 2,1 ),boxysize) + Rhead_distance(3)=boxshift(chead( 3, 2 ) - chead( 3,1 ),boxzsize) +! 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))) + +! 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 +! 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 + 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 + 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) + 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) + dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in) !c! dGCLdR = 0.0d0 - dGCLdOM1 = 0.0d0 - dGCLdOM2 = 0.0d0 - dGCLdOM12 = 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 + 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 @@ -26476,209 +27919,217 @@ chip1=chip(itypi) !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 + 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 + 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 )) + 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 + 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 + dPOLdR2 = dPOLdFGB2 * dFGBdR2 !c! dPOLdR2 = 0.0d0 - dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 + dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 !c! dPOLdOM1 = 0.0d0 - dPOLdOM2 = dPOLdFGB1 * dFGBdOM2 - pom = (pis / Rhead)**6.0d0 - Elj = 4.0d0 * eps_head * pom * (pom-1.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))) + 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 + 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 + 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) + 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) + 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 ) + dQUADdOM12 = fac * ( 6.0d0*om12 - 45.0d0*om1*om2 ) ELSE - Beta1 = 0.0d0 - Equad = 0.0d0 - END IF + Beta1 = 0.0d0 + Equad = 0.0d0 + END IF !c!------------------------------------------------------------------- !c! Return the results !c! Angular stuff - eom1 = dPOLdOM1 + dQUADdOM1 - eom2 = dPOLdOM2 + dQUADdOM2 - eom12 = dQUADdOM12 + 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 + 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)) + 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) & +! sgrad=sss_ele_grad*(Ecl+Egb+FisoCav+epol+Elj)*rij*rreal(k) + 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 + - 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*sss_ele_cut - pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) + 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) & + 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 + + 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*sss_ele_cut !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) + 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)) + 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 + 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 + 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 + 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)*sss_ele_cut + gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)*sss_ele_cut + gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)*sss_ele_cut + gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)*sss_ele_cut + DO l = 1, 4 + gheadtail(k,l,1) = 0.0d0 + gheadtail(k,l,2) = 0.0d0 + END DO END DO eheadtail = (-dlog(eheadtail)) / betaT + do k=1,3 + gvdwx(k,i) = gvdwx(k,i) - eheadtail*sss_ele_grad*rreal(k)*rij + gvdwx(k,j) = gvdwx(k,j) + eheadtail*sss_ele_grad*rreal(k)*rij + gvdwc(k,i) = gvdwc(k,i) - eheadtail*sss_ele_grad*rreal(k)*rij + gvdwc(k,j) = gvdwc(k,j) + eheadtail*sss_ele_grad*rreal(k)*rij + enddo dPOLdOM1 = 0.0d0 dPOLdOM2 = 0.0d0 dQUADdOM1 = 0.0d0 @@ -26697,7 +28148,7 @@ chip1=chip(itypi) R1 = 0.0d0 DO k = 1, 3 !c! Calculate head-to-tail distances - R1=R1+(ctail(k,2)-chead(k,1))**2 + R1=R1+(ctail(k,2)-chead(k,1))**2 END DO !c! Pitagoras R1 = dsqrt(R1) @@ -26715,19 +28166,20 @@ chip1=chip(itypi) 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) + / (fgb1 ** 5.0d0) dFGBdR1 = ( (R1 / MomoFac1) & - * ( 2.0d0 - (0.5d0 * ee1) ) ) & - / ( 2.0d0 * fgb1 ) + * ( 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 + * (2.0d0 - 0.5d0 * ee1) ) & + / (2.0d0 * fgb1) + dPOLdR1 = dPOLdFGB1 * dFGBdR1*sss_ele_cut +! epol=epol*sss_ele_cut !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) + 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)) @@ -26735,17 +28187,20 @@ chip1=chip(itypi) 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))) + 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))) + gvdwx(k,i) = gvdwx(k,i) & + - dPOLdR1 * hawk-epol*sss_ele_grad*rreal(k)*rij + gvdwx(k,j) = gvdwx(k,j) & + + dPOLdR1 * (erhead_tail(k,1) & + -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))& + +epol*sss_ele_grad*rreal(k)*rij - gvdwc(k,i) = gvdwc(k,i) - dPOLdR1 * erhead_tail(k,1) - gvdwc(k,j) = gvdwc(k,j) + dPOLdR1 * erhead_tail(k,1) + gvdwc(k,i) = gvdwc(k,i) - dPOLdR1 * erhead_tail(k,1)& + -epol*sss_ele_grad*rreal(k)*rij + gvdwc(k,j) = gvdwc(k,j) + dPOLdR1 * erhead_tail(k,1)& + +epol*sss_ele_grad*rreal(k)*rij END DO RETURN @@ -26759,7 +28214,7 @@ chip1=chip(itypi) R2 = 0.0d0 DO k = 1, 3 !c! Calculate head-to-tail distances - R2=R2+(chead(k,2)-ctail(k,1))**2 + R2=R2+(chead(k,2)-ctail(k,1))**2 END DO !c! Pitagoras R2 = dsqrt(R2) @@ -26776,14 +28231,15 @@ chip1=chip(itypi) 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) + / (fgb2 ** 5.0d0) dFGBdR2 = ( (R2 / MomoFac2) & - * ( 2.0d0 - (0.5d0 * ee2) ) ) & - / (2.0d0 * fgb2) + * ( 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 + * (2.0d0 - 0.5d0 * ee2) ) & + / (2.0d0 * fgb2) + dPOLdR2 = dPOLdFGB2 * dFGBdR2*sss_ele_cut +! epol=epol*sss_ele_cut !c! dPOLdR2 = 0.0d0 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 !c! dPOLdOM1 = 0.0d0 @@ -26792,26 +28248,30 @@ chip1=chip(itypi) !c! Return the results !c! (See comments in Eqq) DO k = 1, 3 - erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2) + 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) & + 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 + gvdwx(k,i) = gvdwx(k,i) & + - dPOLdR2 * (erhead_tail(k,2) & + -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))& + -epol*sss_ele_grad*rreal(k)*rij + gvdwx(k,j) = gvdwx(k,j) & + + dPOLdR2 * condor+epol*sss_ele_grad*rreal(k)*rij + + + gvdwc(k,i) = gvdwc(k,i) & + - dPOLdR2 * erhead_tail(k,2)-epol*sss_ele_grad*rreal(k)*rij + + gvdwc(k,j) = gvdwc(k,j) & + + dPOLdR2 * erhead_tail(k,2)+epol*sss_ele_grad*rreal(k)*rij - 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 @@ -26821,12 +28281,12 @@ chip1=chip(itypi) use calc_data use comm_momo double precision facd3, adler,epol - alphapol2 = alphapolcat(itypj,itypi) + alphapol2 = alphapolcat(itypi,itypj) !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 + R2=R2+(chead(k,2)-ctail(k,1))**2 END DO !c! Pitagoras R2 = dsqrt(R2) @@ -26843,14 +28303,15 @@ chip1=chip(itypi) 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) + / (fgb2 ** 5.0d0) dFGBdR2 = ( (R2 / MomoFac2) & - * ( 2.0d0 - (0.5d0 * ee2) ) ) & - / (2.0d0 * fgb2) + * ( 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 + * (2.0d0 - 0.5d0 * ee2) ) & + / (2.0d0 * fgb2) + dPOLdR2 = dPOLdFGB2 * dFGBdR2*sss_ele_cut+epol*sss_ele_grad + epol=epol*sss_ele_cut !c! dPOLdR2 = 0.0d0 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 !c! dPOLdOM1 = 0.0d0 @@ -26860,26 +28321,26 @@ chip1=chip(itypi) !c! Return the results !c! (See comments in Eqq) DO k = 1, 3 - erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2) + erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2) END DO eagle = scalar( erhead_tail(1,2), dC_norm(1,j) ) adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) ) facd2 = d2 * vbld_inv(j+nres) facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres) DO k = 1, 3 - condor = (erhead_tail(k,2) & + condor = (erhead_tail(k,2) & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j))) - gradpepcatx(k,i) = gradpepcatx(k,i) & - - dPOLdR2 * (erhead_tail(k,2) & + gradpepcatx(k,i) = gradpepcatx(k,i) & + - dPOLdR2 * (erhead_tail(k,2) & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) ! gradpepcatx(k,j) = gradpepcatx(k,j) & ! + dPOLdR2 * condor - gradpepcat(k,i) = gradpepcat(k,i) & - - dPOLdR2 * erhead_tail(k,2) - gradpepcat(k,j) = gradpepcat(k,j) & - + dPOLdR2 * erhead_tail(k,2) + gradpepcat(k,i) = gradpepcat(k,i) & + - dPOLdR2 * erhead_tail(k,2) + gradpepcat(k,j) = gradpepcat(k,j) & + + dPOLdR2 * erhead_tail(k,2) END DO RETURN @@ -26888,7 +28349,7 @@ chip1=chip(itypi) SUBROUTINE eqd(Ecl,Elj,Epol) use calc_data use comm_momo - double precision facd4, federmaus,ecl,elj,epol + double precision facd4, federmaus,ecl,elj,epol,sgrad alphapol1 = alphapol(itypi,itypj) w1 = wqdip(1,itypi,itypj) w2 = wqdip(2,itypi,itypj) @@ -26899,7 +28360,7 @@ chip1=chip(itypi) R1 = 0.0d0 DO k = 1, 3 !c! Calculate head-to-tail distances - R1=R1+(ctail(k,2)-chead(k,1))**2 + R1=R1+(ctail(k,2)-chead(k,1))**2 END DO !c! Pitagoras R1 = dsqrt(R1) @@ -26914,9 +28375,9 @@ chip1=chip(itypi) 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 + - hawk / Rhead**4.0d0 + dGCLdR = (- 2.0d0 * sparrow / Rhead**3.0d0 & + + 4.0d0 * hawk / Rhead**5.0d0)*sss_ele_cut !c! dF/dom1 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0) !c! dF/dom2 @@ -26933,14 +28394,14 @@ chip1=chip(itypi) !c!------------------------------------------------------------------ !c! derivative of Epol is Gpol... dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) & - / (fgb1 ** 5.0d0) + / (fgb1 ** 5.0d0) dFGBdR1 = ( (R1 / MomoFac1) & - * ( 2.0d0 - (0.5d0 * ee1) ) ) & - / ( 2.0d0 * fgb1 ) + * ( 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 + * (2.0d0 - 0.5d0 * ee1) ) & + / (2.0d0 * fgb1) + dPOLdR1 = dPOLdFGB1 * dFGBdR1*sss_ele_cut !c! dPOLdR1 = 0.0d0 dPOLdOM1 = 0.0d0 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2 @@ -26951,11 +28412,11 @@ chip1=chip(itypi) 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))) + * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) & + + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))*sss_ele_cut DO k = 1, 3 - erhead(k) = Rhead_distance(k)/Rhead - erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1) + 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) ) @@ -26967,42 +28428,163 @@ chip1=chip(itypi) 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))) + hawk = (erhead_tail(k,1) + & + facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))) + sgrad=(epol+elj+ecl)*sss_ele_grad*rreal(k)*rij + pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) + gvdwx(k,i) = gvdwx(k,i) & + - dGCLdR * pom& + - dPOLdR1 * hawk & + - dGLJdR * pom & + -sgrad + + 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+sgrad - 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)-sgrad + + gvdwc(k,j) = gvdwc(k,j) & + + dGCLdR * erhead(k) & + + dPOLdR1 * erhead_tail(k,1) & + + dGLJdR * erhead(k)+sgrad + + END DO + RETURN + END SUBROUTINE eqd + + SUBROUTINE eqd_cat(Ecl,Elj,Epol) + use calc_data + use comm_momo + double precision facd4, federmaus,ecl,elj,epol + alphapol1 = alphapolcat(itypi,itypj) + w1 = wqdipcat(1,itypi,itypj) + w2 = wqdipcat(2,itypi,itypj) + pis = sig0headcat(itypi,itypj) + eps_head = epsheadcat(itypi,itypj) +! eps_head=0.0d0 +! w2=0.0d0 +! alphapol1=0.0d0 +!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 =sss_ele_cut*(-2.0d0 * sparrow / Rhead**3.0d0 & + + 4.0d0 * hawk / Rhead**5.0d0)+sss_ele_grad*ECL + ECL=ECL*sss_ele_cut +!c! dF/dom1 + dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0) +!c! dF/dom2 + dGCLdOM2 = 0.0d0 ! + +!(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 = 0.0d0 ! as om2 is 0 +! (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) & +! * (2.0d0 - 0.5d0 * ee1) ) & +! / (2.0d0 * fgb1) + dPOLdR1 = dPOLdFGB1 * dFGBdR1*sss_ele_cut+epol*sss_ele_grad +!c! dPOLdR1 = 0.0d0 + dPOLdOM1 = 0.0d0 +! dPOLdOM2 = dPOLdFGB1 * dFGBdOM2 + dPOLdOM2 = 0.0d0 + epol=epol*sss_ele_cut +!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*sss_ele_cut & + * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) & + + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))+Elj*sss_ele_grad + Elj=Elj*sss_ele_cut + 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) ) + bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) ) + facd1 = d1 * vbld_inv(i+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)) + gradpepcatx(k,i) = gradpepcatx(k,i) & + - dGCLdR * pom& + - dPOLdR1 * hawk & + - dGLJdR * pom + +! pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) +! gradpepcatx(k,j) = gradpepcatx(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) + gradpepcat(k,i) = gradpepcat(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) + gradpepcat(k,j) = gradpepcat(k,j) & + + dGCLdR * erhead(k) & + + dPOLdR1 * erhead_tail(k,1) & + + dGLJdR * erhead(k) END DO RETURN - END SUBROUTINE eqd + END SUBROUTINE eqd_cat + SUBROUTINE edq(Ecl,Elj,Epol) ! IMPLICIT NONE use comm_momo use calc_data - double precision facd3, adler,ecl,elj,epol + double precision facd3, adler,ecl,elj,epol,sgrad alphapol2 = alphapol(itypj,itypi) w1 = wqdip(1,itypi,itypj) w2 = wqdip(2,itypi,itypj) @@ -27013,7 +28595,7 @@ chip1=chip(itypi) R2 = 0.0d0 DO k = 1, 3 !c! Calculate head-to-tail distances - R2=R2+(chead(k,2)-ctail(k,1))**2 + R2=R2+(chead(k,2)-ctail(k,1))**2 END DO !c! Pitagoras R2 = dsqrt(R2) @@ -27029,12 +28611,12 @@ chip1=chip(itypi) sparrow = w1 * Qj * om1 hawk = w2 * Qj * Qj * (1.0d0 - sqom2) ECL = sparrow / Rhead**2.0d0 & - - hawk / Rhead**4.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 + dGCLdR =sss_ele_cut*(- 2.0d0 * sparrow / Rhead**3.0d0 & + + 4.0d0 * hawk / Rhead**5.0d0) !c! dF/dom1 dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0) !c! dF/dom2 @@ -27048,14 +28630,14 @@ chip1=chip(itypi) 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) + / (fgb2 ** 5.0d0) dFGBdR2 = ( (R2 / MomoFac2) & - * ( 2.0d0 - (0.5d0 * ee2) ) ) & - / (2.0d0 * fgb2) + * ( 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 + * (2.0d0 - 0.5d0 * ee2) ) & + / (2.0d0 * fgb2) + dPOLdR2 = dPOLdFGB2 * dFGBdR2*sss_ele_cut !c! dPOLdR2 = 0.0d0 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 !c! dPOLdOM1 = 0.0d0 @@ -27066,14 +28648,14 @@ chip1=chip(itypi) 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))) + * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) & + + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))*sss_ele_cut !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) + 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) ) @@ -27083,32 +28665,32 @@ chip1=chip(itypi) facd2 = d2 * vbld_inv(j+nres) facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres) DO k = 1, 3 - condor = (erhead_tail(k,2) & + 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) & + sgrad=(epol+elj+ecl)*sss_ele_grad*rreal(k)*rij + 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 + - dGLJdR * pom-sgrad - pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) - gvdwx(k,j) = gvdwx(k,j) & - + dGCLdR * pom & - + dPOLdR2 * condor & - + 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+sgrad - gvdwc(k,i) = gvdwc(k,i) & - - dGCLdR * erhead(k) & - - dPOLdR2 * erhead_tail(k,2) & - - dGLJdR * erhead(k) + gvdwc(k,i) = gvdwc(k,i) & + - dGCLdR * erhead(k) & + - dPOLdR2 * erhead_tail(k,2) & + - dGLJdR * erhead(k)-sgrad - gvdwc(k,j) = gvdwc(k,j) & - + 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)+sgrad END DO RETURN @@ -27119,7 +28701,7 @@ chip1=chip(itypi) use calc_data double precision facd3, adler,ecl,elj,epol - alphapol2 = alphapolcat(itypj,itypi) + alphapol2 = alphapolcat(itypi,itypj) w1 = wqdipcat(1,itypi,itypj) w2 = wqdipcat(2,itypi,itypj) pis = sig0headcat(itypi,itypj) @@ -27129,7 +28711,7 @@ chip1=chip(itypi) R2 = 0.0d0 DO k = 1, 3 !c! Calculate head-to-tail distances - R2=R2+(chead(k,2)-ctail(k,1))**2 + R2=R2+(chead(k,2)-ctail(k,1))**2 END DO !c! Pitagoras R2 = dsqrt(R2) @@ -27142,20 +28724,21 @@ chip1=chip(itypi) !c!------------------------------------------------------------------- !c! ecl - write(iout,*) "KURWA2",Rhead +! write(iout,*) "KURWA2",Rhead sparrow = w1 * Qj * om1 hawk = w2 * Qj * Qj * (1.0d0 - sqom2) ECL = sparrow / Rhead**2.0d0 & - - hawk / Rhead**4.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 + dGCLdR =( - 2.0d0 * sparrow / Rhead**3.0d0 & + + 4.0d0 * hawk / Rhead**5.0d0)*sss_ele_cut+ECL*sss_ele_grad !c! dF/dom1 dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0) !c! dF/dom2 dGCLdOM2 = (2.0d0 * w2 * Qj * Qj * om2) / (Rhead ** 4.0d0) + ECL=ECL*sss_ele_cut !c-------------------------------------------------------------------- !c-------------------------------------------------------------------- !c Polarization energy @@ -27166,33 +28749,36 @@ chip1=chip(itypi) 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) + / (fgb2 ** 5.0d0) dFGBdR2 = ( (R2 / MomoFac2) & - * ( 2.0d0 - (0.5d0 * ee2) ) ) & - / (2.0d0 * fgb2) + * ( 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 + * (2.0d0 - 0.5d0 * ee2) ) & + / (2.0d0 * fgb2) + dPOLdR2 = dPOLdFGB2 * dFGBdR2*sss_ele_cut+epol*sss_ele_grad !c! dPOLdR2 = 0.0d0 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 !c! dPOLdOM1 = 0.0d0 dPOLdOM2 = 0.0d0 + epol=epol*sss_ele_cut !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))) + * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) & + + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))*sss_ele_cut+& + Elj*sss_ele_grad + Elj=Elj*sss_ele_cut !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) + 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) ) @@ -27202,32 +28788,32 @@ chip1=chip(itypi) facd2 = d2 * vbld_inv(j) facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres) DO k = 1, 3 - condor = (erhead_tail(k,2) & + condor = (erhead_tail(k,2) & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j))) - pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) - gradpepcatx(k,i) = gradpepcatx(k,i) & - - dGCLdR * pom & - - dPOLdR2 * (erhead_tail(k,2) & + pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) + gradpepcatx(k,i) = gradpepcatx(k,i) & + - dGCLdR * pom & + - dPOLdR2 * (erhead_tail(k,2) & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) & - - dGLJdR * pom + - dGLJdR * pom - pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j)) + pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j)) ! gradpepcatx(k,j) = gradpepcatx(k,j) & ! + dGCLdR * pom & ! + dPOLdR2 * condor & ! + dGLJdR * pom - gradpepcat(k,i) = gradpepcat(k,i) & - - dGCLdR * erhead(k) & - - dPOLdR2 * erhead_tail(k,2) & - - dGLJdR * erhead(k) + gradpepcat(k,i) = gradpepcat(k,i) & + - dGCLdR * erhead(k) & + - dPOLdR2 * erhead_tail(k,2) & + - dGLJdR * erhead(k) - gradpepcat(k,j) = gradpepcat(k,j) & - + dGCLdR * erhead(k) & - + dPOLdR2 * erhead_tail(k,2) & - + dGLJdR * erhead(k) + gradpepcat(k,j) = gradpepcat(k,j) & + + dGCLdR * erhead(k) & + + dPOLdR2 * erhead_tail(k,2) & + + dGLJdR * erhead(k) END DO RETURN @@ -27238,7 +28824,7 @@ chip1=chip(itypi) use calc_data double precision facd3, adler,ecl,elj,epol - alphapol2 = alphapolcat(itypj,itypi) + alphapol2 = alphapolcat(itypi,itypj) w1 = wqdipcat(1,itypi,itypj) w2 = wqdipcat(2,itypi,itypj) pis = sig0headcat(itypi,itypj) @@ -27248,7 +28834,7 @@ chip1=chip(itypi) R2 = 0.0d0 DO k = 1, 3 !c! Calculate head-to-tail distances - R2=R2+(chead(k,2)-ctail(k,1))**2 + R2=R2+(chead(k,2)-ctail(k,1))**2 END DO !c! Pitagoras R2 = dsqrt(R2) @@ -27266,12 +28852,14 @@ chip1=chip(itypi) ! print *,"CO2", itypi,itypj ! print *,"CO?!.", w1,w2,Qj,om1 ECL = sparrow / Rhead**2.0d0 & - - hawk / Rhead**4.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 + dGCLdR = (- 2.0d0 * sparrow / Rhead**3.0d0 & + + 4.0d0 * hawk / Rhead**5.0d0)*sss_ele_cut+& + ECL*sss_ele_grad + ECL=ECL*sss_ele_cut !c! dF/dom1 dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0) !c! dF/dom2 @@ -27286,14 +28874,15 @@ chip1=chip(itypi) 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) + / (fgb2 ** 5.0d0) dFGBdR2 = ( (R2 / MomoFac2) & - * ( 2.0d0 - (0.5d0 * ee2) ) ) & - / (2.0d0 * fgb2) + * ( 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 + * (2.0d0 - 0.5d0 * ee2) ) & + / (2.0d0 * fgb2) + dPOLdR2 = dPOLdFGB2 * dFGBdR2*sss_ele_cut+epol*sss_ele_grad + epol=epol*sss_ele_grad !c! dPOLdR2 = 0.0d0 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 !c! dPOLdOM1 = 0.0d0 @@ -27303,16 +28892,17 @@ chip1=chip(itypi) 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))) + dGLJdR = 4.0d0 * eps_head*sss_ele_cut & + * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) & + + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))+Elj*sss_ele_grad + Elj=Elj*sss_ele_cut !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) + 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) ) erdxj = scalar( erhead(1), dC_norm(1,j) ) @@ -27322,37 +28912,37 @@ chip1=chip(itypi) facd2 = d2 * vbld_inv(j) facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+1)/2.0 DO k = 1, 3 - condor = (erhead_tail(k,2) & + condor = (erhead_tail(k,2) & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j))) - pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i)) + pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i)) ! gradpepcatx(k,i) = gradpepcatx(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)) + pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j)) ! gradpepcatx(k,j) = gradpepcatx(k,j) & ! + dGCLdR * pom & ! + dPOLdR2 * condor & ! + dGLJdR * pom - gradpepcat(k,i) = gradpepcat(k,i) +0.5d0*( & - - dGCLdR * erhead(k) & - - dPOLdR2 * erhead_tail(k,2) & - - dGLJdR * erhead(k)) - gradpepcat(k,i+1) = gradpepcat(k,i+1) +0.5d0*( & - - dGCLdR * erhead(k) & - - dPOLdR2 * erhead_tail(k,2) & - - dGLJdR * erhead(k)) + gradpepcat(k,i) = gradpepcat(k,i) +0.5d0*( & + - dGCLdR * erhead(k) & + - dPOLdR2 * erhead_tail(k,2) & + - dGLJdR * erhead(k)) + gradpepcat(k,i+1) = gradpepcat(k,i+1) +0.5d0*( & + - dGCLdR * erhead(k) & + - dPOLdR2 * erhead_tail(k,2) & + - dGLJdR * erhead(k)) - gradpepcat(k,j) = gradpepcat(k,j) & - + dGCLdR * erhead(k) & - + dPOLdR2 * erhead_tail(k,2) & - + dGLJdR * erhead(k) + gradpepcat(k,j) = gradpepcat(k,j) & + + dGCLdR * erhead(k) & + + dPOLdR2 * erhead_tail(k,2) & + + dGLJdR * erhead(k) END DO RETURN @@ -27372,7 +28962,7 @@ chip1=chip(itypi) 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)) + * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2)) ECL = c1 - c2 !c! write (*,*) "w1 = ", w1 !c! write (*,*) "w2 = ", w2 @@ -27391,17 +28981,17 @@ chip1=chip(itypi) !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 + * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2)) + dGCLdR = (c1 - c2)*sss_ele_cut!+ECL*sss_ele_grad !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 ) + * ( 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 ) + * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 ) dGCLdOM2 = c1 - c2 !c! dECL/dom12 c1 = w1 / (Rhead ** 3.0d0) @@ -27411,7 +29001,7 @@ chip1=chip(itypi) !c! Return the results !c! (see comments in Eqq) DO k= 1, 3 - erhead(k) = Rhead_distance(k)/Rhead + 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) ) @@ -27419,16 +29009,142 @@ chip1=chip(itypi) 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 + pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) + gvdwx(k,i) = gvdwx(k,i)- dGCLdR * pom-(ecl*sss_ele_grad*Rreal(k)*rij) + pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) + gvdwx(k,j) = gvdwx(k,j)+ dGCLdR * pom+(ecl*sss_ele_grad*Rreal(k)*rij) - gvdwc(k,i) = gvdwc(k,i) - dGCLdR * erhead(k) - gvdwc(k,j) = gvdwc(k,j) + dGCLdR * erhead(k) + gvdwc(k,i) = gvdwc(k,i)- dGCLdR * erhead(k)-(ecl*sss_ele_grad*Rreal(k)*rij) + gvdwc(k,j) = gvdwc(k,j)+ dGCLdR * erhead(k)+(ecl*sss_ele_grad*Rreal(k)*rij) END DO RETURN END SUBROUTINE edd + SUBROUTINE edd_cat(ECL) +! IMPLICIT NONE + use comm_momo + use calc_data + + double precision ecl +!c! csig = sigiso(itypi,itypj) + w1 = wqdipcat(1,itypi,itypj) + w2 = wqdipcat(2,itypi,itypj) +! w2=0.0d0 +!c!------------------------------------------------------------------- +!c! ECL +! print *,"om1",om1,om2,om12 + fac = - 3.0d0 * om1 !after integer and simplify + c1 = (w1 / (Rhead**3.0d0)) * fac + c2 = (w2 / Rhead ** 6.0d0) & + * (4.0d0 + 6.0d0*sqom1 ) !after integration and simplification + ECL = c1 - c2 +!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 + 6.0d0*sqom1) + dGCLdR = (c1 - c2)*sss_ele_cut+ECL*sss_ele_grad +!c! dECL/dom1 + c1 = (-3.0d0 * w1) / (Rhead**3.0d0) + c2 = (12.0d0 * w2*om1) / (Rhead**6.0d0) + dGCLdOM1 = c1 - c2 +!c! dECL/dom2 +! c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0) + c1=0.0 ! this is because om2 is 0 +! c2 = (-6.0d0 * w2) / (Rhead**6.0d0) & +! * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 ) + c2=0.0 !om is 0 + dGCLdOM2 = c1 - c2 +!c! dECL/dom12 +! c1 = w1 / (Rhead ** 3.0d0) + c1=0.0d0 ! this is because om12 is 0 +! c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0 + c2=0.0d0 !om12 is 0 + 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)) + gradpepcatx(k,i) = gradpepcatx(k,i) - dGCLdR * pom +! pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) +! gradpepcatx(k,j) = gradpepcatx(k,j) + dGCLdR * pom + + gradpepcat(k,i) = gradpepcat(k,i) - dGCLdR * erhead(k) + gradpepcat(k,j) = gradpepcat(k,j) + dGCLdR * erhead(k) + END DO + RETURN + END SUBROUTINE edd_cat + SUBROUTINE edd_cat_pep(ECL) +! IMPLICIT NONE + use comm_momo + use calc_data + + double precision ecl +!c! csig = sigiso(itypi,itypj) + w1 = wqdipcat(1,itypi,itypj) + w2 = wqdipcat(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! 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)*sss_ele_cut+ECL*sss_ele_grad + ECL=ECL*sss_ele_cut +!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 + dGCLdOM2=0.0d0 ! this is because om2=0 +!c! dECL/dom12 + c1 = w1 / (Rhead ** 3.0d0) + c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0 + dGCLdOM12 = c1 - c2 + dGCLdOM12=0.0d0 !this is because om12=0.0 +!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) ) + erdxj = scalar( erhead(1), dC_norm(1,j+nres) ) + facd1 = d1 * vbld_inv(i) + facd2 = d2 * vbld_inv(j+nres) + DO k = 1, 3 + + pom = facd1*(erhead(k)-erdxi*dC_norm(k,i)) + gradpepcat(k,i) = gradpepcat(k,i) + dGCLdR * pom + gradpepcat(k,i+1) = gradpepcat(k,i+1) - dGCLdR * pom +! pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) +! gradpepcatx(k,j) = gradpepcatx(k,j) + dGCLdR * pom + + gradpepcat(k,i) = gradpepcat(k,i) - dGCLdR * erhead(k)*0.5d0 + gradpepcat(k,i+1) = gradpepcat(k,i+1)- dGCLdR * erhead(k)*0.5d0 + gradpepcat(k,j) = gradpepcat(k,j) + dGCLdR * erhead(k) + END DO + RETURN + END SUBROUTINE edd_cat_pep + SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol) ! IMPLICIT NONE use comm_momo @@ -27506,8 +29222,8 @@ chip1=chip(itypi) !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) + 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) @@ -27515,9 +29231,9 @@ chip1=chip(itypi) 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))) + (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 @@ -27529,18 +29245,18 @@ chip1=chip(itypi) !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) + 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) + 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))) + (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 @@ -27584,9 +29300,9 @@ chip1=chip(itypi) alf1 = 0.0d0 alf2 = 0.0d0 alf12 = 0.0d0 - dxj = dc_norm( 1, nres+j ) - dyj = dc_norm( 2, nres+j ) - dzj = dc_norm( 3, nres+j ) + dxj = 0.0d0 !dc_norm( 1, nres+j ) + dyj = 0.0d0 !dc_norm( 2, nres+j ) + dzj = 0.0d0 !dc_norm( 3, nres+j ) !c! distance from center of chain(?) to polar/charged head d1 = dheadcat(1, 1, itypi, itypj) d2 = dheadcat(2, 1, itypi, itypj) @@ -27616,8 +29332,8 @@ chip1=chip(itypi) !c! tail location and distance calculations Rtail = 0.0d0 DO k = 1, 3 - ctail(k,1)=c(k,i+nres)-dtailcat(1,itypi,itypj)*dc_norm(k,nres+i) - ctail(k,2)=c(k,j)!-dtailcat(2,itypi,itypj)*dc_norm(k,nres+j) + ctail(k,1)=c(k,i+nres)-dtailcat(1,itypi,itypj)*dc_norm(k,nres+i) + ctail(k,2)=c(k,j)!-dtailcat(2,itypi,itypj)*dc_norm(k,nres+j) END DO !c! tail distances will be themselves usefull elswhere !c1 (in Gcav, for example) @@ -27625,9 +29341,9 @@ chip1=chip(itypi) 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))) + (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 @@ -27639,18 +29355,18 @@ chip1=chip(itypi) !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) + chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres) + chead(k,2) = c(k, j) !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) + 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))) + (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 @@ -27725,8 +29441,8 @@ chip1=chip(itypi) !c! tail location and distance calculations Rtail = 0.0d0 DO k = 1, 3 - ctail(k,1)=(c(k,i)+c(k,i+1))/2.0-dtailcat(1,itypi,itypj)*dc_norm(k,i) - ctail(k,2)=c(k,j)!-dtailcat(2,itypi,itypj)*dc_norm(k,nres+j) + ctail(k,1)=(c(k,i)+c(k,i+1))/2.0-dtailcat(1,itypi,itypj)*dc_norm(k,i) + ctail(k,2)=c(k,j)!-dtailcat(2,itypi,itypj)*dc_norm(k,nres+j) END DO !c! tail distances will be themselves usefull elswhere !c1 (in Gcav, for example) @@ -27734,9 +29450,9 @@ chip1=chip(itypi) 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))) + (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 @@ -27748,18 +29464,18 @@ chip1=chip(itypi) !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)+c(k,i+1))/2.0 + d1 * dc_norm(k, i) - chead(k,2) = c(k, j) + chead(k,1) = (c(k, i)+c(k,i+1))/2.0 + d1 * dc_norm(k, i) + chead(k,2) = c(k, j) !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) + 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))) + (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 @@ -27786,11 +29502,11 @@ chip1=chip(itypi) yy(0)=1.0d0 yy(1)=y do i=2,n - yy(i)=2*yy(1)*yy(i-1)-yy(i-2) + yy(i)=2*yy(1)*yy(i-1)-yy(i-2) enddo aux=0.0d0 do i=m,n - aux=aux+x(i)*yy(i) + aux=aux+x(i)*yy(i) enddo tschebyshev=aux return @@ -27806,96 +29522,291 @@ chip1=chip(itypi) yy(0)=1.0d0 yy(1)=2.0d0*y do i=2,n - yy(i)=2*y*yy(i-1)-yy(i-2) + yy(i)=2*y*yy(i-1)-yy(i-2) enddo aux=0.0d0 do i=m,n - aux=aux+x(i+1)*yy(i)*(i+1) + aux=aux+x(i+1)*yy(i)*(i+1) !C print *, x(i+1),yy(i),i enddo gradtschebyshev=aux return end function gradtschebyshev +!!!!!!!!!-------------------------------------------------------------- + subroutine lipid_bond(elipbond) + real(kind=8) :: elipbond,fac,dist_sub,sumdist + real(kind=8), dimension(3):: dist + integer(kind=8) :: i,j,k,ibra,ityp,jtyp,ityp1 + elipbond=0.0d0 +! print *,"before",ilipbond_start,ilipbond_end + do i=ilipbond_start,ilipbond_end +! print *,i,i+1,"i,i+1" + ityp=itype(i,4) + ityp1=itype(i+1,4) +! print *,ityp,ityp1,"itype" + j=i+1 + if (ityp.eq.12) ibra=i + if ((ityp.eq.ntyp1_molec(4)).or.(ityp1.ge.ntyp1_molec(4)-1)) cycle + if (ityp.eq.(ntyp1_molec(4)-1)) then + !cofniecie do ostatnie GL1 +! i=ibra + j=ibra + else + j=i + endif + jtyp=itype(j,4) + do k=1,3 + dist(k)=c(k,j)-c(k,i+1) + enddo + sumdist=0.0d0 + do k=1,3 + sumdist=sumdist+dist(k)**2 + enddo + dist_sub=sqrt(sumdist) +! print *,"before",i,j,ityp1,ityp,jtyp + elipbond=elipbond+kbondlip*((dist_sub-lip_bond(jtyp,ityp1))**2) + fac=kbondlip*(dist_sub-lip_bond(jtyp,ityp1)) + do k=1,3 + gradlipbond(k,i+1)= gradlipbond(k,i+1)-fac*dist(k)/dist_sub + gradlipbond(k,j)=gradlipbond(k,j)+fac*dist(k)/dist_sub + enddo + if (energy_dec) write(iout,*) "lipbond",j,i+1,dist_sub,lip_bond(jtyp,ityp1),kbondlip,fac + enddo + elipbond=elipbond*0.5d0 + return + end subroutine lipid_bond +!--------------------------------------------------------------------------------------- + subroutine lipid_angle(elipang) + real(kind=8) :: elipang,alfa,xa(3),xb(3),alfaact,alfa0,force,fac,& + scalara,vnorm,wnorm,sss,sss_grad,eangle + integer :: i,j,k,l,m,ibra,ityp1,itypm1,itypp1 + elipang=0.0d0 +! print *,"ilipang_start,ilipang_end",ilipang_start,ilipang_end + do i=ilipang_start,ilipang_end +! do i=4,4 + +! the loop is centered on the central residue + itypm1=itype(i-1,4) + ityp1=itype(i,4) + itypp1=itype(i+1,4) +! print *,i,i,j,"processor",fg_rank + j=i-1 + k=i + l=i+1 + if (ityp1.eq.12) ibra=i + if ((itypm1.eq.ntyp1_molec(4)).or.(ityp1.eq.ntyp1_molec(4))& + .or.(itypp1.eq.ntyp1_molec(4))) cycle !cycle if any of the angles is dummy + if ((itypm1.eq.ntyp1_molec(4)-1).or.(itypp1.eq.ntyp1_molec(4)-1)) cycle + ! branching is only to one angle + if (ityp1.eq.ntyp1_molec(4)-1) then + k=ibra + j=ibra-1 + endif + itypm1=itype(j,4) + ityp1=itype(k,4) + do m=1,3 + xa(m)=c(m,j)-c(m,k) + xb(m)=c(m,l)-c(m,k) +! xb(m)=1.0d0 + enddo + vnorm=dsqrt(xa(1)*xa(1)+xa(2)*xa(2)+xa(3)*xa(3)) + wnorm=dsqrt(xb(1)*xb(1)+xb(2)*xb(2)+xb(3)*xb(3)) + scalara=(xa(1)*xb(1)+xa(2)*xb(2)+xa(3)*xb(3))/(vnorm*wnorm) +! if (((scalar*scalar).gt.0.99999999d0).and.(alfa0.eq.180.0d0)) cycle + + alfaact=scalara +! sss=sscale_martini_angle(alfaact) +! sss_grad=sscale_grad_martini_angle(alfaact) +! print *,sss_grad,"sss_grad",sss +! if (sss.le.0.0) cycle +! if (sss_grad.ne.0.0) print *,sss_grad,"sss_grad" + force=lip_angle_force(itypm1,ityp1,itypp1) + alfa0=lip_angle_angle(itypm1,ityp1,itypp1) + eangle=force*(alfaact-dcos(alfa0))*(alfaact-dcos(alfa0))*0.5d0 + elipang=elipang+eangle!*(1001.0d0-1000.0d0*sss) + fac=force*(alfaact-dcos(alfa0))!*(1001.0d0-1000.0d0*sss)-sss_grad*eangle*1000.0d0 + do m=1,3 + gradlipang(m,j)=gradlipang(m,j)+(fac &!/dsqrt(1.0d0-scalar*scalar)& + *(xb(m)-scalara*wnorm*xa(m)/vnorm)& + /(vnorm*wnorm))!-sss_grad*eangle*xa(m)/vnorm + + gradlipang(m,l)=gradlipang(m,l)+(fac & !/dsqrt(1.0d0-scalar*scalar)& + *(xa(m)-scalara*vnorm*xb(m)/wnorm)& + /(vnorm*wnorm))!+sss_grad*eangle*xb(m)/wnorm + + gradlipang(m,k)=gradlipang(m,k)-(fac)& !/dsqrt(1.0d0-scalar*scalar)& + *(xb(m)-scalara*wnorm*xa(m)/vnorm)& + /((vnorm*wnorm))-(fac & !/dsqrt(1.0d0-scalar*scalar)& + *(xa(m)-scalara*vnorm*xb(m)/wnorm)& + /(vnorm*wnorm))!-sss_grad*eangle*xa(m)/vnorm& + !-sss_grad*eangle*xb(m)/wnorm + +! *(xb(m)*vnorm*wnorm)& + +!-xa(m)*xa(m)*xb(m)*wnorm/vnorm)& + enddo + if (energy_dec) write(iout,*) "elipang",j,k,l,force,alfa0,alfaact,elipang + enddo + return + end subroutine lipid_angle +!-------------------------------------------------------------------- + subroutine lipid_lj(eliplj) + real(kind=8) :: eliplj,fac,sumdist,dist_sub,LJ1,LJ2,LJ,& + xj,yj,zj,xi,yi,zi,sss,sss_grad + real(kind=8), dimension(3):: dist + integer :: i,j,k,inum,ityp,jtyp + eliplj=0.0d0 + do inum=iliplj_start,iliplj_end + i=mlipljlisti(inum) + j=mlipljlistj(inum) +! print *,inum,i,j,"processor",fg_rank + ityp=itype(i,4) + jtyp=itype(j,4) + xi=c(1,i) + yi=c(2,i) + zi=c(3,i) + call to_box(xi,yi,zi) + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) + dist(1)=xj + dist(2)=yj + dist(3)=zj + ! do k=1,3 + ! dist(k)=c(k,j)-c(k,i) + ! enddo + sumdist=0.0d0 + do k=1,3 + sumdist=sumdist+dist(k)**2 + enddo + + dist_sub=sqrt(sumdist) + sss=sscale_martini(dist_sub) + if (energy_dec) write(iout,*) "LJ LIP bef",i,j,ityp,jtyp,dist_sub + if (sss.le.0.0) cycle + sss_grad=sscale_grad_martini(dist_sub) + LJ1 = (lip_sig(ityp,jtyp)/dist_sub)**6 + LJ2 = LJ1**2 + LJ = LJ2 - LJ1 + LJ = 4.0d0*lip_eps(ityp,jtyp)*LJ + eliplj = eliplj + LJ*sss + fac=4.0d0*lip_eps(ityp,jtyp)*(-6.0d0*LJ1/dist_sub+12.0d0*LJ2/dist_sub) + do k=1,3 + gradliplj(k,i)=gradliplj(k,i)+fac*dist(k)/dist_sub*sss-sss_grad*LJ*dist(k)/dist_sub + gradliplj(k,j)=gradliplj(k,j)-fac*dist(k)/dist_sub*sss+sss_grad*LJ*dist(k)/dist_sub + enddo + if (energy_dec) write(iout,'(a7,4i5,2f8.3)') "LJ LIP",i,j,ityp,jtyp,LJ,dist_sub + enddo + return + end subroutine lipid_lj +!-------------------------------------------------------------------------------------- + subroutine lipid_elec(elipelec) + real(kind=8) :: elipelec,fac,sumdist,dist_sub,xj,yj,zj,xi,yi,zi,EQ,& + sss,sss_grad + real(kind=8), dimension(3):: dist + integer :: i,j,k,inum,ityp,jtyp + elipelec=0.0d0 +! print *,"processor",fg_rank,ilip_elec_start,ilipelec_end + do inum=ilip_elec_start,ilipelec_end + i=mlipeleclisti(inum) + j=mlipeleclistj(inum) +! print *,inum,i,j,"processor",fg_rank + ityp=itype(i,4) + jtyp=itype(j,4) + xi=c(1,i) + yi=c(2,i) + zi=c(3,i) + call to_box(xi,yi,zi) + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) + dist(1)=xj + dist(2)=yj + dist(3)=zj +! do k=1,3 +! dist(k)=c(k,j)-c(k,i) +! enddo + sumdist=0.0d0 + do k=1,3 + sumdist=sumdist+dist(k)**2 + enddo + dist_sub=sqrt(sumdist) + sss=sscale_martini(dist_sub) +! print *,sss,dist_sub + if (energy_dec) write(iout,*) "EQ LIP",sss,dist_sub,i,j + if (sss.le.0.0) cycle + sss_grad=sscale_grad_martini(dist_sub) +! print *,"sss",sss,sss_grad + EQ=k_coulomb_lip*(ichargelipid(ityp)*ichargelipid(jtyp)/dist_sub) + elipelec=elipelec+EQ*sss + fac=k_coulomb_lip*(ichargelipid(ityp)*ichargelipid(jtyp)/sumdist)*sss + do k=1,3 + gradlipelec(k,i)=gradlipelec(k,i)+fac*dist(k)/dist_sub& + -sss_grad*EQ*dist(k)/dist_sub + gradlipelec(k,j)=gradlipelec(k,j)-fac*dist(k)/dist_sub& + +sss_grad*EQ*dist(k)/dist_sub + enddo + if (energy_dec) write(iout,*) "EQ LIP",i,j,ityp,jtyp,EQ,dist_sub,elipelec + enddo + return + end subroutine lipid_elec +!------------------------------------------------------------------------- subroutine make_SCSC_inter_list include 'mpif.h' - real*8 :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp - real*8 :: dist_init, dist_temp,r_buff_list - integer:: contlisti(200*nres),contlistj(200*nres) + real(kind=8) :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp + real(kind=8) :: dist_init, dist_temp,r_buff_list + integer:: contlisti(250*nres),contlistj(250*nres) ! integer :: newcontlisti(200*nres),newcontlistj(200*nres) integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_sc,g_ilist_sc integer displ(0:nprocs),i_ilist_sc(0:nprocs),ierr ! print *,"START make_SC" - r_buff_list=5.0 - ilist_sc=0 - do i=iatsc_s,iatsc_e - itypi=iabs(itype(i,1)) - if (itypi.eq.ntyp1) cycle - 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 - do iint=1,nint_gr(i) - do j=istart(i,iint),iend(i,iint) - itypj=iabs(itype(j,1)) - if (itypj.eq.ntyp1) cycle - 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 + r_buff_list=5.0 + ilist_sc=0 + do i=iatsc_s,iatsc_e + itypi=iabs(itype(i,1)) + if (itypi.eq.ntyp1) cycle + xi=c(1,nres+i) + yi=c(2,nres+i) + zi=c(3,nres+i) + call to_box(xi,yi,zi) + do iint=1,nint_gr(i) +! print *,"is it wrong", iint,i + do j=istart(i,iint),iend(i,iint) + itypj=iabs(itype(j,1)) + if (energy_dec) write(iout,*) "LISTA ZAKRES",istart(i,iint),iend(i,iint),iatsc_s,iatsc_e + if (itypj.eq.ntyp1) cycle + xj=c(1,nres+j) + yj=c(2,nres+j) + zj=c(3,nres+j) + call to_box(xj,yj,zj) +! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) +! faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0 + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) + dist_init=xj**2+yj**2+zj**2 +! dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 ! r_buff_list is a read value for a buffer - if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then + if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then ! Here the list is created - ilist_sc=ilist_sc+1 + ilist_sc=ilist_sc+1 ! this can be substituted by cantor and anti-cantor - contlisti(ilist_sc)=i - contlistj(ilist_sc)=j + contlisti(ilist_sc)=i + contlistj(ilist_sc)=j - endif - enddo - enddo - enddo + endif + enddo + enddo + enddo ! call MPI_Reduce(ilist_sc,g_ilist_sc,1,& ! MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) ! call MPI_Gather(newnss,1,MPI_INTEGER,& @@ -27908,38 +29819,38 @@ chip1=chip(itypi) #endif if (nfgtasks.gt.1)then - call MPI_Reduce(ilist_sc,g_ilist_sc,1,& - MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) + call MPI_Reduce(ilist_sc,g_ilist_sc,1,& + MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) ! write(iout,*) "before bcast",g_ilist_sc - call MPI_Gather(ilist_sc,1,MPI_INTEGER,& - i_ilist_sc,1,MPI_INTEGER,king,FG_COMM,IERR) - displ(0)=0 - do i=1,nfgtasks-1,1 - displ(i)=i_ilist_sc(i-1)+displ(i-1) - enddo + call MPI_Gather(ilist_sc,1,MPI_INTEGER,& + i_ilist_sc,1,MPI_INTEGER,king,FG_COMM,IERR) + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_sc(i-1)+displ(i-1) + enddo ! write(iout,*) "before gather",displ(0),displ(1) - call MPI_Gatherv(contlisti,ilist_sc,MPI_INTEGER,& - newcontlisti,i_ilist_sc,displ,MPI_INTEGER,& - king,FG_COMM,IERR) - call MPI_Gatherv(contlistj,ilist_sc,MPI_INTEGER,& - newcontlistj,i_ilist_sc,displ,MPI_INTEGER,& - king,FG_COMM,IERR) - call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM,IERR) + call MPI_Gatherv(contlisti,ilist_sc,MPI_INTEGER,& + newcontlisti,i_ilist_sc,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Gatherv(contlistj,ilist_sc,MPI_INTEGER,& + newcontlistj,i_ilist_sc,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM,IERR) ! write(iout,*) "before bcast",g_ilist_sc ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) - call MPI_Bcast(newcontlisti,g_ilist_sc,MPI_INT,king,FG_COMM,IERR) - call MPI_Bcast(newcontlistj,g_ilist_sc,MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlisti,g_ilist_sc,MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistj,g_ilist_sc,MPI_INT,king,FG_COMM,IERR) ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) - else - g_ilist_sc=ilist_sc + else + g_ilist_sc=ilist_sc - do i=1,ilist_sc - newcontlisti(i)=contlisti(i) - newcontlistj(i)=contlistj(i) - enddo - endif + do i=1,ilist_sc + newcontlisti(i)=contlisti(i) + newcontlistj(i)=contlistj(i) + enddo + endif #ifdef DEBUG write (iout,*) "after MPIREDUCE",g_ilist_sc @@ -27947,7 +29858,7 @@ chip1=chip(itypi) write (iout,*) i,newcontlisti(i),newcontlistj(i) enddo #endif - call int_bounds(g_ilist_sc,g_listscsc_start,g_listscsc_end) + call int_bounds(g_ilist_sc,g_listscsc_start,g_listscsc_end) return end subroutine make_SCSC_inter_list !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -27956,32 +29867,26 @@ chip1=chip(itypi) use MD_data, only: itime_mat include 'mpif.h' - real*8 :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp - real*8 :: dist_init, dist_temp,r_buff_list - integer:: contlistscpi(200*nres),contlistscpj(200*nres) + real(kind=8) :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp + real(kind=8) :: dist_init, dist_temp,r_buff_list + integer:: contlistscpi(350*nres),contlistscpj(350*nres) ! integer :: newcontlistscpi(200*nres),newcontlistscpj(200*nres) integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_scp,g_ilist_scp integer displ(0:nprocs),i_ilist_scp(0:nprocs),ierr ! print *,"START make_SC" r_buff_list=5.0 - ilist_scp=0 + ilist_scp=0 do i=iatscp_s,iatscp_e - if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) 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(i) + if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) 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)) + call to_box(xi,yi,zi) + do iint=1,nscp_gr(i) - do j=iscpstart(i,iint),iscpend(i,iint) - itypj=iabs(itype(j,1)) - if (itypj.eq.ntyp1) cycle + do j=iscpstart(i,iint),iscpend(i,iint) + 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 @@ -27990,67 +29895,35 @@ chip1=chip(itypi) ! 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 + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) + dist_init=xj**2+yj**2+zj**2 #ifdef DEBUG - ! r_buff_list is a read value for a buffer - if ((sqrt(dist_init).le.(r_cut_ele)).and.(ifirstrun.eq.0)) then + ! r_buff_list is a read value for a buffer + if ((sqrt(dist_init).le.(r_cut_ele)).and.(ifirstrun.eq.0)) then ! Here the list is created - ilist_scp_first=ilist_scp_first+1 + ilist_scp_first=ilist_scp_first+1 ! this can be substituted by cantor and anti-cantor - contlistscpi_f(ilist_scp_first)=i - contlistscpj_f(ilist_scp_first)=j - endif + contlistscpi_f(ilist_scp_first)=i + contlistscpj_f(ilist_scp_first)=j + endif #endif ! r_buff_list is a read value for a buffer - if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then + if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then ! Here the list is created - ilist_scp=ilist_scp+1 + ilist_scp=ilist_scp+1 ! this can be substituted by cantor and anti-cantor - contlistscpi(ilist_scp)=i - contlistscpj(ilist_scp)=j - endif - enddo - enddo - enddo + contlistscpi(ilist_scp)=i + contlistscpj(ilist_scp)=j + endif + enddo + enddo + enddo #ifdef DEBUG write (iout,*) "before MPIREDUCE",ilist_scp do i=1,ilist_scp @@ -28059,38 +29932,38 @@ chip1=chip(itypi) #endif if (nfgtasks.gt.1)then - call MPI_Reduce(ilist_scp,g_ilist_scp,1,& - MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) + call MPI_Reduce(ilist_scp,g_ilist_scp,1,& + MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) ! write(iout,*) "before bcast",g_ilist_sc - call MPI_Gather(ilist_scp,1,MPI_INTEGER,& - i_ilist_scp,1,MPI_INTEGER,king,FG_COMM,IERR) - displ(0)=0 - do i=1,nfgtasks-1,1 - displ(i)=i_ilist_scp(i-1)+displ(i-1) - enddo + call MPI_Gather(ilist_scp,1,MPI_INTEGER,& + i_ilist_scp,1,MPI_INTEGER,king,FG_COMM,IERR) + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_scp(i-1)+displ(i-1) + enddo ! write(iout,*) "before gather",displ(0),displ(1) - call MPI_Gatherv(contlistscpi,ilist_scp,MPI_INTEGER,& - newcontlistscpi,i_ilist_scp,displ,MPI_INTEGER,& - king,FG_COMM,IERR) - call MPI_Gatherv(contlistscpj,ilist_scp,MPI_INTEGER,& - newcontlistscpj,i_ilist_scp,displ,MPI_INTEGER,& - king,FG_COMM,IERR) - call MPI_Bcast(g_ilist_scp,1,MPI_INT,king,FG_COMM,IERR) + call MPI_Gatherv(contlistscpi,ilist_scp,MPI_INTEGER,& + newcontlistscpi,i_ilist_scp,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Gatherv(contlistscpj,ilist_scp,MPI_INTEGER,& + newcontlistscpj,i_ilist_scp,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Bcast(g_ilist_scp,1,MPI_INT,king,FG_COMM,IERR) ! write(iout,*) "before bcast",g_ilist_sc ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) - call MPI_Bcast(newcontlistscpi,g_ilist_scp,MPI_INT,king,FG_COMM,IERR) - call MPI_Bcast(newcontlistscpj,g_ilist_scp,MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistscpi,g_ilist_scp,MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistscpj,g_ilist_scp,MPI_INT,king,FG_COMM,IERR) ! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) - else - g_ilist_scp=ilist_scp + else + g_ilist_scp=ilist_scp - do i=1,ilist_scp - newcontlistscpi(i)=contlistscpi(i) - newcontlistscpj(i)=contlistscpj(i) - enddo - endif + do i=1,ilist_scp + newcontlistscpi(i)=contlistscpi(i) + newcontlistscpj(i)=contlistscpj(i) + enddo + endif #ifdef DEBUG write (iout,*) "after MPIREDUCE",g_ilist_scp @@ -28109,7 +29982,7 @@ chip1=chip(itypi) ! 126 continue ! enddo #endif - call int_bounds(g_ilist_scp,g_listscp_start,g_listscp_end) + call int_bounds(g_ilist_scp,g_listscp_start,g_listscp_end) return end subroutine make_SCp_inter_list @@ -28120,15 +29993,15 @@ chip1=chip(itypi) subroutine make_pp_inter_list include 'mpif.h' - real*8 :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp - real*8 :: xmedj,ymedj,zmedj - real*8 :: dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,xmedi,ymedi,zmedi - real*8 :: dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,dx_normj,dy_normj,dz_normj - integer:: contlistppi(200*nres),contlistppj(200*nres) + real(kind=8) :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp + real(kind=8) :: xmedj,ymedj,zmedj,sslipi,ssgradlipi,faclipij2,sslipj,ssgradlipj + real(kind=8) :: dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,xmedi,ymedi,zmedi + real(kind=8) :: dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,dx_normj,dy_normj,dz_normj + integer:: contlistppi(250*nres),contlistppj(250*nres) ! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres) integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_pp,g_ilist_pp integer displ(0:nprocs),i_ilist_pp(0:nprocs),ierr -! print *,"START make_SC" +! write(iout,*),"START make_pp",iatel_s,iatel_e,r_cut_ele+r_buff_list ilist_pp=0 r_buff_list=5.0 do i=iatel_s,iatel_e @@ -28142,17 +30015,16 @@ chip1=chip(itypi) 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(i),ielend(i) + + call to_box(xmedi,ymedi,zmedi) + call lipid_layer(xmedi,ymedi,zmedi,sslipi,ssgradlipi) ! write (iout,*) i,j,itype(i,1),itype(j,1) - if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle +! if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle ! 1,j) + do j=ielstart(i),ielend(i) +! write (iout,*) i,j,itype(i,1),itype(j,1) + if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle dxj=dc(1,j) dyj=dc(2,j) dzj=dc(3,j) @@ -28165,34 +30037,13 @@ chip1=chip(itypi) 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 - - 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 - endif - enddo - enddo - enddo - + call to_box(xj,yj,zj) +! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) +! faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0 + xj=boxshift(xj-xmedi,boxxsize) + yj=boxshift(yj-ymedi,boxysize) + zj=boxshift(zj-zmedi,boxzsize) + dist_init=xj**2+yj**2+zj**2 if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then ! Here the list is created ilist_pp=ilist_pp+1 @@ -28200,9 +30051,9 @@ chip1=chip(itypi) contlistppi(ilist_pp)=i contlistppj(ilist_pp)=j endif +! enddo enddo enddo -! enddo #ifdef DEBUG write (iout,*) "before MPIREDUCE",ilist_pp do i=1,ilist_pp @@ -28252,76 +30103,4457 @@ chip1=chip(itypi) #endif return end subroutine make_pp_inter_list +!--------------------------------------------------------------------------- + subroutine make_cat_pep_list + include 'mpif.h' + real(kind=8) :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp + real(kind=8) :: xmedj,ymedj,zmedj,sslipi,ssgradlipi,faclipij2,sslipj,ssgradlipj + real(kind=8) :: dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,xmedi,ymedi,zmedi + real(kind=8) :: dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,dx_normj,dy_normj,dz_normj + real(kind=8) :: xja,yja,zja + integer:: contlistcatpnormi(300*nres),contlistcatpnormj(300*nres) + integer:: contlistcatscnormi(250*nres),contlistcatscnormj(250*nres) + integer:: contlistcatptrani(250*nres),contlistcatptranj(250*nres) + integer:: contlistcatsctrani(250*nres),contlistcatsctranj(250*nres) + integer:: contlistcatscangi(250*nres),contlistcatscangj(250*nres) + integer:: contlistcatscangfi(250*nres),contlistcatscangfj(250*nres),& + contlistcatscangfk(250*nres) + integer:: contlistcatscangti(250*nres),contlistcatscangtj(250*nres) + integer:: contlistcatscangtk(250*nres),contlistcatscangtl(250*nres) -!----------------------------------------------------------------------------- - double precision function boxshift(x,boxsize) - implicit none - double precision x,boxsize - double precision xtemp - xtemp=dmod(x,boxsize) - if (dabs(xtemp-boxsize).lt.dabs(xtemp)) then - boxshift=xtemp-boxsize - else if (dabs(xtemp+boxsize).lt.dabs(xtemp)) then - boxshift=xtemp+boxsize - else - boxshift=xtemp + +! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres) + integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_catscnorm,& + ilist_catsctran,ilist_catpnorm,ilist_catptran,itmp,ilist_catscang,& + ilist_catscangf,ilist_catscangt,k + integer displ(0:nprocs),i_ilist_catscnorm(0:nprocs),ierr,& + i_ilist_catpnorm(0:nprocs),i_ilist_catsctran(0:nprocs),& + i_ilist_catptran(0:nprocs),i_ilist_catscang(0:nprocs),& + i_ilist_catscangf(0:nprocs),i_ilist_catscangt(0:nprocs) +! write(iout,*),"START make_pp",iatel_s,iatel_e,r_cut_ele+r_buff_list + ilist_catpnorm=0 + ilist_catscnorm=0 + ilist_catptran=0 + ilist_catsctran=0 + ilist_catscang=0 + + + r_buff_list=6.0 + itmp=0 + do i=1,4 + itmp=itmp+nres_molec(i) + enddo +! go to 17 +! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization + do i=ibond_start,ibond_end + +! print *,"I am in EVDW",i + itypi=iabs(itype(i,1)) + +! if (i.ne.47) cycle + if ((itypi.eq.ntyp1).or.(itypi.eq.10)) cycle +! itypi1=iabs(itype(i+1,1)) + xi=c(1,nres+i) + yi=c(2,nres+i) + zi=c(3,nres+i) + call to_box(xi,yi,zi) + dxi=dc_norm(1,i) + dyi=dc_norm(2,i) + dzi=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 + call to_box(xmedi,ymedi,zmedi) + +! dsci_inv=vbld_inv(i+nres) + do j=itmp+1,itmp+nres_molec(5) + dxj=dc(1,j) + dyj=dc(2,j) + dzj=dc(3,j) + dx_normj=dc_norm(1,j) + dy_normj=dc_norm(2,j) + dz_normj=dc_norm(3,j) + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + call to_box(xj,yj,zj) +! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) +! faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0 + xja=boxshift(xj-xmedi,boxxsize) + yja=boxshift(yj-ymedi,boxysize) + zja=boxshift(zj-zmedi,boxzsize) + dist_init=xja**2+yja**2+zja**2 + if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then +! Here the list is created + if (itype(j,5).le.5) then + ilist_catpnorm=ilist_catpnorm+1 +! this can be substituted by cantor and anti-cantor + contlistcatpnormi(ilist_catpnorm)=i + contlistcatpnormj(ilist_catpnorm)=j + else + ilist_catptran=ilist_catptran+1 +! this can be substituted by cantor and anti-cantor + contlistcatptrani(ilist_catptran)=i + contlistcatptranj(ilist_catptran)=j + endif + endif + xja=boxshift(xj-xi,boxxsize) + yja=boxshift(yj-yi,boxysize) + zja=boxshift(zj-zi,boxzsize) + dist_init=xja**2+yja**2+zja**2 + if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then +! Here the list is created + if (itype(j,5).le.5) then + ilist_catscnorm=ilist_catscnorm+1 +! this can be substituted by cantor and anti-cantor +! write(iout,*) "have contact",i,j,ilist_catscnorm + contlistcatscnormi(ilist_catscnorm)=i + contlistcatscnormj(ilist_catscnorm)=j +! write(iout,*) "have contact2",i,j,ilist_catscnorm,& +! contlistcatscnormi(ilist_catscnorm),contlistcatscnormj(ilist_catscnorm) + + else + ilist_catsctran=ilist_catsctran+1 +! this can be substituted by cantor and anti-cantor + contlistcatsctrani(ilist_catsctran)=i + contlistcatsctranj(ilist_catsctran)=j +! print *,"KUR**",i,j,itype(i,1) + if (((itype(i,1).eq.1).or.(itype(i,1).eq.15).or.& + (itype(i,1).eq.16).or.(itype(i,1).eq.17)).and.& + ((sqrt(dist_init).le.(r_cut_ang+r_buff_list)))) then +! print *,"KUR**2",i,j,itype(i,1),ilist_catscang+1 + + ilist_catscang=ilist_catscang+1 + contlistcatscangi(ilist_catscang)=i + contlistcatscangj(ilist_catscang)=j + endif + + endif endif - return - end function boxshift -!----------------------------------------------------------------------------- - subroutine to_box(xi,yi,zi) - implicit none -! include 'DIMENSIONS' -! include 'COMMON.CHAIN' - double precision xi,yi,zi - xi=dmod(xi,boxxsize) - if (xi.lt.0.0d0) xi=xi+boxxsize - yi=dmod(yi,boxysize) - if (yi.lt.0.0d0) yi=yi+boxysize - zi=dmod(zi,boxzsize) - if (zi.lt.0.0d0) zi=zi+boxzsize - return - end subroutine to_box -!-------------------------------------------------------------------------- - subroutine lipid_layer(xi,yi,zi,sslipi,ssgradlipi) - implicit none -! include 'DIMENSIONS' -! include 'COMMON.IOUNITS' -! include 'COMMON.CHAIN' - double precision xi,yi,zi,sslipi,ssgradlipi - double precision fracinbuf -! double precision sscalelip,sscagradlip +! enddo + enddo + enddo #ifdef DEBUG - write (iout,*) "bordlipbot",bordlipbot," bordliptop",bordliptop - write (iout,*) "buflipbot",buflipbot," lipbufthick",lipbufthick - write (iout,*) "xi yi zi",xi,yi,zi + write (iout,*) "before MPIREDUCE",ilist_catsctran,ilist_catptran,& + ilist_catscnorm,ilist_catpnorm,ilist_catscang + + do i=1,ilist_catsctran + write (iout,*) i,contlistcatsctrani(i),contlistcatsctranj(i),& + itype(j,contlistcatsctranj(i)) + enddo + do i=1,ilist_catptran + write (iout,*) i,contlistcatptrani(i),contlistcatsctranj(i) + enddo + do i=1,ilist_catscnorm + write (iout,*) i,contlistcatscnormi(i),contlistcatscnormj(i) + enddo + do i=1,ilist_catpnorm + write (iout,*) i,contlistcatpnormi(i),contlistcatscnormj(i) + enddo + do i=1,ilist_catscang + write (iout,*) i,contlistcatscangi(i),contlistcatscangi(i) + enddo + + #endif - if ((zi.gt.bordlipbot).and.(zi.lt.bordliptop)) then -! the energy transfer exist - if (zi.lt.buflipbot) then -! what fraction I am in - fracinbuf=1.0d0-((zi-bordlipbot)/lipbufthick) -! 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 + if (nfgtasks.gt.1)then + + call MPI_Reduce(ilist_catsctran,g_ilist_catsctran,1,& + MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc + call MPI_Gather(ilist_catsctran,1,MPI_INTEGER,& + i_ilist_catsctran,1,MPI_INTEGER,king,FG_COMM,IERR) + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_catsctran(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlistcatsctrani,ilist_catsctran,MPI_INTEGER,& + newcontlistcatsctrani,i_ilist_catsctran,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Gatherv(contlistcatsctranj,ilist_catsctran,MPI_INTEGER,& + newcontlistcatsctranj,i_ilist_catsctran,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Bcast(g_ilist_catsctran,1,MPI_INT,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + call MPI_Bcast(newcontlistcatsctrani,g_ilist_catsctran,MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistcatsctranj,g_ilist_catsctran,MPI_INT,king,FG_COMM,IERR) + + + call MPI_Reduce(ilist_catptran,g_ilist_catptran,1,& + MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc + call MPI_Gather(ilist_catptran,1,MPI_INTEGER,& + i_ilist_catptran,1,MPI_INTEGER,king,FG_COMM,IERR) + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_catptran(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlistcatptrani,ilist_catptran,MPI_INTEGER,& + newcontlistcatptrani,i_ilist_catptran,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Gatherv(contlistcatptranj,ilist_catptran,MPI_INTEGER,& + newcontlistcatptranj,i_ilist_catptran,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Bcast(g_ilist_catptran,1,MPI_INT,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + call MPI_Bcast(newcontlistcatptrani,g_ilist_catptran,MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistcatptranj,g_ilist_catptran,MPI_INT,king,FG_COMM,IERR) + +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + + call MPI_Reduce(ilist_catscnorm,g_ilist_catscnorm,1,& + MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc + call MPI_Gather(ilist_catscnorm,1,MPI_INTEGER,& + i_ilist_catscnorm,1,MPI_INTEGER,king,FG_COMM,IERR) + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_catscnorm(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlistcatscnormi,ilist_catscnorm,MPI_INTEGER,& + newcontlistcatscnormi,i_ilist_catscnorm,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Gatherv(contlistcatscnormj,ilist_catscnorm,MPI_INTEGER,& + newcontlistcatscnormj,i_ilist_catscnorm,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Bcast(g_ilist_catscnorm,1,MPI_INT,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + call MPI_Bcast(newcontlistcatscnormi,g_ilist_catscnorm,MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistcatscnormj,g_ilist_catscnorm,MPI_INT,king,FG_COMM,IERR) + + + + call MPI_Reduce(ilist_catpnorm,g_ilist_catpnorm,1,& + MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc + call MPI_Gather(ilist_catpnorm,1,MPI_INTEGER,& + i_ilist_catpnorm,1,MPI_INTEGER,king,FG_COMM,IERR) + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_catpnorm(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlistcatpnormi,ilist_catpnorm,MPI_INTEGER,& + newcontlistcatpnormi,i_ilist_catpnorm,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Gatherv(contlistcatpnormj,ilist_catpnorm,MPI_INTEGER,& + newcontlistcatpnormj,i_ilist_catpnorm,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Bcast(g_ilist_catpnorm,1,MPI_INT,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + call MPI_Bcast(newcontlistcatpnormi,g_ilist_catpnorm,MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistcatpnormj,g_ilist_catpnorm,MPI_INT,king,FG_COMM,IERR) + + + + call MPI_Reduce(ilist_catscang,g_ilist_catscang,1,& + MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc + call MPI_Gather(ilist_catscang,1,MPI_INTEGER,& + i_ilist_catscang,1,MPI_INTEGER,king,FG_COMM,IERR) + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_catscang(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlistcatscangi,ilist_catscang,MPI_INTEGER,& + newcontlistcatscangi,i_ilist_catscang,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Gatherv(contlistcatscangj,ilist_catscang,MPI_INTEGER,& + newcontlistcatscangj,i_ilist_catscang,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Bcast(g_ilist_catscang,1,MPI_INT,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + call MPI_Bcast(newcontlistcatscangi,g_ilist_catscang,MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistcatscangj,g_ilist_catscang,MPI_INT,king,FG_COMM,IERR) + + else - sslipi=1.0d0 - ssgradlipi=0.0 + g_ilist_catscnorm=ilist_catscnorm + g_ilist_catsctran=ilist_catsctran + g_ilist_catpnorm=ilist_catpnorm + g_ilist_catptran=ilist_catptran + g_ilist_catscang=ilist_catscang + + + do i=1,ilist_catscnorm + newcontlistcatscnormi(i)=contlistcatscnormi(i) + newcontlistcatscnormj(i)=contlistcatscnormj(i) + enddo + do i=1,ilist_catpnorm + newcontlistcatpnormi(i)=contlistcatpnormi(i) + newcontlistcatpnormj(i)=contlistcatpnormj(i) + enddo + do i=1,ilist_catsctran + newcontlistcatsctrani(i)=contlistcatsctrani(i) + newcontlistcatsctranj(i)=contlistcatsctranj(i) + enddo + do i=1,ilist_catptran + newcontlistcatptrani(i)=contlistcatptrani(i) + newcontlistcatptranj(i)=contlistcatptranj(i) + enddo + + do i=1,ilist_catscang + newcontlistcatscangi(i)=contlistcatscangi(i) + newcontlistcatscangj(i)=contlistcatscangj(i) + enddo + + endif - else - sslipi=0.0d0 - ssgradlipi=0.0 - endif -#ifdef DEBUG - write (iout,*) "sslipi",sslipi," ssgradlipi",ssgradlipi -#endif - return - end subroutine lipid_layer + call int_bounds(g_ilist_catsctran,g_listcatsctran_start,g_listcatsctran_end) + call int_bounds(g_ilist_catptran,g_listcatptran_start,g_listcatptran_end) + call int_bounds(g_ilist_catscnorm,g_listcatscnorm_start,g_listcatscnorm_end) + call int_bounds(g_ilist_catpnorm,g_listcatpnorm_start,g_listcatpnorm_end) + call int_bounds(g_ilist_catscang,g_listcatscang_start,g_listcatscang_end) +! make new ang list + ilist_catscangf=0 + do i=g_listcatscang_start,g_listcatscang_end + do j=2,g_ilist_catscang +! print *,"RWA",i,j,contlistcatscangj(i),contlistcatscangj(j) + if (j.le.i) cycle + if (newcontlistcatscangj(i).ne.newcontlistcatscangj(j)) cycle + ilist_catscangf=ilist_catscangf+1 + contlistcatscangfi(ilist_catscangf)=newcontlistcatscangi(i) + contlistcatscangfj(ilist_catscangf)=newcontlistcatscangj(i) + contlistcatscangfk(ilist_catscangf)=newcontlistcatscangi(j) +! print *,"TUTU",g_listcatscang_start,g_listcatscang_end,i,j,g_ilist_catscangf,myrank + enddo + enddo + if (nfgtasks.gt.1)then -!-------------------------------------------------------------------------- -!-------------------------------------------------------------------------- + call MPI_Reduce(ilist_catscangf,g_ilist_catscangf,1,& + MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc + call MPI_Gather(ilist_catscangf,1,MPI_INTEGER,& + i_ilist_catscangf,1,MPI_INTEGER,king,FG_COMM,IERR) + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_catscangf(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlistcatscangfi,ilist_catscangf,MPI_INTEGER,& + newcontlistcatscangfi,i_ilist_catscangf,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Gatherv(contlistcatscangfj,ilist_catscangf,MPI_INTEGER,& + newcontlistcatscangfj,i_ilist_catscangf,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Gatherv(contlistcatscangfk,ilist_catscangf,MPI_INTEGER,& + newcontlistcatscangfk,i_ilist_catscangf,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + + call MPI_Bcast(g_ilist_catscangf,1,MPI_INT,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + call MPI_Bcast(newcontlistcatscangfi,g_ilist_catscangf,MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistcatscangfj,g_ilist_catscangf,MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistcatscangfk,g_ilist_catscangf,MPI_INT,king,FG_COMM,IERR) + else + g_ilist_catscangf=ilist_catscangf + do i=1,ilist_catscangf + newcontlistcatscangfi(i)=contlistcatscangfi(i) + newcontlistcatscangfj(i)=contlistcatscangfj(i) + newcontlistcatscangfk(i)=contlistcatscangfk(i) + enddo + endif + call int_bounds(g_ilist_catscangf,g_listcatscangf_start,g_listcatscangf_end) + + + ilist_catscangt=0 + do i=g_listcatscang_start,g_listcatscang_end + do j=1,g_ilist_catscang + do k=1,g_ilist_catscang +! print *,"TUTU1",g_listcatscang_start,g_listcatscang_end,i,j + + if (newcontlistcatscangj(i).ne.newcontlistcatscangj(j)) cycle + if (newcontlistcatscangj(i).ne.newcontlistcatscangj(k)) cycle + if (newcontlistcatscangj(k).ne.newcontlistcatscangj(j)) cycle + if (newcontlistcatscangi(i).eq.newcontlistcatscangi(j)) cycle + if (newcontlistcatscangi(i).eq.newcontlistcatscangi(k)) cycle + if (newcontlistcatscangi(k).eq.newcontlistcatscangi(j)) cycle +! print *,"TUTU2",g_listcatscang_start,g_listcatscang_end,i,j + + ilist_catscangt=ilist_catscangt+1 + contlistcatscangti(ilist_catscangt)=newcontlistcatscangi(i) + contlistcatscangtj(ilist_catscangt)=newcontlistcatscangj(i) + contlistcatscangtk(ilist_catscangt)=newcontlistcatscangi(j) + contlistcatscangtl(ilist_catscangt)=newcontlistcatscangi(k) + + enddo + enddo + enddo + if (nfgtasks.gt.1)then + + call MPI_Reduce(ilist_catscangt,g_ilist_catscangt,1,& + MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc + call MPI_Gather(ilist_catscangt,1,MPI_INTEGER,& + i_ilist_catscangt,1,MPI_INTEGER,king,FG_COMM,IERR) + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_catscangt(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlistcatscangti,ilist_catscangt,MPI_INTEGER,& + newcontlistcatscangti,i_ilist_catscangt,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Gatherv(contlistcatscangtj,ilist_catscangt,MPI_INTEGER,& + newcontlistcatscangtj,i_ilist_catscangt,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Gatherv(contlistcatscangtk,ilist_catscangt,MPI_INTEGER,& + newcontlistcatscangtk,i_ilist_catscangt,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Gatherv(contlistcatscangtl,ilist_catscangt,MPI_INTEGER,& + newcontlistcatscangtl,i_ilist_catscangt,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + + call MPI_Bcast(g_ilist_catscangt,1,MPI_INT,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + call MPI_Bcast(newcontlistcatscangti,g_ilist_catscangt,MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistcatscangtj,g_ilist_catscangt,MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistcatscangtk,g_ilist_catscangt,MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistcatscangtl,g_ilist_catscangt,MPI_INT,king,FG_COMM,IERR) + + else + g_ilist_catscangt=ilist_catscangt + do i=1,ilist_catscangt + newcontlistcatscangti(i)=contlistcatscangti(i) + newcontlistcatscangtj(i)=contlistcatscangtj(i) + newcontlistcatscangtk(i)=contlistcatscangtk(i) + newcontlistcatscangtl(i)=contlistcatscangtl(i) + enddo + endif + call int_bounds(g_ilist_catscangt,g_listcatscangt_start,g_listcatscangt_end) + + + + + +#ifdef DEBUG + write (iout,*) "after MPIREDUCE",ilist_catsctran,ilist_catptran, & + ilist_catscnorm,ilist_catpnorm + + do i=1,g_ilist_catsctran + write (iout,*) i,newcontlistcatsctrani(i),newcontlistcatsctranj(i) + enddo + do i=1,g_ilist_catptran + write (iout,*) i,newcontlistcatptrani(i),newcontlistcatsctranj(i) + enddo + do i=1,g_ilist_catscnorm + write (iout,*) i,newcontlistcatscnormi(i),newcontlistcatscnormj(i) + enddo + do i=1,g_ilist_catpnorm + write (iout,*) i,newcontlistcatpnormi(i),newcontlistcatscnormj(i) + enddo + do i=1,g_ilist_catscang + write (iout,*) i,newcontlistcatscangi(i),newcontlistcatscangj(i) + enddo +#endif + return + end subroutine make_cat_pep_list + + subroutine make_lip_pep_list + include 'mpif.h' + real(kind=8) :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp + real(kind=8) :: xmedj,ymedj,zmedj,sslipi,ssgradlipi,faclipij2,sslipj,ssgradlipj + real(kind=8) :: dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,xmedi,ymedi,zmedi + real(kind=8) :: dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,dx_normj,dy_normj,dz_normj + real(kind=8) :: xja,yja,zja + integer:: contlistmartpi(300*nres),contlistmartpj(300*nres) + integer:: contlistmartsci(250*nres),contlistmartscj(250*nres) + + +! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres) + integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_martsc,& + ilist_martp,k,itmp + integer displ(0:nprocs),i_ilist_martsc(0:nprocs),ierr,& + i_ilist_martp(0:nprocs) +! write(iout,*),"START make_pp",iatel_s,iatel_e,r_cut_ele+r_buff_list + ilist_martp=0 + ilist_martsc=0 + + + r_buff_list=6.0 + itmp=0 + do i=1,3 + itmp=itmp+nres_molec(i) + enddo +! go to 17 +! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization + do i=ibond_start,ibond_end + +! print *,"I am in EVDW",i + itypi=iabs(itype(i,1)) + +! if (i.ne.47) cycle + if ((itypi.eq.ntyp1).or.(itypi.eq.10)) cycle +! itypi1=iabs(itype(i+1,1)) + xi=c(1,nres+i) + yi=c(2,nres+i) + zi=c(3,nres+i) + call to_box(xi,yi,zi) + dxi=dc_norm(1,i) + dyi=dc_norm(2,i) + dzi=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 + call to_box(xmedi,ymedi,zmedi) + +! dsci_inv=vbld_inv(i+nres) + do j=itmp+1,itmp+nres_molec(4) + dxj=dc(1,j) + dyj=dc(2,j) + dzj=dc(3,j) + dx_normj=dc_norm(1,j) + dy_normj=dc_norm(2,j) + dz_normj=dc_norm(3,j) + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + call to_box(xj,yj,zj) +! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) +! faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0 + xja=boxshift(xj-xmedi,boxxsize) + yja=boxshift(yj-ymedi,boxysize) + zja=boxshift(zj-zmedi,boxzsize) + dist_init=xja**2+yja**2+zja**2 + if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then +! Here the list is created + ilist_martp=ilist_martp+1 +! this can be substituted by cantor and anti-cantor + contlistmartpi(ilist_martp)=i + contlistmartpj(ilist_martp)=j + endif + xja=boxshift(xj-xi,boxxsize) + yja=boxshift(yj-yi,boxysize) + zja=boxshift(zj-zi,boxzsize) + dist_init=xja**2+yja**2+zja**2 + if (sqrt(dist_init).le.(r_cut_ele+r_buff_list)) then +! Here the list is created + ilist_martsc=ilist_martsc+1 +! this can be substituted by cantor and anti-cantor +! write(iout,*) "have contact",i,j,ilist_martsc + contlistmartsci(ilist_martsc)=i + contlistmartscj(ilist_martsc)=j +! write(iout,*) "have contact2",i,j,ilist_martsc,& +! contlistmartsci(ilist_martsc),contlistmartscj(ilist_martsc) + endif +! enddo + enddo + enddo +#ifdef DEBUG + write (iout,*) "before MPIREDUCE",ilist_catsctran,ilist_catptran,& + ilist_catscnorm,ilist_catpnorm,ilist_catscang + + do i=1,ilist_catsctran + write (iout,*) i,contlistcatsctrani(i),contlistcatsctranj(i),& + itype(j,contlistcatsctranj(i)) + enddo + do i=1,ilist_catptran + write (iout,*) i,contlistcatptrani(i),contlistcatsctranj(i) + enddo + do i=1,ilist_catscnorm + write (iout,*) i,contlistcatscnormi(i),contlistcatscnormj(i) + enddo + do i=1,ilist_catpnorm + write (iout,*) i,contlistcatpnormi(i),contlistcatscnormj(i) + enddo + do i=1,ilist_catscang + write (iout,*) i,contlistcatscangi(i),contlistcatscangi(i) + enddo + + +#endif + if (nfgtasks.gt.1)then + +! write(iout,*) "before bcast",g_ilist_sc +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + + call MPI_Reduce(ilist_martsc,g_ilist_martsc,1,& + MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc + call MPI_Gather(ilist_martsc,1,MPI_INTEGER,& + i_ilist_martsc,1,MPI_INTEGER,king,FG_COMM,IERR) + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_martsc(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlistmartsci,ilist_martsc,MPI_INTEGER,& + newcontlistmartsci,i_ilist_martsc,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Gatherv(contlistmartscj,ilist_martsc,MPI_INTEGER,& + newcontlistmartscj,i_ilist_martsc,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Bcast(g_ilist_martsc,1,MPI_INT,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + call MPI_Bcast(newcontlistmartsci,g_ilist_martsc,MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistmartscj,g_ilist_martsc,MPI_INT,king,FG_COMM,IERR) + + + + call MPI_Reduce(ilist_martp,g_ilist_martp,1,& + MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc + call MPI_Gather(ilist_martp,1,MPI_INTEGER,& + i_ilist_martp,1,MPI_INTEGER,king,FG_COMM,IERR) + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_martp(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlistmartpi,ilist_martp,MPI_INTEGER,& + newcontlistmartpi,i_ilist_martp,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Gatherv(contlistmartpj,ilist_martp,MPI_INTEGER,& + newcontlistmartpj,i_ilist_martp,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Bcast(g_ilist_martp,1,MPI_INT,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + call MPI_Bcast(newcontlistmartpi,g_ilist_martp,MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistmartpj,g_ilist_martp,MPI_INT,king,FG_COMM,IERR) + + + + else + g_ilist_martsc=ilist_martsc + g_ilist_martp=ilist_martp + + + do i=1,ilist_martsc + newcontlistmartsci(i)=contlistmartsci(i) + newcontlistmartscj(i)=contlistmartscj(i) + enddo + do i=1,ilist_martp + newcontlistmartpi(i)=contlistmartpi(i) + newcontlistmartpj(i)=contlistmartpj(i) + enddo + endif + call int_bounds(g_ilist_martsc,g_listmartsc_start,g_listmartsc_end) + call int_bounds(g_ilist_martp,g_listmartp_start,g_listmartp_end) +! print *,"TUTU",g_listcatscang_start,g_listcatscang_end,i,j,g_ilist_catscangf,myrank + +#ifdef DEBUG + write (iout,*) "after MPIREDUCE",ilist_catsctran,ilist_catptran, & + ilist_catscnorm,ilist_catpnorm + + do i=1,g_ilist_catsctran + write (iout,*) i,newcontlistcatsctrani(i),newcontlistcatsctranj(i) + enddo + do i=1,g_ilist_catptran + write (iout,*) i,newcontlistcatptrani(i),newcontlistcatsctranj(i) + enddo + do i=1,g_ilist_catscnorm + write (iout,*) i,newcontlistcatscnormi(i),newcontlistcatscnormj(i) + enddo + do i=1,g_ilist_catpnorm + write (iout,*) i,newcontlistcatpnormi(i),newcontlistcatscnormj(i) + enddo + do i=1,g_ilist_catscang + write (iout,*) i,newcontlistcatscangi(i),newcontlistcatscangj(i) +#endif + return + end subroutine make_lip_pep_list + + + subroutine make_cat_cat_list + include 'mpif.h' + real(kind=8) :: xi,yi,zi,xj,yj,zj,xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp + real(kind=8) :: xmedj,ymedj,zmedj,sslipi,ssgradlipi,faclipij2,sslipj,ssgradlipj + real(kind=8) :: dist_init, dist_temp,r_buff_list,dxi,dyi,dzi,xmedi,ymedi,zmedi + real(kind=8) :: dx_normi,dy_normi,dz_normi,dxj,dyj,dzj,dx_normj,dy_normj,dz_normj + real(kind=8) :: xja,yja,zja + integer,dimension(:),allocatable:: contlistcatpnormi,contlistcatpnormj +! integer :: newcontlistppi(200*nres),newcontlistppj(200*nres) + integer i,j,itypi,itypj,subchap,xshift,yshift,zshift,iint,ilist_catscnorm,& + ilist_catsctran,ilist_catpnorm,ilist_catptran,itmp,ilist_catscang,& + ilist_catscangf,ilist_catscangt,k + integer displ(0:nprocs),i_ilist_catscnorm(0:nprocs),ierr,& + i_ilist_catpnorm(0:nprocs),i_ilist_catsctran(0:nprocs),& + i_ilist_catptran(0:nprocs),i_ilist_catscang(0:nprocs),& + i_ilist_catscangf(0:nprocs),i_ilist_catscangt(0:nprocs) +! write(iout,*),"START make_catcat" + ilist_catpnorm=0 + ilist_catscnorm=0 + ilist_catptran=0 + ilist_catsctran=0 + ilist_catscang=0 + + if (.not.allocated(contlistcatpnormi)) then + allocate(contlistcatpnormi(900*nres)) + allocate(contlistcatpnormj(900*nres)) + endif + r_buff_list=3.0 + itmp=0 + do i=1,4 + itmp=itmp+nres_molec(i) + enddo +! go to 17 +! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization + do i=icatb_start,icatb_end + xi=c(1,i) + yi=c(2,i) + zi=c(3,i) + call to_box(xi,yi,zi) + dxi=dc_norm(1,i) + dyi=dc_norm(2,i) + dzi=dc_norm(3,i) +! dsci_inv=vbld_inv(i+nres) + do j=i+1,itmp+nres_molec(5) + dxj=dc(1,j) + dyj=dc(2,j) + dzj=dc(3,j) + dx_normj=dc_norm(1,j) + dy_normj=dc_norm(2,j) + dz_normj=dc_norm(3,j) + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + call to_box(xj,yj,zj) +! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) +! faclipij2=(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0 + xja=boxshift(xj-xi,boxxsize) + yja=boxshift(yj-yi,boxysize) + zja=boxshift(zj-zi,boxzsize) + dist_init=xja**2+yja**2+zja**2 + if (sqrt(dist_init).le.(10.0+r_buff_list)) then +! Here the list is created +! if (i.eq.2) then +! print *,i,j,dist_init,ilist_catpnorm +! endif + ilist_catpnorm=ilist_catpnorm+1 + +! this can be substituted by cantor and anti-cantor + contlistcatpnormi(ilist_catpnorm)=i + contlistcatpnormj(ilist_catpnorm)=j + endif +! enddo + enddo + enddo +#ifdef DEBUG + write (iout,*) "before MPIREDUCE",ilist_catsctran,ilist_catptran,& + ilist_catscnorm,ilist_catpnorm,ilist_catscang + + do i=1,ilist_catpnorm + write (iout,*) i,contlistcatpnormi(i) + enddo + + +#endif + if (nfgtasks.gt.1)then + + call MPI_Reduce(ilist_catpnorm,g_ilist_catcatnorm,1,& + MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc + call MPI_Gather(ilist_catpnorm,1,MPI_INTEGER,& + i_ilist_catpnorm,1,MPI_INTEGER,king,FG_COMM,IERR) + displ(0)=0 + do i=1,nfgtasks-1,1 + displ(i)=i_ilist_catpnorm(i-1)+displ(i-1) + enddo +! write(iout,*) "before gather",displ(0),displ(1) + call MPI_Gatherv(contlistcatpnormi,ilist_catpnorm,MPI_INTEGER,& + newcontlistcatcatnormi,i_ilist_catpnorm,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Gatherv(contlistcatpnormj,ilist_catpnorm,MPI_INTEGER,& + newcontlistcatcatnormj,i_ilist_catpnorm,displ,MPI_INTEGER,& + king,FG_COMM,IERR) + call MPI_Bcast(g_ilist_catcatnorm,1,MPI_INT,king,FG_COMM,IERR) +! write(iout,*) "before bcast",g_ilist_sc +! call MPI_Bcast(g_ilist_sc,1,MPI_INT,king,FG_COMM) + call MPI_Bcast(newcontlistcatcatnormi,g_ilist_catcatnorm,MPI_INT,king,FG_COMM,IERR) + call MPI_Bcast(newcontlistcatcatnormj,g_ilist_catcatnorm,MPI_INT,king,FG_COMM,IERR) + + + else + g_ilist_catcatnorm=ilist_catpnorm + do i=1,ilist_catpnorm + newcontlistcatcatnormi(i)=contlistcatpnormi(i) + newcontlistcatcatnormj(i)=contlistcatpnormj(i) + enddo + endif + call int_bounds(g_ilist_catcatnorm,g_listcatcatnorm_start,g_listcatcatnorm_end) + +#ifdef DEBUG + write (iout,*) "after MPIREDUCE",g_ilist_catcatnorm + + do i=1,g_ilist_catcatnorm + write (iout,*) i,newcontlistcatcatnormi(i),newcontlistcatcatnormj(i) + enddo +#endif +! write(iout,*),"END make_catcat" + return + end subroutine make_cat_cat_list + + +!----------------------------------------------------------------------------- + double precision function boxshift(x,boxsize) + implicit none + double precision x,boxsize + double precision xtemp + xtemp=dmod(x,boxsize) + if (dabs(xtemp-boxsize).lt.dabs(xtemp)) then + boxshift=xtemp-boxsize + else if (dabs(xtemp+boxsize).lt.dabs(xtemp)) then + boxshift=xtemp+boxsize + else + boxshift=xtemp + endif + return + end function boxshift +!----------------------------------------------------------------------------- + subroutine to_box(xi,yi,zi) + implicit none +! include 'DIMENSIONS' +! include 'COMMON.CHAIN' + double precision xi,yi,zi + xi=dmod(xi,boxxsize) + if (xi.lt.0.0d0) xi=xi+boxxsize + yi=dmod(yi,boxysize) + if (yi.lt.0.0d0) yi=yi+boxysize + zi=dmod(zi,boxzsize) + if (zi.lt.0.0d0) zi=zi+boxzsize + return + end subroutine to_box +!-------------------------------------------------------------------------- + subroutine lipid_layer(xi,yi,zi,sslipi,ssgradlipi) + implicit none +! include 'DIMENSIONS' +! include 'COMMON.IOUNITS' +! include 'COMMON.CHAIN' + double precision xi,yi,zi,sslipi,ssgradlipi + double precision fracinbuf +! double precision sscalelip,sscagradlip +#ifdef DEBUG + write (iout,*) "bordlipbot",bordlipbot," bordliptop",bordliptop + write (iout,*) "buflipbot",buflipbot," lipbufthick",lipbufthick + write (iout,*) "xi yi zi",xi,yi,zi +#endif + if ((zi.gt.bordlipbot).and.(zi.lt.bordliptop)) then +! the energy transfer exist + if (zi.lt.buflipbot) then +! what fraction I am in + fracinbuf=1.0d0-((zi-bordlipbot)/lipbufthick) +! 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 +#ifdef DEBUG + write (iout,*) "sslipi",sslipi," ssgradlipi",ssgradlipi +#endif + return + end subroutine lipid_layer +!------------------------------------------------------------- + subroutine ecat_prot_transition(ecation_prottran) + integer:: itypi,itypj,ityptrani,ityptranj,k,l,i,j + real(kind=8),dimension(3):: cjtemp,citemp,diff,dsctemp,vecsc,& + diffnorm,boxx,r,dEvan1Cm,dEvan2Cm,dEtotalCm + real(kind=8):: ecation_prottran,dista,sdist,De,ene,x0left,& + alphac,grad,sumvec,simplesum,pom,erdxi,facd1,& + sss_ele_cut,sss_ele_cut_grad,sss2min,sss2mingrad,& + ene1,ene2,grad1,grad2,evan1,evan2,rcal,r4,r7,r0p,& + r06,r012,epscalc,rocal,ract + ecation_prottran=0.0d0 + boxx(1)=boxxsize + boxx(2)=boxysize + boxx(3)=boxzsize + write(iout,*) "start ecattran",g_listcatsctran_start,g_listcatsctran_end + do k=g_listcatsctran_start,g_listcatsctran_end + i=newcontlistcatsctrani(k) + j=newcontlistcatsctranj(k) +! print *,i,j,"in new tran" + do l=1,3 + citemp(l)=c(l,i+nres) + cjtemp(l)=c(l,j) + enddo + + itypi=itype(i,1) !as the first is the protein part + itypj=itype(j,5) !as the second part is always cation +! remapping to internal types +! read (iiontran,*,err=123,end=123) (agamacattran(k,j,i),k=1,3),& +! (athetacattran(k,j,i),k=1,6),acatshiftdsc(j,i),bcatshiftdsc(j,i),& +! demorsecat(j,i),alphamorsecat(j,i),x0catleft(j,i),x0catright(j,i),& +! x0cattrans(j,i) + + if (itypj.eq.6) then + ityptranj=1 !as now only Zn2+ is this needs to be modified for other ions + endif + if (itypi.eq.16) then + ityptrani=1 + elseif (itypi.eq.1) then + ityptrani=2 + elseif (itypi.eq.15) then + ityptrani=3 + elseif (itypi.eq.17) then + ityptrani=4 + elseif (itypi.eq.2) then + ityptrani=5 + else + ityptrani=6 + endif + + if (ityptrani.gt.ntrantyp(ityptranj)) then +! do l=1,3 +! write(iout,*),gradcattranc(l,j),gradcattranx(l,i) +! enddo +!volume excluded + call to_box(cjtemp(1),cjtemp(2),cjtemp(3)) + call to_box(citemp(1),citemp(2),citemp(3)) + rcal=0.0d0 + do l=1,3 + r(l)=boxshift(cjtemp(l)-citemp(l),boxx(l)) + rcal=rcal+r(l)*r(l) + enddo + ract=sqrt(rcal) + if (ract.gt.r_cut_ele) cycle + sss_ele_cut=sscale_ele(ract) + sss_ele_cut_grad=sscagrad_ele(ract) + 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 l=1,3 + dEvan1Cm(l) = 12*r(l)*epscalc*r012/r7 + dEvan2Cm(l) = 12*r(l)*epscalc*r06/r4 + enddo + do l=1,3 + dEtotalCm(l)=(dEvan1Cm(l)+dEvan2Cm(l))*sss_ele_cut-& + (Evan1+Evan2)*sss_ele_cut_grad*r(l)/ract + enddo + ecation_prottran = ecation_prottran+& + (Evan1+Evan2)*sss_ele_cut + do l=1,3 + gradcattranx(l,i)=gradcattranx(l,i)+dEtotalCm(l) + gradcattranc(l,i)=gradcattranc(l,i)+dEtotalCm(l) + gradcattranc(l,j)=gradcattranc(l,j)-dEtotalCm(l) + enddo + + ene=0.0d0 + else +! cycle + sumvec=0.0d0 + simplesum=0.0d0 + do l=1,3 + vecsc(l)=citemp(l)-c(l,i) + sumvec=sumvec+vecsc(l)**2 + simplesum=simplesum+vecsc(l) + enddo + sumvec=dsqrt(sumvec) + call to_box(cjtemp(1),cjtemp(2),cjtemp(3)) + call to_box(citemp(1),citemp(2),citemp(3)) +! sumvec=2.0d0 + do l=1,3 + dsctemp(l)=c(l,i+nres)& + +(acatshiftdsc(ityptrani,ityptranj)-1.0d0)*vecsc(l)& + +bcatshiftdsc(ityptrani,ityptranj)*vecsc(l)/sumvec + enddo + call to_box(dsctemp(1),dsctemp(2),dsctemp(3)) + sdist=0.0d0 + do l=1,3 + diff(l)=boxshift(dsctemp(l)-cjtemp(l),boxx(l)) + sdist=sdist+diff(l)*diff(l) + enddo + dista=sqrt(sdist) + if (dista.gt.r_cut_ele) cycle + + sss_ele_cut=sscale_ele(dista) + sss_ele_cut_grad=sscagrad_ele(dista) + sss2min=sscale2(dista,x0cattrans(ityptrani,ityptranj)-0.1d0,0.2d0) + De=demorsecat(ityptrani,ityptranj) + alphac=alphamorsecat(ityptrani,ityptranj) + if (sss2min.eq.1.0d0) then +! print *,"ityptrani",ityptrani,ityptranj + x0left=x0catleft(ityptrani,ityptranj) ! to mn + ene=sss_ele_cut*(-De+De*(1.0d0-dexp(-alphac*(dista-x0left)))**2) + grad=2.0d0*alphac*De*dexp(-alphac*(dista-x0left))*& + (1.0d0-dexp(-alphac*(dista-x0left)))*sss_ele_cut& + +ene/sss_ele_cut*sss_ele_cut_grad + else if (sss2min.eq.0.0d0) then + x0left=x0catright(ityptrani,ityptranj) + ene=sss_ele_cut*(-De+De*(1.0d0-dexp(-alphac*(dista-x0left)))**2) + grad=2.0d0*alphac*De*dexp(-alphac*(dista-x0left))*& + (1.0d0-dexp(-alphac*(dista-x0left)))*sss_ele_cut& + +ene/sss_ele_cut*sss_ele_cut_grad + else + sss2mingrad=sscagrad2(dista,x0cattrans(ityptrani,ityptranj)-0.1d0,0.2d0) + x0left=x0catleft(ityptrani,ityptranj) + ene1=sss_ele_cut*(-De+De*(1.0d0-dexp(-alphac*(dista-x0left)))**2) + grad1=2.0d0*alphac*De*dexp(-alphac*(dista-x0left))*& + (1.0d0-dexp(-alphac*(dista-x0left)))*sss_ele_cut& + +ene/sss_ele_cut*sss_ele_cut_grad + x0left=x0catright(ityptrani,ityptranj) + ene2=sss_ele_cut*(-De+De*(1.0d0-dexp(-alphac*(dista-x0left)))**2) + grad2=2.0d0*alphac*De*dexp(-alphac*(dista-x0left))*& + (1.0d0-dexp(-alphac*(dista-x0left)))*sss_ele_cut& + +ene/sss_ele_cut*sss_ele_cut_grad + ene=sss2min*ene1+(1.0d0-sss2min)*ene2 + grad=sss2min*grad1+(1.0d0-sss2min)*grad2+sss2mingrad*(ene1-ene2) + endif + do l=1,3 + diffnorm(l)= diff(l)/dista + enddo + erdxi=scalar(diffnorm(1),dc_norm(1,i+nres)) + facd1=bcatshiftdsc(ityptrani,ityptranj)/sumvec + + do l=1,3 +! 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) + pom=diffnorm(l)+facd1*(diffnorm(l)-erdxi*dc_norm(l,i+nres)) +! write(iout,*),gradcattranc(l,j),gradcattranx(l,i),grad*diff(l)/dista + + gradcattranx(l,i)=gradcattranx(l,i)+grad*pom& + +grad*diffnorm(l)*(acatshiftdsc(ityptrani,ityptranj)-1.0d0) +! *( bcatshiftdsc(ityptrani,ityptranj)*& +! (1.0d0/sumvec-(vecsc(l)*simplesum)*(sumvec**(-3.0d0)))) + gradcattranc(l,i)=gradcattranc(l,i)+grad*diff(l)/dista +! +sss_ele_cut_grad*ene*diff(l)/dista/sss_ele_cut + gradcattranc(l,j)=gradcattranc(l,j)-grad*diff(l)/dista +! -sss_ele_cut_grad*ene*diff(l)/dista/sss_ele_cut + enddo + ecation_prottran=ecation_prottran+ene + if (energy_dec) write(iout,*) "etrancat",i,j,ene,x0left,De,dista,& + alphac + endif + enddo +! do k=g_listcatptran_start,g_listcatptran_end +! ene=0.0d0 this will be used if peptide group interaction is needed +! enddo + + + return + end subroutine + subroutine ecat_prot_ang(ecation_protang) + integer:: itypi,itypj,ityptrani,ityptranj,k,l,i,j,n,m,& + ityptrani1,ityptranj1,ityptrani2,ityptranj2,& + i1,i2,j1,j2,k1,k2,k3,i3,j3,ityptrani3,ityptranj3 + + real(kind=8),dimension(3):: cjtemp,citemp,diff,dsctemp,vecsc,& + diffnorm,boxx,dscvec,dscvecnorm,diffnorm2,& + dscvec2,dscvecnorm2,cjtemp2,citemp2,diff2,dsctemp2,& + vecsc2,diff1,diffnorm1,diff3,mindiffnorm2 + real(kind=8),dimension(3):: dscvec1,dscvecnorm1,cjtemp1,citemp1,vecsc1,dsctemp1,& + dscvec3,dscvecnorm3,cjtemp3,citemp3,vecsc3,dsctemp3,& + diffnorm3,diff4,diffnorm4 + + real(kind=8):: ecation_protang,dista,sdist,De,ene,x0left,& + alphac,grad,sumvec,sumdscvec,pom,erdxi,facd1,& + sss_ele_cut,sss_ele_cut_grad,sss2min,sss2mingrad,& + simplesum,cosval,part1,part2a,part2,part2b,part3,& + part4a,part4b,part4,bottom,dista2,sdist2,sumvec2,& + sumdscvec2,simplesum2,dista1,sdist1,sumvec1,simplesum1,& + sumdscvec1,facd2,scal1a,scal1b,scal2a,scal2b,& + sss2mingrad1,sss2mingrad2,sss2min1,sss2min2,pom1,pom2,& + det1ij,det2ij,cosom1,cosom2,cosom12,cosphij,dista3,& + sumvec3 + real(kind=8):: sinom1,sinom2,sinaux,dephiij,sumdscvec3,sumscvec3,& + cosphi,sdist3,simplesum3,det1t2ij,sss2mingrad3,sss2min3,& + scal1c,scal2c,scal3a,scal3b,scal3c,facd3,facd2b,scal3d,& + scal3e,dista4,sdist4,pom3,sssmintot + + ecation_protang=0.0d0 + boxx(1)=boxxsize + boxx(2)=boxysize + boxx(3)=boxzsize +! print *,"KUR**3",g_listcatscang_start,g_listcatscang_end +! go to 19 +! go to 21 + do k=g_listcatscang_start,g_listcatscang_end + ene=0.0d0 + i=newcontlistcatscangi(k) + j=newcontlistcatscangj(k) + itypi=itype(i,1) !as the first is the protein part + itypj=itype(j,5) !as the second part is always cation +! print *,"KUR**4",i,j,itypi,itypj +! remapping to internal types +! read (iiontran,*,err=123,end=123) (agamacattran(k,j,i),k=1,3),& +! (athetacattran(k,j,i),k=1,6),acatshiftdsc(j,i),bcatshiftdsc(j,i),& +! demorsecat(j,i),alphamorsecat(j,i),x0catleft(j,i),x0catright(j,i),& +! x0cattrans(j,i) + if (itypj.eq.6) then + ityptranj=1 !as now only Zn2+ is this needs to be modified for other ions + endif + if (itypi.eq.16) then + ityptrani=1 + elseif (itypi.eq.1) then + ityptrani=2 + elseif (itypi.eq.15) then + ityptrani=3 + elseif (itypi.eq.17) then + ityptrani=4 + elseif (itypi.eq.2) then + ityptrani=5 + else + ityptrani=6 + endif + if (ityptrani.gt.ntrantyp(ityptranj)) cycle + do l=1,3 + citemp(l)=c(l,i+nres) + cjtemp(l)=c(l,j) + enddo + sumvec=0.0d0 + simplesum=0.0d0 + do l=1,3 + vecsc(l)=citemp(l)-c(l,i) + sumvec=sumvec+vecsc(l)**2 + simplesum=simplesum+vecsc(l) + enddo + sumvec=dsqrt(sumvec) + sumdscvec=0.0d0 + do l=1,3 + dsctemp(l)=c(l,i)& +! +1.0d0 + +(acatshiftdsc(ityptrani,ityptranj))*vecsc(l)& + +bcatshiftdsc(ityptrani,ityptranj)*vecsc(l)/sumvec + dscvec(l)= & +!1.0d0 + (acatshiftdsc(ityptrani,ityptranj))*vecsc(l)& + +bcatshiftdsc(ityptrani,ityptranj)*vecsc(l)/sumvec + sumdscvec=sumdscvec+dscvec(l)**2 + enddo + sumdscvec=dsqrt(sumdscvec) + do l=1,3 + dscvecnorm(l)=dscvec(l)/sumdscvec + enddo + call to_box(dsctemp(1),dsctemp(2),dsctemp(3)) + call to_box(cjtemp(1),cjtemp(2),cjtemp(3)) + sdist=0.0d0 + do l=1,3 + diff(l)=boxshift(dsctemp(l)-cjtemp(l),boxx(l)) + sdist=sdist+diff(l)*diff(l) + enddo + dista=sqrt(sdist) + do l=1,3 + diffnorm(l)= diff(l)/dista + enddo + cosval=scalar(diffnorm(1),dc_norm(1,i+nres)) + grad=0.0d0 + sss2min=sscale2(dista,r_cut_ang,1.0d0) + sss2mingrad=sscagrad2(dista,r_cut_ang,1.0d0) + ene=ene& + +tschebyshev(1,6,athetacattran(1,ityptrani,ityptranj),cosval) + grad=gradtschebyshev(0,5,athetacattran(1,ityptrani,ityptranj),cosval)*sss2min + + facd1=bcatshiftdsc(ityptrani,ityptranj)/sumvec + erdxi=scalar(diffnorm(1),dc_norm(1,i+nres)) + part1=0.0d0 + part2=0.0d0 + part3=0.0d0 + part4=0.0d0 + do l=1,3 + bottom=sumvec**2*sdist + part1=diff(l)*sumvec*dista + part2a=(acatshiftdsc(ityptrani,ityptranj))*vecsc(l) + part2b=0.0d0 + !bcatshiftdsc(ityptrani,ityptranj)/sumvec*& + !(vecsc(l)-cosval*dista*dc_norm(l,i+nres)) + part2=(part2a+part2b)*sumvec*dista + part3=cosval*sumvec*dista*dc_norm(l,i+nres)*dista + part4a=diff(l)*acatshiftdsc(ityptrani,ityptranj) + part4b=bcatshiftdsc(ityptrani,ityptranj)/sumvec*& + (diff(l)-cosval*dista*dc_norm(l,i+nres)) + part4=cosval*sumvec*(part4a+part4b)*sumvec +! gradlipang(m,l)=gradlipang(m,l)+(fac & +! *(xa(m)-scalar*vnorm*xb(m)/wnorm)& +! /(vnorm*wnorm)) + +! 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) + pom=diffnorm(l)+facd1*(diffnorm(l)-erdxi*dc_norm(l,i+nres)) + + gradcatangc(l,j)=gradcatangc(l,j)-grad*& + (dscvec(l)-cosval*diffnorm(l)*sumdscvec)/(sumdscvec*dista)-& + ene*sss2mingrad*diffnorm(l) + + gradcatangc(l,i)=gradcatangc(l,i)+grad*& + (dscvec(l)-cosval*diffnorm(l)*sumdscvec)/(sumdscvec*dista)+& + ene*sss2mingrad*diffnorm(l) + + gradcatangx(l,i)=gradcatangx(l,i)+grad*& + (part1+part2-part3-part4)/bottom+& + ene*sss2mingrad*pom+& + ene*sss2mingrad*diffnorm(l)*(acatshiftdsc(ityptrani,ityptranj)-1.0d0) +! +grad*(dscvec(l)-cosval*diffnorm(l)*sumdscvec)/(sumdscvec*dista)& +! +grad*pom+grad*diffnorm(l)*(acatshiftdsc(ityptrani,ityptranj)-1.0d0) +!& +! (diff(l)-cosval*dscvecnorm(l)*dista)/(sumdscvec*dista) + + + + + + enddo +! print *,i,j,cosval,tschebyshev(1,3,aomicattr(1,ityptranj),cosval)& +! ,aomicattr(0,ityptranj),ene + if (energy_dec) write(iout,*) i,j,ityptrani,ityptranj,ene,cosval + ecation_protang=ecation_protang+ene*sss2min + enddo + 19 continue +! print *,"KUR**",g_listcatscangf_start,g_listcatscangf_end + do k=g_listcatscangf_start,g_listcatscangf_end + ene=0.0d0 + i1=newcontlistcatscangfi(k) + j1=newcontlistcatscangfj(k) + itypi=itype(i1,1) !as the first is the protein part + itypj=itype(j1,5) !as the second part is always cation + if (itypj.eq.6) then + ityptranj1=1 !as now only Zn2+ is this needs to be modified for other ions + endif + if (itypi.eq.16) then + ityptrani1=1 + elseif (itypi.eq.1) then + ityptrani1=2 + elseif (itypi.eq.15) then + ityptrani1=3 + elseif (itypi.eq.17) then + ityptrani1=4 + elseif (itypi.eq.2) then + ityptrani1=5 + else + ityptrani1=6 + endif + do l=1,3 + citemp1(l)=c(l,i1+nres) + cjtemp1(l)=c(l,j1) + enddo + sumvec1=0.0d0 + simplesum1=0.0d0 + do l=1,3 + vecsc1(l)=citemp1(l)-c(l,i1) + sumvec1=sumvec1+vecsc1(l)**2 + simplesum1=simplesum1+vecsc1(l) + enddo + sumvec1=dsqrt(sumvec1) + sumdscvec1=0.0d0 + do l=1,3 + dsctemp1(l)=c(l,i1)& +! +1.0d0 + +(acatshiftdsc(ityptrani1,ityptranj1))*vecsc1(l)& + +bcatshiftdsc(ityptrani1,ityptranj1)*vecsc1(l)/sumvec1 + dscvec1(l)= & +!1.0d0 + (acatshiftdsc(ityptrani1,ityptranj1))*vecsc1(l)& + +bcatshiftdsc(ityptrani1,ityptranj1)*vecsc1(l)/sumvec1 + sumdscvec1=sumdscvec1+dscvec1(l)**2 + enddo + sumdscvec1=dsqrt(sumdscvec1) + do l=1,3 + dscvecnorm1(l)=dscvec1(l)/sumdscvec1 + enddo + call to_box(dsctemp1(1),dsctemp1(2),dsctemp1(3)) + call to_box(cjtemp1(1),cjtemp1(2),cjtemp1(3)) + sdist1=0.0d0 + do l=1,3 + diff1(l)=boxshift(dsctemp1(l)-cjtemp1(l),boxx(l)) + sdist1=sdist1+diff1(l)*diff1(l) + enddo + dista1=sqrt(sdist1) + do l=1,3 + diffnorm1(l)= diff1(l)/dista1 + enddo + sss2min1=sscale2(dista1,r_cut_ang,1.0d0) + sss2mingrad1=sscagrad2(dista1,r_cut_ang,1.0d0) + if (ityptrani1.gt.ntrantyp(ityptranj1)) cycle + +!----------------------------------------------------------------- +! do m=k+1,g_listcatscang_end + ene=0.0d0 + i2=newcontlistcatscangfk(k) + j2=j1 + if (j1.ne.j2) cycle + itypi=itype(i2,1) !as the first is the protein part + itypj=itype(j2,5) !as the second part is always cation + if (itypj.eq.6) then + ityptranj2=1 !as now only Zn2+ is this needs to be modified for other ions + endif + if (itypi.eq.16) then + ityptrani2=1 + elseif (itypi.eq.1) then + ityptrani2=2 + elseif (itypi.eq.15) then + ityptrani2=3 + elseif (itypi.eq.17) then + ityptrani2=4 + elseif (itypi.eq.2) then + ityptrani2=5 + else + ityptrani2=6 + endif + if (ityptrani2.gt.ntrantyp(ityptranj2)) cycle + + do l=1,3 + citemp2(l)=c(l,i2+nres) + cjtemp2(l)=c(l,j2) + enddo + sumvec2=0.0d0 + simplesum2=0.0d0 + do l=1,3 + vecsc2(l)=citemp2(l)-c(l,i2) + sumvec2=sumvec2+vecsc2(l)**2 + simplesum2=simplesum2+vecsc2(l) + enddo + sumvec2=dsqrt(sumvec2) + sumdscvec2=0.0d0 + do l=1,3 + dsctemp2(l)=c(l,i2)& +! +1.0d0 + +(acatshiftdsc(ityptrani2,ityptranj2))*vecsc2(l)& + +bcatshiftdsc(ityptrani2,ityptranj2)*vecsc2(l)/sumvec2 + dscvec2(l)= & +!1.0d0 + (acatshiftdsc(ityptrani2,ityptranj2))*vecsc2(l)& + +bcatshiftdsc(ityptrani2,ityptranj2)*vecsc2(l)/sumvec2 + sumdscvec2=sumdscvec2+dscvec2(l)**2 + enddo + sumdscvec2=dsqrt(sumdscvec2) + do l=1,3 + dscvecnorm2(l)=dscvec2(l)/sumdscvec2 + enddo + call to_box(dsctemp2(1),dsctemp2(2),dsctemp2(3)) + call to_box(cjtemp2(1),cjtemp2(2),cjtemp2(3)) + sdist2=0.0d0 + do l=1,3 + diff2(l)=boxshift(dsctemp2(l)-cjtemp2(l),boxx(l)) +! diff2(l)=1.0d0 + sdist2=sdist2+diff2(l)*diff2(l) + enddo + dista2=sqrt(sdist2) + do l=1,3 + diffnorm2(l)= diff2(l)/dista2 + enddo +! print *,i1,i2,diffnorm2(1) + cosval=scalar(diffnorm1(1),diffnorm2(1)) + grad=0.0d0 + sss2min2=sscale2(dista2,r_cut_ang,1.0d0) + sss2mingrad2=sscagrad2(dista2,r_cut_ang,1.0d0) + ene=ene+tschebyshev(1,3,aomicattr(1,ityptranj1),cosval) + grad=gradtschebyshev(0,2,aomicattr(1,ityptranj1),cosval)*sss2min2*sss2min1 + part1=0.0d0 + part2=0.0d0 + part3=0.0d0 + part4=0.0d0 + ecation_protang=ecation_protang+ene*sss2min2*sss2min1 + facd1=bcatshiftdsc(ityptrani1,ityptranj1)/sumvec1 + facd2=bcatshiftdsc(ityptrani2,ityptranj2)/sumvec2 + scal1a=scalar(diffnorm1(1),dc_norm(1,i1+nres)) + scal1b=scalar(diffnorm2(1),dc_norm(1,i1+nres)) + scal2a=scalar(diffnorm1(1),dc_norm(1,i2+nres)) + scal2b=scalar(diffnorm2(1),dc_norm(1,i2+nres)) + + if (energy_dec) write(iout,*) "omi", i,j,ityptrani,ityptranj,ene,cosval,aomicattr(1,ityptranj1),& + aomicattr(2,ityptranj1),aomicattr(3,ityptranj1),tschebyshev(1,3,aomicattr(1,ityptranj1),cosval) + +!*sss2min + do l=1,3 + pom1=diffnorm1(l)+facd1*(diffnorm1(l)-scal1a*dc_norm(l,i1+nres)) + pom2=diffnorm2(l)+facd2*(diffnorm2(l)-scal2b*dc_norm(l,i2+nres)) + + + gradcatangc(l,i1)=gradcatangc(l,i1)+grad*(diff2(l)-& + cosval*diffnorm1(l)*dista2)/(dista2*dista1)+& + ene*sss2mingrad1*diffnorm1(l)*sss2min2 + + + gradcatangx(l,i1)=gradcatangx(l,i1)+grad/(dista2*dista1)*& + (acatshiftdsc(ityptrani1,ityptranj1)*diff2(l)+& + facd1*(diff2(l)-scal1b*dc_norm(l,i1+nres)*dista2)-& + cosval*dista2/dista1*& + (acatshiftdsc(ityptrani1,ityptranj1)*diff1(l)+& + facd1*(diff1(l)-scal1a*dc_norm(l,i1+nres)*dista1)))+& + ene*sss2mingrad1*sss2min2*(pom1+& + diffnorm1(l)*(acatshiftdsc(ityptrani1,ityptranj1)-1.0d0)) + + + gradcatangx(l,i2)=gradcatangx(l,i2)+grad/(dista2*dista1)*& + (acatshiftdsc(ityptrani2,ityptranj2)*diff1(l)+& + facd2*(diff1(l)-scal2a*dc_norm(l,i2+nres)*dista1)-& + cosval*dista1/dista2*& + (acatshiftdsc(ityptrani2,ityptranj2)*diff2(l)+& + facd2*(diff2(l)-scal2b*dc_norm(l,i2+nres)*dista2)))+& + ene*sss2mingrad2*sss2min1*(pom2+& + diffnorm2(l)*(acatshiftdsc(ityptrani2,ityptranj2)-1.0d0)) + + + gradcatangx(l,i2)=gradcatangx(l,i2) + gradcatangc(l,i2)=gradcatangc(l,i2)+grad*(diff1(l)-& + cosval*diffnorm2(l)*dista1)/(dista2*dista1)+& + ene*sss2mingrad2*diffnorm2(l)*sss2min1 + + gradcatangc(l,j2)=gradcatangc(l,j2)-grad*(diff2(l)/dista2/dista1-& + cosval*diff1(l)/dista1/dista1+diff1(l)/dista2/dista1-& + cosval*diff2(l)/dista2/dista2)-& + ene*sss2mingrad1*diffnorm1(l)*sss2min2-& + ene*sss2mingrad2*diffnorm2(l)*sss2min1 + + + enddo + + enddo +! enddo +!#ifdef DUBUG + 21 continue +! do k1=g_listcatscang_start,g_listcatscang_end +! print *,"KURNA",g_listcatscangt_start,g_listcatscangt_end + do k1=g_listcatscangt_start,g_listcatscangt_end + i1=newcontlistcatscangti(k1) + j1=newcontlistcatscangtj(k1) + itypi=itype(i1,1) !as the first is the protein part + itypj=itype(j1,5) !as the second part is always cation + if (itypj.eq.6) then + ityptranj1=1 !as now only Zn2+ is this needs to be modified for other ions + endif + if (itypi.eq.16) then + ityptrani1=1 + elseif (itypi.eq.1) then + ityptrani1=2 + elseif (itypi.eq.15) then + ityptrani1=3 + elseif (itypi.eq.17) then + ityptrani1=4 + elseif (itypi.eq.2) then + ityptrani1=5 + else + ityptrani1=6 + endif + do l=1,3 + citemp1(l)=c(l,i1+nres) + cjtemp1(l)=c(l,j1) + enddo + sumvec1=0.0d0 + simplesum1=0.0d0 + do l=1,3 + vecsc1(l)=citemp1(l)-c(l,i1) + sumvec1=sumvec1+vecsc1(l)**2 + simplesum1=simplesum1+vecsc1(l) + enddo + sumvec1=dsqrt(sumvec1) + sumdscvec1=0.0d0 + do l=1,3 + dsctemp1(l)=c(l,i1)& + +(acatshiftdsc(ityptrani1,ityptranj1))*vecsc1(l)& + +bcatshiftdsc(ityptrani1,ityptranj1)*vecsc1(l)/sumvec1 + dscvec1(l)= & + (acatshiftdsc(ityptrani1,ityptranj1))*vecsc1(l)& + +bcatshiftdsc(ityptrani1,ityptranj1)*vecsc1(l)/sumvec1 + sumdscvec1=sumdscvec1+dscvec1(l)**2 + enddo + sumdscvec1=dsqrt(sumdscvec1) + do l=1,3 + dscvecnorm1(l)=dscvec1(l)/sumdscvec1 + enddo + call to_box(dsctemp1(1),dsctemp1(2),dsctemp1(3)) + call to_box(cjtemp1(1),cjtemp1(2),cjtemp1(3)) + sdist1=0.0d0 + do l=1,3 + diff1(l)=boxshift(dsctemp1(l)-cjtemp1(l),boxx(l)) + sdist1=sdist1+diff1(l)*diff1(l) + enddo + dista1=sqrt(sdist1) + do l=1,3 + diffnorm1(l)= diff1(l)/dista1 + enddo + sss2min1=sscale2(dista1,r_cut_ang,1.0d0) + sss2mingrad1=sscagrad2(dista1,r_cut_ang,1.0d0) + if (ityptrani1.gt.ntrantyp(ityptranj1)) cycle +!---------------before second loop +! do k2=k1+1,g_listcatscang_end + i2=newcontlistcatscangtk(k1) + j2=j1 +! print *,"TUTU3",i1,i2,j1,j2 + if (i2.eq.i1) cycle + if (j2.ne.j1) cycle + itypi=itype(i2,1) !as the first is the protein part + itypj=itype(j2,5) !as the second part is always cation + if (itypj.eq.6) then + ityptranj2=1 !as now only Zn2+ is this needs to be modified for other ions + endif + if (itypi.eq.16) then + ityptrani2=1 + elseif (itypi.eq.1) then + ityptrani2=2 + elseif (itypi.eq.15) then + ityptrani2=3 + elseif (itypi.eq.17) then + ityptrani2=4 + elseif (itypi.eq.2) then + ityptrani2=5 + else + ityptrani2=6 + endif + if (ityptrani2.gt.ntrantyp(ityptranj2)) cycle + do l=1,3 + citemp2(l)=c(l,i2+nres) + cjtemp2(l)=c(l,j2) + enddo + sumvec2=0.0d0 + simplesum2=0.0d0 + do l=1,3 + vecsc2(l)=citemp2(l)-c(l,i2) + sumvec2=sumvec2+vecsc2(l)**2 + simplesum2=simplesum2+vecsc2(l) + enddo + sumvec2=dsqrt(sumvec2) + sumdscvec2=0.0d0 + do l=1,3 + dsctemp2(l)=c(l,i2)& + +(acatshiftdsc(ityptrani2,ityptranj2))*vecsc2(l)& + +bcatshiftdsc(ityptrani2,ityptranj2)*vecsc2(l)/sumvec2 + dscvec2(l)= & + (acatshiftdsc(ityptrani2,ityptranj2))*vecsc2(l)& + +bcatshiftdsc(ityptrani2,ityptranj2)*vecsc2(l)/sumvec2 + sumdscvec2=sumdscvec2+dscvec2(l)**2 + enddo + sumdscvec2=dsqrt(sumdscvec2) + do l=1,3 + dscvecnorm2(l)=dscvec2(l)/sumdscvec2 + enddo + call to_box(dsctemp2(1),dsctemp2(2),dsctemp2(3)) + call to_box(cjtemp2(1),cjtemp2(2),cjtemp2(3)) + sdist2=0.0d0 + do l=1,3 + diff2(l)=boxshift(dsctemp2(l)-cjtemp2(l),boxx(l)) +! diff2(l)=1.0d0 + sdist2=sdist2+diff2(l)*diff2(l) + enddo + dista2=sqrt(sdist2) + do l=1,3 + diffnorm2(l)= diff2(l)/dista2 + mindiffnorm2(l)=-diffnorm2(l) + enddo +! print *,i1,i2,diffnorm2(1) + cosom1=scalar(diffnorm1(1),diffnorm2(1)) + sss2min2=sscale2(dista2,r_cut_ang,1.0d0) + sss2mingrad2=sscagrad2(dista2,r_cut_ang,1.0d0) + +!---------------- before third loop +! do k3=g_listcatscang_start,g_listcatscang_end + ene=0.0d0 + i3=newcontlistcatscangtl(k1) + j3=j1 +! print *,"TUTU4",i1,i2,i3,j1,j2,j3 + + if (i3.eq.i2) cycle + if (i3.eq.i1) cycle + if (j3.ne.j1) cycle + itypi=itype(i3,1) !as the first is the protein part + itypj=itype(j3,5) !as the second part is always cation + if (itypj.eq.6) then + ityptranj3=1 !as now only Zn2+ is this needs to be modified for other ions + endif + if (itypi.eq.16) then + ityptrani3=1 + elseif (itypi.eq.1) then + ityptrani3=2 + elseif (itypi.eq.15) then + ityptrani3=3 + elseif (itypi.eq.17) then + ityptrani3=4 + elseif (itypi.eq.2) then + ityptrani3=5 + else + ityptrani3=6 + endif + if (ityptrani3.gt.ntrantyp(ityptranj3)) cycle + do l=1,3 + citemp3(l)=c(l,i3+nres) + cjtemp3(l)=c(l,j3) + enddo + sumvec3=0.0d0 + simplesum3=0.0d0 + do l=1,3 + vecsc3(l)=citemp3(l)-c(l,i3) + sumvec3=sumvec3+vecsc3(l)**2 + simplesum3=simplesum3+vecsc3(l) + enddo + sumvec3=dsqrt(sumvec3) + sumdscvec3=0.0d0 + do l=1,3 + dsctemp3(l)=c(l,i3)& + +(acatshiftdsc(ityptrani3,ityptranj3))*vecsc3(l)& + +bcatshiftdsc(ityptrani3,ityptranj3)*vecsc3(l)/sumvec3 + dscvec3(l)= & + (acatshiftdsc(ityptrani3,ityptranj3))*vecsc3(l)& + +bcatshiftdsc(ityptrani3,ityptranj3)*vecsc3(l)/sumvec3 + sumdscvec3=sumdscvec3+dscvec3(l)**2 + enddo + sumdscvec3=dsqrt(sumdscvec3) + do l=1,3 + dscvecnorm3(l)=dscvec3(l)/sumdscvec3 + enddo + call to_box(dsctemp3(1),dsctemp3(2),dsctemp3(3)) + call to_box(cjtemp3(1),cjtemp3(2),cjtemp3(3)) + sdist3=0.0d0 + do l=1,3 + diff3(l)=boxshift(dsctemp3(l)-dsctemp2(l),boxx(l)) + sdist3=sdist3+diff3(l)*diff3(l) + enddo + dista3=sqrt(sdist3) + do l=1,3 + diffnorm3(l)= diff3(l)/dista3 + enddo + sdist4=0.0d0 + do l=1,3 + diff4(l)=boxshift(dsctemp3(l)-cjtemp2(l),boxx(l)) +! diff2(l)=1.0d0 + sdist4=sdist4+diff4(l)*diff4(l) + enddo + dista4=sqrt(sdist4) + do l=1,3 + diffnorm4(l)= diff4(l)/dista4 + enddo + + sss2min3=sscale2(dista4,r_cut_ang,1.0d0) + sss2mingrad3=sscagrad2(dista4,r_cut_ang,1.0d0) + sssmintot=sss2min3*sss2min2*sss2min1 + if (ityptrani3.gt.ntrantyp(ityptranj3)) cycle + cosom12=scalar(diffnorm3(1),diffnorm1(1)) + cosom2=scalar(diffnorm3(1),mindiffnorm2(1)) + sinom1=dsqrt(1.0d0-cosom1*cosom1) + sinom2=dsqrt(1.0d0-cosom2*cosom2) + cosphi=cosom12-cosom1*cosom2 + sinaux=sinom1*sinom2 + ene=ene+mytschebyshev(1,3,agamacattran(1,ityptrani2,ityptranj2),cosphi,sinaux) + call mygradtschebyshev(1,3,agamacattran(1,ityptrani2,ityptranj2)& + ,cosphi,sinaux,dephiij,det1t2ij) + + det1ij=-det1t2ij*sinom2*cosom1/sinom1-dephiij*cosom2 + det2ij=-det1t2ij*sinom1*cosom2/sinom2-dephiij*cosom1 + facd1=bcatshiftdsc(ityptrani1,ityptranj1)/sumvec1 + facd2=bcatshiftdsc(ityptrani2,ityptranj2)/sumvec2 +! facd2b=bcatshiftdsc(ityptrani2,ityptranj2)/sumvec3 + facd3=bcatshiftdsc(ityptrani3,ityptranj3)/sumvec3 + scal1a=scalar(diffnorm1(1),dc_norm(1,i1+nres)) + scal1b=scalar(diffnorm2(1),dc_norm(1,i1+nres)) + scal1c=scalar(diffnorm3(1),dc_norm(1,i1+nres)) + scal2a=scalar(diffnorm1(1),dc_norm(1,i2+nres)) + scal2b=scalar(diffnorm2(1),dc_norm(1,i2+nres)) + scal2c=scalar(diffnorm3(1),dc_norm(1,i2+nres)) + scal3a=scalar(diffnorm1(1),dc_norm(1,i3+nres)) + scal3b=scalar(mindiffnorm2(1),dc_norm(1,i3+nres)) + scal3d=scalar(diffnorm2(1),dc_norm(1,i3+nres)) + scal3c=scalar(diffnorm3(1),dc_norm(1,i3+nres)) + scal3e=scalar(diffnorm4(1),dc_norm(1,i3+nres)) + + + do l=1,3 + pom1=diffnorm1(l)+facd1*(diffnorm1(l)-scal1a*dc_norm(l,i1+nres)) + pom2=diffnorm2(l)+facd2*(diffnorm2(l)-scal2b*dc_norm(l,i2+nres)) + pom3=diffnorm4(l)+facd3*(diffnorm4(l)-scal3e*dc_norm(l,i3+nres)) + + gradcatangc(l,i1)=gradcatangc(l,i1)& + +det1ij*sssmintot*(diff2(l)-diffnorm1(l)*cosom1*dista2)/(dista2*dista1)+& + dephiij*sssmintot*(diff3(l)-diffnorm1(l)*cosom12*dista3)/(dista3*dista1)& + +ene*sss2mingrad1*diffnorm1(l)*sss2min2*sss2min3 + + + gradcatangc(l,i2)=gradcatangc(l,i2)+(& + det1ij*(diff1(l)-diffnorm2(l)*cosom1*dista1)/(dista2*dista1)+& + det2ij*(-diff3(l)+mindiffnorm2(l)*cosom2*dista3)/(dista3*dista2)& + -det2ij*(-diff2(l)-diffnorm3(l)*cosom2*dista2)/(dista3*dista2)& + -dephiij*(diff1(l)-diffnorm3(l)*cosom12*dista1)/(dista3*dista1))*sssmintot& + +ene*sss2mingrad2*diffnorm2(l)*sss2min1*sss2min3 + + + + gradcatangc(l,i3)=gradcatangc(l,i3)& + +det2ij*(-diff2(l)-diffnorm3(l)*cosom2*dista2)/(dista3*dista2)*sssmintot& + +dephiij*(diff1(l)-diffnorm3(l)*cosom12*dista1)/(dista3*dista1)*sssmintot& + +ene*sss2mingrad3*diffnorm4(l)*sss2min1*sss2min2 + + + gradcatangc(l,j1)=gradcatangc(l,j1)-& + sssmintot*(det1ij*(diff2(l)-diffnorm1(l)*cosom1*dista2)/(dista2*dista1)+& + dephiij*(diff3(l)-diffnorm1(l)*cosom12*dista3)/(dista3*dista1))& + -(det1ij*(diff1(l)-diffnorm2(l)*cosom1*dista1)/(dista1*dista2)+& + det2ij*(-diff3(l)+mindiffnorm2(l)*cosom2*dista3)/(dista3*dista2))*sssmintot& + -ene*sss2mingrad1*diffnorm1(l)*sss2min2*sss2min3& + -ene*sss2mingrad2*diffnorm2(l)*sss2min1*sss2min3& + -ene*sss2mingrad3*diffnorm4(l)*sss2min1*sss2min2 + + + gradcatangx(l,i1)=gradcatangx(l,i1)+(det1ij/(dista2*dista1)*& + (acatshiftdsc(ityptrani1,ityptranj1)*diff2(l)+& + facd1*(diff2(l)-scal1b*dc_norm(l,i1+nres)*dista2)-& + cosom1*dista2/dista1*& + (acatshiftdsc(ityptrani1,ityptranj1)*diff1(l)+& + facd1*(diff1(l)-scal1a*dc_norm(l,i1+nres)*dista1)))& + +dephiij/(dista3*dista1)*& + (acatshiftdsc(ityptrani1,ityptranj1)*diff3(l)+& + facd1*(diff3(l)-scal1c*dc_norm(l,i1+nres)*dista3)-& + cosom12*dista3/dista1*& + (acatshiftdsc(ityptrani1,ityptranj1)*diff1(l)+& + facd1*(diff1(l)-scal1a*dc_norm(l,i1+nres)*dista1))))*sssmintot& + +ene*sss2mingrad1*sss2min2*sss2min3*(pom1+& + diffnorm1(l)*(acatshiftdsc(ityptrani1,ityptranj1)-1.0d0)) + + + gradcatangx(l,i3)=gradcatangx(l,i3)+(& + det2ij/(dista3*dista2)*& + (acatshiftdsc(ityptrani3,ityptranj3)*(-diff2(l))+& + facd3*(-diff2(l)-scal3b*dc_norm(l,i3+nres)*dista2)-& + cosom2*dista2/dista3*& + (acatshiftdsc(ityptrani3,ityptranj3)*diff3(l)+& + facd3*(diff3(l)-scal3c*dc_norm(l,i3+nres)*dista3)))& + +dephiij/(dista3*dista1)*& + (acatshiftdsc(ityptrani3,ityptranj3)*diff1(l)+& + facd3*(diff1(l)-scal3a*dc_norm(l,i3+nres)*dista1)-& + cosom12*dista1/dista3*& + (acatshiftdsc(ityptrani3,ityptranj3)*diff3(l)+& + facd3*(diff3(l)-scal3c*dc_norm(l,i3+nres)*dista3))))*sssmintot& + +ene*sss2mingrad3*sss2min2*sss2min1*(pom3+& + diffnorm4(l)*(acatshiftdsc(ityptrani3,ityptranj3)-1.0d0)) + + + gradcatangx(l,i2)=gradcatangx(l,i2)+(&! + det1ij/(dista2*dista1)*&! + (acatshiftdsc(ityptrani2,ityptranj2)*diff1(l)&! + +facd2*(diff1(l)-scal2a*dc_norm(l,i2+nres)*dista1)& + -cosom1*dista1/dista2*&! + (acatshiftdsc(ityptrani2,ityptranj2)*diff2(l)+&! + facd2*(diff2(l)-scal2b*dc_norm(l,i2+nres)*dista2)))+& + det2ij/(dista3*dista2)*&! + (acatshiftdsc(ityptrani2,ityptranj2)*diff2(l)+&! + facd2*(diff2(l)-scal2b*dc_norm(l,i2+nres)*dista2)& + -(acatshiftdsc(ityptrani2,ityptranj2)*diff3(l)+&! + facd2*(diff3(l)-scal2c*dc_norm(l,i2+nres)*dista3))& + -cosom2*dista3/dista2*&! + (acatshiftdsc(ityptrani2,ityptranj2)*diff2(l)+&! + facd2*(diff2(l)-scal2b*dc_norm(l,i2+nres)*dista2))& + +cosom2*dista2/dista3*&! + (acatshiftdsc(ityptrani2,ityptranj2)*diff3(l)+&! + facd2*(diff3(l)-scal2c*dc_norm(l,i2+nres)*dista3)))& + +dephiij/(dista3*dista1)*&! + (-(acatshiftdsc(ityptrani2,ityptranj2)*diff1(l)+&! + facd2*(diff1(l)-scal2a*dc_norm(l,i2+nres)*dista1))+& + cosom12*dista1/dista3*&! + (acatshiftdsc(ityptrani2,ityptranj2)*diff3(l)+&! + facd2*(diff3(l)-scal2c*dc_norm(l,i2+nres)*dista3))))*sssmintot& + +ene*sss2mingrad2*sss2min3*sss2min1*(pom2+& + diffnorm2(l)*(acatshiftdsc(ityptrani2,ityptranj2)-1.0d0)) + + + enddo +! print *,i1,i2,i3,j1,j2,j3,"tors",ene,sinaux,cosphi +! print *,"param",agamacattran(1,ityptrani2,ityptranj2),ityptranj2,ityptrani2 + ecation_protang=ecation_protang+ene*sssmintot + enddo +! enddo +! enddo +!#endif + return + end subroutine +!-------------------------------------------------------------------------- +!c------------------------------------------------------------------------------ + double precision function mytschebyshev(m,n,x,y,yt) + implicit none + integer i,m,n + double precision x(n),y,yt,yy(0:100),aux +!c Tschebyshev polynomial in y multiplied by sin(t1)sin(t2) (yt). +!c Note that the first term is omitted +!c m=0: the constant term is included +!c m=1: the constant term is not included + yy(0)=1.0d0 + yy(1)=y + do i=2,n + yy(i)=2*yy(1)*yy(i-1)-yy(i-2)*yt*yt + enddo + aux=0.0d0 + do i=m,n + aux=aux+x(i)*yy(i) + enddo +!c print *,(yy(i),i=1,n) + mytschebyshev=aux + return + end function +!C-------------------------------------------------------------------------- +!C-------------------------------------------------------------------------- + subroutine mygradtschebyshev(m,n,x,y,yt,fy,fyt) + implicit none + integer i,m,n + double precision x(n+1),y,yt,fy,fyt,yy(0:100),yb(0:100), & + ybt(0:100) +!c Derivative of Tschebyshev polynomial in y multiplied by sin(t1)sin(t2) (yt). +!c Note that the first term is omitted +!c m=0: the constant term is included +!c m=1: the constant term is not included + yy(0)=1.0d0 + yy(1)=y + yb(0)=0.0d0 + yb(1)=1.0d0 + ybt(0)=0.0d0 + ybt(1)=0.0d0 + do i=2,n + yy(i)=2*yy(1)*yy(i-1)-yy(i-2)*yt*yt + yb(i)=2*yy(i-1)+2*yy(1)*yb(i-1)-yb(i-2)*yt*yt + ybt(i)=2*yy(1)*ybt(i-1)-ybt(i-2)*yt*yt-2*yy(i-2)*yt + enddo + fy=0.0d0 + fyt=0.0d0 + do i=m,n + fy=fy+x(i)*yb(i) + fyt=fyt+x(i)*ybt(i) + enddo + return + end subroutine + subroutine fodstep(nsteps) + use geometry_data, only: c, nres, theta, alph + use geometry, only:alpha,beta,dist + integer, intent(in) :: nsteps + integer idxtomod, j, i + double precision RD0, RD1, fi +! double precision alpha +! double precision beta +! double precision dist +! double precision compute_RD + double precision TT + real :: r21(5) +!c ! Założenia: dla łańcucha zapisanego w tablicy c zawierającego +!c ! nres elementów CA i CB da się wyznaczyć kąty płaskie +!c ! theta (procedura Alpha) i kąty torsyjne (procedura beta), +!c ! zapisywane w tablicach theta i alph. +!c ! Na podstawie danych z tych tablic da się odtworzyć +!c ! strukturę 3D łańcucha procedurą chainbuild. +!c ! +! print *,"fodstep: nres=",nres + RD0 = compute_RD() +! print *, "RD0before step: ",RD0 + do j=1,nsteps +!c ! Wyznaczenie kątów theta na podstawie struktury +!c ! zapisanej w tablicy c + do i=3,nres + TT=alpha(i-2,i-1,i) + theta(i)=TT +!c print *,"TT=",TT + end do +!c ! Wyznaczenie kątów phi na podstawie struktury +!c ! zapisanej w tablicy c + do i=4,nres + phi(i)=beta(i-3,i-2,i-1,i) + end do +!c ! Wyznaczenie odległości między atomami +!c ! vbld(i)=dist(i-1,i) + do i=2,nres + vbld(i)=dist(i-1,i) + end do +!c ! losujemy kilka liczb + call random_number(r21) +!c ! r21(1): indeks pozycji do zmiany +!c ! r21(2): kąt (r21(2)/20.0-1/40.0) +!c ! r21(3): wybór tablicy + RD0 = compute_RD() +!c print *, "RD before step: ",RD0 + fi = (r21(2)/20.0-1.0/40.0) ! o tyle radianów zmienimy losowy kąt + if (r21(3) .le. 0.5) then + idxtomod = 3+r21(1)*(nres - 2) + theta(idxtomod) = theta(idxtomod)+fi +! print *,"Zmiana kąta theta(",& +! idxtomod,") o fi = ",fi + else + idxtomod = 4+r21(1)*(nres - 3) + phi(idxtomod) = phi(idxtomod)+fi +! print *,"Zmiana kąta phi(",& +! idxtomod,") o fi = ",fi + end if +!c ! odtwarzamy łańcuch + call chainbuild +!c ! czy coś się polepszyło? + RD1 = compute_RD() + if (RD1 .gt. RD0) then ! nie, wycofujemy zmianę +! print *, "RD after step: ",RD1," rejected" + if (r21(3) .le. 0.5) then + theta(idxtomod) = theta(idxtomod)-fi + else + phi(idxtomod) = phi(idxtomod)-fi + end if + call chainbuild ! odtworzenie pierwotnej wersji (bez zmienionego kąta) + else +! print *, "RD after step: ",RD1," accepted" + continue + end if + end do + end subroutine +!c----------------------------------------------------------------------------------------- + subroutine orientation_matrix(res) ! obliczenie macierzy oraz przygotowanie ea z tymi przeksztalceniami + use geometry_data, only: c, nres + use energy_data, only: itype + double precision, intent(out) :: res(4,4) + double precision resM(4,4) + double precision M(4,4) + double precision M2(4,4) + integer i, j, maxi, maxj +! double precision sq + double precision maxd, dd + double precision v1(3) + double precision v2(3) + double precision vecnea(3) + double precision mean_ea(3) + double precision fi +!c ! liczymy atomy efektywne i zapisujemy w tablicy ea + do i=1,nres +!c if (itype(i,1) .ne. 10) then + if (itype(i,1) .ne. 10) then + ea(1,i) = c(1,i+nres) + ea(2,i) = c(2,i+nres) + ea(3,i) = c(3,i+nres) + else + ea(1,i) = c(1,i) + ea(2,i) = c(2,i) + ea(3,i) = c(3,i) + end if + end do + call IdentityM(resM) + if (nres .le. 2) then + print *, "nres too small (should be at least 2), stopping" + stop + end if + do i=1,3 + v1(i)=ea(i,1) + v2(i)=ea(i,2) + end do +!c ! szukamy najwiekszej odleglosci miedzy atomami efektywnymi ea + call Dist3d(maxd,v1,v2) +!c ! odleglosc miedzy pierwsza para atomow efektywnych + maxi = 1 + maxj = 2 + do i=1,nres-1 + do j=i+1,nres + v1(1)=ea(1,i) + v1(2)=ea(2,i) + v1(3)=ea(3,i) + v2(1)=ea(1,j) + v2(2)=ea(2,j) + v2(3)=ea(3,j) + call Dist3d(dd,v1,v2) + if (dd .gt. maxd) then + maxd = dd + maxi = i + maxj = j + end if + end do + end do + vecnea(1)=ea(1,maxi)-ea(1,maxj) + vecnea(2)=ea(2,maxi)-ea(2,maxj) + vecnea(3)=ea(3,maxi)-ea(3,maxj) + if (vecnea(1) .lt. 0) then + vecnea(1) = -vecnea(1) + vecnea(2) = -vecnea(2) + vecnea(3) = -vecnea(3) + end if +!c ! obliczenie kata obrotu wokol osi Z + fi = -atan2(vecnea(2),vecnea(1)) + call RotateZ(M,fi) +!c ! obliczenie kata obrotu wokol osi Y + fi = atan2(vecnea(3), sqrt(sq(vecnea(1))+sq(vecnea(2)))) + call RotateY(M2,fi) + M = matmul(M2,M) +!c ! Przeksztalcamy wszystkie atomy efektywne +!c ! uzyskujac najwieksza odleglosc ulożona wzdluz OX +!c ! ea = transform_eatoms(ea,M) + do i=1,nres + v1(1)=ea(1,i) + v1(2)=ea(2,i) + v1(3)=ea(3,i) + call tranform_point(v2,v1,M) + ea(1,i)=v2(1) + ea(2,i)=v2(2) + ea(3,i)=v2(3) + end do + resM = M +!c ! Teraz szukamy najdluzszego rzutu na plaszczyzne YZ +!c ! (czyli w liczeniu odleglosci bierzemy pod uwage tylko wsp. y, z) + maxd = sqrt( sq(ea(2,1)-ea(2,2)) + sq(ea(3,1)-ea(3,2))) ! aktualnie max odl + maxi = 1 ! indeksy atomow + maxj = 2 ! miedzy ktorymi jest max odl (chwilowe) + do i=1,nres-1 + do j=i+1,nres + dd = sqrt( (ea(2,i)-ea(2,j))**2 + (ea(3,i)-ea(3,j))**2) + if (dd .gt. maxd) then + maxd = dd + maxi = i + maxj = j + end if + end do + end do +!c ! Teraz obrocimy wszystko wokol OX tak, zeby znaleziony rzut +!c ! byl rownolegly do OY + vecnea(1) = ea(1,maxi)-ea(1,maxj) + vecnea(2) = ea(2,maxi)-ea(2,maxj) + vecnea(3) = ea(3,maxi)-ea(3,maxj) +!c ! jeśli współrzędna vecnea.y < 0, to robimy odwrotnie + if (vecnea(2) .lt. 0) then + vecnea(1) = -vecnea(1) + vecnea(2) = -vecnea(2) + vecnea(3) = -vecnea(3) + end if +!c ! obliczenie kąta obrotu wokół osi X + fi = -atan2(vecnea(3),vecnea(2)) + call RotateX(M,fi) +!c ! Przeksztalcamy wszystkie atomy efektywne + do i=1,nres + v1(1)=ea(1,i) + v1(2)=ea(2,i) + v1(3)=ea(3,i) + call tranform_point(v2,v1,M) + ea(1,i)=v2(1) + ea(2,i)=v2(2) + ea(3,i)=v2(3) + end do + resM = matmul(M,resM) ! zbieramy wynik (sprawdzic kolejnosc M,resM) +!c ! centrujemy + mean_ea(1) = 0 + mean_ea(2) = 0 + mean_ea(3) = 0 + do i=1,nres + mean_ea(1) = mean_ea(1) + ea(1,i) + mean_ea(2) = mean_ea(2) + ea(2,i) + mean_ea(3) = mean_ea(3) + ea(3,i) + end do + v1(1) = -mean_ea(1)/nres + v1(2) = -mean_ea(2)/nres + v1(3) = -mean_ea(3)/nres + call TranslateV(M,v1) + resM = matmul(M,resM) +!c ! przesuwamy + do i=1,nres + ea(1,i) = ea(1,i) + v1(1) + ea(2,i) = ea(2,i) + v1(2) + ea(3,i) = ea(3,i) + v1(3) + end do + res = resM +!c ! wynikowa macierz przeksztalcenia lancucha +!c ! (ale lancuch w ea juz mamy przeksztalcony) + return + end subroutine + double precision function compute_rd + use geometry_data, only: nres + use energy_data, only: itype + implicit none + double precision or_mat(4,4) +! double precision hydrophobicity + integer neatoms + double precision cutoff + double precision ho(70000) + double precision ht(70000) + double precision hosum, htsum + double precision marg, sigmax, sigmay, sigmaz + integer i, j + double precision v1(3) + double precision v2(3) + double precision rijdivc, coll, tmpkwadrat, tmppotega, dist + double precision OdivT, OdivR, ot_one, or_one, RD_classic + call orientation_matrix(or_mat) +!c ! tam juz liczy sie tablica ea + neatoms = nres + cutoff = 8.99d0 +!c ! granica oddzialywania w A (powyzej ignorujemy oddzialywanie) +!c ! Najpierw liczymy "obserwowana hydrofobowosc" + hosum = 0.0d0 ! na sume pol ho, do celow pozniejszej normalizacji + do j=1,neatoms + ho(j)=0.0d0 + do i=1,neatoms + if (j .eq. i) then ! nie uwzgledniamy oddzialywania atomu z samym soba + cycle + end if + v1(1)=ea(1,i) + v1(2)=ea(2,i) + v1(3)=ea(3,i) + v2(1)=ea(1,j) + v2(2)=ea(2,j) + v2(3)=ea(3,j) + call Dist3d(dist,v1,v2) ! odleglosc miedzy atomami + if (dist .gt. cutoff) then ! za daleko, nie uwzgledniamy + cycle + end if + rijdivc = dist / cutoff + coll = 0.0d0 + tmppotega = rijdivc*rijdivc + tmpkwadrat = tmppotega + coll = coll + 7*tmpkwadrat + tmppotega = tmppotega * tmpkwadrat ! do potęgi 4 + coll = coll - 9*tmppotega + tmppotega = tmppotega * tmpkwadrat ! do potęgi 6 + coll = coll + 5*tmppotega + tmppotega = tmppotega * tmpkwadrat ! do potęgi 8 + coll = coll - tmppotega +!c ! Wersja: Bryliński 2007 +!c ! EAtoms[j].collectedhp += EAtoms[i].hyphob*(1 - 0.5 * coll); +!c ! ea$ho[j] = ea$ho[j] + hydrophobicity(ea$resid[i])*(1-0.5*coll) +!c ! Wersja: Banach Konieczny Roterman 2014 +!c ! EAtoms[j].collectedhp += (EAtoms[i].hyphob+EAtoms[j].hyphob)*(1 - 0.5 * coll); +!c ponizej bylo itype(i,1) w miejscu itype(i) oraz itype(j,1) w miejscu itype(j) + ho(j) = ho(j) + (hydrophobicity(itype(i,1))+& + hydrophobicity(itype(j,1)))*(1.0d0-0.5_8*coll) + end do + hosum = hosum + ho(j) + end do +!c ! Normalizujemy + do i=1,neatoms + ho(i) = ho(i) / hosum + end do +!c ! Koniec liczenia hydrofobowosci obserwowanej (profil ho) +!c ! Teraz liczymy "teoretyczna hydrofobowosc", wedlug kropli i rozkladu Gaussa + htsum = 0.0d0 +!c ! tu zbieramy sume ht, uzyjemy potem do normalizacji +!c ! Ustalimy teraz parametry rozkladu Gaussa, czyli sigmy (srodek jest w (0,0,0)). +!c ! To bedzie (max odl od srodka + margines) / 3, oddzielnie dla kazdej wspolrzednej. + marg = 9.0d0 + htsum = 0.0d0 +!c ! jeszcze raz zerujemy +!c ! szukamy ekstremalnej wartosci wspolrzednej x (max wart bezwzgl) + sigmax = ea(1,1) + do i=2,neatoms + if (abs(ea(1,i))>sigmax) then + sigmax = abs(ea(1,i)) + end if + end do + sigmax = (marg + sigmax) / 3.0d0 +!c ! szukamy ekstremalnej wartosci wspolrzednej y (max wart bezwzgl) + sigmay = ea(2,1) + do i=2,neatoms + if (abs(ea(2,i))>sigmay) then + sigmay = abs(ea(2,i)) + end if + end do + sigmay = (marg + sigmay) / 3.0d0 +!c ! szukamy ekstremalnej wartosci wspolrzednej z (max wart bezwzgl) + sigmaz = ea(3,1) + do i=2,neatoms + if (abs(ea(3,i))>sigmaz) then + sigmaz = abs(ea(3,i)) + end if + end do + sigmaz = (marg + sigmaz) / 3.0d0 +!c !sigmax = (marg + max(abs(max(ea$acoor[,1])), abs(min(ea$acoor[,1]))))/3.0 +!c !sigmay = (marg + max(abs(max(ea$acoor[,2])), abs(min(ea$acoor[,2]))))/3.0 +!c !sigmaz = (marg + max(abs(max(ea$acoor[,3])), abs(min(ea$acoor[,3]))))/3.0 +!c ! print *,"sigmax =",sigmax," sigmay =",sigmay," sigmaz = ",sigmaz + do j=1,neatoms + ht(j)= exp(-(ea(1,j))**2/(2*sigmax**2))& + * exp(-(ea(2,j))**2/(2*sigmay**2)) & + * exp(-(ea(3,j))**2/(2*sigmaz**2)) + htsum = htsum + ht(j) + end do +!c ! Normalizujemy + do i=1, neatoms + ht(i) = ht(i) / htsum + end do +!c ! Teraz liczymy RD + OdivT = 0.0d0 + OdivR = 0.0d0 + do j=1,neatoms + if (ho(j) .ne. 0) then + ot_one = ho(j) * log(ho(j)/ht(j)) / log(2.0d0) + OdivT = OdivT + ot_one + or_one = ho(j) * log(ho(j)/ (1.0d0/neatoms)) / log(2.0_8) + OdivR = OdivR + or_one + endif + end do + RD_classic = OdivT / (OdivT+OdivR) + compute_rd = RD_classic + return + end function + function hydrophobicity(id) ! do przepisania (bylo: identyfikowanie aa po nazwach) + integer id + double precision hydrophobicity + hydrophobicity = 0.0d0 + if (id .eq. 1) then + hydrophobicity = 1.000d0 ! CYS + return + endif + if (id .eq. 2) then + hydrophobicity = 0.828d0 ! MET + return + endif + if (id .eq. 3) then + hydrophobicity = 0.906d0 ! PHE + return + endif + if (id .eq. 4) then + hydrophobicity = 0.883d0 ! ILE + return + endif + if (id .eq. 5) then + hydrophobicity = 0.783d0 ! LEU + return + endif + if (id .eq. 6) then + hydrophobicity = 0.811d0 ! VAL + return + endif + if (id .eq. 7) then + hydrophobicity = 0.856d0 ! TRP + return + endif + if (id .eq. 8) then + hydrophobicity = 0.700d0 ! TYR + return + endif + if (id .eq. 9) then + hydrophobicity = 0.572d0 ! ALA + return + endif + if (id .eq. 10) then + hydrophobicity = 0.550d0 ! GLY + return + endif + if (id .eq. 11) then + hydrophobicity = 0.478d0 ! THR + return + endif + if (id .eq. 12) then + hydrophobicity = 0.422d0 ! SER + return + endif + if (id .eq. 13) then + hydrophobicity = 0.250d0 ! GLN + return + endif + if (id .eq. 14) then + hydrophobicity = 0.278d0 ! ASN + return + endif + if (id .eq. 15) then + hydrophobicity = 0.083d0 ! GLU + return + endif + if (id .eq. 16) then + hydrophobicity = 0.167d0 ! ASP + return + endif + if (id .eq. 17) then + hydrophobicity = 0.628d0 ! HIS + return + endif + if (id .eq. 18) then + hydrophobicity = 0.272d0 ! ARG + return + endif + if (id .eq. 19) then + hydrophobicity = 0.000d0 ! LYS + return + endif + if (id .eq. 20) then + hydrophobicity = 0.300d0 ! PRO + return + endif + return + end function hydrophobicity + subroutine mycrossprod(res,b,c) + implicit none + double precision, intent(out) :: res(3) + double precision, intent(in) :: b(3) + double precision, intent(in) :: c(3) +!c ! Tylko dla wektorów trójwymiarowych, ale nie sprawdzamy tego tutaj + res(1) = b(2)*c(3)-b(3)*c(2) + res(2) = b(3)*c(1)-b(1)*c(3) + res(3) = b(1)*c(2)-b(2)*c(1) + return + end subroutine + subroutine mydotprod(res,b,c) + implicit none + double precision, intent(out) :: res + double precision, intent(in) :: b(3) + double precision, intent(in) :: c(3) +!c ! Tylko dla wektorów trójwymiarowych, ale nie sprawdzamy tego tutaj + res = b(1)*c(1)+b(2)*c(2)+b(3)*c(3) + return + end subroutine +!c ! cosinus k¹ta miêdzy wektorami trójwymiarowymi + subroutine cosfi(res, x, y) + implicit none + double precision, intent(out) :: res + double precision, intent(in) :: x(3) + double precision, intent(in) :: y(3) + double precision LxLy + LxLy=sqrt(x(1)*x(1)+x(2)*x(2)+x(3)*x(3)) *& + sqrt(y(1)*y(1)+y(2)*y(2)+y(3)*y(3)) + if (LxLy==0.0) then + res = 0.0d0 + else + call mydotprod(res,x,y) + res = res / LxLy + end if + return + end subroutine + + + subroutine Dist3d(res,v1,v2) + implicit none + double precision, intent(out) :: res + double precision, intent(in) :: v1(3) + double precision, intent(in) :: v2(3) +! double precision sq + res = sqrt( sq(v1(1)-v2(1)) + sq(v1(2)-v2(2)) + sq(v1(3)-v2(3))) + return + end subroutine +!c ! Przeksztalca wsp. 3d uzywajac macierzy przeksztalcenia M (4x4) + subroutine tranform_point(res,v3d,M) + implicit none + double precision, intent(out) :: res(3) + double precision, intent(in) :: v3d(3) + double precision, intent(in) :: M(4,4) + + res(1) = M(1,1)*v3d(1) + M(1,2)*v3d(2) + M(1,3)*v3d(3) + M(1,4) + res(2) = M(2,1)*v3d(1) + M(2,2)*v3d(2) + M(2,3)*v3d(3) + M(2,4) + res(3) = M(3,1)*v3d(1) + M(3,2)*v3d(2) + M(3,3)*v3d(3) + M(3,4) + return + end subroutine +!c ! TranslateV: macierz translacji o wektor V + subroutine TranslateV(res,V) + implicit none + double precision, intent(out) :: res(4,4) + double precision, intent(in) :: v(3) + res(1,1) = 1.0d0 + res(1,2) = 0 + res(1,3) = 0 + res(1,4) = v(1) + res(2,1) = 0 + res(2,2) = 1.0d0 + res(2,3) = 0 + res(2,4) = v(2) + res(3,1) = 0 + res(3,2) = 0 + res(3,3) = 1.0d0 + res(3,4) = v(3) + res(4,1) = 0 + res(4,2) = 0 + res(4,3) = 0 + res(4,4) = 1.0d0 + return + end subroutine +!c ! RotateX: macierz obrotu wokol osi OX o kat fi + subroutine RotateX(res,fi) + implicit none + double precision, intent(out) :: res(4,4) + double precision, intent(in) :: fi + res(1,1) = 1.0d0 + res(1,2) = 0 + res(1,3) = 0 + res(1,4) = 0 + res(2,1) = 0 + res(2,2) = cos(fi) + res(2,3) = -sin(fi) + res(2,4) = 0 + res(3,1) = 0 + res(3,2) = sin(fi) + res(3,3) = cos(fi) + res(3,4) = 0 + res(4,1) = 0 + res(4,2) = 0 + res(4,3) = 0 + res(4,4) = 1.0d0 + return + end subroutine +!c ! RotateY: macierz obrotu wokol osi OY o kat fi + subroutine RotateY(res,fi) + implicit none + double precision, intent(out) :: res(4,4) + double precision, intent(in) :: fi + res(1,1) = cos(fi) + res(1,2) = 0 + res(1,3) = sin(fi) + res(1,4) = 0 + res(2,1) = 0 + res(2,2) = 1.0d0 + res(2,3) = 0 + res(2,4) = 0 + res(3,1) = -sin(fi) + res(3,2) = 0 + res(3,3) = cos(fi) + res(3,4) = 0 + res(4,1) = 0 + res(4,2) = 0 + res(4,3) = 0 + res(4,4) = 1.0d0 + return + end subroutine +!c ! RotateZ: macierz obrotu wokol osi OZ o kat fi + subroutine RotateZ(res,fi) + implicit none + double precision, intent(out) :: res(4,4) + double precision, intent(in) :: fi + res(1,1) = cos(fi) + res(1,2) = -sin(fi) + res(1,3) = 0 + res(1,4) = 0 + res(2,1) = sin(fi) + res(2,2) = cos(fi) + res(2,3) = 0 + res(2,4) = 0 + res(3,1) = 0 + res(3,2) = 0 + res(3,3) = 1.0d0 + res(3,4) = 0 + res(4,1) = 0 + res(4,2) = 0 + res(4,3) = 0 + res(4,4) = 1.0d0 + return + end subroutine +!c ! IdentityM + subroutine IdentityM(res) + implicit none + double precision, intent(out) :: res(4,4) + res(1,1) = 1.0d0 + res(1,2) = 0 + res(1,3) = 0 + res(1,4) = 0 + res(2,1) = 0 + res(2,2) = 1.0d0 + res(2,3) = 0 + res(2,4) = 0 + res(3,1) = 0 + res(3,2) = 0 + res(3,3) = 1.0d0 + res(3,4) = 0 + res(4,1) = 0 + res(4,2) = 0 + res(4,3) = 0 + res(4,4) = 1.0d0 + return + end subroutine + double precision function sq(x) + double precision x + sq = x*x + return + end function sq + +#ifdef LBFGS + double precision function funcgrad(x,g) + use MD_data, only: totT,usampl + implicit none + double precision energia(0:n_ene) + double precision x(nvar),g(nvar) + integer i + call var_to_geom(nvar,x) + call zerograd + call chainbuild + call etotal(energia(0)) + call sum_gradient + funcgrad=energia(0) + call cart2intgrad(nvar,g) + if (usampl) then + do i=1,nres-3 + gloc(i,icg)=gloc(i,icg)+dugamma(i) + enddo + do i=1,nres-2 + gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i) + enddo + endif + do i=1,nvar + g(i)=g(i)+gloc(i,icg) + enddo + return + end function funcgrad + subroutine cart2intgrad(n,g) + integer n + double precision g(n) + double precision drt(3,3,nres),rdt(3,3,nres),dp(3,3),& + temp(3,3),prordt(3,3,nres),prodrt(3,3,nres) + double precision xx(3),xx1(3),alphi,omegi,xj,dpjk,yp,xp,xxp,yyp + double precision cosalphi,sinalphi,cosomegi,sinomegi,theta2,& + cost2,sint2,rj,dxoiij,tempkl,dxoijk,dsci,zzp,dj,dpkl + double precision fromto(3,3),aux(6) + integer i,ii,j,jjj,k,l,m,indi,ind,ind1 + logical sideonly + sideonly=.false. + g=0.0d0 + if (sideonly) goto 10 + do i=1,nres-2 + rdt(1,1,i)=-rt(1,2,i) + rdt(1,2,i)= rt(1,1,i) + rdt(1,3,i)= 0.0d0 + rdt(2,1,i)=-rt(2,2,i) + rdt(2,2,i)= rt(2,1,i) + rdt(2,3,i)= 0.0d0 + rdt(3,1,i)=-rt(3,2,i) + rdt(3,2,i)= rt(3,1,i) + rdt(3,3,i)= 0.0d0 + enddo + do i=2,nres-2 + drt(1,1,i)= 0.0d0 + drt(1,2,i)= 0.0d0 + drt(1,3,i)= 0.0d0 + drt(2,1,i)= rt(3,1,i) + drt(2,2,i)= rt(3,2,i) + drt(2,3,i)= rt(3,3,i) + drt(3,1,i)=-rt(2,1,i) + drt(3,2,i)=-rt(2,2,i) + drt(3,3,i)=-rt(2,3,i) + enddo + ind1=0 + do i=1,nres-2 + ind1=ind1+1 + if (n.gt.nphi) then + + do j=1,3 + do k=1,2 + dpjk=0.0D0 + do l=1,3 + dpjk=dpjk+prod(j,l,i)*rdt(l,k,i) + enddo + dp(j,k)=dpjk + prordt(j,k,i)=dp(j,k) + enddo + dp(j,3)=0.0D0 + g(nphi+i)=g(nphi+i)+vbld(i+2)*dp(j,1)*gradc(j,i+1,icg) + enddo + xx1(1)=-0.5D0*xloc(2,i+1) + xx1(2)= 0.5D0*xloc(1,i+1) + do j=1,3 + xj=0.0D0 + do k=1,2 + xj=xj+r(j,k,i)*xx1(k) + enddo + xx(j)=xj + enddo + do j=1,3 + rj=0.0D0 + do k=1,3 + rj=rj+prod(j,k,i)*xx(k) + enddo + g(nphi+i)=g(nphi+i)+rj*gradx(j,i+1,icg) + enddo + if (i.lt.nres-2) then + do j=1,3 + dxoiij=0.0D0 + do k=1,3 + dxoiij=dxoiij+dp(j,k)*xrot(k,i+2) + enddo + g(nphi+i)=g(nphi+i)+dxoiij*gradx(j,i+2,icg) + enddo + endif + + endif + + + if (i.gt.1) then + do j=1,3 + do k=1,3 + dpjk=0.0 + do l=2,3 + dpjk=dpjk+prod(j,l,i)*drt(l,k,i) + enddo + dp(j,k)=dpjk + prodrt(j,k,i)=dp(j,k) + enddo + g(i-1)=g(i-1)+vbld(i+2)*dp(j,1)*gradc(j,i+1,icg) + enddo + endif + xx(1)= 0.0D0 + xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i) + xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i) + if (i.gt.1) then + do j=1,3 + rj=0.0D0 + do k=2,3 + rj=rj+prod(j,k,i)*xx(k) + enddo + g(i-1)=g(i-1)-rj*gradx(j,i+1,icg) + enddo + endif + if (i.gt.1) then + do j=1,3 + dxoiij=0.0D0 + do k=1,3 + dxoiij=dxoiij+dp(j,k)*xrot(k,i+2) + enddo + g(i-1)=g(i-1)+dxoiij*gradx(j,i+2,icg) + enddo + endif + do j=i+1,nres-2 + ind1=ind1+1 + call build_fromto(i+1,j+1,fromto) + do k=1,3 + do l=1,3 + tempkl=0.0D0 + do m=1,2 + tempkl=tempkl+prordt(k,m,i)*fromto(m,l) + enddo + temp(k,l)=tempkl + enddo + enddo + if (n.gt.nphi) then + do k=1,3 + g(nphi+i)=g(nphi+i)+vbld(j+2)*temp(k,1)*gradc(k,j+1,icg) + enddo + do k=1,3 + dxoijk=0.0D0 + do l=1,3 + dxoijk=dxoijk+temp(k,l)*xrot(l,j+2) + enddo + g(nphi+i)=g(nphi+i)+dxoijk*gradx(k,j+2,icg) + enddo + endif + do k=1,3 + do l=1,3 + tempkl=0.0D0 + do m=1,3 + tempkl=tempkl+prodrt(k,m,i)*fromto(m,l) + enddo + temp(k,l)=tempkl + enddo + enddo + if (i.gt.1) then + do k=1,3 + g(i-1)=g(i-1)+vbld(j+2)*temp(k,1)*gradc(k,j+1,icg) + enddo + do k=1,3 + dxoijk=0.0D0 + do l=1,3 + dxoijk=dxoijk+temp(k,l)*xrot(l,j+2) + enddo + g(i-1)=g(i-1)+dxoijk*gradx(k,j+2,icg) + enddo + endif + enddo + enddo + + if (nvar.le.nphi+ntheta) return + + 10 continue + do i=2,nres-1 + if (iabs(itype(i,1)).eq.10 .or. itype(i,1).eq.ntyp1& !) cycle + .or. mask_side(i).eq.0 ) cycle + ii=ialph(i,1) + dsci=vbld(i+nres) +#ifdef OSF + alphi=alph(i) + omegi=omeg(i) + if(alphi.ne.alphi) alphi=100.0 + if(omegi.ne.omegi) omegi=-100.0 +#else + alphi=alph(i) + omegi=omeg(i) +#endif + 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 + 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) + enddo + aux(jjj+k)=dj + enddo + jjj=jjj+3 + enddo + do k=1,3 + g(ii)=g(ii)+aux(k)*gradx(k,i,icg) + g(ii+nside)=g(ii+nside)+aux(k+3)*gradx(k,i,icg) + enddo + enddo + return + end subroutine cart2intgrad + + +#endif + +!-----------LIPID-MARTINI-UNRES-PROTEIN + +! new for K+ + subroutine elip_prot(evdw) +! subroutine emart_prot2(emartion_prot) + use calc_data + use comm_momo + + logical :: lprn +!el local variables + integer :: iint,itypi1,subchap,isel,itmp + real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,e1,e2,sigm,epsi + real(kind=8) :: evdw,aa,bb + 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,ki + 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,& + emartions_prot_amber,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) + real(kind=8) ::locbox(3) + locbox(1)=boxxsize + locbox(2)=boxysize + locbox(3)=boxzsize + + evdw=0.0D0 + if (nres_molec(4).eq.0) return + eps_out=80.0d0 +! sss_ele_cut=1.0d0 + + itmp=0 + do i=1,4 + itmp=itmp+nres_molec(i) + enddo +! go to 17 +! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization +! do i=ibond_start,ibond_end + do ki=g_listmartsc_start,g_listmartsc_end + i=newcontlistmartsci(ki) + j=newcontlistmartscj(ki) + +! print *,"I am in EVDW",i + itypi=iabs(itype(i,1)) + +! if (i.ne.47) cycle + if ((itypi.eq.ntyp1).or.(itypi.eq.10)) cycle + itypi1=iabs(itype(i+1,1)) + xi=c(1,nres+i) + yi=c(2,nres+i) + zi=c(3,nres+i) + call to_box(xi,yi,zi) + call lipid_layer(xi,yi,zi,sslipi,ssgradlipi) + dxi=dc_norm(1,nres+i) + dyi=dc_norm(2,nres+i) + dzi=dc_norm(3,nres+i) + dsci_inv=vbld_inv(i+nres) +! do j=itmp+1,itmp+nres_molec(5) + +! Calculate SC interaction energy. + itypj=iabs(itype(j,4)) + if ((itypj.gt.ntyp_molec(4))) cycle + CALL elgrad_init_mart(eheadtail,Egb,Ecl,Elj,Equad,Epol) +! print *,i,j,"after elgrad" + dscj_inv=0.0 + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + + call to_box(xj,yj,zj) +! write(iout,*) "xi,yi,zi,xj,yj,zj", xi,yi,zi,xj,yj,zj + +! call lipid_layer(xj,yj,zj,sslipj,ssgradlipj) +! 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 + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) +! write(iout,*) "xj,yj,zj", xj,yj,zj,boxxsize + rreal(1)=xj + rreal(2)=yj + rreal(3)=zj + dxj=0.0 + dyj=0.0 + dzj=0.0 +! dxj = dc_norm( 1, nres+j ) +! dyj = dc_norm( 2, nres+j ) +! dzj = dc_norm( 3, nres+j ) + + itypi = itype(i,1) + itypj = itype(j,4) +! Parameters from fitting the analitical expressions to the PMF obtained by umbrella +! sampling performed with amber package +! alf1 = 0.0d0 +! alf2 = 0.0d0 +! alf12 = 0.0d0 +! a12sq = rborn(itypi,itypj) * rborn(itypj,itypi) + chi1 = chi1mart(itypi,itypj) + chis1 = chis1mart(itypi,itypj) + chip1 = chipp1mart(itypi,itypj) +! chi1=0.0d0 +! chis1=0.0d0 +! chip1=0.0d0 + chi2=0.0 + chip2=0.0 + chis2=0.0 +! chis2 = chis(itypj,itypi) + chis12 = chis1 * chis2 + sig1 = sigmap1mart(itypi,itypj) + sig2=0.0d0 +! sig2 = sigmap2(itypi,itypj) +! alpha factors from Fcav/Gcav + b1cav = alphasurmart(1,itypi,itypj) + b2cav = alphasurmart(2,itypi,itypj) + b3cav = alphasurmart(3,itypi,itypj) + b4cav = alphasurmart(4,itypi,itypj) + +! b1cav=0.0d0 +! b2cav=0.0d0 +! b3cav=0.0d0 +! b4cav=0.0d0 + +! used to determine whether we want to do quadrupole calculations + eps_in = epsintabmart(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 + + DO k = 1, 3 + ctail(k,1)=c(k,i+nres) + ctail(k,2)=c(k,j) + END DO + call to_box(ctail(1,1),ctail(2,1),ctail(3,1)) + call to_box(ctail(1,2),ctail(2,2),ctail(3,2)) +!c! tail distances will be themselves usefull elswhere +!c1 (in Gcav, for example) + do k=1,3 + Rtail_distance(k) = boxshift(ctail(k,2) - ctail(k,1),locbox(k)) + enddo + Rtail = dsqrt( & + (Rtail_distance(1)*Rtail_distance(1)) & + + (Rtail_distance(2)*Rtail_distance(2)) & + + (Rtail_distance(3)*Rtail_distance(3))) +! tail lomartion and distance calculations +! dhead1 + d1 = dheadmart(1, 1, itypi, itypj) +! d2 = dhead(2, 1, itypi, itypj) + DO k = 1,3 +! lomartion of polar head is computed by taking hydrophobic centre +! and moving by a d1 * dc_norm vector +! see unres publimartions for very informative images + chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres) + chead(k,2) = c(k, j) + enddo + call to_box(chead(1,1),chead(2,1),chead(3,1)) + call to_box(chead(1,2),chead(2,2),chead(3,2)) +! write(iout,*) "TEST",chead(1,1),chead(2,1),chead(3,1),dc_norm(k, i+nres),d1 +! distance +! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres)) +! Rsc(k) = Rsc_distance(k) * Rsc_distance(k) + do k=1,3 + Rhead_distance(k) = boxshift(chead(k,2) - chead(k,1),locbox(k)) + 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 + Fisocav=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) + sss_ele_cut=sscale_ele(1.0d0/(rij)) + sss_ele_grad=sscagrad_ele(1.0d0/(rij)) +! print *,sss_ele_cut,sss_ele_grad,& +! 1.0d0/(rij),r_cut_ele,rlamb_ele + if (sss_ele_cut.le.0.0) cycle + 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 + if (evdw.gt.1.0d6) then + write (*,'(2(1x,a3,i3),7f7.2)') & + restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,& + 1.0d0/rij,Rtail,Rhead,rij_shift, sig, sig0ij,sigsq + write(*,*) facsig,faceps1_inv,om1,chiom1,chi1 + write(*,*) "ANISO?!",chi1 +!evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,& +! Equad,evdwij+Fcav+eheadtail,evdw + endif + + RETURN + END IF + sigder = -sig * sigsq + rij_shift = 1.0D0 / rij_shift + fac = rij_shift**expon + c1 = fac * fac * aa_aq_mart(itypi,itypj) +! print *,"ADAM",aa_aq(itypi,itypj) + +! c1 = 0.0d0 + c2 = fac * bb_aq_mart(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*sss_ele_cut +!#endif + c1 = c1 * eps1 * eps2rt**2 * eps3rt**2 + fac = -expon * (c1 + evdwij) * rij_shift + sigder = fac * sigder +! Calculate distance derivative + gg(1) = fac +!*sss_ele_cut+evdwij*sss_ele_grad + gg(2) = fac +!*sss_ele_cut+evdwij*sss_ele_grad + gg(3) = fac +!*sss_ele_cut+evdwij*sss_ele_grad +! print *,"GG(1),distance grad",gg(1) + fac = chis1 * sqom1 + chis2 * sqom2 & + - 2.0d0 * chis12 * om1 * om2 * om12 + pom = 1.0d0 - chis1 * chis2 * sqom12 + Lambf = (1.0d0 - (fac / pom)) + Lambf = dsqrt(Lambf) + sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0) + Chif = Rtail * 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 + 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) + 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) ) + facd1 = dtailmart(1,itypi,itypj) * vbld_inv(i+nres) + facd2 = dtailmart(2,itypi,itypj) * vbld_inv(j) + DO k = 1, 3 + pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres)) + gradpepmartx(k,i) = gradpepmartx(k,i) & + - (( dFdR + gg(k) ) * pom)*sss_ele_cut& + -(evdwij+Fcav)*rij*sss_ele_grad*rreal(k) + + pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j)) +! gvdwx(k,j) = gvdwx(k,j) & +! + (( dFdR + gg(k) ) * pom) + gradpepmart(k,i) = gradpepmart(k,i) & + - (( dFdR + gg(k) ) * ertail(k))*sss_ele_cut& + -(evdwij+Fcav)*rij*sss_ele_grad*rreal(k) + + gradpepmart(k,j) = gradpepmart(k,j) & + + (( dFdR + gg(k) ) * ertail(k))*sss_ele_cut& + +(evdwij+Fcav)*rij*sss_ele_grad*rreal(k) + + gg(k) = 0.0d0 + ENDDO +!c! Compute head-head and head-tail energies for each state +!! if (.false.) then ! turn off electrostatic + isel = iabs(Qi)+iabs(Qj) + if ((itype(j,4).gt.4).and.(itype(j,4).lt.14)) isel=isel+2 +! isel=0 +! if (isel.eq.2) isel=0 + IF (isel.le.1) THEN + eheadtail = 0.0d0 + ELSE IF (isel.eq.3) THEN + if (iabs(Qj).eq.1) then + CALL edq_mart(ecl, elj, epol) + eheadtail = ECL + elj + epol + else + if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then + Qi=Qi*2 + Qij=Qij*2 + endif + call eqd_mart(ecl,elj,epol) + eheadtail = ECL + elj + epol + endif + ELSE IF ((isel.eq.2)) THEN + if (iabs(Qi).ne.1) then + eheadtail=0.0d0 + else + if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then + Qi=Qi*2 + Qij=Qij*2 + endif + CALL eqq_mart(Ecl,Egb,Epol,Fisocav,Elj) + eheadtail = ECL + Egb + Epol + Fisocav + Elj + endif + ELSE IF (isel.eq.4) then + call edd_mart(ecl) + eheadtail = ECL + ENDIF +! write(iout,*) "not yet implemented",j,itype(j,5) +!! endif ! turn off electrostatic + evdw = evdw + (Fcav + eheadtail)*sss_ele_cut +! if (evdw.gt.1.0d6) then +! write (*,'(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 +! endif + + 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 (energy_dec) write(iout,*) "FCAV", & + sig1,sig2,b1cav,b2cav,b3cav,b4cav +! print *,"before sc_grad_mart", i,j, gradpepmart(1,j) +! iF (nstate(itypi,itypj).eq.1) THEN + CALL sc_grad_mart +! print *,"after sc_grad_mart", i,j, gradpepmart(1,j) + +! END IF +!c!------------------------------------------------------------------- +!c! NAPISY KONCOWE + END DO ! j +! END DO ! i +!c write (iout,*) "Number of loop steps in EGB:",ind +!c energy_dec=.false. +! print *,"EVDW KURW",evdw,nres +!!! return + 17 continue +! go to 23 +! do i=ibond_start,ibond_end + + do ki=g_listmartp_start,g_listmartp_end + i=newcontlistmartpi(ki) + j=newcontlistmartpj(ki) + +! print *,"I am in EVDW",i + itypi=10 ! the peptide group parameters are for glicine + +! if (i.ne.47) cycle + if ((itype(i,1).eq.ntyp1).or.itype(i+1,1).eq.ntyp1) cycle + itypi1=iabs(itype(i+1,1)) + 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 + call to_box(xi,yi,zi) + dxi=dc_norm(1,i) + dyi=dc_norm(2,i) + dzi=dc_norm(3,i) + dsci_inv=vbld_inv(i+1)/2.0 +! do j=itmp+1,itmp+nres_molec(5) + +! Calculate SC interaction energy. + itypj=iabs(itype(j,4)) + if ((itypj.gt.ntyp_molec(4))) cycle + CALL elgrad_init_mart_pep(eheadtail,Egb,Ecl,Elj,Equad,Epol) + + dscj_inv=0.0 + xj=c(1,j) + yj=c(2,j) + zj=c(3,j) + call to_box(xj,yj,zj) + xj=boxshift(xj-xi,boxxsize) + yj=boxshift(yj-yi,boxysize) + zj=boxshift(zj-zi,boxzsize) + rreal(1)=xj + rreal(2)=yj + rreal(3)=zj + + dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2 + + dxj = 0.0d0! dc_norm( 1, nres+j ) + dyj = 0.0d0!dc_norm( 2, nres+j ) + dzj = 0.0d0! dc_norm( 3, nres+j ) + + itypi = 10 + itypj = itype(j,4) +! Parameters from fitting the analitical expressions to the PMF obtained by umbrella +! sampling performed with amber package +! alf1 = 0.0d0 +! alf2 = 0.0d0 +! alf12 = 0.0d0 +! a12sq = rborn(itypi,itypj) * rborn(itypj,itypi) + chi1 = chi1mart(itypi,itypj) + chis1 = chis1mart(itypi,itypj) + chip1 = chipp1mart(itypi,itypj) +! chi1=0.0d0 +! chis1=0.0d0 +! chip1=0.0d0 + chi2=0.0 + chip2=0.0 + chis2=0.0 +! chis2 = chis(itypj,itypi) + chis12 = chis1 * chis2 + sig1 = sigmap1mart(itypi,itypj) + sig2=0.0 +! sig2 = sigmap2(itypi,itypj) +! alpha factors from Fcav/Gcav + b1cav = alphasurmart(1,itypi,itypj) + b2cav = alphasurmart(2,itypi,itypj) + b3cav = alphasurmart(3,itypi,itypj) + b4cav = alphasurmart(4,itypi,itypj) + +! used to determine whether we want to do quadrupole calculations + eps_in = epsintabmart(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 + + DO k = 1, 3 + ctail(k,1)=(c(k,i)+c(k,i+1))/2.0 + ctail(k,2)=c(k,j) + END DO + call to_box(ctail(1,1),ctail(2,1),ctail(3,1)) + call to_box(ctail(1,2),ctail(2,2),ctail(3,2)) +!c! tail distances will be themselves usefull elswhere +!c1 (in Gcav, for example) + do k=1,3 + Rtail_distance(k) = boxshift(ctail(k,2) - ctail(k,1),locbox(k)) + enddo + +!c! tail distances will be themselves usefull elswhere +!c1 (in Gcav, for example) + Rtail = dsqrt( & + (Rtail_distance(1)*Rtail_distance(1)) & + + (Rtail_distance(2)*Rtail_distance(2)) & + + (Rtail_distance(3)*Rtail_distance(3))) +! tail lomartion and distance calculations +! dhead1 + d1 = dheadmart(1, 1, itypi, itypj) +! print *,"d1",d1 +! d1=0.0d0 +! d2 = dhead(2, 1, itypi, itypj) + DO k = 1,3 +! lomartion of polar head is computed by taking hydrophobic centre +! and moving by a d1 * dc_norm vector +! see unres publimartions for very informative images + chead(k,1) = (c(k, i)+c(k,i+1))/2.0 + d1 * dc_norm(k, i) + chead(k,2) = c(k, j) + ENDDO +! distance +! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres)) +! Rsc(k) = Rsc_distance(k) * Rsc_distance(k) + call to_box(chead(1,1),chead(2,1),chead(3,1)) + call to_box(chead(1,2),chead(2,2),chead(3,2)) + +! distance +! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres)) +! Rsc(k) = Rsc_distance(k) * Rsc_distance(k) + do k=1,3 + Rhead_distance(k) = boxshift(chead(k,2) - chead(k,1),locbox(k)) + 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 = 0.0d0 ! 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) + sss_ele_cut=sscale_ele(1.0d0/(rij)) + sss_ele_grad=sscagrad_ele(1.0d0/(rij)) +! print *,sss_ele_cut,sss_ele_grad,& +! 1.0d0/(rij),r_cut_ele,rlamb_ele + if (sss_ele_cut.le.0.0) cycle + 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 + om2=0.0d0 + om12=0.0d0 + 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 +! if (evdw.gt.1.0d6) then +! write (*,'(2(1x,a3,i3),6f6.2)') & +! restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,& +! 1.0d0/rij,Rtail,Rhead,rij_shift, sig, sig0ij +!evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,& +! Equad,evdwij+Fcav+eheadtail,evdw +! endif + RETURN + END IF + sigder = -sig * sigsq + rij_shift = 1.0D0 / rij_shift + fac = rij_shift**expon + c1 = fac * fac * aa_aq_mart(itypi,itypj) +! print *,"ADAM",aa_aq(itypi,itypj) + +! c1 = 0.0d0 + c2 = fac * bb_aq_mart(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*sss_ele_cut +!#endif + c1 = c1 * eps1 * eps2rt**2 * eps3rt**2 + fac = -expon * (c1 + evdwij) * rij_shift + sigder = fac * sigder +! Calculate distance derivative + gg(1) = fac + gg(2) = fac + gg(3) = fac + + fac = chis1 * sqom1 + chis2 * sqom2 & + - 2.0d0 * chis12 * om1 * om2 * om12 + + pom = 1.0d0 - chis1 * chis2 * sqom12 +! print *,"TUT2",fac,chis1,sqom1,pom + Lambf = (1.0d0 - (fac / pom)) + Lambf = dsqrt(Lambf) + sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0) + Chif = Rtail * 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 + 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) + dCAVdOM1 = dFdL * ( dFdOM1 ) +! dCAVdOM2 = dFdL * ( dFdOM2 ) +! dCAVdOM12 = dFdL * ( dFdOM12 ) + dCAVdOM2=0.0d0 + dCAVdOM12=0.0d0 + + DO k= 1, 3 + ertail(k) = Rtail_distance(k)/Rtail + END DO + erdxi = scalar( ertail(1), dC_norm(1,i) ) + erdxj = scalar( ertail(1), dC_norm(1,j) ) + facd1 = dtailmart(1,itypi,itypj) * vbld_inv(i) + facd2 = dtailmart(2,itypi,itypj) * vbld_inv(j+nres) + DO k = 1, 3 + pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i)) +! gradpepmartx(k,i) = gradpepmartx(k,i) & +! - (( dFdR + gg(k) ) * pom) + pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres)) +! gvdwx(k,j) = gvdwx(k,j) & +! + (( dFdR + gg(k) ) * pom) + gradpepmart(k,i) = gradpepmart(k,i) & + - (( dFdR + gg(k) ) * ertail(k))/2.0d0*sss_ele_cut& + -(evdwij+Fcav)*rij*sss_ele_grad*rreal(k)*0.5d0 + gradpepmart(k,i+1) = gradpepmart(k,i+1) & + - (( dFdR + gg(k) ) * ertail(k))/2.0d0*sss_ele_cut& + -(evdwij+Fcav)*rij*sss_ele_grad*rreal(k)*0.5d0 + + gradpepmart(k,j) = gradpepmart(k,j) & + + (( dFdR + gg(k) ) * ertail(k))*sss_ele_cut& + +(evdwij+Fcav)*rij*sss_ele_grad*rreal(k) + + gg(k) = 0.0d0 + ENDDO +!c! Compute head-head and head-tail energies for each state +!c! Dipole-charge interactions + isel = 2+iabs(Qj) + if ((itype(j,4).gt.4).and.(itype(j,4).lt.14)) isel=isel+2 +! if (isel.eq.4) isel=0 + if (isel.le.2) then + eheadtail=0.0d0 + ELSE if (isel.eq.3) then + CALL edq_mart_pep(ecl, elj, epol) + eheadtail = ECL + elj + epol +! print *,"i,",i,eheadtail +! eheadtail = 0.0d0 + else +!HERE WATER and other types of molecules solvents will be added +! write(iout,*) "not yet implemented" + CALL edd_mart_pep(ecl) + eheadtail=ecl +! CALL edd_mart_pep +! eheadtail=0.0d0 + endif + evdw = evdw +( Fcav + eheadtail)*sss_ele_cut +! if (evdw.gt.1.0d6) then +! write (*,'(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 +! endif + 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_mart_pep +! END IF +!c!------------------------------------------------------------------- +!c! NAPISY KONCOWE + END DO ! j +! END DO ! i +!c write (iout,*) "Number of loop steps in EGB:",ind +!c energy_dec=.false. +! print *,"EVDW KURW",evdw,nres + 23 continue +! print *,"before leave sc_grad_mart", i,j, gradpepmart(1,nres-1) + + return + end subroutine elip_prot + + SUBROUTINE eqq_mart(Ecl,Egb,Epol,Fisocav,Elj) + use calc_data + use comm_momo + real (kind=8) :: facd3, facd4, federmaus, adler,& + Ecl,Egb,Epol,Fisocav,Elj,Fgb,debkap +! integer :: k +!c! Epol and Gpol analytical parameters + alphapol1 = alphapolmart(itypi,itypj) + alphapol2 = alphapolmart2(itypj,itypi) +!c! Fisocav and Gisocav analytical parameters + al1 = alphisomart(1,itypi,itypj) + al2 = alphisomart(2,itypi,itypj) + al3 = alphisomart(3,itypi,itypj) + al4 = alphisomart(4,itypi,itypj) + csig = (1.0d0 & + / dsqrt(sigiso1mart(itypi, itypj)**2.0d0 & + + sigiso2mart(itypi,itypj)**2.0d0)) +!c! + pis = sig0headmart(itypi,itypj) + eps_head = epsheadmart(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) + debkap=debaykapmart(itypi,itypj) + if (energy_dec) write(iout,*) "egb",Qij,debkap,Fgb,a12sq,ee0 + Egb = -(332.0d0 * Qij *& + (1.0/eps_in-dexp(-debkap*Fgb)/eps_out)) / 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 * & + (1.0/eps_in-dexp(-debkap*Fgb)/eps_out))/(Fgb*Fgb)& + -(332.0d0 * Qij *& + (dexp(-debkap*Fgb)*debkap/eps_out))/ 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!*sss_ele_cut+epol*sss_ele_grad +!c! dPOLdR1 = 0.0d0 + dPOLdR2 = dPOLdFGB2 * dFGBdR2!*sss_ele_cut+epol*sss_ele_grad +!c! dPOLdR2 = 0.0d0 + dPOLdOM1 = dPOLdFGB2 * dFGBdOM1 +!c! dPOLdOM1 = 0.0d0 + dPOLdOM2 = dPOLdFGB1 * dFGBdOM2 +! epol=epol*sss_ele_cut +!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) ) + bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) ) + federmaus = scalar(erhead_tail(1,1),dC_norm(1,j)) + eagle = scalar( erhead_tail(1,2), dC_norm(1,j) ) + adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) ) + facd1 = d1 * vbld_inv(i+nres) + facd2 = d2 * vbld_inv(j) + facd3 = dtailmart(1,itypi,itypj) * vbld_inv(i+nres) + facd4 = dtailmart(2,itypi,itypj) * vbld_inv(j) + +!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))) + + pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) + gradpepmartx(k,i) = gradpepmartx(k,i) & + +sss_ele_cut*(- 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)-& + sss_ele_grad*rij*rreal(k)*(Ecl+Egb+Epol+Fisocav+Elj) + + pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j)) +! gradpepmartx(k,j) = gradpepmartx(k,j)+ dGCLdR * pom& +! + dGGBdR * pom+ dGCVdR * pom& +! + dPOLdR1 * (erhead_tail(k,1)& +! -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j)))& +! + dPOLdR2 * condor + dGLJdR * pom + + gradpepmart(k,i) = gradpepmart(k,i) + & + sss_ele_cut*(- dGCLdR * erhead(k)& + - dGGBdR * erhead(k)& + - dGCVdR * erhead(k)& + - dPOLdR1 * erhead_tail(k,1)& + - dPOLdR2 * erhead_tail(k,2)& + - dGLJdR * erhead(k))& + - sss_ele_grad*rij*rreal(k)*(Ecl+Egb+Epol+Fisocav+Elj) + + + gradpepmart(k,j) = gradpepmart(k,j) + & + sss_ele_cut*( dGCLdR * erhead(k) & + + dGGBdR * erhead(k) & + + dGCVdR * erhead(k) & + + dPOLdR1 * erhead_tail(k,1) & + + dPOLdR2 * erhead_tail(k,2)& + + dGLJdR * erhead(k))& + +sss_ele_grad*rij*rreal(k)*(Ecl+Egb+Epol+Fisocav+Elj) + END DO + RETURN + END SUBROUTINE eqq_mart + + SUBROUTINE eqd_mart(Ecl,Elj,Epol) + use calc_data + use comm_momo + double precision facd4, federmaus,ecl,elj,epol + alphapol1 = alphapolmart(itypi,itypj) + w1 = wqdipmart(1,itypi,itypj) + w2 = wqdipmart(2,itypi,itypj) + pis = sig0headmart(itypi,itypj) + eps_head = epsheadmart(itypi,itypj) +! eps_head=0.0d0 +! w2=0.0d0 +! alphapol1=0.0d0 +!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 =sss_ele_cut*(-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 = 0.0d0 ! + +!(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 = 0.0d0 ! as om2 is 0 +! (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) & +! * (2.0d0 - 0.5d0 * ee1) ) & +! / (2.0d0 * fgb1) + dPOLdR1 = dPOLdFGB1 * dFGBdR1*sss_ele_cut +!c! dPOLdR1 = 0.0d0 + dPOLdOM1 = 0.0d0 +! dPOLdOM2 = dPOLdFGB1 * dFGBdOM2 + 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*sss_ele_cut & + * (((-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) ) + bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) ) + facd1 = d1 * vbld_inv(i+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)) + gradpepmartx(k,i) = gradpepmartx(k,i) & + - dGCLdR * pom& + - dPOLdR1 * hawk & + - dGLJdR * pom& + -(Ecl+Elj+Epol)*sss_ele_grad*rreal(k)*rij + + +! pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) +! gradpepmartx(k,j) = gradpepmartx(k,j) & +! + dGCLdR * pom & +! + dPOLdR1 * (erhead_tail(k,1) & +! -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) & +! + dGLJdR * pom + + + gradpepmart(k,i) = gradpepmart(k,i) & + - dGCLdR * erhead(k) & + - dPOLdR1 * erhead_tail(k,1) & + - dGLJdR * erhead(k)& + -(Ecl+Elj+Epol)*sss_ele_grad*rreal(k)*rij + + + gradpepmart(k,j) = gradpepmart(k,j) & + + dGCLdR * erhead(k) & + + dPOLdR1 * erhead_tail(k,1) & + + dGLJdR * erhead(k)& + +(Ecl+Elj+Epol)*sss_ele_grad*rreal(k)*rij + + + END DO + RETURN + END SUBROUTINE eqd_mart + + SUBROUTINE edq_mart(Ecl,Elj,Epol) + use comm_momo + use calc_data + + double precision facd3, adler,ecl,elj,epol + alphapol2 = alphapolmart(itypi,itypj) + w1 = wqdipmart(1,itypi,itypj) + w2 = wqdipmart(2,itypi,itypj) + pis = sig0headmart(itypi,itypj) + eps_head = epsheadmart(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 +! write(iout,*) "KURWA2",Rhead + sparrow = w1 * Qj * om1 + hawk = w2 * Qj * Qj * (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)*sss_ele_cut +!c! dF/dom1 + dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0) +!c! dF/dom2 + dGCLdOM2 = (2.0d0 * w2 * Qj * Qj * om2) / (Rhead ** 4.0d0) +!c-------------------------------------------------------------------- +!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*sss_ele_cut +!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)))*sss_ele_cut +!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) ) + eagle = scalar( erhead_tail(1,2), dC_norm(1,j) ) + adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) ) + facd1 = d1 * vbld_inv(i+nres) + facd2 = d2 * vbld_inv(j) + facd3 = dtailmart(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))) + + pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres)) + gradpepmartx(k,i) = gradpepmartx(k,i) & + - dGCLdR * pom & + - dPOLdR2 * (erhead_tail(k,2) & + -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) & + - dGLJdR * pom& + -(Ecl+Elj+Epol)*sss_ele_grad*rreal(k)*rij + + + pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j)) +! gradpepmartx(k,j) = gradpepmartx(k,j) & +! + dGCLdR * pom & +! + dPOLdR2 * condor & +! + dGLJdR * pom + + + gradpepmart(k,i) = gradpepmart(k,i) & + - dGCLdR * erhead(k) & + - dPOLdR2 * erhead_tail(k,2) & + - dGLJdR * erhead(k)& + -(Ecl+Elj+Epol)*sss_ele_grad*rreal(k)*rij + + + gradpepmart(k,j) = gradpepmart(k,j) & + + dGCLdR * erhead(k) & + + dPOLdR2 * erhead_tail(k,2) & + + dGLJdR * erhead(k)& + +(Ecl+Elj+Epol)*sss_ele_grad*rreal(k)*rij + + END DO + RETURN + END SUBROUTINE edq_mart + + SUBROUTINE edq_mart_pep(Ecl,Elj,Epol) + use comm_momo + use calc_data + + double precision facd3, adler,ecl,elj,epol + alphapol2 = alphapolmart(itypi,itypj) + w1 = wqdipmart(1,itypi,itypj) + w2 = wqdipmart(2,itypi,itypj) + pis = sig0headmart(itypi,itypj) + eps_head = epsheadmart(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 * Qj * om1 + hawk = w2 * Qj * Qj * (1.0d0 - sqom2) +! print *,"CO2", itypi,itypj +! print *,"CO?!.", w1,w2,Qj,om1 + 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)*sss_ele_cut +!c! dF/dom1 + dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0) +!c! dF/dom2 + dGCLdOM2 = (2.0d0 * w2 * Qj * Qj * om2) / (Rhead ** 4.0d0) +!c-------------------------------------------------------------------- +!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*sss_ele_cut +!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*sss_ele_cut & + * (((-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) ) + facd1 = d1 * vbld_inv(i+1) + DO k = 1, 3 + pom = facd1*(erhead(k)-erdxi*dC_norm(k,i)) +! gradpepmartx(k,i) = gradpepmartx(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)) +! gradpepmartx(k,j) = gradpepmartx(k,j) & +! + dGCLdR * pom & +! + dPOLdR2 * condor & +! + dGLJdR * pom + + gradpepmart(k,i) = gradpepmart(k,i)+pom*(dGCLdR+dGLJdR) + gradpepmart(k,i+1) = gradpepmart(k,i+1)-pom*(dGCLdR+dGLJdR) + + gradpepmart(k,i) = gradpepmart(k,i) +0.5d0*( & + - dGCLdR * erhead(k) & + - dPOLdR2 * erhead_tail(k,2) & + - dGLJdR * erhead(k))& + -(Ecl+Elj+Epol)*sss_ele_grad*rreal(k)*rij + gradpepmart(k,i+1) = gradpepmart(k,i+1) +0.5d0*( & + - dGCLdR * erhead(k) & + - dPOLdR2 * erhead_tail(k,2) & + - dGLJdR * erhead(k))& + -(Ecl+Elj+Epol)*sss_ele_grad*rreal(k)*rij + + + + gradpepmart(k,j) = gradpepmart(k,j) & + + dGCLdR * erhead(k) & + + dPOLdR2 * erhead_tail(k,2) & + + dGLJdR * erhead(k)& + +(Ecl+Elj+Epol)*sss_ele_grad*rreal(k)*rij + + + END DO + RETURN + END SUBROUTINE edq_mart_pep +!-------------------------------------------------------------------------- + + SUBROUTINE edd_mart(ECL) +! IMPLICIT NONE + use comm_momo + use calc_data + + double precision ecl +!c! csig = sigiso(itypi,itypj) + w1 = wqdipmart(1,itypi,itypj) + w2 = wqdipmart(2,itypi,itypj) +! w2=0.0d0 +!c!------------------------------------------------------------------- +!c! ECL +! print *,"om1",om1,om2,om12 + fac = - 3.0d0 * om1 !after integer and simplify + c1 = (w1 / (Rhead**3.0d0)) * fac + c2 = (w2 / Rhead ** 6.0d0) & + * (4.0d0 + 6.0d0*sqom1 ) !after integration and simplifimartion + ECL = c1 - c2 +!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 + 6.0d0*sqom1) + dGCLdR = (c1 - c2)*sss_ele_cut +!c! dECL/dom1 + c1 = (-3.0d0 * w1) / (Rhead**3.0d0) + c2 = (12.0d0 * w2*om1) / (Rhead**6.0d0) + dGCLdOM1 = c1 - c2 +!c! dECL/dom2 +! c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0) + c1=0.0 ! this is because om2 is 0 +! c2 = (-6.0d0 * w2) / (Rhead**6.0d0) & +! * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 ) + c2=0.0 !om is 0 + dGCLdOM2 = c1 - c2 +!c! dECL/dom12 +! c1 = w1 / (Rhead ** 3.0d0) + c1=0.0d0 ! this is because om12 is 0 +! c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0 + c2=0.0d0 !om12 is 0 + 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)) + gradpepmartx(k,i) = gradpepmartx(k,i) - dGCLdR * pom& + -ecl*sss_ele_grad*rij*rreal(k) +! pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) +! gradpepmartx(k,j) = gradpepmartx(k,j) + dGCLdR * pom + + gradpepmart(k,i) = gradpepmart(k,i) - dGCLdR * erhead(k)& + -ecl*sss_ele_grad*rij*rreal(k) + + gradpepmart(k,j) = gradpepmart(k,j) + dGCLdR * erhead(k)& + +ecl*sss_ele_grad*rij*rreal(k) + + END DO + RETURN + END SUBROUTINE edd_mart + SUBROUTINE edd_mart_pep(ECL) +! IMPLICIT NONE + use comm_momo + use calc_data + + double precision ecl +!c! csig = sigiso(itypi,itypj) + w1 = wqdipmart(1,itypi,itypj) + w2 = wqdipmart(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! 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)*sss_ele_cut +!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 + dGCLdOM2=0.0d0 ! this is because om2=0 +!c! dECL/dom12 + c1 = w1 / (Rhead ** 3.0d0) + c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0 + dGCLdOM12 = c1 - c2 + dGCLdOM12=0.0d0 !this is because om12=0.0 +!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) ) + erdxj = scalar( erhead(1), dC_norm(1,j+nres) ) + facd1 = d1 * vbld_inv(i) + facd2 = d2 * vbld_inv(j+nres) + DO k = 1, 3 + + pom = facd1*(erhead(k)-erdxi*dC_norm(k,i)) + gradpepmart(k,i) = gradpepmart(k,i) + dGCLdR * pom + gradpepmart(k,i+1) = gradpepmart(k,i+1) - dGCLdR * pom +! pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres)) +! gradpepmartx(k,j) = gradpepmartx(k,j) + dGCLdR * pom + + gradpepmart(k,i) = gradpepmart(k,i) - dGCLdR * erhead(k)*0.5d0& + -ECL*sss_ele_grad*rreal(k)*rij + gradpepmart(k,i+1) = gradpepmart(k,i+1)- dGCLdR * erhead(k)*0.5d0& + -ECL*sss_ele_grad*rreal(k)*rij + + gradpepmart(k,j) = gradpepmart(k,j) + dGCLdR * erhead(k)& + +ECL*sss_ele_grad*rreal(k)*rij + + END DO + RETURN + END SUBROUTINE edd_mart_pep + + SUBROUTINE elgrad_init_mart(eheadtail,Egb,Ecl,Elj,Equad,Epol) + 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,4) +! print *,"in elegrad",i,j,itypi,itypj +!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 = sigmamart( itypi,itypj ) + chi1 = chi1mart( itypi, itypj ) + chi2 = 0.0d0 + chi12 = 0.0d0 + chip1 = chipp1mart( itypi, itypj ) + chip2 = 0.0d0 + chip12 = 0.0d0 +!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 + dxj = 0.0d0 !dc_norm( 1, nres+j ) + dyj = 0.0d0 !dc_norm( 2, nres+j ) + dzj = 0.0d0 !dc_norm( 3, nres+j ) +! print *,"before dheadmart" +!c! distance from center of chain(?) to polar/charged head + d1 = dheadmart(1, 1, itypi, itypj) + d2 = dheadmart(2, 1, itypi, itypj) +!c! ai*aj from Fgb + a12sq = rborn1mart(itypi,itypj) * rborn2mart(itypi,itypj) +!c! a12sq = a12sq * a12sq +!c! charge of amino acid itypi is... +! print *,"after dheadmart" + Qi = icharge(itypi) + Qj = ichargelipid(itypj) + Qij = Qi * Qj +! print *,"after icharge" + +!c! chis1,2,12 + chis1 = chis1mart(itypi,itypj) + chis2 = 0.0d0 + chis12 = 0.0d0 + sig1 = sigmap1mart(itypi,itypj) + sig2 = sigmap2mart(itypi,itypj) +! print *,"before alphasurmart" +!c! alpha factors from Fcav/Gcav + b1cav = alphasurmart(1,itypi,itypj) + b2cav = alphasurmart(2,itypi,itypj) + b3cav = alphasurmart(3,itypi,itypj) + b4cav = alphasurmart(4,itypi,itypj) + wqd = wquadmart(itypi, itypj) +! print *,"after alphasurmar n wquad" +!c! used by Fgb + eps_in = epsintabmart(itypi,itypj) + eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out)) +!c!------------------------------------------------------------------- +!c! tail lomartion and distance calculations + Rtail = 0.0d0 + DO k = 1, 3 + ctail(k,1)=c(k,i+nres)-dtailmart(1,itypi,itypj)*dc_norm(k,nres+i) + ctail(k,2)=c(k,j)!-dtailmart(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 lomartion and distance between polar heads +!c! distance between heads +!c! for each one of our three dimensional space... + d1 = dheadmart(1, 1, itypi, itypj) + d2 = dheadmart(2, 1, itypi, itypj) + + DO k = 1,3 +!c! lomartion of polar head is computed by taking hydrophobic centre +!c! and moving by a d1 * dc_norm vector +!c! see unres publimartions for very informative images + chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres) + chead(k,2) = c(k, j) +!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_mart + + SUBROUTINE elgrad_init_mart_pep(eheadtail,Egb,Ecl,Elj,Equad,Epol) + use comm_momo + use calc_data + real(kind=8) :: eheadtail,Egb,Ecl,Elj,Equad,Epol,Rb + eps_out=80.0d0 + itypi = 10 + itypj = itype(j,4) +!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 = sigmamart( itypi,itypj ) + chi1 = chi1mart( itypi, itypj ) + chi2 = 0.0d0 + chi12 = 0.0d0 + chip1 = chipp1mart( itypi, itypj ) + chip2 = 0.0d0 + chip12 = 0.0d0 +!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 + dxj = 0.0d0 !dc_norm( 1, nres+j ) + dyj = 0.0d0 !dc_norm( 2, nres+j ) + dzj = 0.0d0 !dc_norm( 3, nres+j ) +!c! distance from center of chain(?) to polar/charged head + d1 = dheadmart(1, 1, itypi, itypj) + d2 = dheadmart(2, 1, itypi, itypj) +!c! ai*aj from Fgb + a12sq = rborn1mart(itypi,itypj) * rborn2mart(itypi,itypj) +!c! a12sq = a12sq * a12sq +!c! charge of amino acid itypi is... + Qi = 0 + Qj = ichargelipid(itypj) +! Qij = Qi * Qj +!c! chis1,2,12 + chis1 = chis1mart(itypi,itypj) + chis2 = 0.0d0 + chis12 = 0.0d0 + sig1 = sigmap1mart(itypi,itypj) + sig2 = sigmap2mart(itypi,itypj) +!c! alpha factors from Fcav/Gcav + b1cav = alphasurmart(1,itypi,itypj) + b2cav = alphasurmart(2,itypi,itypj) + b3cav = alphasurmart(3,itypi,itypj) + b4cav = alphasurmart(4,itypi,itypj) + wqd = wquadmart(itypi, itypj) +!c! used by Fgb + eps_in = epsintabmart(itypi,itypj) + eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out)) +!c!------------------------------------------------------------------- +!c! tail lomartion and distance calculations + Rtail = 0.0d0 + DO k = 1, 3 + ctail(k,1)=(c(k,i)+c(k,i+1))/2.0-dtailmart(1,itypi,itypj)*dc_norm(k,i) + ctail(k,2)=c(k,j)!-dtailmart(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 lomartion and distance between polar heads +!c! distance between heads +!c! for each one of our three dimensional space... + d1 = dheadmart(1, 1, itypi, itypj) + d2 = dheadmart(2, 1, itypi, itypj) + + DO k = 1,3 +!c! lomartion of polar head is computed by taking hydrophobic centre +!c! and moving by a d1 * dc_norm vector +!c! see unres publimartions for very informative images + chead(k,1) = (c(k, i)+c(k,i+1))/2.0 + d1 * dc_norm(k, i) + chead(k,2) = c(k, j) +!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_mart_pep + + subroutine sc_grad_mart + use calc_data + real(kind=8), dimension(3) :: dcosom1,dcosom2 + 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 +! diagnostics only +! eom1=0.0d0 +! eom2=0.0d0 +! eom12=evdwij*eps1_om12 +! end diagnostics + + 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)) + enddo + do k=1,3 + gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)) +! 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 + gradpepmartx(k,i)=gradpepmartx(k,i)-gg(k)*sss_ele_cut & + +(eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) & + +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss_ele_cut + +! gradpepcatx(k,j)=gradpepcatx(k,j)+gg(k) & +! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)) & +! +eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv + +! 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)) & +! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv + enddo +! +! Calculate the components of the gradient in DC and X +! + do l=1,3 + gradpepmart(l,i)=gradpepmart(l,i)-gg(l)*sss_ele_cut + gradpepmart(l,j)=gradpepmart(l,j)+gg(l)*sss_ele_cut + enddo + end subroutine sc_grad_mart + + subroutine sc_grad_mart_pep + use calc_data + real(kind=8), dimension(3) :: dcosom1,dcosom2 + 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 +! diagnostics only +! eom1=0.0d0 +! eom2=0.0d0 +! eom12=evdwij*eps1_om12 +! end diagnostics +! write (iout,*) "gg",(gg(k),k=1,3) + + 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) + gradpepmart(k,i)= gradpepmart(k,i) +sss_ele_cut*(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) + gradpepmart(k,i+1)= gradpepmart(k,i+1) +sss_ele_cut*(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) + gradpepmart(k,j)=gradpepmart(k,j)+gg(k)*sss_ele_cut + enddo + end subroutine sc_grad_mart_pep end module energy