2 !-----------------------------------------------------------------------------
13 !-----------------------------------------------------------------------------
14 ! Max. number of contacts per residue
16 !-----------------------------------------------------------------------------
17 ! Max. number of derivatives of virtual-bond and side-chain vectors in theta
20 !-----------------------------------------------------------------------------
21 ! Max. number of SC contacts
23 !-----------------------------------------------------------------------------
24 ! Max. number of variables
26 !-----------------------------------------------------------------------------
27 ! Max number of torsional terms in SCCOR in control_data
28 ! integer,parameter :: maxterm_sccor=6
29 !-----------------------------------------------------------------------------
30 ! Maximum number of SC local term fitting function coefficiants
31 integer,parameter :: maxsccoef=65
32 ! Maximum number of local shielding effectors
33 integer,parameter :: maxcontsshi=50
34 !-----------------------------------------------------------------------------
35 ! commom.calc common/calc/
36 !-----------------------------------------------------------------------------
39 ! Change 12/1/95 - common block CONTACTS1 included.
42 integer,dimension(:),allocatable :: num_cont !(maxres)
43 integer,dimension(:,:),allocatable :: jcont !(maxconts,maxres)
44 real(kind=8),dimension(:,:),allocatable :: facont,ees0plist !(maxconts,maxres)
45 real(kind=8),dimension(:,:,:),allocatable :: gacont !(3,maxconts,maxres)
46 integer,dimension(:),allocatable :: ishield_list
47 integer,dimension(:,:),allocatable :: shield_list
48 real(kind=8),dimension(:),allocatable :: enetube,enecavtube
50 ! 12/26/95 - H-bonding contacts
51 ! common /contacts_hb/
52 real(kind=8),dimension(:,:,:),allocatable :: gacontp_hb1,gacontp_hb2,&
53 gacontp_hb3,gacontm_hb1,gacontm_hb2,gacontm_hb3,gacont_hbr,grij_hb_cont !(3,maxconts,maxres)
54 real(kind=8),dimension(:,:),allocatable :: facont_hb,ees0p,&
55 ees0m,d_cont !(maxconts,maxres)
56 integer,dimension(:),allocatable :: num_cont_hb !(maxres)
57 integer,dimension(:,:),allocatable :: jcont_hb !(maxconts,maxres)
58 ! 9/23/99 Added improper rotation matrices and matrices of dipole-dipole
60 ! 7/25/08 commented out; not needed when cumulants used
61 ! Interactions of pseudo-dipoles generated by loc-el interactions.
63 real(kind=8),dimension(:,:,:),allocatable :: dip,&
64 dipderg !(4,maxconts,maxres)
65 real(kind=8),dimension(:,:,:,:,:),allocatable :: dipderx !(3,5,4,maxconts,maxres)
66 ! 10/30/99 Added other pre-computed vectors and matrices needed
67 ! to calculate three - six-order el-loc correlation terms
69 real(kind=8),dimension(:,:,:),allocatable :: Ug,Ugder,Ug2,Ug2der !(2,2,maxres)
70 real(kind=8),dimension(:,:),allocatable :: obrot,obrot2,obrot_der,&
71 obrot2_der !(2,maxres)
73 ! This common block contains vectors and matrices dependent on a single
76 real(kind=8),dimension(:,:),allocatable :: mu,muder,Ub2,Ub2der,&
77 Ctobr,Ctobrder,Dtobr2,Dtobr2der !(2,maxres)
78 real(kind=8),dimension(:,:,:),allocatable :: EUg,EUgder,CUg,&
79 CUgder,DUg,Dugder,DtUg2,DtUg2der !(2,2,maxres)
80 ! This common block contains vectors and matrices dependent on two
81 ! consecutive amino-acid residues.
83 real(kind=8),dimension(:,:),allocatable :: Ug2Db1t,Ug2Db1tder,&
84 CUgb2,CUgb2der !(2,maxres)
85 real(kind=8),dimension(:,:,:),allocatable :: EUgC,EUgCder,&
86 EUgD,EUgDder,DtUg2EUg,Ug2DtEUg !(2,2,maxres)
87 real(kind=8),dimension(:,:,:,:),allocatable :: Ug2DtEUgder,&
88 DtUg2EUgder !(2,2,2,maxres)
90 real(kind=8),dimension(:),allocatable :: costab,sintab,&
91 costab2,sintab2 !(maxres)
92 ! This common block contains dipole-interaction matrices and their
93 ! Cartesian derivatives.
95 real(kind=8),dimension(:,:,:,:),allocatable :: a_chuj !(2,2,maxconts,maxres)
96 real(kind=8),dimension(:,:,:,:,:,:),allocatable :: a_chuj_der !(2,2,3,5,maxconts,maxres)
98 real(kind=8),dimension(2,2,2) :: AEA,AEAderg,EAEA,AECA,&
99 AECAderg,ADtEA,ADtEA1,AEAb1,AEAb1derg,AEAb2
100 real(kind=8),dimension(2,2,2,2) :: EAEAderg,ADtEAderg,&
102 real(kind=8),dimension(2,2,3,5,2,2) :: AEAderx,EAEAderx,&
103 AECAderx,ADtEAderx,ADtEA1derx
104 real(kind=8),dimension(2,3,5,2,2,2) :: AEAb1derx,AEAb2derx
105 real(kind=8),dimension(3,2) :: g_contij
106 real(kind=8) :: ekont
107 ! 12/13/2008 (again Poland-Jaruzel war anniversary)
108 ! RE: Parallelization of 4th and higher order loc-el correlations
109 ! common /contdistrib/
110 integer,dimension(:),allocatable :: ncont_sent,ncont_recv !(maxres)
111 ! ncont_sent,ncont_recv są w multibody_ello i multibody_hb
112 !-----------------------------------------------------------------------------
115 ! real(kind=8),dimension(:,:),allocatable :: dcdv,dxdv !(6,maxdim)
116 ! real(kind=8),dimension(:,:),allocatable :: dxds !(6,maxres)
117 ! real(kind=8),dimension(:,:,:),allocatable :: gradx,gradc !(3,maxres,2)
118 real(kind=8),dimension(:,:),allocatable :: gvdwc,gelc,gelc_long,&
119 gvdwpp,gvdwc_scpp,gradx_scp,gvdwc_scp,ghpbx,ghpbc,&
120 gradcorr,gradcorr_long,gradcorr5_long,gradcorr6_long,&
121 gcorr6_turn_long,gradxorr,gradcorr5,gradcorr6,gliptran,gliptranc,&
123 gshieldx,gshieldc,gshieldc_loc,gshieldx_ec,&
124 gshieldc_ec,gshieldc_loc_ec,gshieldx_t3, &
125 gshieldc_t3,gshieldc_loc_t3,gshieldx_t4,gshieldc_t4, &
126 gshieldc_loc_t4,gshieldx_ll,gshieldc_ll,gshieldc_loc_ll,&
127 grad_shield,gg_tube,gg_tube_sc,gradafm !(3,maxres)
128 !-----------------------------NUCLEIC GRADIENT
129 real(kind=8),dimension(:,:),allocatable ::gradb_nucl,gradbx_nucl, &
130 gvdwpsb1,gelpp,gvdwpsb,gelsbc,gelsbx,gvdwsbx,gvdwsbc,gsbloc,&
131 gsblocx,gradcorr_nucl,gradxorr_nucl,gradcorr3_nucl,gradxorr3_nucl,&
133 !-----------------------------NUCLEIC-PROTEIN GRADIENT
134 real(kind=8),dimension(:,:),allocatable :: gvdwx_scbase,gvdwc_scbase,&
135 gvdwx_pepbase,gvdwc_pepbase,gvdwx_scpho,gvdwc_scpho,&
137 !------------------------------IONS GRADIENT
138 real(kind=8),dimension(:,:),allocatable :: gradcatcat, &
139 gradpepcat,gradpepcatx
140 ! real(kind=8),dimension(:,:),allocatable :: gloc,gloc_x !(maxvar,2)
143 real(kind=8),dimension(:,:),allocatable :: gel_loc,gel_loc_long,&
144 gcorr3_turn,gcorr4_turn,gcorr6_turn,gradb,gradbx !(3,maxres)
145 real(kind=8),dimension(:),allocatable :: gel_loc_loc,&
146 gel_loc_turn3,gel_loc_turn4,gel_loc_turn6,gcorr_loc,g_corr5_loc,&
147 g_corr6_loc !(maxvar)
148 real(kind=8),dimension(:,:),allocatable :: gsccorc,gsccorx !(3,maxres)
149 real(kind=8),dimension(:),allocatable :: gsccor_loc !(maxres)
150 ! real(kind=8),dimension(:,:,:),allocatable :: dtheta !(3,2,maxres)
151 real(kind=8),dimension(:,:),allocatable :: gscloc,gsclocx !(3,maxres)
152 ! real(kind=8),dimension(:,:,:),allocatable :: dphi,dalpha,domega !(3,3,maxres)
153 real(kind=8),dimension(:,:,:),allocatable :: grad_shield_side, &
154 grad_shield_loc ! (3,maxcontsshileding,maxnres)
157 real(kind=8), dimension(:),allocatable :: fac_shield
158 real(kind=8),dimension(3,5,2) :: derx,derx_turn
159 ! common /deriv_scloc/
160 real(kind=8),dimension(:,:),allocatable :: dXX_C1tab,dYY_C1tab,&
161 dZZ_C1tab,dXX_Ctab,dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,&
162 dZZ_XYZtab !(3,maxres)
163 !-----------------------------------------------------------------------------
166 real(kind=8) :: gvdwc_max,gvdwc_scp_max,gelc_max,gvdwpp_max,&
167 gradb_max,ghpbc_max,&
168 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
169 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
170 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
171 gsccorx_max,gsclocx_max
172 !-----------------------------------------------------------------------------
174 ! common /back_constr/
175 real(kind=8),dimension(:),allocatable :: dutheta,dugamma !(maxres)
176 real(kind=8),dimension(:,:),allocatable :: duscdiff,duscdiffx !(3,maxres)
178 real(kind=8) :: Ucdfrag,Ucdpair
179 real(kind=8),dimension(:,:),allocatable :: dUdconst,dUdxconst,&
180 dqwol,dxqwol !(3,0:MAXRES)
181 !-----------------------------------------------------------------------------
183 ! common /dyn_ssbond/
184 real(kind=8),dimension(:,:),allocatable :: dyn_ssbond_ij !(maxres,maxres)
185 !-----------------------------------------------------------------------------
187 ! Parameters of the SCCOR term
189 real(kind=8),dimension(:,:,:,:),allocatable :: dcostau,dsintau,&
190 dcosomicron,domicron !(3,3,3,maxres2)
191 !-----------------------------------------------------------------------------
194 real(kind=8),dimension(:,:),allocatable :: uy,uz !(3,maxres)
195 real(kind=8),dimension(:,:,:,:),allocatable :: uygrad,uzgrad !(3,3,2,maxres)
196 !-----------------------------------------------------------------------------
197 ! common /przechowalnia/
198 real(kind=8),dimension(:,:,:),allocatable :: zapas
199 real(kind=8),dimension(:,:,:,:),allocatable ::zapas2 !(max_dim,maxconts,max_fg_procs)
200 real(kind=8),dimension(:,:,:),allocatable :: fromto !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
201 !-----------------------------------------------------------------------------
202 !-----------------------------------------------------------------------------
205 !-----------------------------------------------------------------------------
207 !-----------------------------------------------------------------------------
208 ! energy_p_new_barrier.F
209 !-----------------------------------------------------------------------------
210 subroutine etotal(energia)
211 ! implicit real*8 (a-h,o-z)
212 ! include 'DIMENSIONS'
217 !MS$ATTRIBUTES C :: proc_proc
223 ! include 'COMMON.SETUP'
224 ! include 'COMMON.IOUNITS'
225 real(kind=8),dimension(0:n_ene) :: energia
226 ! include 'COMMON.LOCAL'
227 ! include 'COMMON.FFIELD'
228 ! include 'COMMON.DERIV'
229 ! include 'COMMON.INTERACT'
230 ! include 'COMMON.SBRIDGE'
231 ! include 'COMMON.CHAIN'
232 ! include 'COMMON.VAR'
233 ! include 'COMMON.MD'
234 ! include 'COMMON.CONTROL'
235 ! include 'COMMON.TIME1'
236 real(kind=8) :: time00
238 integer :: n_corr,n_corr1,ierror
239 real(kind=8) :: etors,edihcnstr,etors_d,esccor,ehpb
240 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,escloc,ees,eel_loc
241 real(kind=8) :: eello_turn3,eello_turn4,estr,ebe,eliptran,etube, &
242 Eafmforce,ethetacnstr
243 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
244 ! now energies for nulceic alone parameters
245 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
246 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
249 real(kind=8) :: ecation_prot,ecationcation
250 ! energies for protein nucleic acid interaction
251 real(kind=8) :: escbase,epepbase,escpho,epeppho
254 real(kind=8) :: weights_(n_ene) !,time_Bcast,time_Bcastw
255 ! shielding effect varibles for MPI
256 ! real(kind=8) fac_shieldbuf(maxres),
257 ! & grad_shield_locbuf(3,maxcontsshi,-1:maxres),
258 ! & grad_shield_sidebuf(3,maxcontsshi,-1:maxres),
259 ! & grad_shieldbuf(3,-1:maxres)
260 ! integer ishield_listbuf(maxres),
261 ! &shield_listbuf(maxcontsshi,maxres)
263 ! print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
264 ! & " nfgtasks",nfgtasks
265 if (nfgtasks.gt.1) then
267 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
268 if (fg_rank.eq.0) then
269 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
270 ! print *,"Processor",myrank," BROADCAST iorder"
271 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
272 ! FG slaves as WEIGHTS array.
292 weights_(26)=wvdwpp_nucl
298 weights_(32)=wbond_nucl
299 weights_(33)=wang_nucl
301 weights_(35)=wtor_nucl
302 weights_(36)=wtor_d_nucl
303 weights_(37)=wcorr_nucl
304 weights_(38)=wcorr3_nucl
306 weights_(42)=wcatprot
310 ! wcatcat= weights(41)
311 ! wcatprot=weights(42)
313 ! FG Master broadcasts the WEIGHTS_ array
314 call MPI_Bcast(weights_(1),n_ene,&
315 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
317 ! FG slaves receive the WEIGHTS array
318 call MPI_Bcast(weights(1),n_ene,&
319 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
339 wvdwpp_nucl =weights(26)
345 wbond_nucl =weights(32)
346 wang_nucl =weights(33)
348 wtor_nucl =weights(35)
349 wtor_d_nucl =weights(36)
350 wcorr_nucl =weights(37)
351 wcorr3_nucl =weights(38)
358 time_Bcast=time_Bcast+MPI_Wtime()-time00
359 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
360 ! call chainbuild_cart
362 ! print *,'Processor',myrank,' calling etotal ipot=',ipot
363 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
365 ! if (modecalc.eq.12.or.modecalc.eq.14) then
366 ! call int_from_cart1(.false.)
373 ! Compute the side-chain and electrostatic interaction energy
374 ! print *, "Before EVDW"
375 ! goto (101,102,103,104,105,106) ipot
377 ! Lennard-Jones potential.
381 !d print '(a)','Exit ELJcall el'
383 ! Lennard-Jones-Kihara potential (shifted).
384 ! 102 call eljk(evdw)
388 ! Berne-Pechukas potential (dilated LJ, angular dependence).
393 ! Gay-Berne potential (shifted LJ, angular dependence).
396 ! print *,"MOMO",scelemode
397 if (scelemode.eq.0) then
403 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
404 ! 105 call egbv(evdw)
408 ! Soft-sphere potential
409 ! 106 call e_softsphere(evdw)
411 call e_softsphere(evdw)
413 ! Calculate electrostatic (H-bonding) energy of the main chain.
417 write(iout,*)"Wrong ipot"
422 ! print *,"after EGB"
424 if (shield_mode.eq.2) then
427 ! print *,"AFTER EGB",ipot,evdw
429 !mc Sep-06: egb takes care of dynamic ss bonds too
431 ! if (dyn_ss) call dyn_set_nss
432 ! print *,"Processor",myrank," computed USCSC"
438 time_vec=time_vec+MPI_Wtime()-time01
440 ! print *,"Processor",myrank," left VEC_AND_DERIV"
443 ! print *,"after ipot if", ipot
444 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
445 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
446 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
447 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
449 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
450 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
451 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
452 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
454 ! print *,"just befor eelec call"
455 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
456 ! write (iout,*) "ELEC calc"
465 ! write (iout,*) "Soft-spheer ELEC potential"
466 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
469 ! print *,"Processor",myrank," computed UELEC"
471 ! Calculate excluded-volume interaction energy between peptide groups
474 !elwrite(iout,*) "in etotal calc exc;luded",ipot
478 call escp(evdw2,evdw2_14)
484 ! write (iout,*) "Soft-sphere SCP potential"
485 call escp_soft_sphere(evdw2,evdw2_14)
487 ! write(iout,*) "in etotal before ebond",ipot
490 ! Calculate the bond-stretching energy
493 ! print *,"EBOND",estr
494 ! write(iout,*) "in etotal afer ebond",ipot
497 ! Calculate the disulfide-bridge and other energy and the contributions
498 ! from other distance constraints.
499 ! print *,'Calling EHPB'
501 !elwrite(iout,*) "in etotal afer edis",ipot
502 ! print *,'EHPB exitted succesfully.'
504 ! Calculate the virtual-bond-angle energy.
506 if (wang.gt.0d0) then
507 call ebend(ebe,ethetacnstr)
512 ! print *,"Processor",myrank," computed UB"
514 ! Calculate the SC local energy.
517 !elwrite(iout,*) "in etotal afer esc",ipot
518 ! print *,"Processor",myrank," computed USC"
520 ! Calculate the virtual-bond torsional energy.
522 !d print *,'nterm=',nterm
524 call etor(etors,edihcnstr)
529 ! print *,"Processor",myrank," computed Utor"
531 ! 6/23/01 Calculate double-torsional energy
533 !elwrite(iout,*) "in etotal",ipot
534 if (wtor_d.gt.0) then
539 ! print *,"Processor",myrank," computed Utord"
541 ! 21/5/07 Calculate local sicdechain correlation energy
543 if (wsccor.gt.0.0d0) then
544 call eback_sc_corr(esccor)
548 ! print *,"Processor",myrank," computed Usccorr"
550 ! 12/1/95 Multi-body terms
554 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
555 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
556 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
557 !d write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
558 !d &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
565 !elwrite(iout,*) "in etotal",ipot
566 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
567 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
568 !d write (iout,*) "multibody_hb ecorr",ecorr
570 !elwrite(iout,*) "afeter multibody hb"
572 ! print *,"Processor",myrank," computed Ucorr"
574 ! If performing constraint dynamics, call the constraint energy
575 ! after the equilibration time
576 if(usampl.and.totT.gt.eq_time) then
577 !elwrite(iout,*) "afeter multibody hb"
579 !elwrite(iout,*) "afeter multibody hb"
581 !elwrite(iout,*) "afeter multibody hb"
587 ! write(iout,*) "after Econstr"
589 if (wliptran.gt.0) then
590 ! print *,"PRZED WYWOLANIEM"
591 call Eliptransfer(eliptran)
595 if (fg_rank.eq.0) then
596 if (AFMlog.gt.0) then
597 call AFMforce(Eafmforce)
598 else if (selfguide.gt.0) then
599 call AFMvel(Eafmforce)
602 if (tubemode.eq.1) then
604 else if (tubemode.eq.2) then
605 call calctube2(etube)
606 elseif (tubemode.eq.3) then
611 !--------------------------------------------------------
612 ! write (iout,*) "NRES_MOLEC(2),",nres_molec(2)
613 ! print *,"before",ees,evdw1,ecorr
614 if (nres_molec(2).gt.0) then
615 call ebond_nucl(estr_nucl)
616 call ebend_nucl(ebe_nucl)
617 call etor_nucl(etors_nucl)
618 call esb_gb(evdwsb,eelsb)
619 call epp_nucl_sub(evdwpp,eespp)
620 call epsb(evdwpsb,eelpsb)
622 call multibody_hb_nucl(ecorr_nucl,ecorr3_nucl,n_corr,n_corr1)
631 if (nfgtasks.gt.1) then
632 if (fg_rank.eq.0) then
633 call ecatcat(ecationcation)
636 call ecatcat(ecationcation)
638 call ecat_prot(ecation_prot)
639 if (nres_molec(2).gt.0) then
640 call eprot_sc_base(escbase)
641 call epep_sc_base(epepbase)
642 call eprot_sc_phosphate(escpho)
643 call eprot_pep_phosphate(epeppho)
650 ! call ecatcat(ecationcation)
651 ! print *,"after ebend", ebe_nucl
653 time_enecalc=time_enecalc+MPI_Wtime()-time00
655 ! print *,"Processor",myrank," computed Uconstr"
664 energia(2)=evdw2-evdw2_14
681 energia(8)=eello_turn3
682 energia(9)=eello_turn4
689 energia(19)=edihcnstr
691 energia(20)=Uconst+Uconst_back
694 energia(23)=Eafmforce
695 energia(24)=ethetacnstr
697 !---------------------------------------------------------------
704 energia(32)=estr_nucl
707 energia(35)=etors_nucl
708 energia(36)=etors_d_nucl
709 energia(37)=ecorr_nucl
710 energia(38)=ecorr3_nucl
711 !----------------------------------------------------------------------
712 ! Here are the energies showed per procesor if the are more processors
713 ! per molecule then we sum it up in sum_energy subroutine
714 ! print *," Processor",myrank," calls SUM_ENERGY"
715 energia(41)=ecation_prot
716 energia(42)=ecationcation
721 call sum_energy(energia,.true.)
722 if (dyn_ss) call dyn_set_nss
723 ! print *," Processor",myrank," left SUM_ENERGY"
725 time_sumene=time_sumene+MPI_Wtime()-time00
727 !el call enerprint(energia)
728 !elwrite(iout,*)"finish etotal"
730 end subroutine etotal
731 !-----------------------------------------------------------------------------
732 subroutine sum_energy(energia,reduce)
733 ! implicit real*8 (a-h,o-z)
734 ! include 'DIMENSIONS'
738 !MS$ATTRIBUTES C :: proc_proc
744 ! include 'COMMON.SETUP'
745 ! include 'COMMON.IOUNITS'
746 real(kind=8) :: energia(0:n_ene),enebuff(0:n_ene+1)
747 ! include 'COMMON.FFIELD'
748 ! include 'COMMON.DERIV'
749 ! include 'COMMON.INTERACT'
750 ! include 'COMMON.SBRIDGE'
751 ! include 'COMMON.CHAIN'
752 ! include 'COMMON.VAR'
753 ! include 'COMMON.CONTROL'
754 ! include 'COMMON.TIME1'
756 real(kind=8) :: evdw,evdw2,evdw2_14,ees,evdw1,ecorr,ecorr5,ecorr6
757 real(kind=8) :: eel_loc,eello_turn3,eello_turn4,eturn6,ebe,escloc
758 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,esccor,etot, &
759 eliptran,etube, Eafmforce,ethetacnstr
760 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
761 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
763 real(kind=8) :: ecation_prot,ecationcation
764 real(kind=8) :: escbase,epepbase,escpho,epeppho
768 real(kind=8) :: time00
769 if (nfgtasks.gt.1 .and. reduce) then
772 write (iout,*) "energies before REDUCE"
773 call enerprint(energia)
777 enebuff(i)=energia(i)
780 call MPI_Barrier(FG_COMM,IERR)
781 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
783 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,&
784 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
786 write (iout,*) "energies after REDUCE"
787 call enerprint(energia)
790 time_Reduce=time_Reduce+MPI_Wtime()-time00
792 if (fg_rank.eq.0) then
796 evdw2=energia(2)+energia(18)
812 eello_turn3=energia(8)
813 eello_turn4=energia(9)
820 edihcnstr=energia(19)
825 Eafmforce=energia(23)
826 ethetacnstr=energia(24)
834 estr_nucl=energia(32)
837 etors_nucl=energia(35)
838 etors_d_nucl=energia(36)
839 ecorr_nucl=energia(37)
840 ecorr3_nucl=energia(38)
841 ecation_prot=energia(41)
842 ecationcation=energia(42)
847 ! energia(41)=ecation_prot
848 ! energia(42)=ecationcation
852 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 &
853 +wang*ebe+wtor*etors+wscloc*escloc &
854 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
855 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
856 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
857 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
858 +Eafmforce+ethetacnstr &
859 +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
860 +wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
861 +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
862 +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
863 +wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
864 +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho
866 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) &
867 +wang*ebe+wtor*etors+wscloc*escloc &
868 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
869 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
870 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
871 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
872 +Eafmforce+ethetacnstr &
873 +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
874 +wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
875 +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
876 +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
877 +wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
878 +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho
884 if (isnan(etot).ne.0) energia(0)=1.0d+99
886 if (isnan(etot)) energia(0)=1.0d+99
891 idumm=proc_proc(etot,i)
893 call proc_proc(etot,i)
895 if(i.eq.1)energia(0)=1.0d+99
900 ! call enerprint(energia)
903 end subroutine sum_energy
904 !-----------------------------------------------------------------------------
905 subroutine rescale_weights(t_bath)
906 ! implicit real*8 (a-h,o-z)
910 ! include 'DIMENSIONS'
911 ! include 'COMMON.IOUNITS'
912 ! include 'COMMON.FFIELD'
913 ! include 'COMMON.SBRIDGE'
914 real(kind=8) :: kfac=2.4d0
915 real(kind=8) :: x,x2,x3,x4,x5,licznik=1.12692801104297249644
917 real(kind=8) :: t_bath,facT(6) !,facT2,facT3,facT4,facT5,facT6
918 real(kind=8) :: T0=3.0d2
921 ! facT=2*temp0/(t_bath+temp0)
922 if (rescale_mode.eq.0) then
929 else if (rescale_mode.eq.1) then
930 facT(1)=kfac/(kfac-1.0d0+t_bath/temp0)
931 facT(2)=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
932 facT(3)=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
933 facT(4)=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
934 facT(5)=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
936 !#if defined(WHAM_RUN) || defined(CLUSTER)
938 ! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
939 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
946 else if (rescale_mode.eq.2) then
952 facT(1)=licznik/dlog(dexp(x)+dexp(-x))
953 facT(2)=licznik/dlog(dexp(x2)+dexp(-x2))
954 facT(3)=licznik/dlog(dexp(x3)+dexp(-x3))
955 facT(4)=licznik/dlog(dexp(x4)+dexp(-x4))
956 facT(5)=licznik/dlog(dexp(x5)+dexp(-x5))
958 !#if defined(WHAM_RUN) || defined(CLUSTER)
960 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
968 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
969 write (*,*) "Wrong RESCALE_MODE",rescale_mode
971 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
975 welec=weights(3)*fact(1)
976 wcorr=weights(4)*fact(3)
977 wcorr5=weights(5)*fact(4)
978 wcorr6=weights(6)*fact(5)
979 wel_loc=weights(7)*fact(2)
980 wturn3=weights(8)*fact(2)
981 wturn4=weights(9)*fact(3)
982 wturn6=weights(10)*fact(5)
983 wtor=weights(13)*fact(1)
984 wtor_d=weights(14)*fact(2)
985 wsccor=weights(21)*fact(1)
988 end subroutine rescale_weights
989 !-----------------------------------------------------------------------------
990 subroutine enerprint(energia)
991 ! implicit real*8 (a-h,o-z)
992 ! include 'DIMENSIONS'
993 ! include 'COMMON.IOUNITS'
994 ! include 'COMMON.FFIELD'
995 ! include 'COMMON.SBRIDGE'
996 ! include 'COMMON.MD'
997 real(kind=8) :: energia(0:n_ene)
999 real(kind=8) :: etot,evdw,evdw2,ees,evdw1,ecorr,ecorr5,ecorr6,eel_loc
1000 real(kind=8) :: eello_turn6,eello_turn3,eello_turn4,ebe,escloc
1001 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,Uconst,esccor,eliptran,&
1002 etube,ethetacnstr,Eafmforce
1003 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
1004 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
1006 real(kind=8) :: ecation_prot,ecationcation
1007 real(kind=8) :: escbase,epepbase,escpho,epeppho
1013 evdw2=energia(2)+energia(18)
1025 eello_turn3=energia(8)
1026 eello_turn4=energia(9)
1027 eello_turn6=energia(10)
1033 edihcnstr=energia(19)
1037 eliptran=energia(22)
1038 Eafmforce=energia(23)
1039 ethetacnstr=energia(24)
1047 estr_nucl=energia(32)
1048 ebe_nucl=energia(33)
1050 etors_nucl=energia(35)
1051 etors_d_nucl=energia(36)
1052 ecorr_nucl=energia(37)
1053 ecorr3_nucl=energia(38)
1054 ecation_prot=energia(41)
1055 ecationcation=energia(42)
1057 epepbase=energia(47)
1061 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,&
1062 estr,wbond,ebe,wang,&
1063 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
1065 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
1066 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,&
1067 edihcnstr,ethetacnstr,ebr*nss,&
1068 Uconst,eliptran,wliptran,Eafmforce,etube,wtube, & ! till now protein
1069 estr_nucl,wbond_nucl,ebe_nucl,wang_nucl, &
1070 evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb,&
1071 evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl,&
1072 etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
1073 ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, &
1074 escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
1076 10 format (/'Virtual-chain energies:'// &
1077 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
1078 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
1079 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
1080 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ &
1081 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
1082 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
1083 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
1084 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
1085 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
1086 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
1087 ' (SS bridges & dist. cnstr.)'/ &
1088 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1089 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1090 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1091 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
1092 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
1093 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
1094 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
1095 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
1096 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
1097 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
1098 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
1099 'UCONST= ',1pE16.6,' (Constraint energy)'/ &
1100 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/&
1101 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
1102 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
1103 'ESTR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
1104 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
1105 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
1106 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
1107 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
1108 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
1109 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
1110 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
1111 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
1112 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
1113 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
1114 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
1115 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
1116 'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ &
1117 'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ &
1118 'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ &
1119 'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
1120 'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
1121 'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
1122 'ETOT= ',1pE16.6,' (total)')
1124 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,&
1125 estr,wbond,ebe,wang,&
1126 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
1128 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
1129 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,&
1130 ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc, &
1132 estr_nucl,wbond_nucl, ebe_nucl,wang_nucl,&
1133 evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb&
1134 evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl&
1135 etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
1136 ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, &
1137 escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
1139 10 format (/'Virtual-chain energies:'// &
1140 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
1141 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
1142 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
1143 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
1144 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
1145 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
1146 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
1147 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
1148 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
1149 ' (SS bridges & dist. cnstr.)'/ &
1150 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1151 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1152 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1153 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
1154 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
1155 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
1156 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
1157 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
1158 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
1159 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
1160 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
1161 'UCONST=',1pE16.6,' (Constraint energy)'/ &
1162 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ &
1163 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
1164 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
1165 'ESTR_nucl= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
1166 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
1167 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
1168 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
1169 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
1170 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
1171 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
1172 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
1173 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
1174 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
1175 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
1176 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
1177 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
1178 'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ &
1179 'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ &
1180 'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ &
1181 'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
1182 'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
1183 'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
1184 'ETOT= ',1pE16.6,' (total)')
1187 end subroutine enerprint
1188 !-----------------------------------------------------------------------------
1189 subroutine elj(evdw)
1191 ! This subroutine calculates the interaction energy of nonbonded side chains
1192 ! assuming the LJ potential of interaction.
1194 ! implicit real*8 (a-h,o-z)
1195 ! include 'DIMENSIONS'
1196 real(kind=8),parameter :: accur=1.0d-10
1197 ! include 'COMMON.GEO'
1198 ! include 'COMMON.VAR'
1199 ! include 'COMMON.LOCAL'
1200 ! include 'COMMON.CHAIN'
1201 ! include 'COMMON.DERIV'
1202 ! include 'COMMON.INTERACT'
1203 ! include 'COMMON.TORSION'
1204 ! include 'COMMON.SBRIDGE'
1205 ! include 'COMMON.NAMES'
1206 ! include 'COMMON.IOUNITS'
1207 ! include 'COMMON.CONTACTS'
1208 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1209 integer :: num_conti
1211 integer :: i,itypi,iint,j,itypi1,itypj,k
1212 real(kind=8) :: rij,rcut,fcont,fprimcont,rrij
1213 real(kind=8) :: evdw,xi,yi,zi,xj,yj,zj
1214 real(kind=8) :: eps0ij,fac,e1,e2,evdwij,sigij,r0ij
1216 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1218 ! allocate(num_cont(iatsc_s:iatsc_e)) !(maxres) nnt,nct-2
1219 ! allocate(jcont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres) (maxconts=maxres/4)
1220 ! allocate(facont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres)
1221 ! allocate(gacont(3,nres/4,iatsc_s:iatsc_e)) !(3,maxconts,maxres)
1223 do i=iatsc_s,iatsc_e
1224 itypi=iabs(itype(i,1))
1225 if (itypi.eq.ntyp1) cycle
1226 itypi1=iabs(itype(i+1,1))
1233 ! Calculate SC interaction energy.
1235 do iint=1,nint_gr(i)
1236 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1237 !d & 'iend=',iend(i,iint)
1238 do j=istart(i,iint),iend(i,iint)
1239 itypj=iabs(itype(j,1))
1240 if (itypj.eq.ntyp1) cycle
1244 ! Change 12/1/95 to calculate four-body interactions
1245 rij=xj*xj+yj*yj+zj*zj
1247 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1248 eps0ij=eps(itypi,itypj)
1250 e1=fac*fac*aa_aq(itypi,itypj)
1251 e2=fac*bb_aq(itypi,itypj)
1253 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1254 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1255 !d write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1256 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1257 !d & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1258 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1261 ! Calculate the components of the gradient in DC and X
1263 fac=-rrij*(e1+evdwij)
1268 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1269 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1270 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1271 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1275 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1279 ! 12/1/95, revised on 5/20/97
1281 ! Calculate the contact function. The ith column of the array JCONT will
1282 ! contain the numbers of atoms that make contacts with the atom I (of numbers
1283 ! greater than I). The arrays FACONT and GACONT will contain the values of
1284 ! the contact function and its derivative.
1286 ! Uncomment next line, if the correlation interactions include EVDW explicitly.
1287 ! if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1288 ! Uncomment next line, if the correlation interactions are contact function only
1289 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1291 sigij=sigma(itypi,itypj)
1292 r0ij=rs0(itypi,itypj)
1294 ! Check whether the SC's are not too far to make a contact.
1297 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1298 ! Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1300 if (fcont.gt.0.0D0) then
1301 ! If the SC-SC distance if close to sigma, apply spline.
1302 !Adam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1303 !Adam & fcont1,fprimcont1)
1304 !Adam fcont1=1.0d0-fcont1
1305 !Adam if (fcont1.gt.0.0d0) then
1306 !Adam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1307 !Adam fcont=fcont*fcont1
1309 ! Uncomment following 4 lines to have the geometric average of the epsilon0's
1310 !ga eps0ij=1.0d0/dsqrt(eps0ij)
1312 !ga gg(k)=gg(k)*eps0ij
1314 !ga eps0ij=-evdwij*eps0ij
1315 ! Uncomment for AL's type of SC correlation interactions.
1316 !adam eps0ij=-evdwij
1317 num_conti=num_conti+1
1318 jcont(num_conti,i)=j
1319 facont(num_conti,i)=fcont*eps0ij
1320 fprimcont=eps0ij*fprimcont/rij
1322 !Adam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1323 !Adam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1324 !Adam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1325 ! Uncomment following 3 lines for Skolnick's type of SC correlation.
1326 gacont(1,num_conti,i)=-fprimcont*xj
1327 gacont(2,num_conti,i)=-fprimcont*yj
1328 gacont(3,num_conti,i)=-fprimcont*zj
1329 !d write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1330 !d write (iout,'(2i3,3f10.5)')
1331 !d & i,j,(gacont(kk,num_conti,i),kk=1,3)
1337 num_cont(i)=num_conti
1341 gvdwc(j,i)=expon*gvdwc(j,i)
1342 gvdwx(j,i)=expon*gvdwx(j,i)
1345 !******************************************************************************
1349 ! To save time, the factor of EXPON has been extracted from ALL components
1350 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
1353 !******************************************************************************
1356 !-----------------------------------------------------------------------------
1357 subroutine eljk(evdw)
1359 ! This subroutine calculates the interaction energy of nonbonded side chains
1360 ! assuming the LJK potential of interaction.
1362 ! implicit real*8 (a-h,o-z)
1363 ! include 'DIMENSIONS'
1364 ! include 'COMMON.GEO'
1365 ! include 'COMMON.VAR'
1366 ! include 'COMMON.LOCAL'
1367 ! include 'COMMON.CHAIN'
1368 ! include 'COMMON.DERIV'
1369 ! include 'COMMON.INTERACT'
1370 ! include 'COMMON.IOUNITS'
1371 ! include 'COMMON.NAMES'
1372 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1375 integer :: i,iint,j,itypi,itypi1,k,itypj
1376 real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij
1377 real(kind=8) :: evdw,rij,r_shift_inv,fac,e1,e2,evdwij
1379 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1381 do i=iatsc_s,iatsc_e
1382 itypi=iabs(itype(i,1))
1383 if (itypi.eq.ntyp1) cycle
1384 itypi1=iabs(itype(i+1,1))
1389 ! Calculate SC interaction energy.
1391 do iint=1,nint_gr(i)
1392 do j=istart(i,iint),iend(i,iint)
1393 itypj=iabs(itype(j,1))
1394 if (itypj.eq.ntyp1) cycle
1398 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1399 fac_augm=rrij**expon
1400 e_augm=augm(itypi,itypj)*fac_augm
1401 r_inv_ij=dsqrt(rrij)
1403 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1404 fac=r_shift_inv**expon
1405 e1=fac*fac*aa_aq(itypi,itypj)
1406 e2=fac*bb_aq(itypi,itypj)
1408 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1409 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1410 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1411 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1412 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1413 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1414 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1417 ! Calculate the components of the gradient in DC and X
1419 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1424 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1425 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1426 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1427 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1431 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1439 gvdwc(j,i)=expon*gvdwc(j,i)
1440 gvdwx(j,i)=expon*gvdwx(j,i)
1445 !-----------------------------------------------------------------------------
1446 subroutine ebp(evdw)
1448 ! This subroutine calculates the interaction energy of nonbonded side chains
1449 ! assuming the Berne-Pechukas potential of interaction.
1453 ! implicit real*8 (a-h,o-z)
1454 ! include 'DIMENSIONS'
1455 ! include 'COMMON.GEO'
1456 ! include 'COMMON.VAR'
1457 ! include 'COMMON.LOCAL'
1458 ! include 'COMMON.CHAIN'
1459 ! include 'COMMON.DERIV'
1460 ! include 'COMMON.NAMES'
1461 ! include 'COMMON.INTERACT'
1462 ! include 'COMMON.IOUNITS'
1463 ! include 'COMMON.CALC'
1465 !el integer :: icall
1466 !el common /srutu/ icall
1467 ! double precision rrsave(maxdim)
1470 integer :: iint,itypi,itypi1,itypj
1471 real(kind=8) :: rrij,xi,yi,zi
1472 real(kind=8) :: evdw,fac,e1,e2,sigm,epsi
1474 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1476 ! if (icall.eq.0) then
1482 do i=iatsc_s,iatsc_e
1483 itypi=iabs(itype(i,1))
1484 if (itypi.eq.ntyp1) cycle
1485 itypi1=iabs(itype(i+1,1))
1489 dxi=dc_norm(1,nres+i)
1490 dyi=dc_norm(2,nres+i)
1491 dzi=dc_norm(3,nres+i)
1492 ! dsci_inv=dsc_inv(itypi)
1493 dsci_inv=vbld_inv(i+nres)
1495 ! Calculate SC interaction energy.
1497 do iint=1,nint_gr(i)
1498 do j=istart(i,iint),iend(i,iint)
1500 itypj=iabs(itype(j,1))
1501 if (itypj.eq.ntyp1) cycle
1502 ! dscj_inv=dsc_inv(itypj)
1503 dscj_inv=vbld_inv(j+nres)
1504 chi1=chi(itypi,itypj)
1505 chi2=chi(itypj,itypi)
1512 alf12=0.5D0*(alf1+alf2)
1513 ! For diagnostics only!!!
1526 dxj=dc_norm(1,nres+j)
1527 dyj=dc_norm(2,nres+j)
1528 dzj=dc_norm(3,nres+j)
1529 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1530 !d if (icall.eq.0) then
1536 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
1538 ! Calculate whole angle-dependent part of epsilon and contributions
1539 ! to its derivatives
1540 fac=(rrij*sigsq)**expon2
1541 e1=fac*fac*aa_aq(itypi,itypj)
1542 e2=fac*bb_aq(itypi,itypj)
1543 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1544 eps2der=evdwij*eps3rt
1545 eps3der=evdwij*eps2rt
1546 evdwij=evdwij*eps2rt*eps3rt
1549 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1550 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1551 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1552 !d & restyp(itypi,1),i,restyp(itypj,1),j,
1553 !d & epsi,sigm,chi1,chi2,chip1,chip2,
1554 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1555 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
1558 ! Calculate gradient components.
1559 e1=e1*eps1*eps2rt**2*eps3rt**2
1560 fac=-expon*(e1+evdwij)
1563 ! Calculate radial part of the gradient
1567 ! Calculate the angular part of the gradient and sum add the contributions
1568 ! to the appropriate components of the Cartesian gradient.
1576 !-----------------------------------------------------------------------------
1577 subroutine egb(evdw)
1579 ! This subroutine calculates the interaction energy of nonbonded side chains
1580 ! assuming the Gay-Berne potential of interaction.
1583 ! implicit real*8 (a-h,o-z)
1584 ! include 'DIMENSIONS'
1585 ! include 'COMMON.GEO'
1586 ! include 'COMMON.VAR'
1587 ! include 'COMMON.LOCAL'
1588 ! include 'COMMON.CHAIN'
1589 ! include 'COMMON.DERIV'
1590 ! include 'COMMON.NAMES'
1591 ! include 'COMMON.INTERACT'
1592 ! include 'COMMON.IOUNITS'
1593 ! include 'COMMON.CALC'
1594 ! include 'COMMON.CONTROL'
1595 ! include 'COMMON.SBRIDGE'
1598 integer :: iint,itypi,itypi1,itypj,subchap
1599 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
1600 real(kind=8) :: evdw,sig0ij
1601 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
1602 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
1603 sslipi,sslipj,faclip
1605 real(kind=8) :: fracinbuf
1607 !cccc energy_dec=.false.
1608 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1611 ! if (icall.eq.0) lprn=.false.
1613 do i=iatsc_s,iatsc_e
1614 !C print *,"I am in EVDW",i
1615 itypi=iabs(itype(i,1))
1616 ! if (i.ne.47) cycle
1617 if (itypi.eq.ntyp1) cycle
1618 itypi1=iabs(itype(i+1,1))
1622 xi=dmod(xi,boxxsize)
1623 if (xi.lt.0) xi=xi+boxxsize
1624 yi=dmod(yi,boxysize)
1625 if (yi.lt.0) yi=yi+boxysize
1626 zi=dmod(zi,boxzsize)
1627 if (zi.lt.0) zi=zi+boxzsize
1629 if ((zi.gt.bordlipbot) &
1630 .and.(zi.lt.bordliptop)) then
1631 !C the energy transfer exist
1632 if (zi.lt.buflipbot) then
1633 !C what fraction I am in
1635 ((zi-bordlipbot)/lipbufthick)
1636 !C lipbufthick is thickenes of lipid buffore
1637 sslipi=sscalelip(fracinbuf)
1638 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1639 elseif (zi.gt.bufliptop) then
1640 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1641 sslipi=sscalelip(fracinbuf)
1642 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1651 ! print *, sslipi,ssgradlipi
1652 dxi=dc_norm(1,nres+i)
1653 dyi=dc_norm(2,nres+i)
1654 dzi=dc_norm(3,nres+i)
1655 ! dsci_inv=dsc_inv(itypi)
1656 dsci_inv=vbld_inv(i+nres)
1657 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1658 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1660 ! Calculate SC interaction energy.
1662 do iint=1,nint_gr(i)
1663 do j=istart(i,iint),iend(i,iint)
1664 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1665 call dyn_ssbond_ene(i,j,evdwij)
1667 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1668 'evdw',i,j,evdwij,' ss'
1669 ! if (energy_dec) write (iout,*) &
1670 ! 'evdw',i,j,evdwij,' ss'
1671 do k=j+1,iend(i,iint)
1672 !C search over all next residues
1673 if (dyn_ss_mask(k)) then
1674 !C check if they are cysteins
1675 !C write(iout,*) 'k=',k
1677 !c write(iout,*) "PRZED TRI", evdwij
1678 ! evdwij_przed_tri=evdwij
1679 call triple_ssbond_ene(i,j,k,evdwij)
1680 !c if(evdwij_przed_tri.ne.evdwij) then
1681 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1684 !c write(iout,*) "PO TRI", evdwij
1685 !C call the energy function that removes the artifical triple disulfide
1686 !C bond the soubroutine is located in ssMD.F
1688 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1689 'evdw',i,j,evdwij,'tss'
1690 endif!dyn_ss_mask(k)
1694 itypj=iabs(itype(j,1))
1695 if (itypj.eq.ntyp1) cycle
1696 ! if (j.ne.78) cycle
1697 ! dscj_inv=dsc_inv(itypj)
1698 dscj_inv=vbld_inv(j+nres)
1699 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,&
1700 ! 1.0d0/vbld(j+nres) !d
1701 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
1702 sig0ij=sigma(itypi,itypj)
1703 chi1=chi(itypi,itypj)
1704 chi2=chi(itypj,itypi)
1711 alf12=0.5D0*(alf1+alf2)
1712 ! For diagnostics only!!!
1725 xj=dmod(xj,boxxsize)
1726 if (xj.lt.0) xj=xj+boxxsize
1727 yj=dmod(yj,boxysize)
1728 if (yj.lt.0) yj=yj+boxysize
1729 zj=dmod(zj,boxzsize)
1730 if (zj.lt.0) zj=zj+boxzsize
1731 ! print *,"tu",xi,yi,zi,xj,yj,zj
1732 ! print *,"tu2",j,j+nres,c(1,j),c(1,j+nres)
1733 ! this fragment set correct epsilon for lipid phase
1734 if ((zj.gt.bordlipbot) &
1735 .and.(zj.lt.bordliptop)) then
1736 !C the energy transfer exist
1737 if (zj.lt.buflipbot) then
1738 !C what fraction I am in
1740 ((zj-bordlipbot)/lipbufthick)
1741 !C lipbufthick is thickenes of lipid buffore
1742 sslipj=sscalelip(fracinbuf)
1743 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1744 elseif (zj.gt.bufliptop) then
1745 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1746 sslipj=sscalelip(fracinbuf)
1747 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1756 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1757 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1758 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1759 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1760 !------------------------------------------------
1761 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1769 xj=xj_safe+xshift*boxxsize
1770 yj=yj_safe+yshift*boxysize
1771 zj=zj_safe+zshift*boxzsize
1772 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1773 if(dist_temp.lt.dist_init) then
1783 if (subchap.eq.1) then
1792 dxj=dc_norm(1,nres+j)
1793 dyj=dc_norm(2,nres+j)
1794 dzj=dc_norm(3,nres+j)
1795 ! write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1796 ! write (iout,*) "j",j," dc_norm",& !d
1797 ! dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1798 ! write(iout,*)"rrij ",rrij
1799 ! write(iout,*)"xj yj zj ", xj, yj, zj
1800 ! write(iout,*)"xi yi zi ", xi, yi, zi
1801 ! write(iout,*)"c ", c(1,:), c(2,:), c(3,:)
1802 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1804 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
1805 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
1806 ! print *,sss_ele_cut,sss_ele_grad,&
1807 ! 1.0d0/(rij),r_cut_ele,rlamb_ele
1808 if (sss_ele_cut.le.0.0) cycle
1809 ! Calculate angle-dependent terms of energy and contributions to their
1813 sig=sig0ij*dsqrt(sigsq)
1814 rij_shift=1.0D0/rij-sig+sig0ij
1815 ! write(iout,*)" rij_shift",rij_shift," rij",rij," sig",sig,&
1817 ! for diagnostics; uncomment
1818 ! rij_shift=1.2*sig0ij
1819 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1820 if (rij_shift.le.0.0D0) then
1822 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1823 !d & restyp(itypi,1),i,restyp(itypj,1),j,
1824 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1828 !---------------------------------------------------------------
1829 rij_shift=1.0D0/rij_shift
1830 fac=rij_shift**expon
1832 e1=fac*fac*aa!(itypi,itypj)
1833 e2=fac*bb!(itypi,itypj)
1834 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1835 eps2der=evdwij*eps3rt
1836 eps3der=evdwij*eps2rt
1837 ! write(iout,*)"aa, bb ",aa(:,:),bb(:,:)
1838 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,& !d
1839 ! " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2," fac",fac !d
1840 evdwij=evdwij*eps2rt*eps3rt
1841 evdw=evdw+evdwij*sss_ele_cut
1843 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1844 epsi=bb**2/aa!(itypi,itypj)
1845 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1846 restyp(itypi,1),i,restyp(itypj,1),j, &
1847 epsi,sigm,chi1,chi2,chip1,chip2, &
1848 eps1,eps2rt**2,eps3rt**2,sig,sig0ij, &
1849 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, &
1853 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2e10.2,e11.3)')&
1854 'evdw',i,j,evdwij,xi,xj,rij !,"egb"
1855 !C print *,i,j,c(1,i),c(1,j),c(2,i),c(2,j),c(3,i),c(3,j)
1856 ! if (energy_dec) write (iout,*) &
1858 ! print *,"ZALAMKA", evdw
1860 ! Calculate gradient components.
1861 e1=e1*eps1*eps2rt**2*eps3rt**2
1862 fac=-expon*(e1+evdwij)*rij_shift
1865 ! print *,'before fac',fac,rij,evdwij
1866 fac=fac+evdwij*sss_ele_grad/sss_ele_cut&
1867 /sigma(itypi,itypj)*rij
1868 ! print *,'grad part scale',fac, &
1869 ! evdwij*sss_ele_grad/sss_ele_cut &
1870 ! /sigma(itypi,itypj)*rij
1872 ! Calculate the radial part of the gradient
1876 !C Calculate the radial part of the gradient
1877 gg_lipi(3)=eps1*(eps2rt*eps2rt)&
1878 *(eps3rt*eps3rt)*sss_ele_cut/2.0d0*(faclip*faclip*&
1879 (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))&
1880 +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1881 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1882 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1884 ! print *,'before sc_grad', gg(1),gg(2),gg(3)
1885 ! Calculate angular part of the gradient.
1891 ! print *,"ZALAMKA", evdw
1892 ! write (iout,*) "Number of loop steps in EGB:",ind
1893 !ccc energy_dec=.false.
1896 !-----------------------------------------------------------------------------
1897 subroutine egbv(evdw)
1899 ! This subroutine calculates the interaction energy of nonbonded side chains
1900 ! assuming the Gay-Berne-Vorobjev potential of interaction.
1904 ! implicit real*8 (a-h,o-z)
1905 ! include 'DIMENSIONS'
1906 ! include 'COMMON.GEO'
1907 ! include 'COMMON.VAR'
1908 ! include 'COMMON.LOCAL'
1909 ! include 'COMMON.CHAIN'
1910 ! include 'COMMON.DERIV'
1911 ! include 'COMMON.NAMES'
1912 ! include 'COMMON.INTERACT'
1913 ! include 'COMMON.IOUNITS'
1914 ! include 'COMMON.CALC'
1916 !el integer :: icall
1917 !el common /srutu/ icall
1920 integer :: iint,itypi,itypi1,itypj
1921 real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2,sigm
1922 real(kind=8) :: evdw,sig0ij,sig,rij_shift,epsi
1924 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1927 ! if (icall.eq.0) lprn=.true.
1929 do i=iatsc_s,iatsc_e
1930 itypi=iabs(itype(i,1))
1931 if (itypi.eq.ntyp1) cycle
1932 itypi1=iabs(itype(i+1,1))
1936 dxi=dc_norm(1,nres+i)
1937 dyi=dc_norm(2,nres+i)
1938 dzi=dc_norm(3,nres+i)
1939 ! dsci_inv=dsc_inv(itypi)
1940 dsci_inv=vbld_inv(i+nres)
1942 ! Calculate SC interaction energy.
1944 do iint=1,nint_gr(i)
1945 do j=istart(i,iint),iend(i,iint)
1947 itypj=iabs(itype(j,1))
1948 if (itypj.eq.ntyp1) cycle
1949 ! dscj_inv=dsc_inv(itypj)
1950 dscj_inv=vbld_inv(j+nres)
1951 sig0ij=sigma(itypi,itypj)
1952 r0ij=r0(itypi,itypj)
1953 chi1=chi(itypi,itypj)
1954 chi2=chi(itypj,itypi)
1961 alf12=0.5D0*(alf1+alf2)
1962 ! For diagnostics only!!!
1975 dxj=dc_norm(1,nres+j)
1976 dyj=dc_norm(2,nres+j)
1977 dzj=dc_norm(3,nres+j)
1978 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1980 ! Calculate angle-dependent terms of energy and contributions to their
1984 sig=sig0ij*dsqrt(sigsq)
1985 rij_shift=1.0D0/rij-sig+r0ij
1986 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1987 if (rij_shift.le.0.0D0) then
1992 !---------------------------------------------------------------
1993 rij_shift=1.0D0/rij_shift
1994 fac=rij_shift**expon
1995 e1=fac*fac*aa_aq(itypi,itypj)
1996 e2=fac*bb_aq(itypi,itypj)
1997 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1998 eps2der=evdwij*eps3rt
1999 eps3der=evdwij*eps2rt
2000 fac_augm=rrij**expon
2001 e_augm=augm(itypi,itypj)*fac_augm
2002 evdwij=evdwij*eps2rt*eps3rt
2003 evdw=evdw+evdwij+e_augm
2005 sigm=dabs(aa_aq(itypi,itypj)/&
2006 bb_aq(itypi,itypj))**(1.0D0/6.0D0)
2007 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
2008 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
2009 restyp(itypi,1),i,restyp(itypj,1),j,&
2010 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
2011 chi1,chi2,chip1,chip2,&
2012 eps1,eps2rt**2,eps3rt**2,&
2013 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
2016 ! Calculate gradient components.
2017 e1=e1*eps1*eps2rt**2*eps3rt**2
2018 fac=-expon*(e1+evdwij)*rij_shift
2020 fac=rij*fac-2*expon*rrij*e_augm
2021 ! Calculate the radial part of the gradient
2025 ! Calculate angular part of the gradient.
2031 !-----------------------------------------------------------------------------
2032 !el subroutine sc_angular in module geometry
2033 !-----------------------------------------------------------------------------
2034 subroutine e_softsphere(evdw)
2036 ! This subroutine calculates the interaction energy of nonbonded side chains
2037 ! assuming the LJ potential of interaction.
2039 ! implicit real*8 (a-h,o-z)
2040 ! include 'DIMENSIONS'
2041 real(kind=8),parameter :: accur=1.0d-10
2042 ! include 'COMMON.GEO'
2043 ! include 'COMMON.VAR'
2044 ! include 'COMMON.LOCAL'
2045 ! include 'COMMON.CHAIN'
2046 ! include 'COMMON.DERIV'
2047 ! include 'COMMON.INTERACT'
2048 ! include 'COMMON.TORSION'
2049 ! include 'COMMON.SBRIDGE'
2050 ! include 'COMMON.NAMES'
2051 ! include 'COMMON.IOUNITS'
2052 ! include 'COMMON.CONTACTS'
2053 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
2054 !d print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2056 integer :: i,iint,j,itypi,itypi1,itypj,k
2057 real(kind=8) :: evdw,xj,yj,zj,xi,yi,zi,rij,r0ij,r0ijsq,evdwij
2061 do i=iatsc_s,iatsc_e
2062 itypi=iabs(itype(i,1))
2063 if (itypi.eq.ntyp1) cycle
2064 itypi1=iabs(itype(i+1,1))
2069 ! Calculate SC interaction energy.
2071 do iint=1,nint_gr(i)
2072 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2073 !d & 'iend=',iend(i,iint)
2074 do j=istart(i,iint),iend(i,iint)
2075 itypj=iabs(itype(j,1))
2076 if (itypj.eq.ntyp1) cycle
2080 rij=xj*xj+yj*yj+zj*zj
2081 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2082 r0ij=r0(itypi,itypj)
2084 ! print *,i,j,r0ij,dsqrt(rij)
2085 if (rij.lt.r0ijsq) then
2086 evdwij=0.25d0*(rij-r0ijsq)**2
2094 ! Calculate the components of the gradient in DC and X
2100 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2101 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2102 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2103 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2107 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2114 end subroutine e_softsphere
2115 !-----------------------------------------------------------------------------
2116 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2118 ! Soft-sphere potential of p-p interaction
2120 ! implicit real*8 (a-h,o-z)
2121 ! include 'DIMENSIONS'
2122 ! include 'COMMON.CONTROL'
2123 ! include 'COMMON.IOUNITS'
2124 ! include 'COMMON.GEO'
2125 ! include 'COMMON.VAR'
2126 ! include 'COMMON.LOCAL'
2127 ! include 'COMMON.CHAIN'
2128 ! include 'COMMON.DERIV'
2129 ! include 'COMMON.INTERACT'
2130 ! include 'COMMON.CONTACTS'
2131 ! include 'COMMON.TORSION'
2132 ! include 'COMMON.VECTORS'
2133 ! include 'COMMON.FFIELD'
2134 real(kind=8),dimension(3) :: ggg
2135 !d write(iout,*) 'In EELEC_soft_sphere'
2137 integer :: i,j,k,num_conti,iteli,itelj
2138 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
2139 real(kind=8) :: dxi,dyi,dzi,xmedi,ymedi,zmedi,r0ij,r0ijsq
2140 real(kind=8) :: dxj,dyj,dzj,xj,yj,zj,rij,evdw1ij,fac
2148 do i=iatel_s,iatel_e
2149 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
2153 xmedi=c(1,i)+0.5d0*dxi
2154 ymedi=c(2,i)+0.5d0*dyi
2155 zmedi=c(3,i)+0.5d0*dzi
2157 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2158 do j=ielstart(i),ielend(i)
2159 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
2163 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2164 r0ij=rpp(iteli,itelj)
2169 xj=c(1,j)+0.5D0*dxj-xmedi
2170 yj=c(2,j)+0.5D0*dyj-ymedi
2171 zj=c(3,j)+0.5D0*dzj-zmedi
2172 rij=xj*xj+yj*yj+zj*zj
2173 if (rij.lt.r0ijsq) then
2174 evdw1ij=0.25d0*(rij-r0ijsq)**2
2182 ! Calculate contributions to the Cartesian gradient.
2188 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2189 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2192 ! Loop over residues i+1 thru j-1.
2196 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2201 !grad do i=nnt,nct-1
2203 !grad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2205 !grad do j=i+1,nct-1
2207 !grad gelc(k,i)=gelc(k,i)+gelc(k,j)
2212 end subroutine eelec_soft_sphere
2213 !-----------------------------------------------------------------------------
2214 subroutine vec_and_deriv
2215 ! implicit real*8 (a-h,o-z)
2216 ! include 'DIMENSIONS'
2220 ! include 'COMMON.IOUNITS'
2221 ! include 'COMMON.GEO'
2222 ! include 'COMMON.VAR'
2223 ! include 'COMMON.LOCAL'
2224 ! include 'COMMON.CHAIN'
2225 ! include 'COMMON.VECTORS'
2226 ! include 'COMMON.SETUP'
2227 ! include 'COMMON.TIME1'
2228 real(kind=8),dimension(3,3,2) :: uyder,uzder
2229 real(kind=8),dimension(2) :: vbld_inv_temp
2230 ! Compute the local reference systems. For reference system (i), the
2231 ! X-axis points from CA(i) to CA(i+1), the Y axis is in the
2232 ! CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2235 real(kind=8) :: facy,fac,costh
2238 do i=ivec_start,ivec_end
2242 if (i.eq.nres-1) then
2243 ! Case of the last full residue
2244 ! Compute the Z-axis
2245 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2246 costh=dcos(pi-theta(nres))
2247 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2251 ! Compute the derivatives of uz
2253 uzder(2,1,1)=-dc_norm(3,i-1)
2254 uzder(3,1,1)= dc_norm(2,i-1)
2255 uzder(1,2,1)= dc_norm(3,i-1)
2257 uzder(3,2,1)=-dc_norm(1,i-1)
2258 uzder(1,3,1)=-dc_norm(2,i-1)
2259 uzder(2,3,1)= dc_norm(1,i-1)
2262 uzder(2,1,2)= dc_norm(3,i)
2263 uzder(3,1,2)=-dc_norm(2,i)
2264 uzder(1,2,2)=-dc_norm(3,i)
2266 uzder(3,2,2)= dc_norm(1,i)
2267 uzder(1,3,2)= dc_norm(2,i)
2268 uzder(2,3,2)=-dc_norm(1,i)
2270 ! Compute the Y-axis
2273 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2275 ! Compute the derivatives of uy
2278 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) &
2279 -dc_norm(k,i)*dc_norm(j,i-1)
2280 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2282 uyder(j,j,1)=uyder(j,j,1)-costh
2283 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2288 uygrad(l,k,j,i)=uyder(l,k,j)
2289 uzgrad(l,k,j,i)=uzder(l,k,j)
2293 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2294 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2295 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2296 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2299 ! Compute the Z-axis
2300 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2301 costh=dcos(pi-theta(i+2))
2302 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2306 ! Compute the derivatives of uz
2308 uzder(2,1,1)=-dc_norm(3,i+1)
2309 uzder(3,1,1)= dc_norm(2,i+1)
2310 uzder(1,2,1)= dc_norm(3,i+1)
2312 uzder(3,2,1)=-dc_norm(1,i+1)
2313 uzder(1,3,1)=-dc_norm(2,i+1)
2314 uzder(2,3,1)= dc_norm(1,i+1)
2317 uzder(2,1,2)= dc_norm(3,i)
2318 uzder(3,1,2)=-dc_norm(2,i)
2319 uzder(1,2,2)=-dc_norm(3,i)
2321 uzder(3,2,2)= dc_norm(1,i)
2322 uzder(1,3,2)= dc_norm(2,i)
2323 uzder(2,3,2)=-dc_norm(1,i)
2325 ! Compute the Y-axis
2328 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2330 ! Compute the derivatives of uy
2333 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) &
2334 -dc_norm(k,i)*dc_norm(j,i+1)
2335 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2337 uyder(j,j,1)=uyder(j,j,1)-costh
2338 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2343 uygrad(l,k,j,i)=uyder(l,k,j)
2344 uzgrad(l,k,j,i)=uzder(l,k,j)
2348 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2349 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2350 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2351 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2355 vbld_inv_temp(1)=vbld_inv(i+1)
2356 if (i.lt.nres-1) then
2357 vbld_inv_temp(2)=vbld_inv(i+2)
2359 vbld_inv_temp(2)=vbld_inv(i)
2364 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2365 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2370 #if defined(PARVEC) && defined(MPI)
2371 if (nfgtasks1.gt.1) then
2373 ! print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2374 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2375 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2376 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),&
2377 MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2379 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),&
2380 MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2382 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),&
2383 ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),&
2384 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2385 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),&
2386 ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),&
2387 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2388 time_gather=time_gather+MPI_Wtime()-time00
2390 ! if (fg_rank.eq.0) then
2391 ! write (iout,*) "Arrays UY and UZ"
2393 ! write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2399 end subroutine vec_and_deriv
2400 !-----------------------------------------------------------------------------
2401 subroutine check_vecgrad
2402 ! implicit real*8 (a-h,o-z)
2403 ! include 'DIMENSIONS'
2404 ! include 'COMMON.IOUNITS'
2405 ! include 'COMMON.GEO'
2406 ! include 'COMMON.VAR'
2407 ! include 'COMMON.LOCAL'
2408 ! include 'COMMON.CHAIN'
2409 ! include 'COMMON.VECTORS'
2410 real(kind=8),dimension(3,3,2,nres) :: uygradt,uzgradt !(3,3,2,maxres)
2411 real(kind=8),dimension(3,nres) :: uyt,uzt !(3,maxres)
2412 real(kind=8),dimension(3,3,2) :: uygradn,uzgradn
2413 real(kind=8),dimension(3) :: erij
2414 real(kind=8) :: delta=1.0d-7
2420 !rc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2421 !rc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2422 !rc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2423 !d write(iout,'(2i5,2(3f10.5,5x))') i,1,
2424 !d & (dc_norm(if90,i),if90=1,3)
2425 !d write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2426 !d write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2427 !d write(iout,'(a)')
2433 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2434 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2447 !d write (iout,*) 'i=',i
2449 erij(k)=dc_norm(k,i)
2453 dc_norm(k,i)=erij(k)
2455 dc_norm(j,i)=dc_norm(j,i)+delta
2456 ! fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2458 ! dc_norm(k,i)=dc_norm(k,i)/fac
2460 ! write (iout,*) (dc_norm(k,i),k=1,3)
2461 ! write (iout,*) (erij(k),k=1,3)
2464 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2465 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2466 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2467 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2469 ! write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2470 ! & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2471 ! & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2474 dc_norm(k,i)=erij(k)
2477 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2478 !d & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2479 !d & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2480 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2481 !d & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2482 !d & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2483 !d write (iout,'(a)')
2487 end subroutine check_vecgrad
2488 !-----------------------------------------------------------------------------
2489 subroutine set_matrices
2490 ! implicit real*8 (a-h,o-z)
2491 ! include 'DIMENSIONS'
2494 ! include "COMMON.SETUP"
2496 integer :: status(MPI_STATUS_SIZE)
2498 ! include 'COMMON.IOUNITS'
2499 ! include 'COMMON.GEO'
2500 ! include 'COMMON.VAR'
2501 ! include 'COMMON.LOCAL'
2502 ! include 'COMMON.CHAIN'
2503 ! include 'COMMON.DERIV'
2504 ! include 'COMMON.INTERACT'
2505 ! include 'COMMON.CONTACTS'
2506 ! include 'COMMON.TORSION'
2507 ! include 'COMMON.VECTORS'
2508 ! include 'COMMON.FFIELD'
2509 real(kind=8) :: auxvec(2),auxmat(2,2)
2510 integer :: i,iti1,iti,k,l
2511 real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2
2512 ! print *,"in set matrices"
2514 ! Compute the virtual-bond-torsional-angle dependent quantities needed
2515 ! to calculate the el-loc multibody terms of various order.
2519 do i=ivec_start+2,ivec_end+2
2524 if (i .lt. nres+1) then
2561 if (i .gt. 3 .and. i .lt. nres+1) then
2562 obrot_der(1,i-2)=-sin1
2563 obrot_der(2,i-2)= cos1
2564 Ugder(1,1,i-2)= sin1
2565 Ugder(1,2,i-2)=-cos1
2566 Ugder(2,1,i-2)=-cos1
2567 Ugder(2,2,i-2)=-sin1
2570 obrot2_der(1,i-2)=-dwasin2
2571 obrot2_der(2,i-2)= dwacos2
2572 Ug2der(1,1,i-2)= dwasin2
2573 Ug2der(1,2,i-2)=-dwacos2
2574 Ug2der(2,1,i-2)=-dwacos2
2575 Ug2der(2,2,i-2)=-dwasin2
2577 obrot_der(1,i-2)=0.0d0
2578 obrot_der(2,i-2)=0.0d0
2579 Ugder(1,1,i-2)=0.0d0
2580 Ugder(1,2,i-2)=0.0d0
2581 Ugder(2,1,i-2)=0.0d0
2582 Ugder(2,2,i-2)=0.0d0
2583 obrot2_der(1,i-2)=0.0d0
2584 obrot2_der(2,i-2)=0.0d0
2585 Ug2der(1,1,i-2)=0.0d0
2586 Ug2der(1,2,i-2)=0.0d0
2587 Ug2der(2,1,i-2)=0.0d0
2588 Ug2der(2,2,i-2)=0.0d0
2590 ! if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2591 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2592 if (itype(i-2,1).eq.0) then
2595 iti = itortyp(itype(i-2,1))
2600 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2601 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2602 if (itype(i-1,1).eq.0) then
2605 iti1 = itortyp(itype(i-1,1))
2610 ! print *,iti,i,"iti",iti1,itype(i-1,1),itype(i-2,1)
2611 !d write (iout,*) '*******i',i,' iti1',iti
2612 !d write (iout,*) 'b1',b1(:,iti)
2613 !d write (iout,*) 'b2',b2(:,iti)
2614 !d write (iout,*) 'Ug',Ug(:,:,i-2)
2615 ! if (i .gt. iatel_s+2) then
2616 if (i .gt. nnt+2) then
2617 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2618 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2619 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2621 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2622 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2623 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2624 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2625 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2636 DtUg2(l,k,i-2)=0.0d0
2640 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2641 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2643 muder(k,i-2)=Ub2der(k,i-2)
2645 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2646 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2647 if (itype(i-1,1).eq.0) then
2649 elseif (itype(i-1,1).le.ntyp) then
2650 iti1 = itortyp(itype(i-1,1))
2658 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2660 ! if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2)
2661 ! if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,iti1)
2662 ! if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2)
2663 !d write (iout,*) 'mu1',mu1(:,i-2)
2664 !d write (iout,*) 'mu2',mu2(:,i-2)
2665 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2667 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2668 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2669 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2670 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2671 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2672 ! Vectors and matrices dependent on a single virtual-bond dihedral.
2673 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2674 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2675 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2676 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2677 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2678 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2679 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2680 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2681 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2684 ! Matrices dependent on two consecutive virtual-bond dihedrals.
2685 ! The order of matrices is from left to right.
2686 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2688 ! do i=max0(ivec_start,2),ivec_end
2690 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2691 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2692 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2693 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2694 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2695 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2696 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2697 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2700 #if defined(MPI) && defined(PARMAT)
2702 ! if (fg_rank.eq.0) then
2703 write (iout,*) "Arrays UG and UGDER before GATHER"
2705 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2706 ((ug(l,k,i),l=1,2),k=1,2),&
2707 ((ugder(l,k,i),l=1,2),k=1,2)
2709 write (iout,*) "Arrays UG2 and UG2DER"
2711 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2712 ((ug2(l,k,i),l=1,2),k=1,2),&
2713 ((ug2der(l,k,i),l=1,2),k=1,2)
2715 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2717 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2718 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2719 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2721 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2723 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2724 costab(i),sintab(i),costab2(i),sintab2(i)
2726 write (iout,*) "Array MUDER"
2728 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2732 if (nfgtasks.gt.1) then
2734 ! write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2735 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2736 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2738 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),&
2739 MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2741 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),&
2742 MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2744 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),&
2745 MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2747 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),&
2748 MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2750 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),&
2751 MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2753 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),&
2754 MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2756 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),&
2757 MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),&
2758 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2759 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),&
2760 MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),&
2761 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2762 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),&
2763 MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),&
2764 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2765 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),&
2766 MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),&
2767 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2768 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2770 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),&
2771 MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2773 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),&
2774 MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2776 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),&
2777 MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2779 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),&
2780 MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2782 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),&
2783 MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2785 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),&
2786 ivec_count(fg_rank1),&
2787 MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2789 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),&
2790 MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2792 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),&
2793 MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2795 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),&
2796 MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2798 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),&
2799 MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2801 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),&
2802 MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2804 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),&
2805 MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2807 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),&
2808 MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2810 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),&
2811 ivec_count(fg_rank1),&
2812 MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2814 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),&
2815 MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2817 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),&
2818 MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2820 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),&
2821 MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2823 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),&
2824 MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2826 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),&
2827 ivec_count(fg_rank1),&
2828 MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2830 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),&
2831 ivec_count(fg_rank1),&
2832 MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2834 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),&
2835 ivec_count(fg_rank1),&
2836 MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2837 MPI_MAT2,FG_COMM1,IERR)
2838 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),&
2839 ivec_count(fg_rank1),&
2840 MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2841 MPI_MAT2,FG_COMM1,IERR)
2844 ! Passes matrix info through the ring
2847 if (irecv.lt.0) irecv=nfgtasks1-1
2850 if (inext.ge.nfgtasks1) inext=0
2852 ! write (iout,*) "isend",isend," irecv",irecv
2854 lensend=lentyp(isend)
2855 lenrecv=lentyp(irecv)
2856 ! write (iout,*) "lensend",lensend," lenrecv",lenrecv
2857 ! call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2858 ! & MPI_ROTAT1(lensend),inext,2200+isend,
2859 ! & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2860 ! & iprev,2200+irecv,FG_COMM,status,IERR)
2861 ! write (iout,*) "Gather ROTAT1"
2863 ! call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2864 ! & MPI_ROTAT2(lensend),inext,3300+isend,
2865 ! & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2866 ! & iprev,3300+irecv,FG_COMM,status,IERR)
2867 ! write (iout,*) "Gather ROTAT2"
2869 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,&
2870 MPI_ROTAT_OLD(lensend),inext,4400+isend,&
2871 costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),&
2872 iprev,4400+irecv,FG_COMM,status,IERR)
2873 ! write (iout,*) "Gather ROTAT_OLD"
2875 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,&
2876 MPI_PRECOMP11(lensend),inext,5500+isend,&
2877 mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),&
2878 iprev,5500+irecv,FG_COMM,status,IERR)
2879 ! write (iout,*) "Gather PRECOMP11"
2881 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,&
2882 MPI_PRECOMP12(lensend),inext,6600+isend,&
2883 Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),&
2884 iprev,6600+irecv,FG_COMM,status,IERR)
2885 ! write (iout,*) "Gather PRECOMP12"
2887 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2889 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,&
2890 MPI_ROTAT2(lensend),inext,7700+isend,&
2891 ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),&
2892 iprev,7700+irecv,FG_COMM,status,IERR)
2893 ! write (iout,*) "Gather PRECOMP21"
2895 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,&
2896 MPI_PRECOMP22(lensend),inext,8800+isend,&
2897 EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),&
2898 iprev,8800+irecv,FG_COMM,status,IERR)
2899 ! write (iout,*) "Gather PRECOMP22"
2901 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,&
2902 MPI_PRECOMP23(lensend),inext,9900+isend,&
2903 Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,&
2904 MPI_PRECOMP23(lenrecv),&
2905 iprev,9900+irecv,FG_COMM,status,IERR)
2906 ! write (iout,*) "Gather PRECOMP23"
2911 if (irecv.lt.0) irecv=nfgtasks1-1
2914 time_gather=time_gather+MPI_Wtime()-time00
2917 ! if (fg_rank.eq.0) then
2918 write (iout,*) "Arrays UG and UGDER"
2920 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2921 ((ug(l,k,i),l=1,2),k=1,2),&
2922 ((ugder(l,k,i),l=1,2),k=1,2)
2924 write (iout,*) "Arrays UG2 and UG2DER"
2926 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2927 ((ug2(l,k,i),l=1,2),k=1,2),&
2928 ((ug2der(l,k,i),l=1,2),k=1,2)
2930 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2932 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2933 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2934 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2936 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2938 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2939 costab(i),sintab(i),costab2(i),sintab2(i)
2941 write (iout,*) "Array MUDER"
2943 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2949 !d iti = itortyp(itype(i,1))
2952 !d write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2953 !d & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2957 end subroutine set_matrices
2958 !-----------------------------------------------------------------------------
2959 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2961 ! This subroutine calculates the average interaction energy and its gradient
2962 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
2963 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2964 ! The potential depends both on the distance of peptide-group centers and on
2965 ! the orientation of the CA-CA virtual bonds.
2968 ! implicit real*8 (a-h,o-z)
2972 ! include 'DIMENSIONS'
2973 ! include 'COMMON.CONTROL'
2974 ! include 'COMMON.SETUP'
2975 ! include 'COMMON.IOUNITS'
2976 ! include 'COMMON.GEO'
2977 ! include 'COMMON.VAR'
2978 ! include 'COMMON.LOCAL'
2979 ! include 'COMMON.CHAIN'
2980 ! include 'COMMON.DERIV'
2981 ! include 'COMMON.INTERACT'
2982 ! include 'COMMON.CONTACTS'
2983 ! include 'COMMON.TORSION'
2984 ! include 'COMMON.VECTORS'
2985 ! include 'COMMON.FFIELD'
2986 ! include 'COMMON.TIME1'
2987 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
2988 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
2989 real(kind=8),dimension(2,2) :: acipa !el,a_temp
2990 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
2991 real(kind=8),dimension(4) :: muij
2992 !el integer :: num_conti,j1,j2
2993 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
2994 !el dz_normi,xmedi,ymedi,zmedi
2996 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
2997 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3000 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3002 real(kind=8) :: scal_el=1.0d0
3004 real(kind=8) :: scal_el=0.5d0
3007 ! 13-go grudnia roku pamietnego...
3008 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
3010 0.0d0,0.0d0,1.0d0/),shape(unmat))
3013 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
3014 real(kind=8) :: fac,t_eelecij,fracinbuf
3017 !d write(iout,*) 'In EELEC'
3018 ! print *,"IN EELEC"
3020 !d write(iout,*) 'Type',i
3021 !d write(iout,*) 'B1',B1(:,i)
3022 !d write(iout,*) 'B2',B2(:,i)
3023 !d write(iout,*) 'CC',CC(:,:,i)
3024 !d write(iout,*) 'DD',DD(:,:,i)
3025 !d write(iout,*) 'EE',EE(:,:,i)
3027 !d call check_vecgrad
3042 if (icheckgrad.eq.1) then
3045 ! dc_norm(1,i)=0.0d0
3046 ! dc_norm(2,i)=0.0d0
3047 ! dc_norm(3,i)=0.0d0
3050 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3052 dc_norm(k,i)=dc(k,i)*fac
3054 ! write (iout,*) 'i',i,' fac',fac
3057 ! print *,wel_loc,"wel_loc",wcorr4,wcorr5,wcorr6,wturn3,wturn4, &
3059 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3060 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
3061 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3062 ! call vec_and_deriv
3066 ! print *, "before set matrices"
3068 ! print *, "after set matrices"
3071 time_mat=time_mat+MPI_Wtime()-time01
3074 ! print *, "after set matrices"
3076 !d write (iout,*) 'i=',i
3078 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3081 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3082 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3095 !d print '(a)','Enter EELEC'
3096 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3097 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
3098 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
3100 gel_loc_loc(i)=0.0d0
3105 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3107 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
3111 ! print *,"before iturn3 loop"
3112 do i=iturn3_start,iturn3_end
3113 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
3114 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
3118 dx_normi=dc_norm(1,i)
3119 dy_normi=dc_norm(2,i)
3120 dz_normi=dc_norm(3,i)
3121 xmedi=c(1,i)+0.5d0*dxi
3122 ymedi=c(2,i)+0.5d0*dyi
3123 zmedi=c(3,i)+0.5d0*dzi
3124 xmedi=dmod(xmedi,boxxsize)
3125 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3126 ymedi=dmod(ymedi,boxysize)
3127 if (ymedi.lt.0) ymedi=ymedi+boxysize
3128 zmedi=dmod(zmedi,boxzsize)
3129 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3131 if ((zmedi.gt.bordlipbot) &
3132 .and.(zmedi.lt.bordliptop)) then
3133 !C the energy transfer exist
3134 if (zmedi.lt.buflipbot) then
3135 !C what fraction I am in
3137 ((zmedi-bordlipbot)/lipbufthick)
3138 !C lipbufthick is thickenes of lipid buffore
3139 sslipi=sscalelip(fracinbuf)
3140 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3141 elseif (zmedi.gt.bufliptop) then
3142 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3143 sslipi=sscalelip(fracinbuf)
3144 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3153 ! print *,i,sslipi,ssgradlipi
3154 call eelecij(i,i+2,ees,evdw1,eel_loc)
3155 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3156 num_cont_hb(i)=num_conti
3158 do i=iturn4_start,iturn4_end
3159 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
3160 .or. itype(i+3,1).eq.ntyp1 &
3161 .or. itype(i+4,1).eq.ntyp1) cycle
3165 dx_normi=dc_norm(1,i)
3166 dy_normi=dc_norm(2,i)
3167 dz_normi=dc_norm(3,i)
3168 xmedi=c(1,i)+0.5d0*dxi
3169 ymedi=c(2,i)+0.5d0*dyi
3170 zmedi=c(3,i)+0.5d0*dzi
3171 xmedi=dmod(xmedi,boxxsize)
3172 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3173 ymedi=dmod(ymedi,boxysize)
3174 if (ymedi.lt.0) ymedi=ymedi+boxysize
3175 zmedi=dmod(zmedi,boxzsize)
3176 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3177 if ((zmedi.gt.bordlipbot) &
3178 .and.(zmedi.lt.bordliptop)) then
3179 !C the energy transfer exist
3180 if (zmedi.lt.buflipbot) then
3181 !C what fraction I am in
3183 ((zmedi-bordlipbot)/lipbufthick)
3184 !C lipbufthick is thickenes of lipid buffore
3185 sslipi=sscalelip(fracinbuf)
3186 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3187 elseif (zmedi.gt.bufliptop) then
3188 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3189 sslipi=sscalelip(fracinbuf)
3190 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3200 num_conti=num_cont_hb(i)
3201 call eelecij(i,i+3,ees,evdw1,eel_loc)
3202 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
3203 call eturn4(i,eello_turn4)
3204 num_cont_hb(i)=num_conti
3207 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3209 ! print *,"iatel_s,iatel_e,",iatel_s,iatel_e
3210 do i=iatel_s,iatel_e
3211 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
3215 dx_normi=dc_norm(1,i)
3216 dy_normi=dc_norm(2,i)
3217 dz_normi=dc_norm(3,i)
3218 xmedi=c(1,i)+0.5d0*dxi
3219 ymedi=c(2,i)+0.5d0*dyi
3220 zmedi=c(3,i)+0.5d0*dzi
3221 xmedi=dmod(xmedi,boxxsize)
3222 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3223 ymedi=dmod(ymedi,boxysize)
3224 if (ymedi.lt.0) ymedi=ymedi+boxysize
3225 zmedi=dmod(zmedi,boxzsize)
3226 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3227 if ((zmedi.gt.bordlipbot) &
3228 .and.(zmedi.lt.bordliptop)) then
3229 !C the energy transfer exist
3230 if (zmedi.lt.buflipbot) then
3231 !C what fraction I am in
3233 ((zmedi-bordlipbot)/lipbufthick)
3234 !C lipbufthick is thickenes of lipid buffore
3235 sslipi=sscalelip(fracinbuf)
3236 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3237 elseif (zmedi.gt.bufliptop) then
3238 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3239 sslipi=sscalelip(fracinbuf)
3240 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3250 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3251 num_conti=num_cont_hb(i)
3252 do j=ielstart(i),ielend(i)
3253 ! write (iout,*) i,j,itype(i,1),itype(j,1)
3254 if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
3255 call eelecij(i,j,ees,evdw1,eel_loc)
3257 num_cont_hb(i)=num_conti
3259 ! write (iout,*) "Number of loop steps in EELEC:",ind
3261 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
3262 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3264 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3265 !cc eel_loc=eel_loc+eello_turn3
3266 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
3268 end subroutine eelec
3269 !-----------------------------------------------------------------------------
3270 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3273 ! implicit real*8 (a-h,o-z)
3274 ! include 'DIMENSIONS'
3278 ! include 'COMMON.CONTROL'
3279 ! include 'COMMON.IOUNITS'
3280 ! include 'COMMON.GEO'
3281 ! include 'COMMON.VAR'
3282 ! include 'COMMON.LOCAL'
3283 ! include 'COMMON.CHAIN'
3284 ! include 'COMMON.DERIV'
3285 ! include 'COMMON.INTERACT'
3286 ! include 'COMMON.CONTACTS'
3287 ! include 'COMMON.TORSION'
3288 ! include 'COMMON.VECTORS'
3289 ! include 'COMMON.FFIELD'
3290 ! include 'COMMON.TIME1'
3291 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
3292 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
3293 real(kind=8),dimension(2,2) :: acipa !el,a_temp
3294 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3295 real(kind=8),dimension(4) :: muij
3296 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
3297 dist_temp, dist_init,rlocshield,fracinbuf
3298 integer xshift,yshift,zshift,ilist,iresshield
3299 !el integer :: num_conti,j1,j2
3300 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3301 !el dz_normi,xmedi,ymedi,zmedi
3303 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3304 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3307 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3309 real(kind=8) :: scal_el=1.0d0
3311 real(kind=8) :: scal_el=0.5d0
3314 ! 13-go grudnia roku pamietnego...
3315 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
3317 0.0d0,0.0d0,1.0d0/),shape(unmat))
3318 ! integer :: maxconts=nres/4
3320 integer :: k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap
3321 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
3322 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
3323 real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
3324 rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
3325 evdwij,el1,el2,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
3326 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
3327 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
3328 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
3329 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
3330 ecosgp,ecosam,ecosbm,ecosgm,ghalf
3332 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
3333 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
3335 ! time00=MPI_Wtime()
3336 !d write (iout,*) "eelecij",i,j
3340 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3341 aaa=app(iteli,itelj)
3342 bbb=bpp(iteli,itelj)
3343 ael6i=ael6(iteli,itelj)
3344 ael3i=ael3(iteli,itelj)
3348 dx_normj=dc_norm(1,j)
3349 dy_normj=dc_norm(2,j)
3350 dz_normj=dc_norm(3,j)
3351 ! xj=c(1,j)+0.5D0*dxj-xmedi
3352 ! yj=c(2,j)+0.5D0*dyj-ymedi
3353 ! zj=c(3,j)+0.5D0*dzj-zmedi
3358 if (xj.lt.0) xj=xj+boxxsize
3360 if (yj.lt.0) yj=yj+boxysize
3362 if (zj.lt.0) zj=zj+boxzsize
3363 if ((zj.gt.bordlipbot) &
3364 .and.(zj.lt.bordliptop)) then
3365 !C the energy transfer exist
3366 if (zj.lt.buflipbot) then
3367 !C what fraction I am in
3369 ((zj-bordlipbot)/lipbufthick)
3370 !C lipbufthick is thickenes of lipid buffore
3371 sslipj=sscalelip(fracinbuf)
3372 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
3373 elseif (zj.gt.bufliptop) then
3374 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
3375 sslipj=sscalelip(fracinbuf)
3376 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
3387 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3394 xj=xj_safe+xshift*boxxsize
3395 yj=yj_safe+yshift*boxysize
3396 zj=zj_safe+zshift*boxzsize
3397 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3398 if(dist_temp.lt.dist_init) then
3408 if (isubchap.eq.1) then
3419 rij=xj*xj+yj*yj+zj*zj
3422 !C print *,xmedi,ymedi,zmedi,xj,yj,zj,boxxsize,rij
3423 sss_ele_cut=sscale_ele(rij)
3424 sss_ele_grad=sscagrad_ele(rij)
3426 ! sss_ele_grad=0.0d0
3427 ! print *,sss_ele_cut,sss_ele_grad,&
3428 ! (rij),r_cut_ele,rlamb_ele
3429 ! if (sss_ele_cut.le.0.0) go to 128
3434 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3435 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3436 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3437 fac=cosa-3.0D0*cosb*cosg
3439 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3440 if (j.eq.i+2) ev1=scal_el*ev1
3445 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3448 if (shield_mode.gt.0) then
3449 !C fac_shield(i)=0.4
3450 !C fac_shield(j)=0.6
3451 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3452 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3454 ees=ees+eesij*sss_ele_cut
3455 !C FOR NOW SHIELD IS NOT USED WITH LIPSCALE
3456 !C & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3462 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)*sss_ele_cut
3463 !C print *,"TUCC",(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
3466 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
3467 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3468 ! ees=ees+eesij*sss_ele_cut
3469 evdw1=evdw1+evdwij*sss_ele_cut &
3470 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3471 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3472 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3473 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3474 !d & xmedi,ymedi,zmedi,xj,yj,zj
3476 if (energy_dec) then
3477 ! write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') &
3478 ! 'evdw1',i,j,evdwij,&
3479 ! iteli,itelj,aaa,evdw1
3480 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3481 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3484 ! Calculate contributions to the Cartesian gradient.
3487 facvdw=-6*rrmij*(ev1+evdwij)*sss_ele_cut &
3488 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3489 facel=-3*rrmij*(el1+eesij)*sss_ele_cut &
3490 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3496 ! Radial derivatives. First process both termini of the fragment (i,j)
3498 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj* &
3499 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3500 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj* &
3501 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3502 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj* &
3503 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3505 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3506 (shield_mode.gt.0)) then
3508 do ilist=1,ishield_list(i)
3509 iresshield=shield_list(ilist,i)
3511 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)&
3513 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3515 +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0 &
3517 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3520 do ilist=1,ishield_list(j)
3521 iresshield=shield_list(ilist,j)
3523 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j) &
3525 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3527 +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0 &
3529 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3533 gshieldc(k,i)=gshieldc(k,i)+ &
3534 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3537 gshieldc(k,j)=gshieldc(k,j)+ &
3538 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3541 gshieldc(k,i-1)=gshieldc(k,i-1)+ &
3542 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3545 gshieldc(k,j-1)=gshieldc(k,j-1)+ &
3546 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3554 ! ghalf=0.5D0*ggg(k)
3555 ! gelc(k,i)=gelc(k,i)+ghalf
3556 ! gelc(k,j)=gelc(k,j)+ghalf
3558 ! 9/28/08 AL Gradient compotents will be summed only at the end
3560 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3561 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3563 gelc_long(3,j)=gelc_long(3,j)+ &
3564 ssgradlipj*eesij/2.0d0*lipscale**2&
3567 gelc_long(3,i)=gelc_long(3,i)+ &
3568 ssgradlipi*eesij/2.0d0*lipscale**2&
3573 ! Loop over residues i+1 thru j-1.
3577 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3580 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj &
3581 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3582 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj &
3583 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3584 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj &
3585 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3588 ! ghalf=0.5D0*ggg(k)
3589 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3590 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3592 ! 9/28/08 AL Gradient compotents will be summed only at the end
3594 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3595 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3598 !C Lipidic part for scaling weight
3599 gvdwpp(3,j)=gvdwpp(3,j)+ &
3600 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3601 gvdwpp(3,i)=gvdwpp(3,i)+ &
3602 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3603 !! Loop over residues i+1 thru j-1.
3607 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3611 facvdw=(ev1+evdwij)*sss_ele_cut &
3612 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3614 facel=(el1+eesij)*sss_ele_cut
3616 fac=-3*rrmij*(facvdw+facvdw+facel)
3621 ! Radial derivatives. First process both termini of the fragment (i,j)
3623 ggg(1)=fac*xj+sss_ele_grad*rmij*(eesij+evdwij)*xj
3624 ggg(2)=fac*yj+sss_ele_grad*rmij*(eesij+evdwij)*yj
3625 ggg(3)=fac*zj+sss_ele_grad*rmij*(eesij+evdwij)*zj
3627 ! ghalf=0.5D0*ggg(k)
3628 ! gelc(k,i)=gelc(k,i)+ghalf
3629 ! gelc(k,j)=gelc(k,j)+ghalf
3631 ! 9/28/08 AL Gradient compotents will be summed only at the end
3633 gelc_long(k,j)=gelc(k,j)+ggg(k)
3634 gelc_long(k,i)=gelc(k,i)-ggg(k)
3637 ! Loop over residues i+1 thru j-1.
3641 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3644 ! 9/28/08 AL Gradient compotents will be summed only at the end
3646 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3648 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3650 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3653 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3654 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3656 gvdwpp(3,j)=gvdwpp(3,j)+ &
3657 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3658 gvdwpp(3,i)=gvdwpp(3,i)+ &
3659 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3665 ecosa=2.0D0*fac3*fac1+fac4
3668 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3669 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3671 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3672 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3674 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3675 !d & (dcosg(k),k=1,3)
3677 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*sss_ele_cut &
3678 *fac_shield(i)**2*fac_shield(j)**2 &
3679 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3683 ! ghalf=0.5D0*ggg(k)
3684 ! gelc(k,i)=gelc(k,i)+ghalf
3685 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3686 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3687 ! gelc(k,j)=gelc(k,j)+ghalf
3688 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3689 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3693 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3697 gelc(k,i)=gelc(k,i) &
3698 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3699 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
3701 *fac_shield(i)**2*fac_shield(j)**2 &
3702 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3704 gelc(k,j)=gelc(k,j) &
3705 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3706 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
3708 *fac_shield(i)**2*fac_shield(j)**2 &
3709 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3711 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3712 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3715 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3716 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
3717 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3719 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3720 ! energy of a peptide unit is assumed in the form of a second-order
3721 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3722 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3723 ! are computed for EVERY pair of non-contiguous peptide groups.
3725 if (j.lt.nres-1) then
3736 muij(kkk)=mu(k,i)*mu(l,j)
3739 !d write (iout,*) 'EELEC: i',i,' j',j
3740 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
3741 !d write(iout,*) 'muij',muij
3742 ury=scalar(uy(1,i),erij)
3743 urz=scalar(uz(1,i),erij)
3744 vry=scalar(uy(1,j),erij)
3745 vrz=scalar(uz(1,j),erij)
3746 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3747 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3748 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3749 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3750 fac=dsqrt(-ael6i)*r3ij
3755 !d write (iout,'(4i5,4f10.5)')
3756 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
3757 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3758 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3759 !d & uy(:,j),uz(:,j)
3760 !d write (iout,'(4f10.5)')
3761 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3762 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3763 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
3764 !d write (iout,'(9f10.5/)')
3765 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3766 ! Derivatives of the elements of A in virtual-bond vectors
3767 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3769 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3770 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3771 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3772 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3773 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3774 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3775 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3776 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3777 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3778 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3779 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3780 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3782 ! Compute radial contributions to the gradient
3800 ! Add the contributions coming from er
3803 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3804 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3805 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3806 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3809 ! Derivatives in DC(i)
3810 !grad ghalf1=0.5d0*agg(k,1)
3811 !grad ghalf2=0.5d0*agg(k,2)
3812 !grad ghalf3=0.5d0*agg(k,3)
3813 !grad ghalf4=0.5d0*agg(k,4)
3814 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
3815 -3.0d0*uryg(k,2)*vry)!+ghalf1
3816 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
3817 -3.0d0*uryg(k,2)*vrz)!+ghalf2
3818 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
3819 -3.0d0*urzg(k,2)*vry)!+ghalf3
3820 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
3821 -3.0d0*urzg(k,2)*vrz)!+ghalf4
3822 ! Derivatives in DC(i+1)
3823 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
3824 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3825 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
3826 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3827 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
3828 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3829 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
3830 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3831 ! Derivatives in DC(j)
3832 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
3833 -3.0d0*vryg(k,2)*ury)!+ghalf1
3834 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
3835 -3.0d0*vrzg(k,2)*ury)!+ghalf2
3836 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
3837 -3.0d0*vryg(k,2)*urz)!+ghalf3
3838 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
3839 -3.0d0*vrzg(k,2)*urz)!+ghalf4
3840 ! Derivatives in DC(j+1) or DC(nres-1)
3841 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
3842 -3.0d0*vryg(k,3)*ury)
3843 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
3844 -3.0d0*vrzg(k,3)*ury)
3845 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
3846 -3.0d0*vryg(k,3)*urz)
3847 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
3848 -3.0d0*vrzg(k,3)*urz)
3849 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
3851 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3864 aggi(k,l)=-aggi(k,l)
3865 aggi1(k,l)=-aggi1(k,l)
3866 aggj(k,l)=-aggj(k,l)
3867 aggj1(k,l)=-aggj1(k,l)
3870 if (j.lt.nres-1) then
3876 aggi(k,l)=-aggi(k,l)
3877 aggi1(k,l)=-aggi1(k,l)
3878 aggj(k,l)=-aggj(k,l)
3879 aggj1(k,l)=-aggj1(k,l)
3890 aggi(k,l)=-aggi(k,l)
3891 aggi1(k,l)=-aggi1(k,l)
3892 aggj(k,l)=-aggj(k,l)
3893 aggj1(k,l)=-aggj1(k,l)
3898 IF (wel_loc.gt.0.0d0) THEN
3899 ! Contribution to the local-electrostatic energy coming from the i-j pair
3900 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
3902 if (shield_mode.eq.0) then
3906 eel_loc_ij=eel_loc_ij &
3907 *fac_shield(i)*fac_shield(j) &
3908 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3909 !C Now derivative over eel_loc
3910 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3911 (shield_mode.gt.0)) then
3914 do ilist=1,ishield_list(i)
3915 iresshield=shield_list(ilist,i)
3917 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij &
3920 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
3922 +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i) &
3925 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
3929 do ilist=1,ishield_list(j)
3930 iresshield=shield_list(ilist,j)
3932 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij &
3935 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
3937 +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j) &
3940 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
3947 gshieldc_ll(k,i)=gshieldc_ll(k,i)+ &
3948 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
3950 gshieldc_ll(k,j)=gshieldc_ll(k,j)+ &
3951 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
3953 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+ &
3954 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
3956 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+ &
3957 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
3964 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3966 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3967 ! 'eelloc',i,j,eel_loc_ij
3968 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,8f8.3)') &
3969 'eelloc',i,j,eel_loc_ij,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3970 ! print *,"EELLOC",i,gel_loc_loc(i-1)
3972 ! if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33
3973 ! if (energy_dec) write (iout,*) "muij",muij
3974 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3976 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
3977 ! Partial derivatives in virtual-bond dihedral angles gamma
3979 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
3980 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
3981 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
3983 *fac_shield(i)*fac_shield(j) &
3984 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3986 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
3987 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
3988 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
3990 *fac_shield(i)*fac_shield(j) &
3991 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3992 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3994 ! ggg(1)=(agg(1,1)*muij(1)+ &
3995 ! agg(1,2)*muij(2)+agg(1,3)*muij(3)+agg(1,4)*muij(4)) &
3997 ! +eel_loc_ij*sss_ele_grad*rmij*xj
3998 ! ggg(2)=(agg(2,1)*muij(1)+ &
3999 ! agg(2,2)*muij(2)+agg(2,3)*muij(3)+agg(2,4)*muij(4)) &
4001 ! +eel_loc_ij*sss_ele_grad*rmij*yj
4002 ! ggg(3)=(agg(3,1)*muij(1)+ &
4003 ! agg(3,2)*muij(2)+agg(3,3)*muij(3)+agg(3,4)*muij(4)) &
4005 ! +eel_loc_ij*sss_ele_grad*rmij*zj
4011 ggg(l)=(agg(l,1)*muij(1)+ &
4012 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
4014 *fac_shield(i)*fac_shield(j) &
4015 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) &
4016 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4019 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4020 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4021 !grad ghalf=0.5d0*ggg(l)
4022 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
4023 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
4025 gel_loc_long(3,j)=gel_loc_long(3,j)+ &
4026 ssgradlipj*eel_loc_ij/2.0d0*lipscale/ &
4027 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
4029 gel_loc_long(3,i)=gel_loc_long(3,i)+ &
4030 ssgradlipi*eel_loc_ij/2.0d0*lipscale/ &
4031 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
4035 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4038 ! Remaining derivatives of eello
4040 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
4041 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
4043 *fac_shield(i)*fac_shield(j) &
4044 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4046 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4047 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
4048 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3) &
4049 +aggi1(l,4)*muij(4))&
4051 *fac_shield(i)*fac_shield(j) &
4052 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4054 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4055 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
4056 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
4058 *fac_shield(i)*fac_shield(j) &
4059 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4061 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4062 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
4063 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3) &
4064 +aggj1(l,4)*muij(4))&
4066 *fac_shield(i)*fac_shield(j) &
4067 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4069 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4072 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
4073 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
4074 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
4075 .and. num_conti.le.maxconts) then
4076 ! write (iout,*) i,j," entered corr"
4078 ! Calculate the contact function. The ith column of the array JCONT will
4079 ! contain the numbers of atoms that make contacts with the atom I (of numbers
4080 ! greater than I). The arrays FACONT and GACONT will contain the values of
4081 ! the contact function and its derivative.
4082 ! r0ij=1.02D0*rpp(iteli,itelj)
4083 ! r0ij=1.11D0*rpp(iteli,itelj)
4084 r0ij=2.20D0*rpp(iteli,itelj)
4085 ! r0ij=1.55D0*rpp(iteli,itelj)
4086 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4087 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
4088 if (fcont.gt.0.0D0) then
4089 num_conti=num_conti+1
4090 if (num_conti.gt.maxconts) then
4091 !el write (iout,*) "esrgresgdsrgdfsrgdswrgaresfgaerwgae"
4092 !el write (iout,*) "num_conti",num_conti, "maxconts",maxconts
4093 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
4094 ' will skip next contacts for this conf.', num_conti
4096 jcont_hb(num_conti,i)=j
4097 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
4098 !d & " jcont_hb",jcont_hb(num_conti,i)
4099 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
4100 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4101 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4103 d_cont(num_conti,i)=rij
4104 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4105 ! --- Electrostatic-interaction matrix ---
4106 a_chuj(1,1,num_conti,i)=a22
4107 a_chuj(1,2,num_conti,i)=a23
4108 a_chuj(2,1,num_conti,i)=a32
4109 a_chuj(2,2,num_conti,i)=a33
4110 ! --- Gradient of rij
4112 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4119 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4120 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4121 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4122 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4123 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4128 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4129 ! Calculate contact energies
4131 wij=cosa-3.0D0*cosb*cosg
4134 ! fac3=dsqrt(-ael6i)/r0ij**3
4135 fac3=dsqrt(-ael6i)*r3ij
4136 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4137 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4138 if (ees0tmp.gt.0) then
4139 ees0pij=dsqrt(ees0tmp)
4143 if (shield_mode.eq.0) then
4147 ees0plist(num_conti,i)=j
4149 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4150 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4151 if (ees0tmp.gt.0) then
4152 ees0mij=dsqrt(ees0tmp)
4157 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
4159 *fac_shield(i)*fac_shield(j)
4161 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
4163 *fac_shield(i)*fac_shield(j)
4165 ! Diagnostics. Comment out or remove after debugging!
4166 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4167 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4168 ! ees0m(num_conti,i)=0.0D0
4170 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4171 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4172 ! Angular derivatives of the contact function
4173 ees0pij1=fac3/ees0pij
4174 ees0mij1=fac3/ees0mij
4175 fac3p=-3.0D0*fac3*rrmij
4176 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4177 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4179 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4180 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4181 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4182 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4183 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4184 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4185 ecosap=ecosa1+ecosa2
4186 ecosbp=ecosb1+ecosb2
4187 ecosgp=ecosg1+ecosg2
4188 ecosam=ecosa1-ecosa2
4189 ecosbm=ecosb1-ecosb2
4190 ecosgm=ecosg1-ecosg2
4199 facont_hb(num_conti,i)=fcont
4200 fprimcont=fprimcont/rij
4201 !d facont_hb(num_conti,i)=1.0D0
4202 ! Following line is for diagnostics.
4205 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4206 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4209 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4210 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4212 gggp(1)=gggp(1)+ees0pijp*xj &
4213 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
4214 gggp(2)=gggp(2)+ees0pijp*yj &
4215 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
4216 gggp(3)=gggp(3)+ees0pijp*zj &
4217 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
4219 gggm(1)=gggm(1)+ees0mijp*xj &
4220 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
4222 gggm(2)=gggm(2)+ees0mijp*yj &
4223 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
4225 gggm(3)=gggm(3)+ees0mijp*zj &
4226 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
4228 ! Derivatives due to the contact function
4229 gacont_hbr(1,num_conti,i)=fprimcont*xj
4230 gacont_hbr(2,num_conti,i)=fprimcont*yj
4231 gacont_hbr(3,num_conti,i)=fprimcont*zj
4234 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
4235 ! following the change of gradient-summation algorithm.
4237 !grad ghalfp=0.5D0*gggp(k)
4238 !grad ghalfm=0.5D0*gggm(k)
4239 gacontp_hb1(k,num_conti,i)= & !ghalfp+
4240 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4241 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
4242 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4244 gacontp_hb2(k,num_conti,i)= & !ghalfp+
4245 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4246 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
4247 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4249 gacontp_hb3(k,num_conti,i)=gggp(k) &
4250 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4252 gacontm_hb1(k,num_conti,i)= & !ghalfm+
4253 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4254 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
4255 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4257 gacontm_hb2(k,num_conti,i)= & !ghalfm+
4258 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4259 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
4260 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4262 gacontm_hb3(k,num_conti,i)=gggm(k) &
4263 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4266 ! Diagnostics. Comment out or remove after debugging!
4268 !diag gacontp_hb1(k,num_conti,i)=0.0D0
4269 !diag gacontp_hb2(k,num_conti,i)=0.0D0
4270 !diag gacontp_hb3(k,num_conti,i)=0.0D0
4271 !diag gacontm_hb1(k,num_conti,i)=0.0D0
4272 !diag gacontm_hb2(k,num_conti,i)=0.0D0
4273 !diag gacontm_hb3(k,num_conti,i)=0.0D0
4276 endif ! num_conti.le.maxconts
4279 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4282 ghalf=0.5d0*agg(l,k)
4283 aggi(l,k)=aggi(l,k)+ghalf
4284 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4285 aggj(l,k)=aggj(l,k)+ghalf
4288 if (j.eq.nres-1 .and. i.lt.j-2) then
4291 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4297 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
4299 end subroutine eelecij
4300 !-----------------------------------------------------------------------------
4301 subroutine eturn3(i,eello_turn3)
4302 ! Third- and fourth-order contributions from turns
4305 ! implicit real*8 (a-h,o-z)
4306 ! include 'DIMENSIONS'
4307 ! include 'COMMON.IOUNITS'
4308 ! include 'COMMON.GEO'
4309 ! include 'COMMON.VAR'
4310 ! include 'COMMON.LOCAL'
4311 ! include 'COMMON.CHAIN'
4312 ! include 'COMMON.DERIV'
4313 ! include 'COMMON.INTERACT'
4314 ! include 'COMMON.CONTACTS'
4315 ! include 'COMMON.TORSION'
4316 ! include 'COMMON.VECTORS'
4317 ! include 'COMMON.FFIELD'
4318 ! include 'COMMON.CONTROL'
4319 real(kind=8),dimension(3) :: ggg
4320 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4321 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
4322 real(kind=8),dimension(2) :: auxvec,auxvec1
4323 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4324 real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
4325 !el integer :: num_conti,j1,j2
4326 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4327 !el dz_normi,xmedi,ymedi,zmedi
4329 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4330 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4333 integer :: i,j,l,k,ilist,iresshield
4334 real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield
4337 ! write (iout,*) "eturn3",i,j,j1,j2
4338 zj=(c(3,j)+c(3,j+1))/2.0d0
4340 if (zj.lt.0) zj=zj+boxzsize
4341 if ((zj.lt.0)) write (*,*) "CHUJ"
4342 if ((zj.gt.bordlipbot) &
4343 .and.(zj.lt.bordliptop)) then
4344 !C the energy transfer exist
4345 if (zj.lt.buflipbot) then
4346 !C what fraction I am in
4348 ((zj-bordlipbot)/lipbufthick)
4349 !C lipbufthick is thickenes of lipid buffore
4350 sslipj=sscalelip(fracinbuf)
4351 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4352 elseif (zj.gt.bufliptop) then
4353 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4354 sslipj=sscalelip(fracinbuf)
4355 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4369 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4371 ! Third-order contributions
4378 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4379 !d call checkint_turn3(i,a_temp,eello_turn3_num)
4380 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4381 call transpose2(auxmat(1,1),auxmat1(1,1))
4382 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4383 if (shield_mode.eq.0) then
4388 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) &
4389 *fac_shield(i)*fac_shield(j) &
4390 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4392 0.5d0*(pizda(1,1)+pizda(2,2)) &
4393 *fac_shield(i)*fac_shield(j)
4395 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4396 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4397 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4398 (shield_mode.gt.0)) then
4401 do ilist=1,ishield_list(i)
4402 iresshield=shield_list(ilist,i)
4404 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4405 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4407 +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4408 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4412 do ilist=1,ishield_list(j)
4413 iresshield=shield_list(ilist,j)
4415 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4416 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4418 +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4419 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4426 gshieldc_t3(k,i)=gshieldc_t3(k,i)+ &
4427 grad_shield(k,i)*eello_t3/fac_shield(i)
4428 gshieldc_t3(k,j)=gshieldc_t3(k,j)+ &
4429 grad_shield(k,j)*eello_t3/fac_shield(j)
4430 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+ &
4431 grad_shield(k,i)*eello_t3/fac_shield(i)
4432 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+ &
4433 grad_shield(k,j)*eello_t3/fac_shield(j)
4437 !d write (2,*) 'i,',i,' j',j,'eello_turn3',
4438 !d & 0.5d0*(pizda(1,1)+pizda(2,2)),
4439 !d & ' eello_turn3_num',4*eello_turn3_num
4440 ! Derivatives in gamma(i)
4441 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4442 call transpose2(auxmat2(1,1),auxmat3(1,1))
4443 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4444 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))&
4445 *fac_shield(i)*fac_shield(j) &
4446 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4447 ! Derivatives in gamma(i+1)
4448 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4449 call transpose2(auxmat2(1,1),auxmat3(1,1))
4450 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4451 gel_loc_turn3(i+1)=gel_loc_turn3(i+1) &
4452 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4453 *fac_shield(i)*fac_shield(j) &
4454 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4456 ! Cartesian derivatives
4458 ! ghalf1=0.5d0*agg(l,1)
4459 ! ghalf2=0.5d0*agg(l,2)
4460 ! ghalf3=0.5d0*agg(l,3)
4461 ! ghalf4=0.5d0*agg(l,4)
4462 a_temp(1,1)=aggi(l,1)!+ghalf1
4463 a_temp(1,2)=aggi(l,2)!+ghalf2
4464 a_temp(2,1)=aggi(l,3)!+ghalf3
4465 a_temp(2,2)=aggi(l,4)!+ghalf4
4466 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4467 gcorr3_turn(l,i)=gcorr3_turn(l,i) &
4468 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4469 *fac_shield(i)*fac_shield(j) &
4470 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4472 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4473 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4474 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4475 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4476 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4477 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) &
4478 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4479 *fac_shield(i)*fac_shield(j) &
4480 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4482 a_temp(1,1)=aggj(l,1)!+ghalf1
4483 a_temp(1,2)=aggj(l,2)!+ghalf2
4484 a_temp(2,1)=aggj(l,3)!+ghalf3
4485 a_temp(2,2)=aggj(l,4)!+ghalf4
4486 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4487 gcorr3_turn(l,j)=gcorr3_turn(l,j) &
4488 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4489 *fac_shield(i)*fac_shield(j) &
4490 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4492 a_temp(1,1)=aggj1(l,1)
4493 a_temp(1,2)=aggj1(l,2)
4494 a_temp(2,1)=aggj1(l,3)
4495 a_temp(2,2)=aggj1(l,4)
4496 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4497 gcorr3_turn(l,j1)=gcorr3_turn(l,j1) &
4498 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4499 *fac_shield(i)*fac_shield(j) &
4500 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4502 gshieldc_t3(3,i)=gshieldc_t3(3,i)+ &
4503 ssgradlipi*eello_t3/4.0d0*lipscale
4504 gshieldc_t3(3,j)=gshieldc_t3(3,j)+ &
4505 ssgradlipj*eello_t3/4.0d0*lipscale
4506 gshieldc_t3(3,i-1)=gshieldc_t3(3,i-1)+ &
4507 ssgradlipi*eello_t3/4.0d0*lipscale
4508 gshieldc_t3(3,j-1)=gshieldc_t3(3,j-1)+ &
4509 ssgradlipj*eello_t3/4.0d0*lipscale
4512 end subroutine eturn3
4513 !-----------------------------------------------------------------------------
4514 subroutine eturn4(i,eello_turn4)
4515 ! Third- and fourth-order contributions from turns
4518 ! implicit real*8 (a-h,o-z)
4519 ! include 'DIMENSIONS'
4520 ! include 'COMMON.IOUNITS'
4521 ! include 'COMMON.GEO'
4522 ! include 'COMMON.VAR'
4523 ! include 'COMMON.LOCAL'
4524 ! include 'COMMON.CHAIN'
4525 ! include 'COMMON.DERIV'
4526 ! include 'COMMON.INTERACT'
4527 ! include 'COMMON.CONTACTS'
4528 ! include 'COMMON.TORSION'
4529 ! include 'COMMON.VECTORS'
4530 ! include 'COMMON.FFIELD'
4531 ! include 'COMMON.CONTROL'
4532 real(kind=8),dimension(3) :: ggg
4533 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4534 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
4535 real(kind=8),dimension(2) :: auxvec,auxvec1
4536 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4537 real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
4538 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4539 !el dz_normi,xmedi,ymedi,zmedi
4540 !el integer :: num_conti,j1,j2
4541 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4542 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4545 integer :: i,j,iti1,iti2,iti3,l,k,ilist,iresshield
4546 real(kind=8) :: eello_turn4,s1,s2,s3,zj,fracinbuf,eello_t4,&
4550 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4552 ! Fourth-order contributions
4560 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4561 !d call checkint_turn4(i,a_temp,eello_turn4_num)
4562 ! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4563 zj=(c(3,j)+c(3,j+1))/2.0d0
4565 if (zj.lt.0) zj=zj+boxzsize
4566 if ((zj.gt.bordlipbot) &
4567 .and.(zj.lt.bordliptop)) then
4568 !C the energy transfer exist
4569 if (zj.lt.buflipbot) then
4570 !C what fraction I am in
4572 ((zj-bordlipbot)/lipbufthick)
4573 !C lipbufthick is thickenes of lipid buffore
4574 sslipj=sscalelip(fracinbuf)
4575 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4576 elseif (zj.gt.bufliptop) then
4577 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4578 sslipj=sscalelip(fracinbuf)
4579 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4593 iti1=itortyp(itype(i+1,1))
4594 iti2=itortyp(itype(i+2,1))
4595 iti3=itortyp(itype(i+3,1))
4596 ! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4597 call transpose2(EUg(1,1,i+1),e1t(1,1))
4598 call transpose2(Eug(1,1,i+2),e2t(1,1))
4599 call transpose2(Eug(1,1,i+3),e3t(1,1))
4600 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4601 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4602 s1=scalar2(b1(1,iti2),auxvec(1))
4603 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4604 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4605 s2=scalar2(b1(1,iti1),auxvec(1))
4606 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4607 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4608 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4609 if (shield_mode.eq.0) then
4614 eello_turn4=eello_turn4-(s1+s2+s3) &
4615 *fac_shield(i)*fac_shield(j) &
4616 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4617 eello_t4=-(s1+s2+s3) &
4618 *fac_shield(i)*fac_shield(j)
4619 !C Now derivative over shield:
4620 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4621 (shield_mode.gt.0)) then
4624 do ilist=1,ishield_list(i)
4625 iresshield=shield_list(ilist,i)
4627 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
4628 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
4630 +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
4631 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
4635 do ilist=1,ishield_list(j)
4636 iresshield=shield_list(ilist,j)
4638 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
4639 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
4641 +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
4642 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
4649 gshieldc_t4(k,i)=gshieldc_t4(k,i)+ &
4650 grad_shield(k,i)*eello_t4/fac_shield(i)
4651 gshieldc_t4(k,j)=gshieldc_t4(k,j)+ &
4652 grad_shield(k,j)*eello_t4/fac_shield(j)
4653 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+ &
4654 grad_shield(k,i)*eello_t4/fac_shield(i)
4655 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+ &
4656 grad_shield(k,j)*eello_t4/fac_shield(j)
4660 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4661 'eturn4',i,j,-(s1+s2+s3)
4662 !d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4663 !d & ' eello_turn4_num',8*eello_turn4_num
4664 ! Derivatives in gamma(i)
4665 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4666 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4667 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4668 s1=scalar2(b1(1,iti2),auxvec(1))
4669 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4670 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4671 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) &
4672 *fac_shield(i)*fac_shield(j) &
4673 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4675 ! Derivatives in gamma(i+1)
4676 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4677 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4678 s2=scalar2(b1(1,iti1),auxvec(1))
4679 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4680 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4681 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4682 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) &
4683 *fac_shield(i)*fac_shield(j) &
4684 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4686 ! Derivatives in gamma(i+2)
4687 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4688 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4689 s1=scalar2(b1(1,iti2),auxvec(1))
4690 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4691 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4692 s2=scalar2(b1(1,iti1),auxvec(1))
4693 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4694 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4695 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4696 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) &
4697 *fac_shield(i)*fac_shield(j) &
4698 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4700 ! Cartesian derivatives
4701 ! Derivatives of this turn contributions in DC(i+2)
4702 if (j.lt.nres-1) then
4704 a_temp(1,1)=agg(l,1)
4705 a_temp(1,2)=agg(l,2)
4706 a_temp(2,1)=agg(l,3)
4707 a_temp(2,2)=agg(l,4)
4708 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4709 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4710 s1=scalar2(b1(1,iti2),auxvec(1))
4711 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4712 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4713 s2=scalar2(b1(1,iti1),auxvec(1))
4714 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4715 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4716 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4718 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)&
4719 *fac_shield(i)*fac_shield(j) &
4720 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4724 ! Remaining derivatives of this turn contribution
4726 a_temp(1,1)=aggi(l,1)
4727 a_temp(1,2)=aggi(l,2)
4728 a_temp(2,1)=aggi(l,3)
4729 a_temp(2,2)=aggi(l,4)
4730 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4731 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4732 s1=scalar2(b1(1,iti2),auxvec(1))
4733 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4734 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4735 s2=scalar2(b1(1,iti1),auxvec(1))
4736 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4737 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4738 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4739 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) &
4740 *fac_shield(i)*fac_shield(j) &
4741 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4744 a_temp(1,1)=aggi1(l,1)
4745 a_temp(1,2)=aggi1(l,2)
4746 a_temp(2,1)=aggi1(l,3)
4747 a_temp(2,2)=aggi1(l,4)
4748 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4749 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4750 s1=scalar2(b1(1,iti2),auxvec(1))
4751 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4752 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4753 s2=scalar2(b1(1,iti1),auxvec(1))
4754 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4755 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4756 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4757 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) &
4758 *fac_shield(i)*fac_shield(j) &
4759 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4762 a_temp(1,1)=aggj(l,1)
4763 a_temp(1,2)=aggj(l,2)
4764 a_temp(2,1)=aggj(l,3)
4765 a_temp(2,2)=aggj(l,4)
4766 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4767 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4768 s1=scalar2(b1(1,iti2),auxvec(1))
4769 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4770 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4771 s2=scalar2(b1(1,iti1),auxvec(1))
4772 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4773 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4774 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4775 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) &
4776 *fac_shield(i)*fac_shield(j) &
4777 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4780 a_temp(1,1)=aggj1(l,1)
4781 a_temp(1,2)=aggj1(l,2)
4782 a_temp(2,1)=aggj1(l,3)
4783 a_temp(2,2)=aggj1(l,4)
4784 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4785 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4786 s1=scalar2(b1(1,iti2),auxvec(1))
4787 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4788 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4789 s2=scalar2(b1(1,iti1),auxvec(1))
4790 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4791 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4792 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4793 ! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4794 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) &
4795 *fac_shield(i)*fac_shield(j) &
4796 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4799 gshieldc_t4(3,i)=gshieldc_t4(3,i)+ &
4800 ssgradlipi*eello_t4/4.0d0*lipscale
4801 gshieldc_t4(3,j)=gshieldc_t4(3,j)+ &
4802 ssgradlipj*eello_t4/4.0d0*lipscale
4803 gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+ &
4804 ssgradlipi*eello_t4/4.0d0*lipscale
4805 gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+ &
4806 ssgradlipj*eello_t4/4.0d0*lipscale
4809 end subroutine eturn4
4810 !-----------------------------------------------------------------------------
4811 subroutine unormderiv(u,ugrad,unorm,ungrad)
4812 ! This subroutine computes the derivatives of a normalized vector u, given
4813 ! the derivatives computed without normalization conditions, ugrad. Returns
4816 real(kind=8),dimension(3) :: u,vec
4817 real(kind=8),dimension(3,3) ::ugrad,ungrad
4818 real(kind=8) :: unorm !,scalar
4820 ! write (2,*) 'ugrad',ugrad
4823 vec(i)=scalar(ugrad(1,i),u(1))
4825 ! write (2,*) 'vec',vec
4828 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4831 ! write (2,*) 'ungrad',ungrad
4833 end subroutine unormderiv
4834 !-----------------------------------------------------------------------------
4835 subroutine escp_soft_sphere(evdw2,evdw2_14)
4837 ! This subroutine calculates the excluded-volume interaction energy between
4838 ! peptide-group centers and side chains and its gradient in virtual-bond and
4839 ! side-chain vectors.
4841 ! implicit real*8 (a-h,o-z)
4842 ! include 'DIMENSIONS'
4843 ! include 'COMMON.GEO'
4844 ! include 'COMMON.VAR'
4845 ! include 'COMMON.LOCAL'
4846 ! include 'COMMON.CHAIN'
4847 ! include 'COMMON.DERIV'
4848 ! include 'COMMON.INTERACT'
4849 ! include 'COMMON.FFIELD'
4850 ! include 'COMMON.IOUNITS'
4851 ! include 'COMMON.CONTROL'
4852 real(kind=8),dimension(3) :: ggg
4854 integer :: i,iint,j,k,iteli,itypj
4855 real(kind=8) :: evdw2,evdw2_14,r0_scp,xi,yi,zi,xj,yj,zj,&
4856 fac,rij,r0ij,r0ijsq,evdwij,e1,e2
4861 !d print '(a)','Enter ESCP'
4862 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4863 do i=iatscp_s,iatscp_e
4864 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
4866 xi=0.5D0*(c(1,i)+c(1,i+1))
4867 yi=0.5D0*(c(2,i)+c(2,i+1))
4868 zi=0.5D0*(c(3,i)+c(3,i+1))
4870 do iint=1,nscp_gr(i)
4872 do j=iscpstart(i,iint),iscpend(i,iint)
4873 if (itype(j,1).eq.ntyp1) cycle
4874 itypj=iabs(itype(j,1))
4875 ! Uncomment following three lines for SC-p interactions
4879 ! Uncomment following three lines for Ca-p interactions
4883 rij=xj*xj+yj*yj+zj*zj
4886 if (rij.lt.r0ijsq) then
4887 evdwij=0.25d0*(rij-r0ijsq)**2
4895 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
4900 !grad if (j.lt.i) then
4901 !d write (iout,*) 'j<i'
4902 ! Uncomment following three lines for SC-p interactions
4904 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4907 !d write (iout,*) 'j>i'
4909 !grad ggg(k)=-ggg(k)
4910 ! Uncomment following line for SC-p interactions
4911 ! gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4915 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4917 !grad kstart=min0(i+1,j)
4918 !grad kend=max0(i-1,j-1)
4919 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4920 !d write (iout,*) ggg(1),ggg(2),ggg(3)
4921 !grad do k=kstart,kend
4923 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4927 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4928 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4935 end subroutine escp_soft_sphere
4936 !-----------------------------------------------------------------------------
4937 subroutine escp(evdw2,evdw2_14)
4939 ! This subroutine calculates the excluded-volume interaction energy between
4940 ! peptide-group centers and side chains and its gradient in virtual-bond and
4941 ! side-chain vectors.
4943 ! implicit real*8 (a-h,o-z)
4944 ! include 'DIMENSIONS'
4945 ! include 'COMMON.GEO'
4946 ! include 'COMMON.VAR'
4947 ! include 'COMMON.LOCAL'
4948 ! include 'COMMON.CHAIN'
4949 ! include 'COMMON.DERIV'
4950 ! include 'COMMON.INTERACT'
4951 ! include 'COMMON.FFIELD'
4952 ! include 'COMMON.IOUNITS'
4953 ! include 'COMMON.CONTROL'
4954 real(kind=8),dimension(3) :: ggg
4956 integer :: i,iint,j,k,iteli,itypj,subchap
4957 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
4959 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
4960 dist_temp, dist_init
4961 integer xshift,yshift,zshift
4965 !d print '(a)','Enter ESCP'
4966 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4967 do i=iatscp_s,iatscp_e
4968 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
4970 xi=0.5D0*(c(1,i)+c(1,i+1))
4971 yi=0.5D0*(c(2,i)+c(2,i+1))
4972 zi=0.5D0*(c(3,i)+c(3,i+1))
4974 if (xi.lt.0) xi=xi+boxxsize
4976 if (yi.lt.0) yi=yi+boxysize
4978 if (zi.lt.0) zi=zi+boxzsize
4980 do iint=1,nscp_gr(i)
4982 do j=iscpstart(i,iint),iscpend(i,iint)
4983 itypj=iabs(itype(j,1))
4984 if (itypj.eq.ntyp1) cycle
4985 ! Uncomment following three lines for SC-p interactions
4989 ! Uncomment following three lines for Ca-p interactions
4997 if (xj.lt.0) xj=xj+boxxsize
4999 if (yj.lt.0) yj=yj+boxysize
5001 if (zj.lt.0) zj=zj+boxzsize
5002 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5010 xj=xj_safe+xshift*boxxsize
5011 yj=yj_safe+yshift*boxysize
5012 zj=zj_safe+zshift*boxzsize
5013 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5014 if(dist_temp.lt.dist_init) then
5024 if (subchap.eq.1) then
5034 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5035 rij=dsqrt(1.0d0/rrij)
5036 sss_ele_cut=sscale_ele(rij)
5037 sss_ele_grad=sscagrad_ele(rij)
5038 ! print *,sss_ele_cut,sss_ele_grad,&
5039 ! (rij),r_cut_ele,rlamb_ele
5040 if (sss_ele_cut.le.0.0) cycle
5042 e1=fac*fac*aad(itypj,iteli)
5043 e2=fac*bad(itypj,iteli)
5044 if (iabs(j-i) .le. 2) then
5047 evdw2_14=evdw2_14+(e1+e2)*sss_ele_cut
5050 evdw2=evdw2+evdwij*sss_ele_cut
5051 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') &
5052 ! 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),&
5053 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
5056 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
5058 fac=-(evdwij+e1)*rrij*sss_ele_cut
5059 fac=fac+evdwij*sss_ele_grad/rij/expon
5063 !grad if (j.lt.i) then
5064 !d write (iout,*) 'j<i'
5065 ! Uncomment following three lines for SC-p interactions
5067 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5070 !d write (iout,*) 'j>i'
5072 !grad ggg(k)=-ggg(k)
5073 ! Uncomment following line for SC-p interactions
5074 !cgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5075 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5079 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5081 !grad kstart=min0(i+1,j)
5082 !grad kend=max0(i-1,j-1)
5083 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5084 !d write (iout,*) ggg(1),ggg(2),ggg(3)
5085 !grad do k=kstart,kend
5087 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5091 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5092 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5100 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5101 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5102 gradx_scp(j,i)=expon*gradx_scp(j,i)
5105 !******************************************************************************
5109 ! To save time the factor EXPON has been extracted from ALL components
5110 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
5113 !******************************************************************************
5116 !-----------------------------------------------------------------------------
5117 subroutine edis(ehpb)
5119 ! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5121 ! implicit real*8 (a-h,o-z)
5122 ! include 'DIMENSIONS'
5123 ! include 'COMMON.SBRIDGE'
5124 ! include 'COMMON.CHAIN'
5125 ! include 'COMMON.DERIV'
5126 ! include 'COMMON.VAR'
5127 ! include 'COMMON.INTERACT'
5128 ! include 'COMMON.IOUNITS'
5129 real(kind=8),dimension(3) :: ggg
5131 integer :: i,j,ii,jj,iii,jjj,k
5132 real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
5135 !d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5136 !d write(iout,*)'link_start=',link_start,' link_end=',link_end
5137 if (link_end.eq.0) return
5138 do i=link_start,link_end
5139 ! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5140 ! CA-CA distance used in regularization of structure.
5143 ! iii and jjj point to the residues for which the distance is assigned.
5144 if (ii.gt.nres) then
5151 ! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5152 ! & dhpb(i),dhpb1(i),forcon(i)
5153 ! 24/11/03 AL: SS bridges handled separately because of introducing a specific
5154 ! distance and angle dependent SS bond potential.
5155 !mc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5156 ! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5157 if (.not.dyn_ss .and. i.le.nss) then
5158 ! 15/02/13 CC dynamic SSbond - additional check
5159 if (ii.gt.nres .and. iabs(itype(iii,1)).eq.1 .and. &
5160 iabs(itype(jjj,1)).eq.1) then
5161 call ssbond_ene(iii,jjj,eij)
5163 !d write (iout,*) "eij",eij
5165 else if (ii.gt.nres .and. jj.gt.nres) then
5166 !c Restraints from contact prediction
5168 if (constr_dist.eq.11) then
5169 ehpb=ehpb+fordepth(i)**4.0d0 &
5170 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5171 fac=fordepth(i)**4.0d0 &
5172 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5173 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
5176 if (dhpb1(i).gt.0.0d0) then
5177 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5178 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5179 !c write (iout,*) "beta nmr",
5180 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5184 !C Get the force constant corresponding to this distance.
5186 !C Calculate the contribution to energy.
5187 ehpb=ehpb+waga*rdis*rdis
5188 !c write (iout,*) "beta reg",dd,waga*rdis*rdis
5190 !C Evaluate gradient.
5196 ggg(j)=fac*(c(j,jj)-c(j,ii))
5199 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5200 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5203 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5204 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5208 if (constr_dist.eq.11) then
5209 ehpb=ehpb+fordepth(i)**4.0d0 &
5210 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5211 fac=fordepth(i)**4.0d0 &
5212 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5213 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
5216 if (dhpb1(i).gt.0.0d0) then
5217 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5218 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5219 !c write (iout,*) "alph nmr",
5220 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5223 !C Get the force constant corresponding to this distance.
5225 !C Calculate the contribution to energy.
5226 ehpb=ehpb+waga*rdis*rdis
5227 !c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5229 !C Evaluate gradient.
5236 ggg(j)=fac*(c(j,jj)-c(j,ii))
5238 !cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5239 !C If this is a SC-SC distance, we need to calculate the contributions to the
5240 !C Cartesian gradient in the SC vectors (ghpbx).
5243 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5244 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5247 !cgrad do j=iii,jjj-1
5249 !cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5253 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5254 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5258 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5262 !-----------------------------------------------------------------------------
5263 subroutine ssbond_ene(i,j,eij)
5265 ! Calculate the distance and angle dependent SS-bond potential energy
5266 ! using a free-energy function derived based on RHF/6-31G** ab initio
5267 ! calculations of diethyl disulfide.
5269 ! A. Liwo and U. Kozlowska, 11/24/03
5271 ! implicit real*8 (a-h,o-z)
5272 ! include 'DIMENSIONS'
5273 ! include 'COMMON.SBRIDGE'
5274 ! include 'COMMON.CHAIN'
5275 ! include 'COMMON.DERIV'
5276 ! include 'COMMON.LOCAL'
5277 ! include 'COMMON.INTERACT'
5278 ! include 'COMMON.VAR'
5279 ! include 'COMMON.IOUNITS'
5280 real(kind=8),dimension(3) :: erij,dcosom1,dcosom2,gg
5282 integer :: i,j,itypi,itypj,k
5283 real(kind=8) :: eij,rij,rrij,xi,yi,zi,dxi,dyi,dzi,dsci_inv,&
5284 xj,yj,zj,dxj,dyj,dzj,om1,om2,om12,deltad,dscj_inv,&
5285 deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,&
5288 itypi=iabs(itype(i,1))
5292 dxi=dc_norm(1,nres+i)
5293 dyi=dc_norm(2,nres+i)
5294 dzi=dc_norm(3,nres+i)
5295 ! dsci_inv=dsc_inv(itypi)
5296 dsci_inv=vbld_inv(nres+i)
5297 itypj=iabs(itype(j,1))
5298 ! dscj_inv=dsc_inv(itypj)
5299 dscj_inv=vbld_inv(nres+j)
5303 dxj=dc_norm(1,nres+j)
5304 dyj=dc_norm(2,nres+j)
5305 dzj=dc_norm(3,nres+j)
5306 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5311 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5312 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5313 om12=dxi*dxj+dyi*dyj+dzi*dzj
5315 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5316 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5322 deltat12=om2-om1+2.0d0
5324 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
5325 +akct*deltad*deltat12 &
5326 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5327 ! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5328 ! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5329 ! & " deltat12",deltat12," eij",eij
5330 ed=2*akcm*deltad+akct*deltat12
5332 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5333 eom1=-2*akth*deltat1-pom1-om2*pom2
5334 eom2= 2*akth*deltat2+pom1-om1*pom2
5337 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5338 ghpbx(k,i)=ghpbx(k,i)-ggk &
5339 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
5340 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5341 ghpbx(k,j)=ghpbx(k,j)+ggk &
5342 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
5343 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5344 ghpbc(k,i)=ghpbc(k,i)-ggk
5345 ghpbc(k,j)=ghpbc(k,j)+ggk
5348 ! Calculate the components of the gradient in DC and X
5352 !grad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5356 end subroutine ssbond_ene
5357 !-----------------------------------------------------------------------------
5358 subroutine ebond(estr)
5360 ! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5362 ! implicit real*8 (a-h,o-z)
5363 ! include 'DIMENSIONS'
5364 ! include 'COMMON.LOCAL'
5365 ! include 'COMMON.GEO'
5366 ! include 'COMMON.INTERACT'
5367 ! include 'COMMON.DERIV'
5368 ! include 'COMMON.VAR'
5369 ! include 'COMMON.CHAIN'
5370 ! include 'COMMON.IOUNITS'
5371 ! include 'COMMON.NAMES'
5372 ! include 'COMMON.FFIELD'
5373 ! include 'COMMON.CONTROL'
5374 ! include 'COMMON.SETUP'
5375 real(kind=8),dimension(3) :: u,ud
5377 integer :: i,j,iti,nbi,k
5378 real(kind=8) :: estr,estr1,diff,uprod,usum,usumsqder,&
5383 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
5384 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
5386 do i=ibondp_start,ibondp_end
5387 if (itype(i-1,1).eq.ntyp1 .and. itype(i,1).eq.ntyp1) cycle
5388 if (itype(i-1,1).eq.ntyp1 .or. itype(i,1).eq.ntyp1) then
5389 !C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5391 !C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) &
5392 !C *dc(j,i-1)/vbld(i)
5394 !C if (energy_dec) write(iout,*) &
5395 !C "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5396 diff = vbld(i)-vbldpDUM
5398 diff = vbld(i)-vbldp0
5400 if (energy_dec) write (iout,'(a7,i5,4f7.3)') &
5401 "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5404 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5406 ! write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5409 estr=0.5d0*AKP*estr+estr1
5410 ! print *,"estr_bb",estr,AKP
5412 ! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5414 do i=ibond_start,ibond_end
5415 iti=iabs(itype(i,1))
5416 if (iti.eq.0) print *,"WARNING WRONG SETTTING",i
5417 if (iti.ne.10 .and. iti.ne.ntyp1) then
5420 diff=vbld(i+nres)-vbldsc0(1,iti)
5421 if (energy_dec) write (iout,*) &
5422 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5423 AKSC(1,iti),AKSC(1,iti)*diff*diff
5424 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5425 ! print *,"estr_sc",estr
5427 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5431 diff=vbld(i+nres)-vbldsc0(j,iti)
5432 ud(j)=aksc(j,iti)*diff
5433 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5447 uprod2=uprod2*u(k)*u(k)
5451 usumsqder=usumsqder+ud(j)*uprod2
5453 estr=estr+uprod/usum
5454 ! print *,"estr_sc",estr,i
5456 if (energy_dec) write (iout,*) &
5457 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5458 AKSC(1,iti),uprod/usum
5460 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5466 end subroutine ebond
5468 !-----------------------------------------------------------------------------
5469 subroutine ebend(etheta)
5471 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5472 ! angles gamma and its derivatives in consecutive thetas and gammas.
5475 ! implicit real*8 (a-h,o-z)
5476 ! include 'DIMENSIONS'
5477 ! include 'COMMON.LOCAL'
5478 ! include 'COMMON.GEO'
5479 ! include 'COMMON.INTERACT'
5480 ! include 'COMMON.DERIV'
5481 ! include 'COMMON.VAR'
5482 ! include 'COMMON.CHAIN'
5483 ! include 'COMMON.IOUNITS'
5484 ! include 'COMMON.NAMES'
5485 ! include 'COMMON.FFIELD'
5486 ! include 'COMMON.CONTROL'
5487 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5488 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5489 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5491 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5492 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5493 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5495 integer :: i,k,ichir1,ichir2,itype1,ichir11,ichir12,itype2,&
5497 real(kind=8) :: etheta,delta,ss,ssd,phii,phii1,thet_pred_mean,&
5498 athetk,bthetk,dthett,dthetg1,dthetg2,f0,fprim0,E_tc0,fprim_tc0,&
5499 f1,fprim1,E_tc1,ethetai,E_theta,E_tc
5500 real(kind=8),dimension(2) :: y,z
5503 ! time11=dexp(-2*time)
5506 ! write (*,'(a,i2)') 'EBEND ICG=',icg
5507 do i=ithet_start,ithet_end
5508 if (itype(i-1,1).eq.ntyp1) cycle
5509 ! Zero the energy function and its derivative at 0 or pi.
5510 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5512 ichir1=isign(1,itype(i-2,1))
5513 ichir2=isign(1,itype(i,1))
5514 if (itype(i-2,1).eq.10) ichir1=isign(1,itype(i-1,1))
5515 if (itype(i,1).eq.10) ichir2=isign(1,itype(i-1,1))
5516 if (itype(i-1,1).eq.10) then
5517 itype1=isign(10,itype(i-2,1))
5518 ichir11=isign(1,itype(i-2,1))
5519 ichir12=isign(1,itype(i-2,1))
5520 itype2=isign(10,itype(i,1))
5521 ichir21=isign(1,itype(i,1))
5522 ichir22=isign(1,itype(i,1))
5525 if (i.gt.3 .and. itype(i-2,1).ne.ntyp1) then
5528 if (phii.ne.phii) phii=150.0
5538 if (i.lt.nres .and. itype(i,1).ne.ntyp1) then
5541 if (phii1.ne.phii1) phii1=150.0
5553 ! Calculate the "mean" value of theta from the part of the distribution
5554 ! dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5555 ! In following comments this theta will be referred to as t_c.
5556 thet_pred_mean=0.0d0
5558 athetk=athet(k,it,ichir1,ichir2)
5559 bthetk=bthet(k,it,ichir1,ichir2)
5561 athetk=athet(k,itype1,ichir11,ichir12)
5562 bthetk=bthet(k,itype2,ichir21,ichir22)
5564 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5566 dthett=thet_pred_mean*ssd
5567 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5568 ! Derivatives of the "mean" values in gamma1 and gamma2.
5569 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) &
5570 +athet(2,it,ichir1,ichir2)*y(1))*ss
5571 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) &
5572 +bthet(2,it,ichir1,ichir2)*z(1))*ss
5574 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) &
5575 +athet(2,itype1,ichir11,ichir12)*y(1))*ss
5576 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) &
5577 +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5579 if (theta(i).gt.pi-delta) then
5580 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,&
5582 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5583 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5584 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,&
5586 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,&
5588 else if (theta(i).lt.delta) then
5589 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5590 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5591 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,&
5593 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5594 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,&
5597 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,&
5600 etheta=etheta+ethetai
5601 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5603 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5604 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5605 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
5607 ! print *,ithetaconstr_start,ithetaconstr_end,"TU"
5609 ! Ufff.... We've done all this!!!
5611 end subroutine ebend
5612 !-----------------------------------------------------------------------------
5613 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
5616 ! implicit real*8 (a-h,o-z)
5617 ! include 'DIMENSIONS'
5618 ! include 'COMMON.LOCAL'
5619 ! include 'COMMON.IOUNITS'
5620 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5621 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5622 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5624 real(kind=8) :: thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc
5626 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5627 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5628 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5630 real(kind=8) :: sig,fac,escloci0,escloci1,esclocbi0,dersc12,&
5631 esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5633 ! Calculate the contributions to both Gaussian lobes.
5634 ! 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5635 ! The "polynomial part" of the "standard deviation" of this part of
5639 sig=sig*thet_pred_mean+polthet(j,it)
5641 ! Derivative of the "interior part" of the "standard deviation of the"
5642 ! gamma-dependent Gaussian lobe in t_c.
5643 sigtc=3*polthet(3,it)
5645 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5648 ! Set the parameters of both Gaussian lobes of the distribution.
5649 ! "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5650 fac=sig*sig+sigc0(it)
5653 ! Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5654 sigsqtc=-4.0D0*sigcsq*sigtc
5655 ! print *,i,sig,sigtc,sigsqtc
5656 ! Following variable (sigtc) is d[sigma(t_c)]/dt_c
5657 sigtc=-sigtc/(fac*fac)
5658 ! Following variable is sigma(t_c)**(-2)
5659 sigcsq=sigcsq*sigcsq
5661 sig0inv=1.0D0/sig0i**2
5662 delthec=thetai-thet_pred_mean
5663 delthe0=thetai-theta0i
5664 term1=-0.5D0*sigcsq*delthec*delthec
5665 term2=-0.5D0*sig0inv*delthe0*delthe0
5666 ! Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5667 ! NaNs in taking the logarithm. We extract the largest exponent which is added
5668 ! to the energy (this being the log of the distribution) at the end of energy
5669 ! term evaluation for this virtual-bond angle.
5670 if (term1.gt.term2) then
5672 term2=dexp(term2-termm)
5676 term1=dexp(term1-termm)
5679 ! The ratio between the gamma-independent and gamma-dependent lobes of
5680 ! the distribution is a Gaussian function of thet_pred_mean too.
5681 diffak=gthet(2,it)-thet_pred_mean
5682 ratak=diffak/gthet(3,it)**2
5683 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5684 ! Let's differentiate it in thet_pred_mean NOW.
5686 ! Now put together the distribution terms to make complete distribution.
5687 termexp=term1+ak*term2
5688 termpre=sigc+ak*sig0i
5689 ! Contribution of the bending energy from this theta is just the -log of
5690 ! the sum of the contributions from the two lobes and the pre-exponential
5691 ! factor. Simple enough, isn't it?
5692 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5693 ! NOW the derivatives!!!
5694 ! 6/6/97 Take into account the deformation.
5695 E_theta=(delthec*sigcsq*term1 &
5696 +ak*delthe0*sig0inv*term2)/termexp
5697 E_tc=((sigtc+aktc*sig0i)/termpre &
5698 -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ &
5699 aktc*term2)/termexp)
5701 end subroutine theteng
5703 !-----------------------------------------------------------------------------
5704 subroutine ebend(etheta,ethetacnstr)
5706 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5707 ! angles gamma and its derivatives in consecutive thetas and gammas.
5708 ! ab initio-derived potentials from
5709 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5711 ! implicit real*8 (a-h,o-z)
5712 ! include 'DIMENSIONS'
5713 ! include 'COMMON.LOCAL'
5714 ! include 'COMMON.GEO'
5715 ! include 'COMMON.INTERACT'
5716 ! include 'COMMON.DERIV'
5717 ! include 'COMMON.VAR'
5718 ! include 'COMMON.CHAIN'
5719 ! include 'COMMON.IOUNITS'
5720 ! include 'COMMON.NAMES'
5721 ! include 'COMMON.FFIELD'
5722 ! include 'COMMON.CONTROL'
5723 real(kind=8),dimension(nntheterm) :: coskt,sinkt !mmaxtheterm
5724 real(kind=8),dimension(nsingle) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
5725 real(kind=8),dimension(ndouble,ndouble) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
5726 logical :: lprn=.false., lprn1=.false.
5728 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
5729 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
5730 real(kind=8) :: aux,etheta,ccl,ssl,scl,csl,ethetacnstr
5731 ! local variables for constrains
5732 real(kind=8) :: difi,thetiii
5736 do i=ithet_start,ithet_end
5737 if (itype(i-1,1).eq.ntyp1) cycle
5738 if (itype(i-2,1).eq.ntyp1.or.itype(i,1).eq.ntyp1) cycle
5739 if (iabs(itype(i+1,1)).eq.20) iblock=2
5740 if (iabs(itype(i+1,1)).ne.20) iblock=1
5744 theti2=0.5d0*theta(i)
5745 ityp2=ithetyp((itype(i-1,1)))
5747 coskt(k)=dcos(k*theti2)
5748 sinkt(k)=dsin(k*theti2)
5750 if (i.gt.3 .and. itype(max0(i-3,1),1).ne.ntyp1) then
5753 if (phii.ne.phii) phii=150.0
5757 ityp1=ithetyp((itype(i-2,1)))
5758 ! propagation of chirality for glycine type
5760 cosph1(k)=dcos(k*phii)
5761 sinph1(k)=dsin(k*phii)
5765 ityp1=ithetyp(itype(i-2,1))
5771 if (i.lt.nres .and. itype(i+1,1).ne.ntyp1) then
5774 if (phii1.ne.phii1) phii1=150.0
5779 ityp3=ithetyp((itype(i,1)))
5781 cosph2(k)=dcos(k*phii1)
5782 sinph2(k)=dsin(k*phii1)
5786 ityp3=ithetyp(itype(i,1))
5792 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5795 ccl=cosph1(l)*cosph2(k-l)
5796 ssl=sinph1(l)*sinph2(k-l)
5797 scl=sinph1(l)*cosph2(k-l)
5798 csl=cosph1(l)*sinph2(k-l)
5799 cosph1ph2(l,k)=ccl-ssl
5800 cosph1ph2(k,l)=ccl+ssl
5801 sinph1ph2(l,k)=scl+csl
5802 sinph1ph2(k,l)=scl-csl
5806 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
5807 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5808 write (iout,*) "coskt and sinkt"
5810 write (iout,*) k,coskt(k),sinkt(k)
5814 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5815 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) &
5818 write (iout,*) "k",k,&
5819 "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),&
5823 write (iout,*) "cosph and sinph"
5825 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5827 write (iout,*) "cosph1ph2 and sinph2ph2"
5830 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
5831 sinph1ph2(l,k),sinph1ph2(k,l)
5834 write(iout,*) "ethetai",ethetai
5838 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) &
5839 +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) &
5840 +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) &
5841 +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5842 ethetai=ethetai+sinkt(m)*aux
5843 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5844 dephii=dephii+k*sinkt(m)* &
5845 (ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- &
5846 bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5847 dephii1=dephii1+k*sinkt(m)* &
5848 (eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- &
5849 ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5851 write (iout,*) "m",m," k",k," bbthet", &
5852 bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", &
5853 ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", &
5854 ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", &
5855 eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5859 write(iout,*) "ethetai",ethetai
5863 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
5864 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ &
5865 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
5866 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5867 ethetai=ethetai+sinkt(m)*aux
5868 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5869 dephii=dephii+l*sinkt(m)* &
5870 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- &
5871 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
5872 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
5873 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5874 dephii1=dephii1+(k-l)*sinkt(m)* &
5875 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
5876 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
5877 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- &
5878 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5880 write (iout,*) "m",m," k",k," l",l," ffthet",&
5881 ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
5882 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",&
5883 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
5884 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),&
5886 write (iout,*) cosph1ph2(l,k)*sinkt(m),&
5887 cosph1ph2(k,l)*sinkt(m),&
5888 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5896 write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
5897 i,theta(i)*rad2deg,phii*rad2deg,&
5898 phii1*rad2deg,ethetai
5900 etheta=etheta+ethetai
5901 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5903 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5904 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5905 gloc(nphi+i-2,icg)=wang*dethetai
5907 !-----------thete constrains
5908 ! if (tor_mode.ne.2) then
5910 ! print *,ithetaconstr_start,ithetaconstr_end,"TU"
5911 do i=ithetaconstr_start,ithetaconstr_end
5912 itheta=itheta_constr(i)
5913 thetiii=theta(itheta)
5914 difi=pinorm(thetiii-theta_constr0(i))
5915 if (difi.gt.theta_drange(i)) then
5916 difi=difi-theta_drange(i)
5917 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5918 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
5919 +for_thet_constr(i)*difi**3
5920 else if (difi.lt.-drange(i)) then
5922 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5923 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
5924 +for_thet_constr(i)*difi**3
5928 if (energy_dec) then
5929 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc", &
5930 i,itheta,rad2deg*thetiii, &
5931 rad2deg*theta_constr0(i), rad2deg*theta_drange(i), &
5932 rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4, &
5933 gloc(itheta+nphi-2,icg)
5939 end subroutine ebend
5942 !-----------------------------------------------------------------------------
5943 subroutine esc(escloc)
5944 ! Calculate the local energy of a side chain and its derivatives in the
5945 ! corresponding virtual-bond valence angles THETA and the spherical angles
5949 ! implicit real*8 (a-h,o-z)
5950 ! include 'DIMENSIONS'
5951 ! include 'COMMON.GEO'
5952 ! include 'COMMON.LOCAL'
5953 ! include 'COMMON.VAR'
5954 ! include 'COMMON.INTERACT'
5955 ! include 'COMMON.DERIV'
5956 ! include 'COMMON.CHAIN'
5957 ! include 'COMMON.IOUNITS'
5958 ! include 'COMMON.NAMES'
5959 ! include 'COMMON.FFIELD'
5960 ! include 'COMMON.CONTROL'
5961 real(kind=8),dimension(3) :: x,dersc,xemp,dersc0,dersc1,&
5962 ddersc0,ddummy,xtemp,temp
5963 !el real(kind=8) :: time11,time12,time112,theti
5964 real(kind=8) :: escloc,delta
5965 !el integer :: it,nlobit
5966 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5969 real(kind=8) :: escloci0,escloci1,escloci,esclocbi0,&
5970 dersc12,esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5973 ! write (iout,'(a)') 'ESC'
5974 do i=loc_start,loc_end
5976 if (it.eq.ntyp1) cycle
5977 if (it.eq.10) goto 1
5978 nlobit=nlob(iabs(it))
5979 ! print *,'i=',i,' it=',it,' nlobit=',nlobit
5980 ! write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5981 theti=theta(i+1)-pipol
5986 if (x(2).gt.pi-delta) then
5990 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5992 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5993 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),&
5995 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
5996 ddersc0(1),dersc(1))
5997 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),&
5998 ddersc0(3),dersc(3))
6000 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6002 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6003 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,&
6004 dersc0(2),esclocbi,dersc02)
6005 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
6007 call splinthet(x(2),0.5d0*delta,ss,ssd)
6012 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6014 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6015 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6017 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6019 ! write (iout,*) escloci
6020 else if (x(2).lt.delta) then
6024 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6026 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6027 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),&
6029 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
6030 ddersc0(1),dersc(1))
6031 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),&
6032 ddersc0(3),dersc(3))
6034 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6036 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6037 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,&
6038 dersc0(2),esclocbi,dersc02)
6039 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
6044 call splinthet(x(2),0.5d0*delta,ss,ssd)
6046 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6048 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6049 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6051 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6052 ! write (iout,*) escloci
6054 call enesc(x,escloci,dersc,ddummy,.false.)
6057 escloc=escloc+escloci
6058 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6060 ! write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6062 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ &
6064 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6065 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6070 !-----------------------------------------------------------------------------
6071 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6074 ! implicit real*8 (a-h,o-z)
6075 ! include 'DIMENSIONS'
6076 ! include 'COMMON.GEO'
6077 ! include 'COMMON.LOCAL'
6078 ! include 'COMMON.IOUNITS'
6079 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6080 real(kind=8),dimension(3) :: x,z,dersc,ddersc
6081 real(kind=8),dimension(3,nlobit,-1:1) :: Ax !(3,maxlob,-1:1)
6082 real(kind=8),dimension(nlobit,-1:1) :: contr !(maxlob,-1:1)
6083 real(kind=8) :: escloci
6086 integer :: j,iii,l,k !el,it,nlobit
6087 real(kind=8) :: escloc_i,x3,Axk,expfac,emin !el,theti,&
6088 !el time11,time12,time112
6089 ! write (iout,*) 'it=',it,' nlobit=',nlobit
6093 if (mixed) ddersc(j)=0.0d0
6097 ! Because of periodicity of the dependence of the SC energy in omega we have
6098 ! to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6099 ! To avoid underflows, first compute & store the exponents.
6107 z(k)=x(k)-censc(k,j,it)
6112 Axk=Axk+gaussc(l,k,j,it)*z(l)
6118 expfac=expfac+Ax(k,j,iii)*z(k)
6126 ! As in the case of ebend, we want to avoid underflows in exponentiation and
6127 ! subsequent NaNs and INFs in energy calculation.
6128 ! Find the largest exponent
6132 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6136 !d print *,'it=',it,' emin=',emin
6138 ! Compute the contribution to SC energy and derivatives
6143 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6144 if(adexp.ne.adexp) adexp=1.0
6147 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6149 !d print *,'j=',j,' expfac=',expfac
6150 escloc_i=escloc_i+expfac
6152 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6156 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) &
6157 +gaussc(k,2,j,it))*expfac
6164 dersc(1)=dersc(1)/cos(theti)**2
6165 ddersc(1)=ddersc(1)/cos(theti)**2
6168 escloci=-(dlog(escloc_i)-emin)
6170 dersc(j)=dersc(j)/escloc_i
6174 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6178 end subroutine enesc
6179 !-----------------------------------------------------------------------------
6180 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6183 ! implicit real*8 (a-h,o-z)
6184 ! include 'DIMENSIONS'
6185 ! include 'COMMON.GEO'
6186 ! include 'COMMON.LOCAL'
6187 ! include 'COMMON.IOUNITS'
6188 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6189 real(kind=8),dimension(3) :: x,z,dersc
6190 real(kind=8),dimension(3,nlobit) :: Ax !(3,maxlob)
6191 real(kind=8),dimension(nlobit) :: contr !(maxlob)
6192 real(kind=8) :: escloci,dersc12,emin
6195 integer :: j,k,l !el,it,nlobit
6196 real(kind=8) :: escloc_i,Axk,expfac !el,time11,time12,time112,theti
6206 z(k)=x(k)-censc(k,j,it)
6212 Axk=Axk+gaussc(l,k,j,it)*z(l)
6218 expfac=expfac+Ax(k,j)*z(k)
6223 ! As in the case of ebend, we want to avoid underflows in exponentiation and
6224 ! subsequent NaNs and INFs in energy calculation.
6225 ! Find the largest exponent
6228 if (emin.gt.contr(j)) emin=contr(j)
6232 ! Compute the contribution to SC energy and derivatives
6236 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6237 escloc_i=escloc_i+expfac
6239 dersc(k)=dersc(k)+Ax(k,j)*expfac
6241 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) &
6242 +gaussc(1,2,j,it))*expfac
6246 dersc(1)=dersc(1)/cos(theti)**2
6247 dersc12=dersc12/cos(theti)**2
6248 escloci=-(dlog(escloc_i)-emin)
6250 dersc(j)=dersc(j)/escloc_i
6252 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6254 end subroutine enesc_bound
6256 !-----------------------------------------------------------------------------
6257 subroutine esc(escloc)
6258 ! Calculate the local energy of a side chain and its derivatives in the
6259 ! corresponding virtual-bond valence angles THETA and the spherical angles
6260 ! ALPHA and OMEGA derived from AM1 all-atom calculations.
6261 ! added by Urszula Kozlowska. 07/11/2007
6264 ! implicit real*8 (a-h,o-z)
6265 ! include 'DIMENSIONS'
6266 ! include 'COMMON.GEO'
6267 ! include 'COMMON.LOCAL'
6268 ! include 'COMMON.VAR'
6269 ! include 'COMMON.SCROT'
6270 ! include 'COMMON.INTERACT'
6271 ! include 'COMMON.DERIV'
6272 ! include 'COMMON.CHAIN'
6273 ! include 'COMMON.IOUNITS'
6274 ! include 'COMMON.NAMES'
6275 ! include 'COMMON.FFIELD'
6276 ! include 'COMMON.CONTROL'
6277 ! include 'COMMON.VECTORS'
6278 real(kind=8),dimension(3) :: x_prime,y_prime,z_prime
6279 real(kind=8),dimension(65) :: x
6280 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1,sumene2,sumene3,&
6281 sumene4,s1,s1_6,s2,s2_6,de_dxx,de_dyy,de_dzz,de_dt
6282 real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
6283 real(kind=8),dimension(3) :: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,dYY_Ci,&
6284 dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
6286 integer :: i,j,k !el,it,nlobit
6287 real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
6288 !el real(kind=8) :: time11,time12,time112,theti
6289 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6290 real(kind=8) :: dscp1,dscp2,pom_s1,pom_s16,pom_s2,pom_s26,&
6291 pom,pom_dx,pom_dy,pom_dt1,pom_dt2,pom1,pom2,&
6292 sumene1x,sumene2x,sumene3x,sumene4x,&
6293 sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,&
6296 real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,&
6297 de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,&
6300 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
6304 do i=loc_start,loc_end
6305 if (itype(i,1).eq.ntyp1) cycle
6306 costtab(i+1) =dcos(theta(i+1))
6307 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6308 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6309 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6310 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6311 cosfac=dsqrt(cosfac2)
6312 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6313 sinfac=dsqrt(sinfac2)
6315 if (it.eq.10) goto 1
6317 ! Compute the axes of tghe local cartesian coordinates system; store in
6318 ! x_prime, y_prime and z_prime
6325 ! write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6326 ! & dc_norm(3,i+nres)
6328 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6329 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6332 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i,1)))
6335 ! write (2,*) "x_prime",(x_prime(j),j=1,3)
6336 ! write (2,*) "y_prime",(y_prime(j),j=1,3)
6337 ! write (2,*) "z_prime",(z_prime(j),j=1,3)
6338 ! write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6339 ! & " xy",scalar(x_prime(1),y_prime(1)),
6340 ! & " xz",scalar(x_prime(1),z_prime(1)),
6341 ! & " yy",scalar(y_prime(1),y_prime(1)),
6342 ! & " yz",scalar(y_prime(1),z_prime(1)),
6343 ! & " zz",scalar(z_prime(1),z_prime(1))
6345 ! Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6346 ! to local coordinate system. Store in xx, yy, zz.
6352 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6353 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6354 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6361 ! Compute the energy of the ith side cbain
6363 ! write (2,*) "xx",xx," yy",yy," zz",zz
6366 x(j) = sc_parmin(j,it)
6369 !c diagnostics - remove later
6371 yy1 = dsin(alph(2))*dcos(omeg(2))
6372 zz1 = -dsign(1.0,dfloat(itype(i,1)))*dsin(alph(2))*dsin(omeg(2))
6373 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
6374 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
6376 !," --- ", xx_w,yy_w,zz_w
6379 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6380 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6382 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6383 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6385 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6386 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6387 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6388 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6389 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6391 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6392 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6393 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6394 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6395 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6397 dsc_i = 0.743d0+x(61)
6399 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6400 *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6401 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6402 *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6403 s1=(1+x(63))/(0.1d0 + dscp1)
6404 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6405 s2=(1+x(65))/(0.1d0 + dscp2)
6406 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6407 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) &
6408 + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6409 ! write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6411 ! & dscp1,dscp2,sumene
6412 ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6413 escloc = escloc + sumene
6414 ! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i,1)
6419 ! This section to check the numerical derivatives of the energy of ith side
6420 ! chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6421 ! #define DEBUG in the code to turn it on.
6423 write (2,*) "sumene =",sumene
6427 write (2,*) xx,yy,zz
6428 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6429 de_dxx_num=(sumenep-sumene)/aincr
6431 write (2,*) "xx+ sumene from enesc=",sumenep
6434 write (2,*) xx,yy,zz
6435 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6436 de_dyy_num=(sumenep-sumene)/aincr
6438 write (2,*) "yy+ sumene from enesc=",sumenep
6441 write (2,*) xx,yy,zz
6442 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6443 de_dzz_num=(sumenep-sumene)/aincr
6445 write (2,*) "zz+ sumene from enesc=",sumenep
6446 costsave=cost2tab(i+1)
6447 sintsave=sint2tab(i+1)
6448 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6449 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6450 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6451 de_dt_num=(sumenep-sumene)/aincr
6452 write (2,*) " t+ sumene from enesc=",sumenep
6453 cost2tab(i+1)=costsave
6454 sint2tab(i+1)=sintsave
6455 ! End of diagnostics section.
6458 ! Compute the gradient of esc
6460 ! zz=zz*dsign(1.0,dfloat(itype(i,1)))
6461 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6462 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6463 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6464 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6465 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6466 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6467 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6468 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6469 pom1=(sumene3*sint2tab(i+1)+sumene1) &
6470 *(pom_s1/dscp1+pom_s16*dscp1**4)
6471 pom2=(sumene4*cost2tab(i+1)+sumene2) &
6472 *(pom_s2/dscp2+pom_s26*dscp2**4)
6473 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6474 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 &
6475 +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) &
6477 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6478 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 &
6479 +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) &
6481 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) &
6482 +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
6485 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i,1)
6488 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6489 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 &
6490 +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) &
6492 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6493 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz &
6494 +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz &
6495 +x(59)*zz**2 +x(60)*xx*zz
6496 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) &
6497 +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
6500 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i,1)
6503 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
6504 +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx &
6505 +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) &
6506 +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) &
6507 +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 &
6508 +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy &
6509 +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
6510 + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6512 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i,1)
6515 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
6516 -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
6517 +pom1*pom_dt1+pom2*pom_dt2
6519 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i,1)
6523 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6524 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6525 cosfac2xx=cosfac2*xx
6526 sinfac2yy=sinfac2*yy
6528 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* &
6530 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* &
6532 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6533 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6534 ! write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6535 ! & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6536 ! write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6537 ! & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6538 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6539 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6540 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6541 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6545 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
6546 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
6547 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
6548 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
6551 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6552 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6553 dZZ_XYZ(k)=vbld_inv(i+nres)* &
6554 (z_prime(k)-zz*dC_norm(k,i+nres))
6556 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6557 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6561 dXX_Ctab(k,i)=dXX_Ci(k)
6562 dXX_C1tab(k,i)=dXX_Ci1(k)
6563 dYY_Ctab(k,i)=dYY_Ci(k)
6564 dYY_C1tab(k,i)=dYY_Ci1(k)
6565 dZZ_Ctab(k,i)=dZZ_Ci(k)
6566 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6567 dXX_XYZtab(k,i)=dXX_XYZ(k)
6568 dYY_XYZtab(k,i)=dYY_XYZ(k)
6569 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6573 ! write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6574 ! & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6575 ! write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6576 ! & dyy_ci(k)," dzz_ci",dzz_ci(k)
6577 ! write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6579 ! write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6580 ! & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6581 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) &
6582 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6583 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) &
6584 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6585 gsclocx(k,i)= de_dxx*dxx_XYZ(k) &
6586 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6588 ! write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6589 ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6591 ! to check gradient call subroutine check_grad
6597 !-----------------------------------------------------------------------------
6598 real(kind=8) function enesc(x,xx,yy,zz,cost2,sint2)
6600 real(kind=8),dimension(65) :: x
6601 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2,sumene3,&
6602 sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6604 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6605 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6607 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6608 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6610 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6611 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6612 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6613 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6614 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6616 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6617 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6618 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6619 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6620 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6622 dsc_i = 0.743d0+x(61)
6624 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6625 *(xx*cost2+yy*sint2))
6626 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6627 *(xx*cost2-yy*sint2))
6628 s1=(1+x(63))/(0.1d0 + dscp1)
6629 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6630 s2=(1+x(65))/(0.1d0 + dscp2)
6631 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6632 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) &
6633 + (sumene4*cost2 +sumene2)*(s2+s2_6)
6638 !-----------------------------------------------------------------------------
6639 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6641 ! This procedure calculates two-body contact function g(rij) and its derivative:
6644 ! g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6647 ! where x=(rij-r0ij)/delta
6649 ! rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6652 real(kind=8) :: rij,r0ij,eps0ij,fcont,fprimcont
6653 real(kind=8) :: x,x2,x4,delta
6657 if (x.lt.-1.0D0) then
6660 else if (x.le.1.0D0) then
6663 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6664 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6670 end subroutine gcont
6671 !-----------------------------------------------------------------------------
6672 subroutine splinthet(theti,delta,ss,ssder)
6673 ! implicit real*8 (a-h,o-z)
6674 ! include 'DIMENSIONS'
6675 ! include 'COMMON.VAR'
6676 ! include 'COMMON.GEO'
6677 real(kind=8) :: theti,delta,ss,ssder
6678 real(kind=8) :: thetup,thetlow
6681 if (theti.gt.pipol) then
6682 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6684 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6688 end subroutine splinthet
6689 !-----------------------------------------------------------------------------
6690 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6692 real(kind=8) :: x,x0,delta,f0,f1,fprim0,f,fprim
6693 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6694 a1=fprim0*delta/(f1-f0)
6700 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6701 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6703 end subroutine spline1
6704 !-----------------------------------------------------------------------------
6705 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6707 real(kind=8) :: x,x0,delta,f0x,f1x,fprim0x,fx
6708 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6713 a2=3*(f1x-f0x)-2*fprim0x*delta
6714 a3=fprim0x*delta-2*(f1x-f0x)
6715 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6717 end subroutine spline2
6718 !-----------------------------------------------------------------------------
6720 !-----------------------------------------------------------------------------
6721 subroutine etor(etors,edihcnstr)
6722 ! implicit real*8 (a-h,o-z)
6723 ! include 'DIMENSIONS'
6724 ! include 'COMMON.VAR'
6725 ! include 'COMMON.GEO'
6726 ! include 'COMMON.LOCAL'
6727 ! include 'COMMON.TORSION'
6728 ! include 'COMMON.INTERACT'
6729 ! include 'COMMON.DERIV'
6730 ! include 'COMMON.CHAIN'
6731 ! include 'COMMON.NAMES'
6732 ! include 'COMMON.IOUNITS'
6733 ! include 'COMMON.FFIELD'
6734 ! include 'COMMON.TORCNSTR'
6735 ! include 'COMMON.CONTROL'
6736 real(kind=8) :: etors,edihcnstr
6740 real(kind=8) :: phii,fac,etors_ii
6742 ! Set lprn=.true. for debugging
6746 do i=iphi_start,iphi_end
6748 if (itype(i-2,1).eq.ntyp1.or. itype(i-1,1).eq.ntyp1 &
6749 .or. itype(i,1).eq.ntyp1) cycle
6750 itori=itortyp(itype(i-2,1))
6751 itori1=itortyp(itype(i-1,1))
6754 ! Proline-Proline pair is a special case...
6755 if (itori.eq.3 .and. itori1.eq.3) then
6756 if (phii.gt.-dwapi3) then
6758 fac=1.0D0/(1.0D0-cosphi)
6759 etorsi=v1(1,3,3)*fac
6760 etorsi=etorsi+etorsi
6761 etors=etors+etorsi-v1(1,3,3)
6762 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6763 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6766 v1ij=v1(j+1,itori,itori1)
6767 v2ij=v2(j+1,itori,itori1)
6770 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6771 if (energy_dec) etors_ii=etors_ii+ &
6772 v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6773 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6777 v1ij=v1(j,itori,itori1)
6778 v2ij=v2(j,itori,itori1)
6781 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6782 if (energy_dec) etors_ii=etors_ii+ &
6783 v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6784 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6787 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6790 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6791 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
6792 (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6793 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6794 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6796 ! 6/20/98 - dihedral angle constraints
6799 itori=idih_constr(i)
6802 if (difi.gt.drange(i)) then
6804 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6805 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6806 else if (difi.lt.-drange(i)) then
6808 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6809 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6811 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6812 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6814 ! write (iout,*) 'edihcnstr',edihcnstr
6817 !-----------------------------------------------------------------------------
6818 subroutine etor_d(etors_d)
6819 real(kind=8) :: etors_d
6822 end subroutine etor_d
6824 !-----------------------------------------------------------------------------
6825 subroutine etor(etors,edihcnstr)
6826 ! implicit real*8 (a-h,o-z)
6827 ! include 'DIMENSIONS'
6828 ! include 'COMMON.VAR'
6829 ! include 'COMMON.GEO'
6830 ! include 'COMMON.LOCAL'
6831 ! include 'COMMON.TORSION'
6832 ! include 'COMMON.INTERACT'
6833 ! include 'COMMON.DERIV'
6834 ! include 'COMMON.CHAIN'
6835 ! include 'COMMON.NAMES'
6836 ! include 'COMMON.IOUNITS'
6837 ! include 'COMMON.FFIELD'
6838 ! include 'COMMON.TORCNSTR'
6839 ! include 'COMMON.CONTROL'
6840 real(kind=8) :: etors,edihcnstr
6843 integer :: i,j,iblock,itori,itori1
6844 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
6845 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
6846 ! Set lprn=.true. for debugging
6850 do i=iphi_start,iphi_end
6851 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
6852 .or. itype(i-3,1).eq.ntyp1 &
6853 .or. itype(i,1).eq.ntyp1) cycle
6855 if (iabs(itype(i,1)).eq.20) then
6860 itori=itortyp(itype(i-2,1))
6861 itori1=itortyp(itype(i-1,1))
6864 ! Regular cosine and sine terms
6865 do j=1,nterm(itori,itori1,iblock)
6866 v1ij=v1(j,itori,itori1,iblock)
6867 v2ij=v2(j,itori,itori1,iblock)
6870 etors=etors+v1ij*cosphi+v2ij*sinphi
6871 if (energy_dec) etors_ii=etors_ii+ &
6872 v1ij*cosphi+v2ij*sinphi
6873 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6877 ! E = SUM ----------------------------------- - v1
6878 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6880 cosphi=dcos(0.5d0*phii)
6881 sinphi=dsin(0.5d0*phii)
6882 do j=1,nlor(itori,itori1,iblock)
6883 vl1ij=vlor1(j,itori,itori1)
6884 vl2ij=vlor2(j,itori,itori1)
6885 vl3ij=vlor3(j,itori,itori1)
6886 pom=vl2ij*cosphi+vl3ij*sinphi
6887 pom1=1.0d0/(pom*pom+1.0d0)
6888 etors=etors+vl1ij*pom1
6889 if (energy_dec) etors_ii=etors_ii+ &
6892 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6894 ! Subtract the constant term
6895 etors=etors-v0(itori,itori1,iblock)
6896 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6897 'etor',i,etors_ii-v0(itori,itori1,iblock)
6899 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6900 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
6901 (v1(j,itori,itori1,iblock),j=1,6),&
6902 (v2(j,itori,itori1,iblock),j=1,6)
6903 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6904 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6906 ! 6/20/98 - dihedral angle constraints
6908 ! do i=1,ndih_constr
6909 do i=idihconstr_start,idihconstr_end
6910 itori=idih_constr(i)
6912 difi=pinorm(phii-phi0(i))
6913 if (difi.gt.drange(i)) then
6915 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6916 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6917 else if (difi.lt.-drange(i)) then
6919 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6920 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6924 !d write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6925 !d & rad2deg*phi0(i), rad2deg*drange(i),
6926 !d & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6928 !d write (iout,*) 'edihcnstr',edihcnstr
6931 !-----------------------------------------------------------------------------
6932 subroutine etor_d(etors_d)
6933 ! 6/23/01 Compute double torsional energy
6934 ! implicit real*8 (a-h,o-z)
6935 ! include 'DIMENSIONS'
6936 ! include 'COMMON.VAR'
6937 ! include 'COMMON.GEO'
6938 ! include 'COMMON.LOCAL'
6939 ! include 'COMMON.TORSION'
6940 ! include 'COMMON.INTERACT'
6941 ! include 'COMMON.DERIV'
6942 ! include 'COMMON.CHAIN'
6943 ! include 'COMMON.NAMES'
6944 ! include 'COMMON.IOUNITS'
6945 ! include 'COMMON.FFIELD'
6946 ! include 'COMMON.TORCNSTR'
6947 real(kind=8) :: etors_d,etors_d_ii
6950 integer :: i,j,k,l,itori,itori1,itori2,iblock
6951 real(kind=8) :: phii,phii1,gloci1,gloci2,&
6952 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
6953 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
6954 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
6955 ! Set lprn=.true. for debugging
6959 ! write(iout,*) "a tu??"
6960 do i=iphid_start,iphid_end
6962 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
6963 .or. itype(i-3,1).eq.ntyp1 &
6964 .or. itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
6965 itori=itortyp(itype(i-2,1))
6966 itori1=itortyp(itype(i-1,1))
6967 itori2=itortyp(itype(i,1))
6973 if (iabs(itype(i+1,1)).eq.20) iblock=2
6975 ! Regular cosine and sine terms
6976 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6977 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6978 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6979 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6980 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6981 cosphi1=dcos(j*phii)
6982 sinphi1=dsin(j*phii)
6983 cosphi2=dcos(j*phii1)
6984 sinphi2=dsin(j*phii1)
6985 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
6986 v2cij*cosphi2+v2sij*sinphi2
6987 if (energy_dec) etors_d_ii=etors_d_ii+ &
6988 v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
6989 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6990 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6992 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6994 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6995 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6996 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6997 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6998 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6999 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7000 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7001 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7002 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
7003 v1sdij*sinphi1p2+v2sdij*sinphi1m2
7004 if (energy_dec) etors_d_ii=etors_d_ii+ &
7005 v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
7006 v1sdij*sinphi1p2+v2sdij*sinphi1m2
7007 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
7008 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7009 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
7010 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7013 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
7014 'etor_d',i,etors_d_ii
7015 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7016 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7019 end subroutine etor_d
7021 !-----------------------------------------------------------------------------
7022 subroutine eback_sc_corr(esccor)
7023 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
7024 ! conformational states; temporarily implemented as differences
7025 ! between UNRES torsional potentials (dependent on three types of
7026 ! residues) and the torsional potentials dependent on all 20 types
7027 ! of residues computed from AM1 energy surfaces of terminally-blocked
7028 ! amino-acid residues.
7029 ! implicit real*8 (a-h,o-z)
7030 ! include 'DIMENSIONS'
7031 ! include 'COMMON.VAR'
7032 ! include 'COMMON.GEO'
7033 ! include 'COMMON.LOCAL'
7034 ! include 'COMMON.TORSION'
7035 ! include 'COMMON.SCCOR'
7036 ! include 'COMMON.INTERACT'
7037 ! include 'COMMON.DERIV'
7038 ! include 'COMMON.CHAIN'
7039 ! include 'COMMON.NAMES'
7040 ! include 'COMMON.IOUNITS'
7041 ! include 'COMMON.FFIELD'
7042 ! include 'COMMON.CONTROL'
7043 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
7046 integer :: i,interty,j,isccori,isccori1,intertyp
7047 ! Set lprn=.true. for debugging
7050 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7052 do i=itau_start,itau_end
7053 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1)) cycle
7055 isccori=isccortyp(itype(i-2,1))
7056 isccori1=isccortyp(itype(i-1,1))
7058 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7060 do intertyp=1,3 !intertyp
7062 !c Added 09 May 2012 (Adasko)
7063 !c Intertyp means interaction type of backbone mainchain correlation:
7064 ! 1 = SC...Ca...Ca...Ca
7065 ! 2 = Ca...Ca...Ca...SC
7066 ! 3 = SC...Ca...Ca...SCi
7068 if (((intertyp.eq.3).and.((itype(i-2,1).eq.10).or. &
7069 (itype(i-1,1).eq.10).or.(itype(i-2,1).eq.ntyp1).or. &
7070 (itype(i-1,1).eq.ntyp1))) &
7071 .or. ((intertyp.eq.1).and.((itype(i-2,1).eq.10) &
7072 .or.(itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1) &
7073 .or.(itype(i,1).eq.ntyp1))) &
7074 .or.((intertyp.eq.2).and.((itype(i-1,1).eq.10).or. &
7075 (itype(i-1,1).eq.ntyp1).or.(itype(i-2,1).eq.ntyp1).or. &
7076 (itype(i-3,1).eq.ntyp1)))) cycle
7077 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1,1).eq.ntyp1)) cycle
7078 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres,1).eq.ntyp1)) &
7080 do j=1,nterm_sccor(isccori,isccori1)
7081 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7082 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7083 cosphi=dcos(j*tauangle(intertyp,i))
7084 sinphi=dsin(j*tauangle(intertyp,i))
7085 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
7086 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7087 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7089 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
7090 'esccor',i,intertyp,esccor_ii
7091 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7092 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7094 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
7095 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,isccori,isccori1,&
7096 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
7097 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7098 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7103 end subroutine eback_sc_corr
7104 !-----------------------------------------------------------------------------
7105 subroutine multibody(ecorr)
7106 ! This subroutine calculates multi-body contributions to energy following
7107 ! the idea of Skolnick et al. If side chains I and J make a contact and
7108 ! at the same time side chains I+1 and J+1 make a contact, an extra
7109 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7110 ! implicit real*8 (a-h,o-z)
7111 ! include 'DIMENSIONS'
7112 ! include 'COMMON.IOUNITS'
7113 ! include 'COMMON.DERIV'
7114 ! include 'COMMON.INTERACT'
7115 ! include 'COMMON.CONTACTS'
7116 real(kind=8),dimension(3) :: gx,gx1
7118 real(kind=8) :: ecorr
7119 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
7120 ! Set lprn=.true. for debugging
7124 write (iout,'(a)') 'Contact function values:'
7126 write (iout,'(i2,20(1x,i2,f10.5))') &
7127 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7132 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7133 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7145 num_conti=num_cont(i)
7146 num_conti1=num_cont(i1)
7151 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7152 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7153 !d & ' ishift=',ishift
7154 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7155 ! The system gains extra energy.
7156 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7157 endif ! j1==j+-ishift
7165 end subroutine multibody
7166 !-----------------------------------------------------------------------------
7167 real(kind=8) function esccorr(i,j,k,l,jj,kk)
7168 ! implicit real*8 (a-h,o-z)
7169 ! include 'DIMENSIONS'
7170 ! include 'COMMON.IOUNITS'
7171 ! include 'COMMON.DERIV'
7172 ! include 'COMMON.INTERACT'
7173 ! include 'COMMON.CONTACTS'
7174 real(kind=8),dimension(3) :: gx,gx1
7176 integer :: i,j,k,l,jj,kk,m,ll
7177 real(kind=8) :: eij,ekl
7181 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7182 ! Calculate the multi-body contribution to energy.
7183 ! Calculate multi-body contributions to the gradient.
7184 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7185 !d & k,l,(gacont(m,kk,k),m=1,3)
7187 gx(m) =ekl*gacont(m,jj,i)
7188 gx1(m)=eij*gacont(m,kk,k)
7189 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7190 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7191 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7192 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7196 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7201 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7206 end function esccorr
7207 !-----------------------------------------------------------------------------
7208 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7209 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7210 ! implicit real*8 (a-h,o-z)
7211 ! include 'DIMENSIONS'
7212 ! include 'COMMON.IOUNITS'
7215 ! integer :: maxconts !max_cont=maxconts =nres/4
7216 integer,parameter :: max_dim=26
7217 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7218 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7219 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7220 !el common /przechowalnia/ zapas
7221 integer :: status(MPI_STATUS_SIZE)
7222 integer,dimension((nres/4)*2) :: req !maxconts*2
7223 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
7225 ! include 'COMMON.SETUP'
7226 ! include 'COMMON.FFIELD'
7227 ! include 'COMMON.DERIV'
7228 ! include 'COMMON.INTERACT'
7229 ! include 'COMMON.CONTACTS'
7230 ! include 'COMMON.CONTROL'
7231 ! include 'COMMON.LOCAL'
7232 real(kind=8),dimension(3) :: gx,gx1
7233 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
7234 logical :: lprn,ldone
7236 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
7237 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
7239 ! Set lprn=.true. for debugging
7243 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7246 if (nfgtasks.le.1) goto 30
7248 write (iout,'(a)') 'Contact function values before RECEIVE:'
7250 write (iout,'(2i3,50(1x,i2,f5.2))') &
7251 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7256 do i=1,ntask_cont_from
7259 do i=1,ntask_cont_to
7262 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7264 ! Make the list of contacts to send to send to other procesors
7265 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7267 do i=iturn3_start,iturn3_end
7268 ! write (iout,*) "make contact list turn3",i," num_cont",
7270 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7272 do i=iturn4_start,iturn4_end
7273 ! write (iout,*) "make contact list turn4",i," num_cont",
7275 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7279 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7281 do j=1,num_cont_hb(i)
7284 iproc=iint_sent_local(k,jjc,ii)
7285 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7286 if (iproc.gt.0) then
7287 ncont_sent(iproc)=ncont_sent(iproc)+1
7288 nn=ncont_sent(iproc)
7290 zapas(2,nn,iproc)=jjc
7291 zapas(3,nn,iproc)=facont_hb(j,i)
7292 zapas(4,nn,iproc)=ees0p(j,i)
7293 zapas(5,nn,iproc)=ees0m(j,i)
7294 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7295 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7296 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7297 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7298 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7299 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7300 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7301 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7302 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7303 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7304 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7305 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7306 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7307 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7308 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7309 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7310 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7311 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7312 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7313 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7314 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7321 "Numbers of contacts to be sent to other processors",&
7322 (ncont_sent(i),i=1,ntask_cont_to)
7323 write (iout,*) "Contacts sent"
7324 do ii=1,ntask_cont_to
7326 iproc=itask_cont_to(ii)
7327 write (iout,*) nn," contacts to processor",iproc,&
7328 " of CONT_TO_COMM group"
7330 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7338 CorrelID1=nfgtasks+fg_rank+1
7340 ! Receive the numbers of needed contacts from other processors
7341 do ii=1,ntask_cont_from
7342 iproc=itask_cont_from(ii)
7344 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7345 FG_COMM,req(ireq),IERR)
7347 ! write (iout,*) "IRECV ended"
7349 ! Send the number of contacts needed by other processors
7350 do ii=1,ntask_cont_to
7351 iproc=itask_cont_to(ii)
7353 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7354 FG_COMM,req(ireq),IERR)
7356 ! write (iout,*) "ISEND ended"
7357 ! write (iout,*) "number of requests (nn)",ireq
7360 call MPI_Waitall(ireq,req,status_array,ierr)
7362 ! & "Numbers of contacts to be received from other processors",
7363 ! & (ncont_recv(i),i=1,ntask_cont_from)
7367 do ii=1,ntask_cont_from
7368 iproc=itask_cont_from(ii)
7370 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7371 ! & " of CONT_TO_COMM group"
7375 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7376 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7377 ! write (iout,*) "ireq,req",ireq,req(ireq)
7380 ! Send the contacts to processors that need them
7381 do ii=1,ntask_cont_to
7382 iproc=itask_cont_to(ii)
7384 ! write (iout,*) nn," contacts to processor",iproc,
7385 ! & " of CONT_TO_COMM group"
7388 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7389 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7390 ! write (iout,*) "ireq,req",ireq,req(ireq)
7392 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7396 ! write (iout,*) "number of requests (contacts)",ireq
7397 ! write (iout,*) "req",(req(i),i=1,4)
7400 call MPI_Waitall(ireq,req,status_array,ierr)
7401 do iii=1,ntask_cont_from
7402 iproc=itask_cont_from(iii)
7405 write (iout,*) "Received",nn," contacts from processor",iproc,&
7406 " of CONT_FROM_COMM group"
7409 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7414 ii=zapas_recv(1,i,iii)
7415 ! Flag the received contacts to prevent double-counting
7416 jj=-zapas_recv(2,i,iii)
7417 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7419 nnn=num_cont_hb(ii)+1
7422 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7423 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7424 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7425 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7426 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7427 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7428 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7429 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7430 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7431 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7432 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7433 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7434 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7435 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7436 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7437 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7438 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7439 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7440 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7441 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7442 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7443 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7444 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7445 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7450 write (iout,'(a)') 'Contact function values after receive:'
7452 write (iout,'(2i3,50(1x,i3,f5.2))') &
7453 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7461 write (iout,'(a)') 'Contact function values:'
7463 write (iout,'(2i3,50(1x,i3,f5.2))') &
7464 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7470 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7471 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7472 ! Remove the loop below after debugging !!!
7479 ! Calculate the local-electrostatic correlation terms
7480 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7482 num_conti=num_cont_hb(i)
7483 num_conti1=num_cont_hb(i+1)
7490 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
7491 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
7492 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7493 .or. j.lt.0 .and. j1.gt.0) .and. &
7494 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7495 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7496 ! The system gains extra energy.
7497 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7498 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
7499 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7501 else if (j1.eq.j) then
7502 ! Contacts I-J and I-(J+1) occur simultaneously.
7503 ! The system loses extra energy.
7504 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7509 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7510 ! & ' jj=',jj,' kk=',kk
7512 ! Contacts I-J and (I+1)-J occur simultaneously.
7513 ! The system loses extra energy.
7514 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7520 end subroutine multibody_hb
7521 !-----------------------------------------------------------------------------
7522 subroutine add_hb_contact(ii,jj,itask)
7523 ! implicit real*8 (a-h,o-z)
7524 ! include "DIMENSIONS"
7525 ! include "COMMON.IOUNITS"
7526 ! include "COMMON.CONTACTS"
7527 ! integer,parameter :: maxconts=nres/4
7528 integer,parameter :: max_dim=26
7529 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7530 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7531 ! common /przechowalnia/ zapas
7532 integer :: i,j,ii,jj,iproc,nn,jjc
7533 integer,dimension(4) :: itask
7534 ! write (iout,*) "itask",itask
7537 if (iproc.gt.0) then
7538 do j=1,num_cont_hb(ii)
7540 ! write (iout,*) "i",ii," j",jj," jjc",jjc
7542 ncont_sent(iproc)=ncont_sent(iproc)+1
7543 nn=ncont_sent(iproc)
7544 zapas(1,nn,iproc)=ii
7545 zapas(2,nn,iproc)=jjc
7546 zapas(3,nn,iproc)=facont_hb(j,ii)
7547 zapas(4,nn,iproc)=ees0p(j,ii)
7548 zapas(5,nn,iproc)=ees0m(j,ii)
7549 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7550 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7551 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7552 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7553 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7554 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7555 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7556 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7557 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7558 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7559 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7560 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7561 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7562 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7563 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7564 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7565 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7566 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7567 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7568 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7569 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7576 end subroutine add_hb_contact
7577 !-----------------------------------------------------------------------------
7578 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
7579 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7580 ! implicit real*8 (a-h,o-z)
7581 ! include 'DIMENSIONS'
7582 ! include 'COMMON.IOUNITS'
7583 integer,parameter :: max_dim=70
7586 ! integer :: maxconts !max_cont=maxconts=nres/4
7587 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7588 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7589 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7590 ! common /przechowalnia/ zapas
7591 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
7592 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
7595 ! include 'COMMON.SETUP'
7596 ! include 'COMMON.FFIELD'
7597 ! include 'COMMON.DERIV'
7598 ! include 'COMMON.LOCAL'
7599 ! include 'COMMON.INTERACT'
7600 ! include 'COMMON.CONTACTS'
7601 ! include 'COMMON.CHAIN'
7602 ! include 'COMMON.CONTROL'
7603 real(kind=8),dimension(3) :: gx,gx1
7604 integer,dimension(nres) :: num_cont_hb_old
7605 logical :: lprn,ldone
7606 !EL double precision eello4,eello5,eelo6,eello_turn6
7607 !EL external eello4,eello5,eello6,eello_turn6
7609 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
7610 j1,jp1,i1,num_conti1
7611 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
7612 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
7614 ! Set lprn=.true. for debugging
7619 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7621 num_cont_hb_old(i)=num_cont_hb(i)
7625 if (nfgtasks.le.1) goto 30
7627 write (iout,'(a)') 'Contact function values before RECEIVE:'
7629 write (iout,'(2i3,50(1x,i2,f5.2))') &
7630 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7635 do i=1,ntask_cont_from
7638 do i=1,ntask_cont_to
7641 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7643 ! Make the list of contacts to send to send to other procesors
7644 do i=iturn3_start,iturn3_end
7645 ! write (iout,*) "make contact list turn3",i," num_cont",
7647 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7649 do i=iturn4_start,iturn4_end
7650 ! write (iout,*) "make contact list turn4",i," num_cont",
7652 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7656 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7658 do j=1,num_cont_hb(i)
7661 iproc=iint_sent_local(k,jjc,ii)
7662 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7663 if (iproc.ne.0) then
7664 ncont_sent(iproc)=ncont_sent(iproc)+1
7665 nn=ncont_sent(iproc)
7667 zapas(2,nn,iproc)=jjc
7668 zapas(3,nn,iproc)=d_cont(j,i)
7672 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7677 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7685 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7696 "Numbers of contacts to be sent to other processors",&
7697 (ncont_sent(i),i=1,ntask_cont_to)
7698 write (iout,*) "Contacts sent"
7699 do ii=1,ntask_cont_to
7701 iproc=itask_cont_to(ii)
7702 write (iout,*) nn," contacts to processor",iproc,&
7703 " of CONT_TO_COMM group"
7705 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7713 CorrelID1=nfgtasks+fg_rank+1
7715 ! Receive the numbers of needed contacts from other processors
7716 do ii=1,ntask_cont_from
7717 iproc=itask_cont_from(ii)
7719 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7720 FG_COMM,req(ireq),IERR)
7722 ! write (iout,*) "IRECV ended"
7724 ! Send the number of contacts needed by other processors
7725 do ii=1,ntask_cont_to
7726 iproc=itask_cont_to(ii)
7728 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7729 FG_COMM,req(ireq),IERR)
7731 ! write (iout,*) "ISEND ended"
7732 ! write (iout,*) "number of requests (nn)",ireq
7735 call MPI_Waitall(ireq,req,status_array,ierr)
7737 ! & "Numbers of contacts to be received from other processors",
7738 ! & (ncont_recv(i),i=1,ntask_cont_from)
7742 do ii=1,ntask_cont_from
7743 iproc=itask_cont_from(ii)
7745 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7746 ! & " of CONT_TO_COMM group"
7750 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7751 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7752 ! write (iout,*) "ireq,req",ireq,req(ireq)
7755 ! Send the contacts to processors that need them
7756 do ii=1,ntask_cont_to
7757 iproc=itask_cont_to(ii)
7759 ! write (iout,*) nn," contacts to processor",iproc,
7760 ! & " of CONT_TO_COMM group"
7763 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7764 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7765 ! write (iout,*) "ireq,req",ireq,req(ireq)
7767 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7771 ! write (iout,*) "number of requests (contacts)",ireq
7772 ! write (iout,*) "req",(req(i),i=1,4)
7775 call MPI_Waitall(ireq,req,status_array,ierr)
7776 do iii=1,ntask_cont_from
7777 iproc=itask_cont_from(iii)
7780 write (iout,*) "Received",nn," contacts from processor",iproc,&
7781 " of CONT_FROM_COMM group"
7784 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7789 ii=zapas_recv(1,i,iii)
7790 ! Flag the received contacts to prevent double-counting
7791 jj=-zapas_recv(2,i,iii)
7792 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7794 nnn=num_cont_hb(ii)+1
7797 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7801 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7806 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7814 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7823 write (iout,'(a)') 'Contact function values after receive:'
7825 write (iout,'(2i3,50(1x,i3,5f6.3))') &
7826 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
7827 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7834 write (iout,'(a)') 'Contact function values:'
7836 write (iout,'(2i3,50(1x,i2,5f6.3))') &
7837 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
7838 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7845 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7846 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7847 ! Remove the loop below after debugging !!!
7854 ! Calculate the dipole-dipole interaction energies
7855 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7856 do i=iatel_s,iatel_e+1
7857 num_conti=num_cont_hb(i)
7866 ! Calculate the local-electrostatic correlation terms
7867 ! write (iout,*) "gradcorr5 in eello5 before loop"
7869 ! write (iout,'(i5,3f10.5)')
7870 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7872 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7873 ! write (iout,*) "corr loop i",i
7875 num_conti=num_cont_hb(i)
7876 num_conti1=num_cont_hb(i+1)
7883 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7884 ! & ' jj=',jj,' kk=',kk
7885 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
7886 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7887 .or. j.lt.0 .and. j1.gt.0) .and. &
7888 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7889 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7890 ! The system gains extra energy.
7892 sqd1=dsqrt(d_cont(jj,i))
7893 sqd2=dsqrt(d_cont(kk,i1))
7894 sred_geom = sqd1*sqd2
7895 IF (sred_geom.lt.cutoff_corr) THEN
7896 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
7898 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7899 !d & ' jj=',jj,' kk=',kk
7900 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7901 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7903 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7904 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7907 !d write (iout,*) 'sred_geom=',sred_geom,
7908 !d & ' ekont=',ekont,' fprim=',fprimcont,
7909 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7910 !d write (iout,*) "g_contij",g_contij
7911 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7912 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7913 call calc_eello(i,jp,i+1,jp1,jj,kk)
7914 if (wcorr4.gt.0.0d0) &
7915 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7916 if (energy_dec.and.wcorr4.gt.0.0d0) &
7917 write (iout,'(a6,4i5,0pf7.3)') &
7918 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7919 ! write (iout,*) "gradcorr5 before eello5"
7921 ! write (iout,'(i5,3f10.5)')
7922 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7924 if (wcorr5.gt.0.0d0) &
7925 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7926 ! write (iout,*) "gradcorr5 after eello5"
7928 ! write (iout,'(i5,3f10.5)')
7929 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7931 if (energy_dec.and.wcorr5.gt.0.0d0) &
7932 write (iout,'(a6,4i5,0pf7.3)') &
7933 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7934 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7935 !d write(2,*)'ijkl',i,jp,i+1,jp1
7936 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
7937 .or. wturn6.eq.0.0d0))then
7938 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7939 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7940 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
7941 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7942 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7943 !d & 'ecorr6=',ecorr6
7944 !d write (iout,'(4e15.5)') sred_geom,
7945 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7946 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7947 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7948 else if (wturn6.gt.0.0d0 &
7949 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7950 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7951 eturn6=eturn6+eello_turn6(i,jj,kk)
7952 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
7953 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7954 !d write (2,*) 'multibody_eello:eturn6',eturn6
7963 num_cont_hb(i)=num_cont_hb_old(i)
7965 ! write (iout,*) "gradcorr5 in eello5"
7967 ! write (iout,'(i5,3f10.5)')
7968 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7971 end subroutine multibody_eello
7972 !-----------------------------------------------------------------------------
7973 subroutine add_hb_contact_eello(ii,jj,itask)
7974 ! implicit real*8 (a-h,o-z)
7975 ! include "DIMENSIONS"
7976 ! include "COMMON.IOUNITS"
7977 ! include "COMMON.CONTACTS"
7978 ! integer,parameter :: maxconts=nres/4
7979 integer,parameter :: max_dim=70
7980 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7981 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7982 ! common /przechowalnia/ zapas
7984 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
7985 integer,dimension(4) ::itask
7986 ! write (iout,*) "itask",itask
7989 if (iproc.gt.0) then
7990 do j=1,num_cont_hb(ii)
7992 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7994 ncont_sent(iproc)=ncont_sent(iproc)+1
7995 nn=ncont_sent(iproc)
7996 zapas(1,nn,iproc)=ii
7997 zapas(2,nn,iproc)=jjc
7998 zapas(3,nn,iproc)=d_cont(j,ii)
8002 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8007 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8015 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8026 end subroutine add_hb_contact_eello
8027 !-----------------------------------------------------------------------------
8028 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8029 ! implicit real*8 (a-h,o-z)
8030 ! include 'DIMENSIONS'
8031 ! include 'COMMON.IOUNITS'
8032 ! include 'COMMON.DERIV'
8033 ! include 'COMMON.INTERACT'
8034 ! include 'COMMON.CONTACTS'
8035 real(kind=8),dimension(3) :: gx,gx1
8038 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
8039 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
8040 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
8041 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
8052 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8053 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8054 ! Following 4 lines for diagnostics.
8059 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8060 ! & 'Contacts ',i,j,
8061 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8062 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8064 ! Calculate the multi-body contribution to energy.
8065 ! ecorr=ecorr+ekont*ees
8066 ! Calculate multi-body contributions to the gradient.
8067 coeffpees0pij=coeffp*ees0pij
8068 coeffmees0mij=coeffm*ees0mij
8069 coeffpees0pkl=coeffp*ees0pkl
8070 coeffmees0mkl=coeffm*ees0mkl
8072 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8073 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
8074 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
8075 coeffmees0mkl*gacontm_hb1(ll,jj,i))
8076 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
8077 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
8078 coeffmees0mkl*gacontm_hb2(ll,jj,i))
8079 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8080 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
8081 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
8082 coeffmees0mij*gacontm_hb1(ll,kk,k))
8083 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
8084 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
8085 coeffmees0mij*gacontm_hb2(ll,kk,k))
8086 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
8087 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
8088 coeffmees0mkl*gacontm_hb3(ll,jj,i))
8089 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8090 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8091 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
8092 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
8093 coeffmees0mij*gacontm_hb3(ll,kk,k))
8094 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8095 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8096 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8101 !grad gradcorr(ll,m)=gradcorr(ll,m)+
8102 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
8103 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8104 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8109 !grad gradcorr(ll,m)=gradcorr(ll,m)+
8110 !grad & ees*eij*gacont_hbr(ll,kk,k)-
8111 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8112 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8115 ! write (iout,*) "ehbcorr",ekont*ees
8117 if (shield_mode.gt.0) then
8120 !C print *,i,j,fac_shield(i),fac_shield(j),
8121 !C &fac_shield(k),fac_shield(l)
8122 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
8123 (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
8124 do ilist=1,ishield_list(i)
8125 iresshield=shield_list(ilist,i)
8127 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
8128 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8130 +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
8131 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8135 do ilist=1,ishield_list(j)
8136 iresshield=shield_list(ilist,j)
8138 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
8139 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8141 +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
8142 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8147 do ilist=1,ishield_list(k)
8148 iresshield=shield_list(ilist,k)
8150 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
8151 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8153 +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
8154 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8158 do ilist=1,ishield_list(l)
8159 iresshield=shield_list(ilist,l)
8161 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
8162 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8164 +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
8165 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8170 gshieldc_ec(m,i)=gshieldc_ec(m,i)+ &
8171 grad_shield(m,i)*ehbcorr/fac_shield(i)
8172 gshieldc_ec(m,j)=gshieldc_ec(m,j)+ &
8173 grad_shield(m,j)*ehbcorr/fac_shield(j)
8174 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ &
8175 grad_shield(m,i)*ehbcorr/fac_shield(i)
8176 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ &
8177 grad_shield(m,j)*ehbcorr/fac_shield(j)
8179 gshieldc_ec(m,k)=gshieldc_ec(m,k)+ &
8180 grad_shield(m,k)*ehbcorr/fac_shield(k)
8181 gshieldc_ec(m,l)=gshieldc_ec(m,l)+ &
8182 grad_shield(m,l)*ehbcorr/fac_shield(l)
8183 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ &
8184 grad_shield(m,k)*ehbcorr/fac_shield(k)
8185 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ &
8186 grad_shield(m,l)*ehbcorr/fac_shield(l)
8192 end function ehbcorr
8194 !-----------------------------------------------------------------------------
8195 subroutine dipole(i,j,jj)
8196 ! implicit real*8 (a-h,o-z)
8197 ! include 'DIMENSIONS'
8198 ! include 'COMMON.IOUNITS'
8199 ! include 'COMMON.CHAIN'
8200 ! include 'COMMON.FFIELD'
8201 ! include 'COMMON.DERIV'
8202 ! include 'COMMON.INTERACT'
8203 ! include 'COMMON.CONTACTS'
8204 ! include 'COMMON.TORSION'
8205 ! include 'COMMON.VAR'
8206 ! include 'COMMON.GEO'
8207 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
8208 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
8209 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
8211 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
8212 allocate(dipderx(3,5,4,maxconts,nres))
8215 iti1 = itortyp(itype(i+1,1))
8216 if (j.lt.nres-1) then
8217 itj1 = itortyp(itype(j+1,1))
8222 dipi(iii,1)=Ub2(iii,i)
8223 dipderi(iii)=Ub2der(iii,i)
8224 dipi(iii,2)=b1(iii,iti1)
8225 dipj(iii,1)=Ub2(iii,j)
8226 dipderj(iii)=Ub2der(iii,j)
8227 dipj(iii,2)=b1(iii,itj1)
8231 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8234 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8241 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
8245 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8250 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8251 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8253 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8255 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8257 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8260 end subroutine dipole
8262 !-----------------------------------------------------------------------------
8263 subroutine calc_eello(i,j,k,l,jj,kk)
8265 ! This subroutine computes matrices and vectors needed to calculate
8266 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
8269 ! implicit real*8 (a-h,o-z)
8270 ! include 'DIMENSIONS'
8271 ! include 'COMMON.IOUNITS'
8272 ! include 'COMMON.CHAIN'
8273 ! include 'COMMON.DERIV'
8274 ! include 'COMMON.INTERACT'
8275 ! include 'COMMON.CONTACTS'
8276 ! include 'COMMON.TORSION'
8277 ! include 'COMMON.VAR'
8278 ! include 'COMMON.GEO'
8279 ! include 'COMMON.FFIELD'
8280 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
8281 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
8282 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
8285 !el common /kutas/ lprn
8286 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8287 !d & ' jj=',jj,' kk=',kk
8288 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8289 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8290 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8293 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8294 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8297 call transpose2(aa1(1,1),aa1t(1,1))
8298 call transpose2(aa2(1,1),aa2t(1,1))
8301 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
8302 aa1tder(1,1,lll,kkk))
8303 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
8304 aa2tder(1,1,lll,kkk))
8308 ! parallel orientation of the two CA-CA-CA frames.
8310 iti=itortyp(itype(i,1))
8314 itk1=itortyp(itype(k+1,1))
8315 itj=itortyp(itype(j,1))
8316 if (l.lt.nres-1) then
8317 itl1=itortyp(itype(l+1,1))
8321 ! A1 kernel(j+1) A2T
8323 !d write (iout,'(3f10.5,5x,3f10.5)')
8324 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8326 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8327 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
8328 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8329 ! Following matrices are needed only for 6-th order cumulants
8330 IF (wcorr6.gt.0.0d0) THEN
8331 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8332 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
8333 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8334 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8335 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
8336 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8337 ADtEAderx(1,1,1,1,1,1))
8339 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8340 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
8341 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8342 ADtEA1derx(1,1,1,1,1,1))
8344 ! End 6-th order cumulants
8347 !d write (2,*) 'In calc_eello6'
8349 !d write (2,*) 'iii=',iii
8351 !d write (2,*) 'kkk=',kkk
8353 !d write (2,'(3(2f10.5),5x)')
8354 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8359 call transpose2(EUgder(1,1,k),auxmat(1,1))
8360 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8361 call transpose2(EUg(1,1,k),auxmat(1,1))
8362 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8363 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8367 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8368 EAEAderx(1,1,lll,kkk,iii,1))
8372 ! A1T kernel(i+1) A2
8373 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8374 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
8375 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8376 ! Following matrices are needed only for 6-th order cumulants
8377 IF (wcorr6.gt.0.0d0) THEN
8378 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8379 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
8380 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8381 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8382 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
8383 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8384 ADtEAderx(1,1,1,1,1,2))
8385 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8386 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
8387 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8388 ADtEA1derx(1,1,1,1,1,2))
8390 ! End 6-th order cumulants
8391 call transpose2(EUgder(1,1,l),auxmat(1,1))
8392 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8393 call transpose2(EUg(1,1,l),auxmat(1,1))
8394 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8395 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8399 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8400 EAEAderx(1,1,lll,kkk,iii,2))
8405 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8406 ! They are needed only when the fifth- or the sixth-order cumulants are
8408 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8409 call transpose2(AEA(1,1,1),auxmat(1,1))
8410 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8411 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8412 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8413 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8414 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8415 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8416 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8417 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8418 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8419 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8420 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8421 call transpose2(AEA(1,1,2),auxmat(1,1))
8422 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
8423 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8424 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8425 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8426 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
8427 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8428 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
8429 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
8430 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8431 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8432 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8433 ! Calculate the Cartesian derivatives of the vectors.
8437 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8438 call matvec2(auxmat(1,1),b1(1,iti),&
8439 AEAb1derx(1,lll,kkk,iii,1,1))
8440 call matvec2(auxmat(1,1),Ub2(1,i),&
8441 AEAb2derx(1,lll,kkk,iii,1,1))
8442 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8443 AEAb1derx(1,lll,kkk,iii,2,1))
8444 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8445 AEAb2derx(1,lll,kkk,iii,2,1))
8446 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8447 call matvec2(auxmat(1,1),b1(1,itj),&
8448 AEAb1derx(1,lll,kkk,iii,1,2))
8449 call matvec2(auxmat(1,1),Ub2(1,j),&
8450 AEAb2derx(1,lll,kkk,iii,1,2))
8451 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
8452 AEAb1derx(1,lll,kkk,iii,2,2))
8453 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
8454 AEAb2derx(1,lll,kkk,iii,2,2))
8461 ! Antiparallel orientation of the two CA-CA-CA frames.
8463 iti=itortyp(itype(i,1))
8467 itk1=itortyp(itype(k+1,1))
8468 itl=itortyp(itype(l,1))
8469 itj=itortyp(itype(j,1))
8470 if (j.lt.nres-1) then
8471 itj1=itortyp(itype(j+1,1))
8475 ! A2 kernel(j-1)T A1T
8476 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8477 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
8478 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8479 ! Following matrices are needed only for 6-th order cumulants
8480 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8481 j.eq.i+4 .and. l.eq.i+3)) THEN
8482 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8483 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
8484 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8485 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8486 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
8487 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8488 ADtEAderx(1,1,1,1,1,1))
8489 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8490 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
8491 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8492 ADtEA1derx(1,1,1,1,1,1))
8494 ! End 6-th order cumulants
8495 call transpose2(EUgder(1,1,k),auxmat(1,1))
8496 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8497 call transpose2(EUg(1,1,k),auxmat(1,1))
8498 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8499 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8503 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8504 EAEAderx(1,1,lll,kkk,iii,1))
8508 ! A2T kernel(i+1)T A1
8509 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8510 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
8511 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8512 ! Following matrices are needed only for 6-th order cumulants
8513 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8514 j.eq.i+4 .and. l.eq.i+3)) THEN
8515 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8516 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
8517 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8518 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8519 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
8520 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8521 ADtEAderx(1,1,1,1,1,2))
8522 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8523 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
8524 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8525 ADtEA1derx(1,1,1,1,1,2))
8527 ! End 6-th order cumulants
8528 call transpose2(EUgder(1,1,j),auxmat(1,1))
8529 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8530 call transpose2(EUg(1,1,j),auxmat(1,1))
8531 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8532 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8536 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8537 EAEAderx(1,1,lll,kkk,iii,2))
8542 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8543 ! They are needed only when the fifth- or the sixth-order cumulants are
8545 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
8546 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8547 call transpose2(AEA(1,1,1),auxmat(1,1))
8548 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8549 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8550 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8551 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8552 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8553 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8554 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8555 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8556 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8557 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8558 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8559 call transpose2(AEA(1,1,2),auxmat(1,1))
8560 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
8561 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8562 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8563 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8564 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
8565 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8566 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
8567 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
8568 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8569 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8570 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8571 ! Calculate the Cartesian derivatives of the vectors.
8575 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8576 call matvec2(auxmat(1,1),b1(1,iti),&
8577 AEAb1derx(1,lll,kkk,iii,1,1))
8578 call matvec2(auxmat(1,1),Ub2(1,i),&
8579 AEAb2derx(1,lll,kkk,iii,1,1))
8580 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8581 AEAb1derx(1,lll,kkk,iii,2,1))
8582 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8583 AEAb2derx(1,lll,kkk,iii,2,1))
8584 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8585 call matvec2(auxmat(1,1),b1(1,itl),&
8586 AEAb1derx(1,lll,kkk,iii,1,2))
8587 call matvec2(auxmat(1,1),Ub2(1,l),&
8588 AEAb2derx(1,lll,kkk,iii,1,2))
8589 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
8590 AEAb1derx(1,lll,kkk,iii,2,2))
8591 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
8592 AEAb2derx(1,lll,kkk,iii,2,2))
8600 end subroutine calc_eello
8601 !-----------------------------------------------------------------------------
8602 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
8607 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
8608 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
8609 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
8610 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
8611 integer :: iii,kkk,lll
8614 !el common /kutas/ lprn
8615 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8617 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
8620 !d if (lprn) write (2,*) 'In kernel'
8622 !d if (lprn) write (2,*) 'kkk=',kkk
8624 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
8625 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8627 !d write (2,*) 'lll=',lll
8628 !d write (2,*) 'iii=1'
8630 !d write (2,'(3(2f10.5),5x)')
8631 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8634 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
8635 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8637 !d write (2,*) 'lll=',lll
8638 !d write (2,*) 'iii=2'
8640 !d write (2,'(3(2f10.5),5x)')
8641 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8647 end subroutine kernel
8648 !-----------------------------------------------------------------------------
8649 real(kind=8) function eello4(i,j,k,l,jj,kk)
8650 ! implicit real*8 (a-h,o-z)
8651 ! include 'DIMENSIONS'
8652 ! include 'COMMON.IOUNITS'
8653 ! include 'COMMON.CHAIN'
8654 ! include 'COMMON.DERIV'
8655 ! include 'COMMON.INTERACT'
8656 ! include 'COMMON.CONTACTS'
8657 ! include 'COMMON.TORSION'
8658 ! include 'COMMON.VAR'
8659 ! include 'COMMON.GEO'
8660 real(kind=8),dimension(2,2) :: pizda
8661 real(kind=8),dimension(3) :: ggg1,ggg2
8662 real(kind=8) :: eel4,glongij,glongkl
8663 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
8664 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8668 !d print *,'eello4:',i,j,k,l,jj,kk
8669 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
8670 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
8671 !old eij=facont_hb(jj,i)
8672 !old ekl=facont_hb(kk,k)
8674 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8675 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8676 gcorr_loc(k-1)=gcorr_loc(k-1) &
8677 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8679 gcorr_loc(l-1)=gcorr_loc(l-1) &
8680 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8682 gcorr_loc(j-1)=gcorr_loc(j-1) &
8683 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8688 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
8689 -EAEAderx(2,2,lll,kkk,iii,1)
8690 !d derx(lll,kkk,iii)=0.0d0
8694 !d gcorr_loc(l-1)=0.0d0
8695 !d gcorr_loc(j-1)=0.0d0
8696 !d gcorr_loc(k-1)=0.0d0
8698 !d write (iout,*)'Contacts have occurred for peptide groups',
8699 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
8700 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8701 if (j.lt.nres-1) then
8708 if (l.lt.nres-1) then
8716 !grad ggg1(ll)=eel4*g_contij(ll,1)
8717 !grad ggg2(ll)=eel4*g_contij(ll,2)
8718 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8719 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8720 !grad ghalf=0.5d0*ggg1(ll)
8721 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8722 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8723 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8724 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8725 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8726 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8727 !grad ghalf=0.5d0*ggg2(ll)
8728 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8729 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8730 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8731 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8732 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8733 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8737 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8742 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8747 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8752 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8756 !d write (2,*) iii,gcorr_loc(iii)
8759 !d write (2,*) 'ekont',ekont
8760 !d write (iout,*) 'eello4',ekont*eel4
8763 !-----------------------------------------------------------------------------
8764 real(kind=8) function eello5(i,j,k,l,jj,kk)
8765 ! implicit real*8 (a-h,o-z)
8766 ! include 'DIMENSIONS'
8767 ! include 'COMMON.IOUNITS'
8768 ! include 'COMMON.CHAIN'
8769 ! include 'COMMON.DERIV'
8770 ! include 'COMMON.INTERACT'
8771 ! include 'COMMON.CONTACTS'
8772 ! include 'COMMON.TORSION'
8773 ! include 'COMMON.VAR'
8774 ! include 'COMMON.GEO'
8775 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8776 real(kind=8),dimension(2) :: vv
8777 real(kind=8),dimension(3) :: ggg1,ggg2
8778 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
8779 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
8780 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
8781 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8786 ! /l\ / \ \ / \ / \ / C
8787 ! / \ / \ \ / \ / \ / C
8788 ! j| o |l1 | o | o| o | | o |o C
8789 ! \ |/k\| |/ \| / |/ \| |/ \| C
8790 ! \i/ \ / \ / / \ / \ C
8792 ! (I) (II) (III) (IV) C
8794 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8796 ! Antiparallel chains C
8799 ! /j\ / \ \ / \ / \ / C
8800 ! / \ / \ \ / \ / \ / C
8801 ! j1| o |l | o | o| o | | o |o C
8802 ! \ |/k\| |/ \| / |/ \| |/ \| C
8803 ! \i/ \ / \ / / \ / \ C
8805 ! (I) (II) (III) (IV) C
8807 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8809 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
8811 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8812 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8817 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8819 itk=itortyp(itype(k,1))
8820 itl=itortyp(itype(l,1))
8821 itj=itortyp(itype(j,1))
8826 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8827 !d & eel5_3_num,eel5_4_num)
8831 derx(lll,kkk,iii)=0.0d0
8835 !d eij=facont_hb(jj,i)
8836 !d ekl=facont_hb(kk,k)
8838 !d write (iout,*)'Contacts have occurred for peptide groups',
8839 !d & i,j,' fcont:',eij,' eij',' and ',k,l
8841 ! Contribution from the graph I.
8842 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8843 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8844 call transpose2(EUg(1,1,k),auxmat(1,1))
8845 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8846 vv(1)=pizda(1,1)-pizda(2,2)
8847 vv(2)=pizda(1,2)+pizda(2,1)
8848 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
8849 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8850 ! Explicit gradient in virtual-dihedral angles.
8851 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
8852 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
8853 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8854 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8855 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8856 vv(1)=pizda(1,1)-pizda(2,2)
8857 vv(2)=pizda(1,2)+pizda(2,1)
8858 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8859 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
8860 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8861 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8862 vv(1)=pizda(1,1)-pizda(2,2)
8863 vv(2)=pizda(1,2)+pizda(2,1)
8865 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8866 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
8867 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8869 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8870 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
8871 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8873 ! Cartesian gradient
8877 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
8879 vv(1)=pizda(1,1)-pizda(2,2)
8880 vv(2)=pizda(1,2)+pizda(2,1)
8881 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8882 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
8883 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8889 ! Contribution from graph II
8890 call transpose2(EE(1,1,itk),auxmat(1,1))
8891 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8892 vv(1)=pizda(1,1)+pizda(2,2)
8893 vv(2)=pizda(2,1)-pizda(1,2)
8894 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
8895 -0.5d0*scalar2(vv(1),Ctobr(1,k))
8896 ! Explicit gradient in virtual-dihedral angles.
8897 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8898 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8899 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8900 vv(1)=pizda(1,1)+pizda(2,2)
8901 vv(2)=pizda(2,1)-pizda(1,2)
8903 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8904 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
8905 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8907 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8908 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
8909 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8911 ! Cartesian gradient
8915 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8917 vv(1)=pizda(1,1)+pizda(2,2)
8918 vv(2)=pizda(2,1)-pizda(1,2)
8919 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8920 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
8921 -0.5d0*scalar2(vv(1),Ctobr(1,k))
8929 ! Parallel orientation
8930 ! Contribution from graph III
8931 call transpose2(EUg(1,1,l),auxmat(1,1))
8932 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8933 vv(1)=pizda(1,1)-pizda(2,2)
8934 vv(2)=pizda(1,2)+pizda(2,1)
8935 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
8936 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8937 ! Explicit gradient in virtual-dihedral angles.
8938 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8939 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
8940 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8941 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8942 vv(1)=pizda(1,1)-pizda(2,2)
8943 vv(2)=pizda(1,2)+pizda(2,1)
8944 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8945 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
8946 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8947 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8948 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8949 vv(1)=pizda(1,1)-pizda(2,2)
8950 vv(2)=pizda(1,2)+pizda(2,1)
8951 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8952 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
8953 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8954 ! Cartesian gradient
8958 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
8960 vv(1)=pizda(1,1)-pizda(2,2)
8961 vv(2)=pizda(1,2)+pizda(2,1)
8962 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8963 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
8964 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8969 ! Contribution from graph IV
8971 call transpose2(EE(1,1,itl),auxmat(1,1))
8972 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8973 vv(1)=pizda(1,1)+pizda(2,2)
8974 vv(2)=pizda(2,1)-pizda(1,2)
8975 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
8976 -0.5d0*scalar2(vv(1),Ctobr(1,l))
8977 ! Explicit gradient in virtual-dihedral angles.
8978 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8979 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8980 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8981 vv(1)=pizda(1,1)+pizda(2,2)
8982 vv(2)=pizda(2,1)-pizda(1,2)
8983 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8984 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
8985 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8986 ! Cartesian gradient
8990 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8992 vv(1)=pizda(1,1)+pizda(2,2)
8993 vv(2)=pizda(2,1)-pizda(1,2)
8994 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8995 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
8996 -0.5d0*scalar2(vv(1),Ctobr(1,l))
9001 ! Antiparallel orientation
9002 ! Contribution from graph III
9004 call transpose2(EUg(1,1,j),auxmat(1,1))
9005 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9006 vv(1)=pizda(1,1)-pizda(2,2)
9007 vv(2)=pizda(1,2)+pizda(2,1)
9008 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
9009 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9010 ! Explicit gradient in virtual-dihedral angles.
9011 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9012 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
9013 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9014 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9015 vv(1)=pizda(1,1)-pizda(2,2)
9016 vv(2)=pizda(1,2)+pizda(2,1)
9017 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9018 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
9019 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9020 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9021 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9022 vv(1)=pizda(1,1)-pizda(2,2)
9023 vv(2)=pizda(1,2)+pizda(2,1)
9024 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9025 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
9026 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9027 ! Cartesian gradient
9031 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
9033 vv(1)=pizda(1,1)-pizda(2,2)
9034 vv(2)=pizda(1,2)+pizda(2,1)
9035 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
9036 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
9037 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9042 ! Contribution from graph IV
9044 call transpose2(EE(1,1,itj),auxmat(1,1))
9045 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9046 vv(1)=pizda(1,1)+pizda(2,2)
9047 vv(2)=pizda(2,1)-pizda(1,2)
9048 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
9049 -0.5d0*scalar2(vv(1),Ctobr(1,j))
9050 ! Explicit gradient in virtual-dihedral angles.
9051 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9052 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9053 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9054 vv(1)=pizda(1,1)+pizda(2,2)
9055 vv(2)=pizda(2,1)-pizda(1,2)
9056 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9057 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
9058 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9059 ! Cartesian gradient
9063 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
9065 vv(1)=pizda(1,1)+pizda(2,2)
9066 vv(2)=pizda(2,1)-pizda(1,2)
9067 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
9068 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
9069 -0.5d0*scalar2(vv(1),Ctobr(1,j))
9075 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9076 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9077 !d write (2,*) 'ijkl',i,j,k,l
9078 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9079 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
9081 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9082 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9083 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9084 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9085 if (j.lt.nres-1) then
9092 if (l.lt.nres-1) then
9102 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9103 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
9104 ! summed up outside the subrouine as for the other subroutines
9105 ! handling long-range interactions. The old code is commented out
9106 ! with "cgrad" to keep track of changes.
9108 !grad ggg1(ll)=eel5*g_contij(ll,1)
9109 !grad ggg2(ll)=eel5*g_contij(ll,2)
9110 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9111 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9112 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9113 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9114 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9115 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9116 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9117 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9119 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9120 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9121 !grad ghalf=0.5d0*ggg1(ll)
9123 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9124 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9125 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9126 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9127 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9128 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9129 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9130 !grad ghalf=0.5d0*ggg2(ll)
9132 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
9133 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9134 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
9135 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9136 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9137 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9142 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9143 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9148 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9149 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9155 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9160 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9164 !d write (2,*) iii,g_corr5_loc(iii)
9167 !d write (2,*) 'ekont',ekont
9168 !d write (iout,*) 'eello5',ekont*eel5
9171 !-----------------------------------------------------------------------------
9172 real(kind=8) function eello6(i,j,k,l,jj,kk)
9173 ! implicit real*8 (a-h,o-z)
9174 ! include 'DIMENSIONS'
9175 ! include 'COMMON.IOUNITS'
9176 ! include 'COMMON.CHAIN'
9177 ! include 'COMMON.DERIV'
9178 ! include 'COMMON.INTERACT'
9179 ! include 'COMMON.CONTACTS'
9180 ! include 'COMMON.TORSION'
9181 ! include 'COMMON.VAR'
9182 ! include 'COMMON.GEO'
9183 ! include 'COMMON.FFIELD'
9184 real(kind=8),dimension(3) :: ggg1,ggg2
9185 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
9187 real(kind=8) :: gradcorr6ij,gradcorr6kl
9188 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
9189 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9194 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9202 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9203 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9207 derx(lll,kkk,iii)=0.0d0
9211 !d eij=facont_hb(jj,i)
9212 !d ekl=facont_hb(kk,k)
9218 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9219 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9220 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9221 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9222 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9223 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9225 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9226 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9227 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9228 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9229 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9230 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9234 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9236 ! If turn contributions are considered, they will be handled separately.
9237 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9238 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9239 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9240 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9241 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9242 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9243 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9245 if (j.lt.nres-1) then
9252 if (l.lt.nres-1) then
9260 !grad ggg1(ll)=eel6*g_contij(ll,1)
9261 !grad ggg2(ll)=eel6*g_contij(ll,2)
9262 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9263 !grad ghalf=0.5d0*ggg1(ll)
9265 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9266 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9267 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9268 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9269 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9270 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9271 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9272 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9273 !grad ghalf=0.5d0*ggg2(ll)
9274 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9276 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9277 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9278 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9279 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9280 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9281 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9286 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9287 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9292 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9293 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9299 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9304 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9308 !d write (2,*) iii,g_corr6_loc(iii)
9311 !d write (2,*) 'ekont',ekont
9312 !d write (iout,*) 'eello6',ekont*eel6
9315 !-----------------------------------------------------------------------------
9316 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
9318 ! implicit real*8 (a-h,o-z)
9319 ! include 'DIMENSIONS'
9320 ! include 'COMMON.IOUNITS'
9321 ! include 'COMMON.CHAIN'
9322 ! include 'COMMON.DERIV'
9323 ! include 'COMMON.INTERACT'
9324 ! include 'COMMON.CONTACTS'
9325 ! include 'COMMON.TORSION'
9326 ! include 'COMMON.VAR'
9327 ! include 'COMMON.GEO'
9328 real(kind=8),dimension(2) :: vv,vv1
9329 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
9332 !el common /kutas/ lprn
9333 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
9334 real(kind=8) :: s1,s2,s3,s4,s5
9335 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9337 ! Parallel Antiparallel C
9343 ! \ j|/k\| / \ |/k\|l / C
9348 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9349 itk=itortyp(itype(k,1))
9350 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9351 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9352 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9353 call transpose2(EUgC(1,1,k),auxmat(1,1))
9354 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9355 vv1(1)=pizda1(1,1)-pizda1(2,2)
9356 vv1(2)=pizda1(1,2)+pizda1(2,1)
9357 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9358 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
9359 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
9360 s5=scalar2(vv(1),Dtobr2(1,i))
9361 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9362 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9363 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
9364 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
9365 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
9366 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
9367 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
9368 +scalar2(vv(1),Dtobr2der(1,i)))
9369 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9370 vv1(1)=pizda1(1,1)-pizda1(2,2)
9371 vv1(2)=pizda1(1,2)+pizda1(2,1)
9372 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
9373 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
9375 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
9376 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
9377 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
9378 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
9379 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9381 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
9382 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
9383 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
9384 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
9385 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9387 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9388 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9389 vv1(1)=pizda1(1,1)-pizda1(2,2)
9390 vv1(2)=pizda1(1,2)+pizda1(2,1)
9391 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
9392 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
9393 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
9394 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9403 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9404 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9405 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9406 call transpose2(EUgC(1,1,k),auxmat(1,1))
9407 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
9409 vv1(1)=pizda1(1,1)-pizda1(2,2)
9410 vv1(2)=pizda1(1,2)+pizda1(2,1)
9411 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9412 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
9413 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
9414 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
9415 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
9416 s5=scalar2(vv(1),Dtobr2(1,i))
9417 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9422 end function eello6_graph1
9423 !-----------------------------------------------------------------------------
9424 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
9426 ! implicit real*8 (a-h,o-z)
9427 ! include 'DIMENSIONS'
9428 ! include 'COMMON.IOUNITS'
9429 ! include 'COMMON.CHAIN'
9430 ! include 'COMMON.DERIV'
9431 ! include 'COMMON.INTERACT'
9432 ! include 'COMMON.CONTACTS'
9433 ! include 'COMMON.TORSION'
9434 ! include 'COMMON.VAR'
9435 ! include 'COMMON.GEO'
9437 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
9438 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9440 !el common /kutas/ lprn
9441 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
9442 real(kind=8) :: s2,s3,s4
9443 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9445 ! Parallel Antiparallel C
9451 ! \ j|/k\| \ |/k\|l C
9456 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9457 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9458 ! AL 7/4/01 s1 would occur in the sixth-order moment,
9459 ! but not in a cluster cumulant
9461 s1=dip(1,jj,i)*dip(1,kk,k)
9463 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9464 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9465 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9466 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9467 call transpose2(EUg(1,1,k),auxmat(1,1))
9468 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9469 vv(1)=pizda(1,1)-pizda(2,2)
9470 vv(2)=pizda(1,2)+pizda(2,1)
9471 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9472 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9474 eello6_graph2=-(s1+s2+s3+s4)
9476 eello6_graph2=-(s2+s3+s4)
9479 ! Derivatives in gamma(i-1)
9482 s1=dipderg(1,jj,i)*dip(1,kk,k)
9484 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9485 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9486 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9487 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9489 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9491 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9493 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9495 ! Derivatives in gamma(k-1)
9497 s1=dip(1,jj,i)*dipderg(1,kk,k)
9499 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9500 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9501 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9502 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9503 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9504 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9505 vv(1)=pizda(1,1)-pizda(2,2)
9506 vv(2)=pizda(1,2)+pizda(2,1)
9507 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9509 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9511 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9513 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9514 ! Derivatives in gamma(j-1) or gamma(l-1)
9517 s1=dipderg(3,jj,i)*dip(1,kk,k)
9519 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9520 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9521 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9522 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9523 vv(1)=pizda(1,1)-pizda(2,2)
9524 vv(2)=pizda(1,2)+pizda(2,1)
9525 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9528 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9530 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9533 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9534 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9536 ! Derivatives in gamma(l-1) or gamma(j-1)
9539 s1=dip(1,jj,i)*dipderg(3,kk,k)
9541 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9542 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9543 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9544 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9545 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9546 vv(1)=pizda(1,1)-pizda(2,2)
9547 vv(2)=pizda(1,2)+pizda(2,1)
9548 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9551 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9553 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9556 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9557 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9559 ! Cartesian derivatives.
9561 write (2,*) 'In eello6_graph2'
9563 write (2,*) 'iii=',iii
9565 write (2,*) 'kkk=',kkk
9567 write (2,'(3(2f10.5),5x)') &
9568 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9578 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9580 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9583 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
9585 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9586 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
9588 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9589 call transpose2(EUg(1,1,k),auxmat(1,1))
9590 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
9592 vv(1)=pizda(1,1)-pizda(2,2)
9593 vv(2)=pizda(1,2)+pizda(2,1)
9594 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9595 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9597 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9599 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9602 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9604 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9610 end function eello6_graph2
9611 !-----------------------------------------------------------------------------
9612 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
9613 ! implicit real*8 (a-h,o-z)
9614 ! include 'DIMENSIONS'
9615 ! include 'COMMON.IOUNITS'
9616 ! include 'COMMON.CHAIN'
9617 ! include 'COMMON.DERIV'
9618 ! include 'COMMON.INTERACT'
9619 ! include 'COMMON.CONTACTS'
9620 ! include 'COMMON.TORSION'
9621 ! include 'COMMON.VAR'
9622 ! include 'COMMON.GEO'
9623 real(kind=8),dimension(2) :: vv,auxvec
9624 real(kind=8),dimension(2,2) :: pizda,auxmat
9626 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
9627 real(kind=8) :: s1,s2,s3,s4
9628 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9630 ! Parallel Antiparallel C
9636 ! j|/k\| / |/k\|l / C
9641 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9643 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9644 ! energy moment and not to the cluster cumulant.
9645 iti=itortyp(itype(i,1))
9646 if (j.lt.nres-1) then
9647 itj1=itortyp(itype(j+1,1))
9651 itk=itortyp(itype(k,1))
9652 itk1=itortyp(itype(k+1,1))
9653 if (l.lt.nres-1) then
9654 itl1=itortyp(itype(l+1,1))
9659 s1=dip(4,jj,i)*dip(4,kk,k)
9661 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
9662 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9663 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
9664 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9665 call transpose2(EE(1,1,itk),auxmat(1,1))
9666 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9667 vv(1)=pizda(1,1)+pizda(2,2)
9668 vv(2)=pizda(2,1)-pizda(1,2)
9669 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9670 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9671 !d & "sum",-(s2+s3+s4)
9673 eello6_graph3=-(s1+s2+s3+s4)
9675 eello6_graph3=-(s2+s3+s4)
9678 ! Derivatives in gamma(k-1)
9679 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
9680 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9681 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9682 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9683 ! Derivatives in gamma(l-1)
9684 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
9685 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9686 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9687 vv(1)=pizda(1,1)+pizda(2,2)
9688 vv(2)=pizda(2,1)-pizda(1,2)
9689 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9690 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9691 ! Cartesian derivatives.
9697 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9699 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9702 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
9704 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9705 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
9707 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9708 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
9710 vv(1)=pizda(1,1)+pizda(2,2)
9711 vv(2)=pizda(2,1)-pizda(1,2)
9712 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9714 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9716 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9719 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9721 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9723 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9728 end function eello6_graph3
9729 !-----------------------------------------------------------------------------
9730 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9731 ! implicit real*8 (a-h,o-z)
9732 ! include 'DIMENSIONS'
9733 ! include 'COMMON.IOUNITS'
9734 ! include 'COMMON.CHAIN'
9735 ! include 'COMMON.DERIV'
9736 ! include 'COMMON.INTERACT'
9737 ! include 'COMMON.CONTACTS'
9738 ! include 'COMMON.TORSION'
9739 ! include 'COMMON.VAR'
9740 ! include 'COMMON.GEO'
9741 ! include 'COMMON.FFIELD'
9742 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
9743 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9745 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
9747 real(kind=8) :: s1,s2,s3,s4
9748 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9750 ! Parallel Antiparallel C
9756 ! \ j|/k\| \ |/k\|l C
9761 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9763 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9764 ! energy moment and not to the cluster cumulant.
9765 !d write (2,*) 'eello_graph4: wturn6',wturn6
9766 iti=itortyp(itype(i,1))
9767 itj=itortyp(itype(j,1))
9768 if (j.lt.nres-1) then
9769 itj1=itortyp(itype(j+1,1))
9773 itk=itortyp(itype(k,1))
9774 if (k.lt.nres-1) then
9775 itk1=itortyp(itype(k+1,1))
9779 itl=itortyp(itype(l,1))
9780 if (l.lt.nres-1) then
9781 itl1=itortyp(itype(l+1,1))
9785 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9786 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9787 !d & ' itl',itl,' itl1',itl1
9790 s1=dip(3,jj,i)*dip(3,kk,k)
9792 s1=dip(2,jj,j)*dip(2,kk,l)
9795 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9796 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9798 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9799 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9801 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9802 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9804 call transpose2(EUg(1,1,k),auxmat(1,1))
9805 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9806 vv(1)=pizda(1,1)-pizda(2,2)
9807 vv(2)=pizda(2,1)+pizda(1,2)
9808 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9809 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9811 eello6_graph4=-(s1+s2+s3+s4)
9813 eello6_graph4=-(s2+s3+s4)
9815 ! Derivatives in gamma(i-1)
9819 s1=dipderg(2,jj,i)*dip(3,kk,k)
9821 s1=dipderg(4,jj,j)*dip(2,kk,l)
9824 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9826 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9827 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9829 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9830 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9832 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9833 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9834 !d write (2,*) 'turn6 derivatives'
9836 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9838 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9842 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9844 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9848 ! Derivatives in gamma(k-1)
9851 s1=dip(3,jj,i)*dipderg(2,kk,k)
9853 s1=dip(2,jj,j)*dipderg(4,kk,l)
9856 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9857 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9859 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9860 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9862 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9863 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9865 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9866 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9867 vv(1)=pizda(1,1)-pizda(2,2)
9868 vv(2)=pizda(2,1)+pizda(1,2)
9869 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9870 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9872 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9874 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9878 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9880 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9883 ! Derivatives in gamma(j-1) or gamma(l-1)
9884 if (l.eq.j+1 .and. l.gt.1) then
9885 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9886 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9887 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9888 vv(1)=pizda(1,1)-pizda(2,2)
9889 vv(2)=pizda(2,1)+pizda(1,2)
9890 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9891 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9892 else if (j.gt.1) then
9893 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9894 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9895 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9896 vv(1)=pizda(1,1)-pizda(2,2)
9897 vv(2)=pizda(2,1)+pizda(1,2)
9898 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9899 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9900 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9902 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9905 ! Cartesian derivatives.
9912 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9914 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9918 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9920 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9924 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
9926 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9928 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
9929 b1(1,itj1),auxvec(1))
9930 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9932 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
9933 b1(1,itl1),auxvec(1))
9934 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9936 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
9938 vv(1)=pizda(1,1)-pizda(2,2)
9939 vv(2)=pizda(2,1)+pizda(1,2)
9940 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9942 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9944 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
9947 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
9950 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9953 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9955 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9957 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9961 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9963 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9966 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9968 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9975 end function eello6_graph4
9976 !-----------------------------------------------------------------------------
9977 real(kind=8) function eello_turn6(i,jj,kk)
9978 ! implicit real*8 (a-h,o-z)
9979 ! include 'DIMENSIONS'
9980 ! include 'COMMON.IOUNITS'
9981 ! include 'COMMON.CHAIN'
9982 ! include 'COMMON.DERIV'
9983 ! include 'COMMON.INTERACT'
9984 ! include 'COMMON.CONTACTS'
9985 ! include 'COMMON.TORSION'
9986 ! include 'COMMON.VAR'
9987 ! include 'COMMON.GEO'
9988 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
9989 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
9990 real(kind=8),dimension(3) :: ggg1,ggg2
9991 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
9992 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
9993 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9994 ! the respective energy moment and not to the cluster cumulant.
9996 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
9997 integer :: j1,j2,l1,l2,ll
9998 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
9999 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
10008 iti=itortyp(itype(i,1))
10009 itk=itortyp(itype(k,1))
10010 itk1=itortyp(itype(k+1,1))
10011 itl=itortyp(itype(l,1))
10012 itj=itortyp(itype(j,1))
10013 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10014 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
10015 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10020 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10022 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
10026 derx_turn(lll,kkk,iii)=0.0d0
10033 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10035 !d write (2,*) 'eello6_5',eello6_5
10037 call transpose2(AEA(1,1,1),auxmat(1,1))
10038 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10039 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
10040 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10042 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
10043 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10044 s2 = scalar2(b1(1,itk),vtemp1(1))
10046 call transpose2(AEA(1,1,2),atemp(1,1))
10047 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10048 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10049 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10051 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10052 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10053 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10055 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10056 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10057 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10058 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10059 ss13 = scalar2(b1(1,itk),vtemp4(1))
10060 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10062 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10068 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10069 ! Derivatives in gamma(i+2)
10073 call transpose2(AEA(1,1,1),auxmatd(1,1))
10074 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10075 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10076 call transpose2(AEAderg(1,1,2),atempd(1,1))
10077 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10078 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10080 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10081 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10082 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10088 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10089 ! Derivatives in gamma(i+3)
10091 call transpose2(AEA(1,1,1),auxmatd(1,1))
10092 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10093 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
10094 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10096 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
10097 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10098 s2d = scalar2(b1(1,itk),vtemp1d(1))
10100 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10101 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10103 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10105 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10106 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10107 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10115 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
10116 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10118 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
10119 -0.5d0*ekont*(s2d+s12d)
10121 ! Derivatives in gamma(i+4)
10122 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10123 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10124 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10126 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10127 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10128 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10136 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10138 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10140 ! Derivatives in gamma(i+5)
10142 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10143 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10144 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10146 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
10147 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10148 s2d = scalar2(b1(1,itk),vtemp1d(1))
10150 call transpose2(AEA(1,1,2),atempd(1,1))
10151 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10152 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10154 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10155 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10157 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10158 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10159 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10167 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
10168 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10170 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
10171 -0.5d0*ekont*(s2d+s12d)
10173 ! Cartesian derivatives
10178 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10179 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10180 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10182 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
10183 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
10185 s2d = scalar2(b1(1,itk),vtemp1d(1))
10187 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10188 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10189 s8d = -(atempd(1,1)+atempd(2,2))* &
10190 scalar2(cc(1,1,itl),vtemp2(1))
10192 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
10194 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10195 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10202 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
10205 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
10209 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
10212 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
10221 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
10223 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10224 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10225 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10226 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10227 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
10229 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10230 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10231 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10235 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10236 !d & 16*eel_turn6_num
10238 if (j.lt.nres-1) then
10245 if (l.lt.nres-1) then
10253 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
10254 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
10255 !grad ghalf=0.5d0*ggg1(ll)
10257 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10258 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10259 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
10260 +ekont*derx_turn(ll,2,1)
10261 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10262 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
10263 +ekont*derx_turn(ll,4,1)
10264 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10265 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10266 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10267 !grad ghalf=0.5d0*ggg2(ll)
10269 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
10270 +ekont*derx_turn(ll,2,2)
10271 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10272 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
10273 +ekont*derx_turn(ll,4,2)
10274 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10275 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10276 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10281 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10286 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10292 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10297 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10301 !d write (2,*) iii,g_corr6_loc(iii)
10303 eello_turn6=ekont*eel_turn6
10304 !d write (2,*) 'ekont',ekont
10305 !d write (2,*) 'eel_turn6',ekont*eel_turn6
10307 end function eello_turn6
10308 !-----------------------------------------------------------------------------
10309 subroutine MATVEC2(A1,V1,V2)
10310 !DIR$ INLINEALWAYS MATVEC2
10312 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10314 ! implicit real*8 (a-h,o-z)
10315 ! include 'DIMENSIONS'
10316 real(kind=8),dimension(2) :: V1,V2
10317 real(kind=8),dimension(2,2) :: A1
10318 real(kind=8) :: vaux1,vaux2
10322 ! 3 VI=VI+A1(I,K)*V1(K)
10326 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10327 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10331 end subroutine MATVEC2
10332 !-----------------------------------------------------------------------------
10333 subroutine MATMAT2(A1,A2,A3)
10335 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10337 ! implicit real*8 (a-h,o-z)
10338 ! include 'DIMENSIONS'
10339 real(kind=8),dimension(2,2) :: A1,A2,A3
10340 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
10341 ! DIMENSION AI3(2,2)
10345 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
10351 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10352 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10353 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10354 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10360 end subroutine MATMAT2
10361 !-----------------------------------------------------------------------------
10362 real(kind=8) function scalar2(u,v)
10363 !DIR$ INLINEALWAYS scalar2
10365 real(kind=8),dimension(2) :: u,v
10368 scalar2=u(1)*v(1)+u(2)*v(2)
10370 end function scalar2
10371 !-----------------------------------------------------------------------------
10372 subroutine transpose2(a,at)
10373 !DIR$ INLINEALWAYS transpose2
10375 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
10378 real(kind=8),dimension(2,2) :: a,at
10384 end subroutine transpose2
10385 !-----------------------------------------------------------------------------
10386 subroutine transpose(n,a,at)
10389 real(kind=8),dimension(n,n) :: a,at
10396 end subroutine transpose
10397 !-----------------------------------------------------------------------------
10398 subroutine prodmat3(a1,a2,kk,transp,prod)
10399 !DIR$ INLINEALWAYS prodmat3
10401 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
10405 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
10407 !rc double precision auxmat(2,2),prod_(2,2)
10410 !rc call transpose2(kk(1,1),auxmat(1,1))
10411 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10412 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10414 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
10415 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10416 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
10417 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10418 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
10419 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10420 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
10421 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10424 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10425 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10427 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
10428 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10429 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
10430 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10431 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
10432 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10433 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
10434 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10437 ! call transpose2(a2(1,1),a2t(1,1))
10440 !rc print *,((prod_(i,j),i=1,2),j=1,2)
10441 !rc print *,((prod(i,j),i=1,2),j=1,2)
10444 end subroutine prodmat3
10445 !-----------------------------------------------------------------------------
10446 ! energy_p_new_barrier.F
10447 !-----------------------------------------------------------------------------
10448 subroutine sum_gradient
10449 ! implicit real*8 (a-h,o-z)
10450 use io_base, only: pdbout
10451 ! include 'DIMENSIONS'
10455 !MS$ATTRIBUTES C :: proc_proc
10461 real(kind=8),dimension(3,-1:nres) :: gradbufc,gradbufx,gradbufc_sum,&
10462 gloc_scbuf !(3,maxres)
10464 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
10466 !el local variables
10467 integer :: i,j,k,ierror,ierr
10468 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
10469 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
10470 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
10471 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
10472 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
10473 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
10474 gsccorr_max,gsccorrx_max,time00
10476 ! include 'COMMON.SETUP'
10477 ! include 'COMMON.IOUNITS'
10478 ! include 'COMMON.FFIELD'
10479 ! include 'COMMON.DERIV'
10480 ! include 'COMMON.INTERACT'
10481 ! include 'COMMON.SBRIDGE'
10482 ! include 'COMMON.CHAIN'
10483 ! include 'COMMON.VAR'
10484 ! include 'COMMON.CONTROL'
10485 ! include 'COMMON.TIME1'
10486 ! include 'COMMON.MAXGRAD'
10487 ! include 'COMMON.SCCOR'
10492 write (iout,*) "sum_gradient gvdwc, gvdwx"
10494 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10495 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
10505 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
10506 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
10507 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
10510 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
10511 ! in virtual-bond-vector coordinates
10514 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
10516 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
10517 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
10519 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
10521 ! write (iout,'(i5,3f10.5,2x,f10.5)')
10522 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
10524 write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
10526 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10527 i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
10528 (gvdwc_scpp(j,i),j=1,3)
10530 write (iout,*) "gelc_long gvdwpp gel_loc_long"
10532 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10533 i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
10534 (gelc_loc_long(j,i),j=1,3)
10541 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10542 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10543 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10544 wel_loc*gel_loc_long(j,i)+ &
10545 wcorr*gradcorr_long(j,i)+ &
10546 wcorr5*gradcorr5_long(j,i)+ &
10547 wcorr6*gradcorr6_long(j,i)+ &
10548 wturn6*gcorr6_turn_long(j,i)+ &
10549 wstrain*ghpbc(j,i) &
10550 +wliptran*gliptranc(j,i) &
10552 +welec*gshieldc(j,i) &
10553 +wcorr*gshieldc_ec(j,i) &
10554 +wturn3*gshieldc_t3(j,i)&
10555 +wturn4*gshieldc_t4(j,i)&
10556 +wel_loc*gshieldc_ll(j,i)&
10557 +wtube*gg_tube(j,i) &
10558 +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
10559 wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
10560 wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
10561 wcorr_nucl*gradcorr_nucl(j,i)&
10562 +wcorr3_nucl*gradcorr3_nucl(j,i)+&
10563 wcatprot* gradpepcat(j,i)+ &
10564 wcatcat*gradcatcat(j,i)+ &
10565 wscbase*gvdwc_scbase(j,i)+ &
10566 wpepbase*gvdwc_pepbase(j,i)+&
10567 wscpho*gvdwc_scpho(j,i)+ &
10568 wpeppho*gvdwc_peppho(j,i)
10579 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10580 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10581 welec*gelc_long(j,i)+ &
10582 wbond*gradb(j,i)+ &
10583 wel_loc*gel_loc_long(j,i)+ &
10584 wcorr*gradcorr_long(j,i)+ &
10585 wcorr5*gradcorr5_long(j,i)+ &
10586 wcorr6*gradcorr6_long(j,i)+ &
10587 wturn6*gcorr6_turn_long(j,i)+ &
10588 wstrain*ghpbc(j,i) &
10589 +wliptran*gliptranc(j,i) &
10591 +welec*gshieldc(j,i)&
10592 +wcorr*gshieldc_ec(j,i) &
10593 +wturn4*gshieldc_t4(j,i) &
10594 +wel_loc*gshieldc_ll(j,i)&
10595 +wtube*gg_tube(j,i) &
10596 +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
10597 wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
10598 wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
10599 wcorr_nucl*gradcorr_nucl(j,i) &
10600 +wcorr3_nucl*gradcorr3_nucl(j,i) +&
10601 wcatprot* gradpepcat(j,i)+ &
10602 wcatcat*gradcatcat(j,i)+ &
10603 wscbase*gvdwc_scbase(j,i) &
10604 wpepbase*gvdwc_pepbase(j,i)+&
10605 wscpho*gvdwc_scpho(j,i)+&
10606 wpeppho*gvdwc_peppho(j,i)
10613 if (nfgtasks.gt.1) then
10616 write (iout,*) "gradbufc before allreduce"
10618 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10624 gradbufc_sum(j,i)=gradbufc(j,i)
10627 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
10628 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
10629 ! time_reduce=time_reduce+MPI_Wtime()-time00
10631 ! write (iout,*) "gradbufc_sum after allreduce"
10633 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
10638 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
10642 gradbufc(k,i)=0.0d0
10646 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
10647 write (iout,*) (i," jgrad_start",jgrad_start(i),&
10648 " jgrad_end ",jgrad_end(i),&
10649 i=igrad_start,igrad_end)
10652 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
10653 ! do not parallelize this part.
10655 ! do i=igrad_start,igrad_end
10656 ! do j=jgrad_start(i),jgrad_end(i)
10658 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
10663 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10667 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10671 write (iout,*) "gradbufc after summing"
10673 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10681 write (iout,*) "gradbufc"
10683 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10690 gradbufc_sum(j,i)=gradbufc(j,i)
10691 gradbufc(j,i)=0.0d0
10695 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10699 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10704 ! gradbufc(k,i)=0.0d0
10708 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
10714 write (iout,*) "gradbufc after summing"
10716 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10725 gradbufc(k,nres)=0.0d0
10727 !el----------------
10728 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
10729 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
10730 !el-----------------
10734 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10735 wel_loc*gel_loc(j,i)+ &
10736 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10737 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10738 wel_loc*gel_loc_long(j,i)+ &
10739 wcorr*gradcorr_long(j,i)+ &
10740 wcorr5*gradcorr5_long(j,i)+ &
10741 wcorr6*gradcorr6_long(j,i)+ &
10742 wturn6*gcorr6_turn_long(j,i))+ &
10743 wbond*gradb(j,i)+ &
10744 wcorr*gradcorr(j,i)+ &
10745 wturn3*gcorr3_turn(j,i)+ &
10746 wturn4*gcorr4_turn(j,i)+ &
10747 wcorr5*gradcorr5(j,i)+ &
10748 wcorr6*gradcorr6(j,i)+ &
10749 wturn6*gcorr6_turn(j,i)+ &
10750 wsccor*gsccorc(j,i) &
10751 +wscloc*gscloc(j,i) &
10752 +wliptran*gliptranc(j,i) &
10754 +welec*gshieldc(j,i) &
10755 +welec*gshieldc_loc(j,i) &
10756 +wcorr*gshieldc_ec(j,i) &
10757 +wcorr*gshieldc_loc_ec(j,i) &
10758 +wturn3*gshieldc_t3(j,i) &
10759 +wturn3*gshieldc_loc_t3(j,i) &
10760 +wturn4*gshieldc_t4(j,i) &
10761 +wturn4*gshieldc_loc_t4(j,i) &
10762 +wel_loc*gshieldc_ll(j,i) &
10763 +wel_loc*gshieldc_loc_ll(j,i) &
10764 +wtube*gg_tube(j,i) &
10765 +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
10766 +wvdwpsb*gvdwpsb1(j,i))&
10767 +wbond_nucl*gradb_nucl(j,i)+wsbloc*gsbloc(j,i)
10769 ! if ((i.le.2).and.(i.ge.1))
10770 ! print *,gradc(j,i,icg),&
10771 ! gradbufc(j,i),welec*gelc(j,i), &
10772 ! wel_loc*gel_loc(j,i), &
10773 ! wscp*gvdwc_scpp(j,i), &
10774 ! welec*gelc_long(j,i),wvdwpp*gvdwpp(j,i), &
10775 ! wel_loc*gel_loc_long(j,i), &
10776 ! wcorr*gradcorr_long(j,i), &
10777 ! wcorr5*gradcorr5_long(j,i), &
10778 ! wcorr6*gradcorr6_long(j,i), &
10779 ! wturn6*gcorr6_turn_long(j,i), &
10780 ! wbond*gradb(j,i), &
10781 ! wcorr*gradcorr(j,i), &
10782 ! wturn3*gcorr3_turn(j,i), &
10783 ! wturn4*gcorr4_turn(j,i), &
10784 ! wcorr5*gradcorr5(j,i), &
10785 ! wcorr6*gradcorr6(j,i), &
10786 ! wturn6*gcorr6_turn(j,i), &
10787 ! wsccor*gsccorc(j,i) &
10788 ! ,wscloc*gscloc(j,i) &
10789 ! ,wliptran*gliptranc(j,i) &
10791 ! ,welec*gshieldc(j,i) &
10792 ! ,welec*gshieldc_loc(j,i) &
10793 ! ,wcorr*gshieldc_ec(j,i) &
10794 ! ,wcorr*gshieldc_loc_ec(j,i) &
10795 ! ,wturn3*gshieldc_t3(j,i) &
10796 ! ,wturn3*gshieldc_loc_t3(j,i) &
10797 ! ,wturn4*gshieldc_t4(j,i) &
10798 ! ,wturn4*gshieldc_loc_t4(j,i) &
10799 ! ,wel_loc*gshieldc_ll(j,i) &
10800 ! ,wel_loc*gshieldc_loc_ll(j,i) &
10801 ! ,wtube*gg_tube(j,i) &
10802 ! ,wbond_nucl*gradb_nucl(j,i) &
10803 ! ,wvdwpp_nucl*gvdwpp_nucl(j,i),welpp*gelpp(j,i),&
10804 ! wvdwpsb*gvdwpsb1(j,i)&
10805 ! ,wbond_nucl*gradb_nucl(j,i),wsbloc*gsbloc(j,i)
10809 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10810 wel_loc*gel_loc(j,i)+ &
10811 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10812 welec*gelc_long(j,i)+ &
10813 wel_loc*gel_loc_long(j,i)+ &
10814 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
10815 wcorr5*gradcorr5_long(j,i)+ &
10816 wcorr6*gradcorr6_long(j,i)+ &
10817 wturn6*gcorr6_turn_long(j,i))+ &
10818 wbond*gradb(j,i)+ &
10819 wcorr*gradcorr(j,i)+ &
10820 wturn3*gcorr3_turn(j,i)+ &
10821 wturn4*gcorr4_turn(j,i)+ &
10822 wcorr5*gradcorr5(j,i)+ &
10823 wcorr6*gradcorr6(j,i)+ &
10824 wturn6*gcorr6_turn(j,i)+ &
10825 wsccor*gsccorc(j,i) &
10826 +wscloc*gscloc(j,i) &
10828 +wliptran*gliptranc(j,i) &
10829 +welec*gshieldc(j,i) &
10830 +welec*gshieldc_loc(j,) &
10831 +wcorr*gshieldc_ec(j,i) &
10832 +wcorr*gshieldc_loc_ec(j,i) &
10833 +wturn3*gshieldc_t3(j,i) &
10834 +wturn3*gshieldc_loc_t3(j,i) &
10835 +wturn4*gshieldc_t4(j,i) &
10836 +wturn4*gshieldc_loc_t4(j,i) &
10837 +wel_loc*gshieldc_ll(j,i) &
10838 +wel_loc*gshieldc_loc_ll(j,i) &
10839 +wtube*gg_tube(j,i) &
10840 +wbond_nucl*gradb_nucl(j,i) &
10841 +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
10842 +wvdwpsb*gvdwpsb1(j,i))&
10843 +wsbloc*gsbloc(j,i)
10849 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
10850 wbond*gradbx(j,i)+ &
10851 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
10852 wsccor*gsccorx(j,i) &
10853 +wscloc*gsclocx(j,i) &
10854 +wliptran*gliptranx(j,i) &
10855 +welec*gshieldx(j,i) &
10856 +wcorr*gshieldx_ec(j,i) &
10857 +wturn3*gshieldx_t3(j,i) &
10858 +wturn4*gshieldx_t4(j,i) &
10859 +wel_loc*gshieldx_ll(j,i)&
10860 +wtube*gg_tube_sc(j,i) &
10861 +wbond_nucl*gradbx_nucl(j,i) &
10862 +wvdwsb*gvdwsbx(j,i) &
10863 +welsb*gelsbx(j,i) &
10864 +wcorr_nucl*gradxorr_nucl(j,i)&
10865 +wcorr3_nucl*gradxorr3_nucl(j,i) &
10866 +wsbloc*gsblocx(j,i) &
10867 +wcatprot* gradpepcatx(j,i)&
10868 +wscbase*gvdwx_scbase(j,i) &
10869 +wpepbase*gvdwx_pepbase(j,i)&
10870 +wscpho*gvdwx_scpho(j,i)
10871 ! if (i.eq.3) print *,"tu?", wscpho,gvdwx_scpho(j,i)
10876 write (iout,*) "gloc before adding corr"
10878 write (iout,*) i,gloc(i,icg)
10882 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
10883 +wcorr5*g_corr5_loc(i) &
10884 +wcorr6*g_corr6_loc(i) &
10885 +wturn4*gel_loc_turn4(i) &
10886 +wturn3*gel_loc_turn3(i) &
10887 +wturn6*gel_loc_turn6(i) &
10888 +wel_loc*gel_loc_loc(i)
10891 write (iout,*) "gloc after adding corr"
10893 write (iout,*) i,gloc(i,icg)
10897 if (nfgtasks.gt.1) then
10900 gradbufc(j,i)=gradc(j,i,icg)
10901 gradbufx(j,i)=gradx(j,i,icg)
10905 glocbuf(i)=gloc(i,icg)
10909 write (iout,*) "gloc_sc before reduce"
10912 write (iout,*) i,j,gloc_sc(j,i,icg)
10919 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
10923 call MPI_Barrier(FG_COMM,IERR)
10924 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
10926 call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,&
10927 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10928 call MPI_Reduce(gradbufx(1,0),gradx(1,0,icg),3*nres+3,&
10929 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10930 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
10931 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10932 time_reduce=time_reduce+MPI_Wtime()-time00
10933 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
10934 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10935 time_reduce=time_reduce+MPI_Wtime()-time00
10937 ! print *,"gradbuf",gradbufc(1,1),gradc(1,1,icg)
10939 write (iout,*) "gloc_sc after reduce"
10942 write (iout,*) i,j,gloc_sc(j,i,icg)
10948 write (iout,*) "gloc after reduce"
10950 write (iout,*) i,gloc(i,icg)
10955 if (gnorm_check) then
10957 ! Compute the maximum elements of the gradient
10960 gvdwc_scp_max=0.0d0
10967 gcorr3_turn_max=0.0d0
10968 gcorr4_turn_max=0.0d0
10969 gradcorr5_max=0.0d0
10970 gradcorr6_max=0.0d0
10971 gcorr6_turn_max=0.0d0
10975 gradx_scp_max=0.0d0
10981 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
10982 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
10983 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
10984 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
10985 gvdwc_scp_max=gvdwc_scp_norm
10986 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
10987 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
10988 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
10989 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
10990 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
10991 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
10992 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
10993 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
10994 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
10995 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
10996 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
10997 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
10998 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
11000 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
11001 gcorr3_turn_max=gcorr3_turn_norm
11002 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
11004 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
11005 gcorr4_turn_max=gcorr4_turn_norm
11006 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
11007 if (gradcorr5_norm.gt.gradcorr5_max) &
11008 gradcorr5_max=gradcorr5_norm
11009 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
11010 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
11011 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
11013 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
11014 gcorr6_turn_max=gcorr6_turn_norm
11015 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
11016 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
11017 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
11018 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
11019 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
11020 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
11021 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
11022 if (gradx_scp_norm.gt.gradx_scp_max) &
11023 gradx_scp_max=gradx_scp_norm
11024 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
11025 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
11026 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
11027 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
11028 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
11029 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
11030 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
11031 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
11035 open(istat,file=statname,position="append")
11037 open(istat,file=statname,access="append")
11039 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
11040 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
11041 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
11042 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
11043 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
11044 gsccorx_max,gsclocx_max
11046 if (gvdwc_max.gt.1.0d4) then
11047 write (iout,*) "gvdwc gvdwx gradb gradbx"
11049 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
11050 gradb(j,i),gradbx(j,i),j=1,3)
11052 call pdbout(0.0d0,'cipiszcze',iout)
11059 write (iout,*) "gradc gradx gloc"
11061 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
11062 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
11067 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
11070 end subroutine sum_gradient
11071 !-----------------------------------------------------------------------------
11073 ! implicit real*8 (a-h,o-z)
11075 ! include 'DIMENSIONS'
11076 ! include 'COMMON.CHAIN'
11077 ! include 'COMMON.DERIV'
11078 ! include 'COMMON.CALC'
11079 ! include 'COMMON.IOUNITS'
11080 real(kind=8), dimension(3) :: dcosom1,dcosom2
11081 ! print *,"wchodze"
11082 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 &
11083 +dCAVdOM1+ dGCLdOM1+ dPOLdOM1
11084 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 &
11085 +dCAVdOM2+ dGCLdOM2+ dPOLdOM2
11087 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
11088 -2.0D0*alf12*eps3der+sigder*sigsq_om12&
11089 +dCAVdOM12+ dGCLdOM12
11093 ! eom12=evdwij*eps1_om12
11095 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
11097 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
11098 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
11099 !C print *,sss_ele_cut,'in sc_grad'
11101 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
11102 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
11105 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
11106 !C print *,'gg',k,gg(k)
11108 ! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
11109 ! write (iout,*) "gg",(gg(k),k=1,3)
11111 gvdwx(k,i)=gvdwx(k,i)-gg(k) +gg_lipi(k)&
11112 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
11113 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
11116 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)&
11117 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
11118 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv &
11121 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
11122 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
11123 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
11124 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
11127 ! Calculate the components of the gradient in DC and X
11131 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
11135 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
11136 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
11139 end subroutine sc_grad
11141 !-----------------------------------------------------------------------------
11142 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
11145 ! implicit real*8 (a-h,o-z)
11146 ! include 'DIMENSIONS'
11147 ! include 'COMMON.LOCAL'
11148 ! include 'COMMON.IOUNITS'
11149 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
11150 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
11151 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
11152 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
11153 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
11155 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
11156 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
11157 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
11158 !el local variables
11160 delthec=thetai-thet_pred_mean
11161 delthe0=thetai-theta0i
11162 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
11163 t3 = thetai-thet_pred_mean
11167 t14 = t12+t6*sigsqtc
11169 t21 = thetai-theta0i
11175 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
11176 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
11177 *(-t12*t9-ak*sig0inv*t27)
11179 end subroutine mixder
11181 !-----------------------------------------------------------------------------
11183 !-----------------------------------------------------------------------------
11185 !-----------------------------------------------------------------------------
11186 ! This subroutine calculates the derivatives of the consecutive virtual
11187 ! bond vectors and the SC vectors in the virtual-bond angles theta and
11188 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
11189 ! in the angles alpha and omega, describing the location of a side chain
11190 ! in its local coordinate system.
11192 ! The derivatives are stored in the following arrays:
11194 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
11195 ! The structure is as follows:
11197 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
11198 ! dDC(x,3)/dT(4),...,dDC(z,3)/dT(4),dDC(x,3)/dP(4),dDC(y,4)/dP(4),dDC(z,4)/dP(4)
11199 ! . . . . . . . . . . . . . . . . . .
11200 ! dDC(x,N-1)/dT(4),...,dDC(z,N-1)/dT(4),dDC(x,N-1)/dP(4),dDC(y,N-1)/dP(4),dDC(z,N-1)/dP(4)
11204 ! dDC(x,N-1)/dT(N),...,dDC(z,N-1)/dT(N),dDC(x,N-1)/dP(N),dDC(y,N-1)/dP(N),dDC(z,N-1)/dP(N)
11206 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
11207 ! The structure is same as above.
11209 ! DCDS - the derivatives of the side chain vectors in the local spherical
11210 ! andgles alph and omega:
11212 ! dX(x,2)/dA(2),dX(y,2)/dA(2),dX(z,2)/dA(2),dX(x,2)/dO(2),dX(y,2)/dO(2),dX(z,2)/dO(2)
11213 ! dX(x,3)/dA(3),dX(y,3)/dA(3),dX(z,3)/dA(3),dX(x,3)/dO(3),dX(y,3)/dO(3),dX(z,3)/dO(3)
11217 ! dX(x,N-1)/dA(N-1),dX(y,N-1)/dA(N-1),dX(z,N-1)/dA(N-1),dX(x,N-1)/dO(N-1),dX(y,N-1)/dO(N-1),dX(z,N-1)/dO(N-1)
11219 ! Version of March '95, based on an early version of November '91.
11221 !**********************************************************************
11222 ! implicit real*8 (a-h,o-z)
11223 ! include 'DIMENSIONS'
11224 ! include 'COMMON.VAR'
11225 ! include 'COMMON.CHAIN'
11226 ! include 'COMMON.DERIV'
11227 ! include 'COMMON.GEO'
11228 ! include 'COMMON.LOCAL'
11229 ! include 'COMMON.INTERACT'
11230 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
11231 real(kind=8),dimension(3,3) :: dp,temp
11232 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
11233 real(kind=8),dimension(3) :: xx,xx1
11234 !el local variables
11235 integer :: i,k,l,j,m,ind,ind1,jjj
11236 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
11237 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
11238 sint2,xp,yp,xxp,yyp,zzp,dj
11240 ! common /przechowalnia/ fromto
11241 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
11242 ! get the position of the jth ijth fragment of the chain coordinate system
11243 ! in the fromto array.
11244 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
11246 ! maxdim=(nres-1)*(nres-2)/2
11247 ! allocate(dcdv(6,maxdim),dxds(6,nres))
11248 ! calculate the derivatives of transformation matrix elements in theta
11251 !el call flush(iout) !el
11253 rdt(1,1,i)=-rt(1,2,i)
11254 rdt(1,2,i)= rt(1,1,i)
11256 rdt(2,1,i)=-rt(2,2,i)
11257 rdt(2,2,i)= rt(2,1,i)
11259 rdt(3,1,i)=-rt(3,2,i)
11260 rdt(3,2,i)= rt(3,1,i)
11264 ! derivatives in phi
11270 drt(2,1,i)= rt(3,1,i)
11271 drt(2,2,i)= rt(3,2,i)
11272 drt(2,3,i)= rt(3,3,i)
11273 drt(3,1,i)=-rt(2,1,i)
11274 drt(3,2,i)=-rt(2,2,i)
11275 drt(3,3,i)=-rt(2,3,i)
11278 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
11284 temp(k,l)=rt(k,l,i)
11289 fromto(k,l,ind)=temp(k,l)
11298 dpkl=dpkl+temp(k,m)*rt(m,l,j)
11301 fromto(k,l,ind)=dpkl
11312 ! Calculate derivatives.
11318 ! Derivatives of DC(i+1) in theta(i+2)
11324 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
11327 prordt(j,k,i)=dp(j,k)
11330 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
11333 ! Derivatives of SC(i+1) in theta(i+2)
11335 xx1(1)=-0.5D0*xloc(2,i+1)
11336 xx1(2)= 0.5D0*xloc(1,i+1)
11340 xj=xj+r(j,k,i)*xx1(k)
11347 rj=rj+prod(j,k,i)*xx(k)
11352 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
11353 ! than the other off-diagonal derivatives.
11358 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
11360 dxdv(j,ind1+1)=dxoiij
11362 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
11364 ! Derivatives of DC(i+1) in phi(i+2)
11370 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
11373 prodrt(j,k,i)=dp(j,k)
11375 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
11378 ! Derivatives of SC(i+1) in phi(i+2)
11381 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
11382 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
11386 rj=rj+prod(j,k,i)*xx(k)
11391 ! Derivatives of SC(i+1) in phi(i+3).
11396 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
11398 dxdv(j+3,ind1+1)=dxoiij
11401 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
11402 ! theta(nres) and phi(i+3) thru phi(nres).
11406 ind=indmat(i+1,j+1)
11407 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
11412 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
11417 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
11418 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
11419 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
11420 ! Derivatives of virtual-bond vectors in theta
11422 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
11424 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
11425 ! Derivatives of SC vectors in theta
11429 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
11431 dxdv(k,ind1+1)=dxoijk
11434 !--- Calculate the derivatives in phi
11440 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
11446 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
11451 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
11453 dxdv(k+3,ind1+1)=dxoijk
11458 ! Derivatives in alpha and omega:
11461 ! dsci=dsc(itype(i,1))
11466 if(alphi.ne.alphi) alphi=100.0
11467 if(omegi.ne.omegi) omegi=-100.0
11472 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
11473 cosalphi=dcos(alphi)
11474 sinalphi=dsin(alphi)
11475 cosomegi=dcos(omegi)
11476 sinomegi=dsin(omegi)
11477 temp(1,1)=-dsci*sinalphi
11478 temp(2,1)= dsci*cosalphi*cosomegi
11479 temp(3,1)=-dsci*cosalphi*sinomegi
11481 temp(2,2)=-dsci*sinalphi*sinomegi
11482 temp(3,2)=-dsci*sinalphi*cosomegi
11483 theta2=pi-0.5D0*theta(i+1)
11487 !d print *,((temp(l,k),l=1,3),k=1,2)
11491 xxp= xp*cost2+yp*sint2
11492 yyp=-xp*sint2+yp*cost2
11495 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
11496 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
11500 dj=dj+prod(k,l,i-1)*xx(l)
11508 end subroutine cartder
11509 !-----------------------------------------------------------------------------
11511 !-----------------------------------------------------------------------------
11512 subroutine check_cartgrad
11513 ! Check the gradient of Cartesian coordinates in internal coordinates.
11514 ! implicit real*8 (a-h,o-z)
11515 ! include 'DIMENSIONS'
11516 ! include 'COMMON.IOUNITS'
11517 ! include 'COMMON.VAR'
11518 ! include 'COMMON.CHAIN'
11519 ! include 'COMMON.GEO'
11520 ! include 'COMMON.LOCAL'
11521 ! include 'COMMON.DERIV'
11522 real(kind=8),dimension(6,nres) :: temp
11523 real(kind=8),dimension(3) :: xx,gg
11524 integer :: i,k,j,ii
11525 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
11526 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
11528 ! Check the gradient of the virtual-bond and SC vectors in the internal
11534 write (iout,'(a)') '**************** dx/dalpha'
11538 alph(i)=alph(i)+aincr
11540 temp(k,i)=dc(k,nres+i)
11544 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11545 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
11547 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11548 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
11554 write (iout,'(a)') '**************** dx/domega'
11558 omeg(i)=omeg(i)+aincr
11560 temp(k,i)=dc(k,nres+i)
11564 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11565 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
11566 (aincr*dabs(dxds(k+3,i))+aincr))
11568 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11569 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
11575 write (iout,'(a)') '**************** dx/dtheta'
11579 theta(i)=theta(i)+aincr
11582 temp(k,j)=dc(k,nres+j)
11588 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
11590 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11591 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
11592 (aincr*dabs(dxdv(k,ii))+aincr))
11594 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11595 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
11602 write (iout,'(a)') '***************** dx/dphi'
11605 phi(i)=phi(i)+aincr
11608 temp(k,j)=dc(k,nres+j)
11616 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11617 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
11618 (aincr*dabs(dxdv(k+3,ii))+aincr))
11620 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11621 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11624 phi(i)=phi(i)-aincr
11627 write (iout,'(a)') '****************** ddc/dtheta'
11630 theta(i+2)=thet+aincr
11641 gg(k)=(dc(k,j)-temp(k,j))/aincr
11642 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
11643 (aincr*dabs(dcdv(k,ii))+aincr))
11645 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11646 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
11656 write (iout,'(a)') '******************* ddc/dphi'
11659 phi(i+3)=phii+aincr
11670 gg(k)=(dc(k,j)-temp(k,j))/aincr
11671 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
11672 (aincr*dabs(dcdv(k+3,ii))+aincr))
11674 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11675 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11686 end subroutine check_cartgrad
11687 !-----------------------------------------------------------------------------
11688 subroutine check_ecart
11689 ! Check the gradient of the energy in Cartesian coordinates.
11690 ! implicit real*8 (a-h,o-z)
11691 ! include 'DIMENSIONS'
11692 ! include 'COMMON.CHAIN'
11693 ! include 'COMMON.DERIV'
11694 ! include 'COMMON.IOUNITS'
11695 ! include 'COMMON.VAR'
11696 ! include 'COMMON.CONTACTS'
11698 !el integer :: icall
11699 !el common /srutu/ icall
11700 real(kind=8),dimension(6) :: ggg
11701 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
11702 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11703 real(kind=8),dimension(6,nres) :: grad_s
11704 real(kind=8),dimension(0:n_ene) :: energia,energia1
11705 integer :: uiparm(1)
11706 real(kind=8) :: urparm(1)
11708 integer :: nf,i,j,k
11709 real(kind=8) :: aincr,etot,etot1
11715 print '(a)','CG processor',me,' calling CHECK_CART.',aincr
11718 call geom_to_var(nvar,x)
11719 call etotal(energia)
11721 !el call enerprint(energia)
11722 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
11725 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11729 grad_s(j,i)=gradc(j,i,icg)
11730 grad_s(j+3,i)=gradx(j,i,icg)
11734 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11739 ddx(j)=dc(j,i+nres)
11742 dc(j,i)=dc(j,i)+aincr
11744 c(j,k)=c(j,k)+aincr
11745 c(j,k+nres)=c(j,k+nres)+aincr
11747 call etotal(energia1)
11749 ggg(j)=(etot1-etot)/aincr
11752 c(j,k)=c(j,k)-aincr
11753 c(j,k+nres)=c(j,k+nres)-aincr
11757 c(j,i+nres)=c(j,i+nres)+aincr
11758 dc(j,i+nres)=dc(j,i+nres)+aincr
11759 call etotal(energia1)
11761 ggg(j+3)=(etot1-etot)/aincr
11763 dc(j,i+nres)=ddx(j)
11765 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
11766 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
11769 end subroutine check_ecart
11771 !-----------------------------------------------------------------------------
11772 subroutine check_ecartint
11773 ! Check the gradient of the energy in Cartesian coordinates.
11774 use io_base, only: intout
11775 ! implicit real*8 (a-h,o-z)
11776 ! include 'DIMENSIONS'
11777 ! include 'COMMON.CONTROL'
11778 ! include 'COMMON.CHAIN'
11779 ! include 'COMMON.DERIV'
11780 ! include 'COMMON.IOUNITS'
11781 ! include 'COMMON.VAR'
11782 ! include 'COMMON.CONTACTS'
11783 ! include 'COMMON.MD'
11784 ! include 'COMMON.LOCAL'
11785 ! include 'COMMON.SPLITELE'
11787 !el integer :: icall
11788 !el common /srutu/ icall
11789 real(kind=8),dimension(6) :: ggg,ggg1
11790 real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
11791 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11792 real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
11793 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
11794 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
11795 real(kind=8),dimension(0:n_ene) :: energia,energia1
11796 integer :: uiparm(1)
11797 real(kind=8) :: urparm(1)
11799 integer :: i,j,k,nf
11800 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
11808 ! call intcartderiv
11809 ! call checkintcartgrad
11812 write(iout,*) 'Calling CHECK_ECARTINT.'
11815 call geom_to_var(nvar,x)
11816 write (iout,*) "split_ene ",split_ene
11818 if (.not.split_ene) then
11819 call etotal(energia)
11824 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11827 grad_s(j,0)=gcart(j,0)
11831 grad_s(j,i)=gcart(j,i)
11832 grad_s(j+3,i)=gxcart(j,i)
11836 !- split gradient check
11838 call etotal_long(energia)
11839 !el call enerprint(energia)
11843 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11844 (gxcart(j,i),j=1,3)
11847 grad_s(j,0)=gcart(j,0)
11851 grad_s(j,i)=gcart(j,i)
11852 grad_s(j+3,i)=gxcart(j,i)
11856 call etotal_short(energia)
11857 call enerprint(energia)
11861 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11862 (gxcart(j,i),j=1,3)
11865 grad_s1(j,0)=gcart(j,0)
11869 grad_s1(j,i)=gcart(j,i)
11870 grad_s1(j+3,i)=gxcart(j,i)
11874 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11878 if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
11879 if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
11882 dcnorm_safe1(j)=dc_norm(j,i-1)
11883 dcnorm_safe2(j)=dc_norm(j,i)
11884 dxnorm_safe(j)=dc_norm(j,i+nres)
11887 c(j,i)=ddc(j)+aincr
11888 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
11889 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
11890 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11891 dc(j,i)=c(j,i+1)-c(j,i)
11892 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11893 call int_from_cart1(.false.)
11894 if (.not.split_ene) then
11895 call etotal(energia1)
11897 write (iout,*) "ij",i,j," etot1",etot1
11900 call etotal_long(energia1)
11902 call etotal_short(energia1)
11905 !- end split gradient
11906 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11907 c(j,i)=ddc(j)-aincr
11908 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
11909 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
11910 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11911 dc(j,i)=c(j,i+1)-c(j,i)
11912 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11913 call int_from_cart1(.false.)
11914 if (.not.split_ene) then
11915 call etotal(energia1)
11917 write (iout,*) "ij",i,j," etot2",etot2
11918 ggg(j)=(etot1-etot2)/(2*aincr)
11921 call etotal_long(energia1)
11923 ggg(j)=(etot11-etot21)/(2*aincr)
11924 call etotal_short(energia1)
11926 ggg1(j)=(etot12-etot22)/(2*aincr)
11927 !- end split gradient
11928 ! write (iout,*) "etot21",etot21," etot22",etot22
11930 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11932 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
11933 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
11934 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11935 dc(j,i)=c(j,i+1)-c(j,i)
11936 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11937 dc_norm(j,i-1)=dcnorm_safe1(j)
11938 dc_norm(j,i)=dcnorm_safe2(j)
11939 dc_norm(j,i+nres)=dxnorm_safe(j)
11942 c(j,i+nres)=ddx(j)+aincr
11943 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11944 call int_from_cart1(.false.)
11945 if (.not.split_ene) then
11946 call etotal(energia1)
11950 call etotal_long(energia1)
11952 call etotal_short(energia1)
11955 !- end split gradient
11956 c(j,i+nres)=ddx(j)-aincr
11957 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11958 call int_from_cart1(.false.)
11959 if (.not.split_ene) then
11960 call etotal(energia1)
11962 ggg(j+3)=(etot1-etot2)/(2*aincr)
11965 call etotal_long(energia1)
11967 ggg(j+3)=(etot11-etot21)/(2*aincr)
11968 call etotal_short(energia1)
11970 ggg1(j+3)=(etot12-etot22)/(2*aincr)
11971 !- end split gradient
11973 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11975 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11976 dc_norm(j,i+nres)=dxnorm_safe(j)
11977 call int_from_cart1(.false.)
11979 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11980 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
11981 if (split_ene) then
11982 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11983 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
11985 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11986 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
11987 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
11991 end subroutine check_ecartint
11993 !-----------------------------------------------------------------------------
11994 subroutine check_ecartint
11995 ! Check the gradient of the energy in Cartesian coordinates.
11996 use io_base, only: intout
11997 ! implicit real*8 (a-h,o-z)
11998 ! include 'DIMENSIONS'
11999 ! include 'COMMON.CONTROL'
12000 ! include 'COMMON.CHAIN'
12001 ! include 'COMMON.DERIV'
12002 ! include 'COMMON.IOUNITS'
12003 ! include 'COMMON.VAR'
12004 ! include 'COMMON.CONTACTS'
12005 ! include 'COMMON.MD'
12006 ! include 'COMMON.LOCAL'
12007 ! include 'COMMON.SPLITELE'
12009 !el integer :: icall
12010 !el common /srutu/ icall
12011 real(kind=8),dimension(6) :: ggg,ggg1
12012 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
12013 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
12014 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
12015 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
12016 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
12017 real(kind=8),dimension(0:n_ene) :: energia,energia1
12018 integer :: uiparm(1)
12019 real(kind=8) :: urparm(1)
12021 integer :: i,j,k,nf
12022 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
12030 ! call intcartderiv
12031 ! call checkintcartgrad
12034 write(iout,*) 'Calling CHECK_ECARTINT.',aincr
12037 call geom_to_var(nvar,x)
12038 if (.not.split_ene) then
12039 call etotal(energia)
12041 !el call enerprint(energia)
12045 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
12048 grad_s(j,0)=gcart(j,0)
12052 grad_s(j,i)=gcart(j,i)
12053 ! if (i.le.2) print *,"tu?!",gcart(j,i),grad_s(j,i),gxcart(j,i)
12054 grad_s(j+3,i)=gxcart(j,i)
12058 !- split gradient check
12060 call etotal_long(energia)
12061 !el call enerprint(energia)
12065 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12066 (gxcart(j,i),j=1,3)
12069 grad_s(j,0)=gcart(j,0)
12073 grad_s(j,i)=gcart(j,i)
12074 grad_s(j+3,i)=gxcart(j,i)
12078 call etotal_short(energia)
12079 !el call enerprint(energia)
12083 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12084 (gxcart(j,i),j=1,3)
12087 grad_s1(j,0)=gcart(j,0)
12091 grad_s1(j,i)=gcart(j,i)
12092 grad_s1(j+3,i)=gxcart(j,i)
12096 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
12101 ddx(j)=dc(j,i+nres)
12103 dcnorm_safe(k)=dc_norm(k,i)
12104 dxnorm_safe(k)=dc_norm(k,i+nres)
12108 dc(j,i)=ddc(j)+aincr
12109 call chainbuild_cart
12111 ! Broadcast the order to compute internal coordinates to the slaves.
12112 ! if (nfgtasks.gt.1)
12113 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
12115 ! call int_from_cart1(.false.)
12116 if (.not.split_ene) then
12117 call etotal(energia1)
12119 ! call enerprint(energia1)
12122 call etotal_long(energia1)
12124 call etotal_short(energia1)
12126 ! write (iout,*) "etot11",etot11," etot12",etot12
12128 !- end split gradient
12129 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12130 dc(j,i)=ddc(j)-aincr
12131 call chainbuild_cart
12132 ! call int_from_cart1(.false.)
12133 if (.not.split_ene) then
12134 call etotal(energia1)
12136 ggg(j)=(etot1-etot2)/(2*aincr)
12139 call etotal_long(energia1)
12141 ggg(j)=(etot11-etot21)/(2*aincr)
12142 call etotal_short(energia1)
12144 ggg1(j)=(etot12-etot22)/(2*aincr)
12145 !- end split gradient
12146 ! write (iout,*) "etot21",etot21," etot22",etot22
12148 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12150 call chainbuild_cart
12153 dc(j,i+nres)=ddx(j)+aincr
12154 call chainbuild_cart
12155 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
12156 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
12157 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
12158 ! write (iout,*) "dxnormnorm",dsqrt(
12159 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
12160 ! write (iout,*) "dxnormnormsafe",dsqrt(
12161 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
12163 if (.not.split_ene) then
12164 call etotal(energia1)
12168 call etotal_long(energia1)
12170 call etotal_short(energia1)
12173 !- end split gradient
12174 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12175 dc(j,i+nres)=ddx(j)-aincr
12176 call chainbuild_cart
12177 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
12178 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
12179 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
12181 ! write (iout,*) "dxnormnorm",dsqrt(
12182 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
12183 ! write (iout,*) "dxnormnormsafe",dsqrt(
12184 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
12185 if (.not.split_ene) then
12186 call etotal(energia1)
12188 ggg(j+3)=(etot1-etot2)/(2*aincr)
12191 call etotal_long(energia1)
12193 ggg(j+3)=(etot11-etot21)/(2*aincr)
12194 call etotal_short(energia1)
12196 ggg1(j+3)=(etot12-etot22)/(2*aincr)
12197 !- end split gradient
12199 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12200 dc(j,i+nres)=ddx(j)
12201 call chainbuild_cart
12203 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12204 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
12205 if (split_ene) then
12206 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12207 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
12209 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12210 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
12211 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
12215 end subroutine check_ecartint
12217 !-----------------------------------------------------------------------------
12218 subroutine check_eint
12219 ! Check the gradient of energy in internal coordinates.
12220 ! implicit real*8 (a-h,o-z)
12221 ! include 'DIMENSIONS'
12222 ! include 'COMMON.CHAIN'
12223 ! include 'COMMON.DERIV'
12224 ! include 'COMMON.IOUNITS'
12225 ! include 'COMMON.VAR'
12226 ! include 'COMMON.GEO'
12228 !el integer :: icall
12229 !el common /srutu/ icall
12230 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
12231 integer :: uiparm(1)
12232 real(kind=8) :: urparm(1)
12233 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
12234 character(len=6) :: key
12237 real(kind=8) :: xi,aincr,etot,etot1,etot2
12240 print '(a)','Calling CHECK_INT.'
12244 call geom_to_var(nvar,x)
12245 call var_to_geom(nvar,x)
12248 ! print *,'ICG=',ICG
12249 call etotal(energia)
12251 !el call enerprint(energia)
12252 ! print *,'ICG=',ICG
12254 if (MyID.ne.BossID) then
12255 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
12263 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
12264 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
12265 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
12269 x(i)=xi-0.5D0*aincr
12270 call var_to_geom(nvar,x)
12272 call etotal(energia1)
12274 x(i)=xi+0.5D0*aincr
12275 call var_to_geom(nvar,x)
12277 call etotal(energia2)
12279 gg(i)=(etot2-etot1)/aincr
12280 write (iout,*) i,etot1,etot2
12283 write (iout,'(/2a)')' Variable Numerical Analytical',&
12286 if (i.le.nphi) then
12289 else if (i.le.nphi+ntheta) then
12292 else if (i.le.nphi+ntheta+nside) then
12296 ii=i-(nphi+ntheta+nside)
12299 write (iout,'(i3,a,i3,3(1pd16.6))') &
12300 i,key,ii,gg(i),gana(i),&
12301 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
12304 end subroutine check_eint
12305 !-----------------------------------------------------------------------------
12307 !-----------------------------------------------------------------------------
12308 subroutine Econstr_back
12309 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
12310 ! implicit real*8 (a-h,o-z)
12311 ! include 'DIMENSIONS'
12312 ! include 'COMMON.CONTROL'
12313 ! include 'COMMON.VAR'
12314 ! include 'COMMON.MD'
12317 ! include 'COMMON.LANGEVIN'
12319 ! include 'COMMON.LANGEVIN.lang0'
12321 ! include 'COMMON.CHAIN'
12322 ! include 'COMMON.DERIV'
12323 ! include 'COMMON.GEO'
12324 ! include 'COMMON.LOCAL'
12325 ! include 'COMMON.INTERACT'
12326 ! include 'COMMON.IOUNITS'
12327 ! include 'COMMON.NAMES'
12328 ! include 'COMMON.TIME1'
12329 integer :: i,j,ii,k
12330 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
12332 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
12333 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
12334 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
12341 duscdiff(j,i)=0.0d0
12342 duscdiffx(j,i)=0.0d0
12346 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
12348 ! Deviations from theta angles
12351 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
12352 dtheta_i=theta(j)-thetaref(j)
12353 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
12354 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
12356 utheta(i)=utheta_i/(ii-1)
12358 ! Deviations from gamma angles
12361 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
12362 dgamma_i=pinorm(phi(j)-phiref(j))
12363 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
12364 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
12365 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
12366 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
12368 ugamma(i)=ugamma_i/(ii-2)
12370 ! Deviations from local SC geometry
12373 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
12374 dxx=xxtab(j)-xxref(j)
12375 dyy=yytab(j)-yyref(j)
12376 dzz=zztab(j)-zzref(j)
12377 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
12379 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
12380 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
12382 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
12383 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
12385 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
12386 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
12389 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
12390 ! & xxref(j),yyref(j),zzref(j)
12392 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
12393 ! write (iout,*) i," uscdiff",uscdiff(i)
12395 ! Put together deviations from local geometry
12397 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
12398 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
12399 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
12400 ! & " uconst_back",uconst_back
12401 utheta(i)=dsqrt(utheta(i))
12402 ugamma(i)=dsqrt(ugamma(i))
12403 uscdiff(i)=dsqrt(uscdiff(i))
12406 end subroutine Econstr_back
12407 !-----------------------------------------------------------------------------
12408 ! energy_p_new-sep_barrier.F
12409 !-----------------------------------------------------------------------------
12410 real(kind=8) function sscale(r)
12411 ! include "COMMON.SPLITELE"
12412 real(kind=8) :: r,gamm
12413 if(r.lt.r_cut-rlamb) then
12415 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
12416 gamm=(r-(r_cut-rlamb))/rlamb
12417 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12422 end function sscale
12423 real(kind=8) function sscale_grad(r)
12424 ! include "COMMON.SPLITELE"
12425 real(kind=8) :: r,gamm
12426 if(r.lt.r_cut-rlamb) then
12428 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
12429 gamm=(r-(r_cut-rlamb))/rlamb
12430 sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
12435 end function sscale_grad
12437 !!!!!!!!!! PBCSCALE
12438 real(kind=8) function sscale_ele(r)
12439 ! include "COMMON.SPLITELE"
12440 real(kind=8) :: r,gamm
12441 if(r.lt.r_cut_ele-rlamb_ele) then
12443 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12444 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12445 sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12450 end function sscale_ele
12452 real(kind=8) function sscagrad_ele(r)
12453 real(kind=8) :: r,gamm
12454 ! include "COMMON.SPLITELE"
12455 if(r.lt.r_cut_ele-rlamb_ele) then
12457 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12458 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12459 sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
12464 end function sscagrad_ele
12465 real(kind=8) function sscalelip(r)
12466 real(kind=8) r,gamm
12467 sscalelip=1.0d0+r*r*(2.0d0*r-3.0d0)
12469 end function sscalelip
12470 !C-----------------------------------------------------------------------
12471 real(kind=8) function sscagradlip(r)
12472 real(kind=8) r,gamm
12473 sscagradlip=r*(6.0d0*r-6.0d0)
12475 end function sscagradlip
12478 !-----------------------------------------------------------------------------
12479 subroutine elj_long(evdw)
12481 ! This subroutine calculates the interaction energy of nonbonded side chains
12482 ! assuming the LJ potential of interaction.
12484 ! implicit real*8 (a-h,o-z)
12485 ! include 'DIMENSIONS'
12486 ! include 'COMMON.GEO'
12487 ! include 'COMMON.VAR'
12488 ! include 'COMMON.LOCAL'
12489 ! include 'COMMON.CHAIN'
12490 ! include 'COMMON.DERIV'
12491 ! include 'COMMON.INTERACT'
12492 ! include 'COMMON.TORSION'
12493 ! include 'COMMON.SBRIDGE'
12494 ! include 'COMMON.NAMES'
12495 ! include 'COMMON.IOUNITS'
12496 ! include 'COMMON.CONTACTS'
12497 real(kind=8),parameter :: accur=1.0d-10
12498 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12499 !el local variables
12500 integer :: i,iint,j,k,itypi,itypi1,itypj
12501 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12502 real(kind=8) :: e1,e2,evdwij,evdw
12503 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12505 do i=iatsc_s,iatsc_e
12507 if (itypi.eq.ntyp1) cycle
12508 itypi1=itype(i+1,1)
12513 ! Calculate SC interaction energy.
12515 do iint=1,nint_gr(i)
12516 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12517 !d & 'iend=',iend(i,iint)
12518 do j=istart(i,iint),iend(i,iint)
12520 if (itypj.eq.ntyp1) cycle
12524 rij=xj*xj+yj*yj+zj*zj
12525 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12526 if (sss.lt.1.0d0) then
12528 eps0ij=eps(itypi,itypj)
12530 e1=fac*fac*aa_aq(itypi,itypj)
12531 e2=fac*bb_aq(itypi,itypj)
12533 evdw=evdw+(1.0d0-sss)*evdwij
12535 ! Calculate the components of the gradient in DC and X
12537 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
12542 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12543 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12544 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12545 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12553 gvdwc(j,i)=expon*gvdwc(j,i)
12554 gvdwx(j,i)=expon*gvdwx(j,i)
12557 !******************************************************************************
12561 ! To save time, the factor of EXPON has been extracted from ALL components
12562 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12565 !******************************************************************************
12567 end subroutine elj_long
12568 !-----------------------------------------------------------------------------
12569 subroutine elj_short(evdw)
12571 ! This subroutine calculates the interaction energy of nonbonded side chains
12572 ! assuming the LJ potential of interaction.
12574 ! implicit real*8 (a-h,o-z)
12575 ! include 'DIMENSIONS'
12576 ! include 'COMMON.GEO'
12577 ! include 'COMMON.VAR'
12578 ! include 'COMMON.LOCAL'
12579 ! include 'COMMON.CHAIN'
12580 ! include 'COMMON.DERIV'
12581 ! include 'COMMON.INTERACT'
12582 ! include 'COMMON.TORSION'
12583 ! include 'COMMON.SBRIDGE'
12584 ! include 'COMMON.NAMES'
12585 ! include 'COMMON.IOUNITS'
12586 ! include 'COMMON.CONTACTS'
12587 real(kind=8),parameter :: accur=1.0d-10
12588 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12589 !el local variables
12590 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
12591 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12592 real(kind=8) :: e1,e2,evdwij,evdw
12593 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12595 do i=iatsc_s,iatsc_e
12597 if (itypi.eq.ntyp1) cycle
12598 itypi1=itype(i+1,1)
12605 ! Calculate SC interaction energy.
12607 do iint=1,nint_gr(i)
12608 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12609 !d & 'iend=',iend(i,iint)
12610 do j=istart(i,iint),iend(i,iint)
12612 if (itypj.eq.ntyp1) cycle
12616 ! Change 12/1/95 to calculate four-body interactions
12617 rij=xj*xj+yj*yj+zj*zj
12618 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12619 if (sss.gt.0.0d0) then
12621 eps0ij=eps(itypi,itypj)
12623 e1=fac*fac*aa_aq(itypi,itypj)
12624 e2=fac*bb_aq(itypi,itypj)
12626 evdw=evdw+sss*evdwij
12628 ! Calculate the components of the gradient in DC and X
12630 fac=-rrij*(e1+evdwij)*sss
12635 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12636 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12637 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12638 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12646 gvdwc(j,i)=expon*gvdwc(j,i)
12647 gvdwx(j,i)=expon*gvdwx(j,i)
12650 !******************************************************************************
12654 ! To save time, the factor of EXPON has been extracted from ALL components
12655 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12658 !******************************************************************************
12660 end subroutine elj_short
12661 !-----------------------------------------------------------------------------
12662 subroutine eljk_long(evdw)
12664 ! This subroutine calculates the interaction energy of nonbonded side chains
12665 ! assuming the LJK potential of interaction.
12667 ! implicit real*8 (a-h,o-z)
12668 ! include 'DIMENSIONS'
12669 ! include 'COMMON.GEO'
12670 ! include 'COMMON.VAR'
12671 ! include 'COMMON.LOCAL'
12672 ! include 'COMMON.CHAIN'
12673 ! include 'COMMON.DERIV'
12674 ! include 'COMMON.INTERACT'
12675 ! include 'COMMON.IOUNITS'
12676 ! include 'COMMON.NAMES'
12677 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12679 !el local variables
12680 integer :: i,iint,j,k,itypi,itypi1,itypj
12681 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12682 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12683 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12685 do i=iatsc_s,iatsc_e
12687 if (itypi.eq.ntyp1) cycle
12688 itypi1=itype(i+1,1)
12693 ! Calculate SC interaction energy.
12695 do iint=1,nint_gr(i)
12696 do j=istart(i,iint),iend(i,iint)
12698 if (itypj.eq.ntyp1) cycle
12702 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12703 fac_augm=rrij**expon
12704 e_augm=augm(itypi,itypj)*fac_augm
12705 r_inv_ij=dsqrt(rrij)
12707 sss=sscale(rij/sigma(itypi,itypj))
12708 if (sss.lt.1.0d0) then
12709 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12710 fac=r_shift_inv**expon
12711 e1=fac*fac*aa_aq(itypi,itypj)
12712 e2=fac*bb_aq(itypi,itypj)
12713 evdwij=e_augm+e1+e2
12714 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12715 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12716 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12717 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
12718 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12719 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12720 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12721 evdw=evdw+(1.0d0-sss)*evdwij
12723 ! Calculate the components of the gradient in DC and X
12725 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12726 fac=fac*(1.0d0-sss)
12731 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12732 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12733 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12734 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12742 gvdwc(j,i)=expon*gvdwc(j,i)
12743 gvdwx(j,i)=expon*gvdwx(j,i)
12747 end subroutine eljk_long
12748 !-----------------------------------------------------------------------------
12749 subroutine eljk_short(evdw)
12751 ! This subroutine calculates the interaction energy of nonbonded side chains
12752 ! assuming the LJK potential of interaction.
12754 ! implicit real*8 (a-h,o-z)
12755 ! include 'DIMENSIONS'
12756 ! include 'COMMON.GEO'
12757 ! include 'COMMON.VAR'
12758 ! include 'COMMON.LOCAL'
12759 ! include 'COMMON.CHAIN'
12760 ! include 'COMMON.DERIV'
12761 ! include 'COMMON.INTERACT'
12762 ! include 'COMMON.IOUNITS'
12763 ! include 'COMMON.NAMES'
12764 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12766 !el local variables
12767 integer :: i,iint,j,k,itypi,itypi1,itypj
12768 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12769 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12770 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12772 do i=iatsc_s,iatsc_e
12774 if (itypi.eq.ntyp1) cycle
12775 itypi1=itype(i+1,1)
12780 ! Calculate SC interaction energy.
12782 do iint=1,nint_gr(i)
12783 do j=istart(i,iint),iend(i,iint)
12785 if (itypj.eq.ntyp1) cycle
12789 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12790 fac_augm=rrij**expon
12791 e_augm=augm(itypi,itypj)*fac_augm
12792 r_inv_ij=dsqrt(rrij)
12794 sss=sscale(rij/sigma(itypi,itypj))
12795 if (sss.gt.0.0d0) then
12796 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12797 fac=r_shift_inv**expon
12798 e1=fac*fac*aa_aq(itypi,itypj)
12799 e2=fac*bb_aq(itypi,itypj)
12800 evdwij=e_augm+e1+e2
12801 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12802 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12803 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12804 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
12805 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12806 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12807 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12808 evdw=evdw+sss*evdwij
12810 ! Calculate the components of the gradient in DC and X
12812 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12818 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12819 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12820 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12821 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12829 gvdwc(j,i)=expon*gvdwc(j,i)
12830 gvdwx(j,i)=expon*gvdwx(j,i)
12834 end subroutine eljk_short
12835 !-----------------------------------------------------------------------------
12836 subroutine ebp_long(evdw)
12838 ! This subroutine calculates the interaction energy of nonbonded side chains
12839 ! assuming the Berne-Pechukas potential of interaction.
12842 ! implicit real*8 (a-h,o-z)
12843 ! include 'DIMENSIONS'
12844 ! include 'COMMON.GEO'
12845 ! include 'COMMON.VAR'
12846 ! include 'COMMON.LOCAL'
12847 ! include 'COMMON.CHAIN'
12848 ! include 'COMMON.DERIV'
12849 ! include 'COMMON.NAMES'
12850 ! include 'COMMON.INTERACT'
12851 ! include 'COMMON.IOUNITS'
12852 ! include 'COMMON.CALC'
12854 !el integer :: icall
12855 !el common /srutu/ icall
12856 ! double precision rrsave(maxdim)
12858 !el local variables
12859 integer :: iint,itypi,itypi1,itypj
12860 real(kind=8) :: rrij,xi,yi,zi,fac
12861 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
12863 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
12865 ! if (icall.eq.0) then
12871 do i=iatsc_s,iatsc_e
12873 if (itypi.eq.ntyp1) cycle
12874 itypi1=itype(i+1,1)
12878 dxi=dc_norm(1,nres+i)
12879 dyi=dc_norm(2,nres+i)
12880 dzi=dc_norm(3,nres+i)
12881 ! dsci_inv=dsc_inv(itypi)
12882 dsci_inv=vbld_inv(i+nres)
12884 ! Calculate SC interaction energy.
12886 do iint=1,nint_gr(i)
12887 do j=istart(i,iint),iend(i,iint)
12890 if (itypj.eq.ntyp1) cycle
12891 ! dscj_inv=dsc_inv(itypj)
12892 dscj_inv=vbld_inv(j+nres)
12893 chi1=chi(itypi,itypj)
12894 chi2=chi(itypj,itypi)
12901 alf12=0.5D0*(alf1+alf2)
12905 dxj=dc_norm(1,nres+j)
12906 dyj=dc_norm(2,nres+j)
12907 dzj=dc_norm(3,nres+j)
12908 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12910 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12912 if (sss.lt.1.0d0) then
12914 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
12916 ! Calculate whole angle-dependent part of epsilon and contributions
12917 ! to its derivatives
12918 fac=(rrij*sigsq)**expon2
12919 e1=fac*fac*aa_aq(itypi,itypj)
12920 e2=fac*bb_aq(itypi,itypj)
12921 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12922 eps2der=evdwij*eps3rt
12923 eps3der=evdwij*eps2rt
12924 evdwij=evdwij*eps2rt*eps3rt
12925 evdw=evdw+evdwij*(1.0d0-sss)
12927 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
12928 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
12929 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
12930 !d & restyp(itypi,1),i,restyp(itypj,1),j,
12931 !d & epsi,sigm,chi1,chi2,chip1,chip2,
12932 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
12933 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
12936 ! Calculate gradient components.
12937 e1=e1*eps1*eps2rt**2*eps3rt**2
12938 fac=-expon*(e1+evdwij)
12941 ! Calculate radial part of the gradient
12945 ! Calculate the angular part of the gradient and sum add the contributions
12946 ! to the appropriate components of the Cartesian gradient.
12947 call sc_grad_scale(1.0d0-sss)
12954 end subroutine ebp_long
12955 !-----------------------------------------------------------------------------
12956 subroutine ebp_short(evdw)
12958 ! This subroutine calculates the interaction energy of nonbonded side chains
12959 ! assuming the Berne-Pechukas potential of interaction.
12962 ! implicit real*8 (a-h,o-z)
12963 ! include 'DIMENSIONS'
12964 ! include 'COMMON.GEO'
12965 ! include 'COMMON.VAR'
12966 ! include 'COMMON.LOCAL'
12967 ! include 'COMMON.CHAIN'
12968 ! include 'COMMON.DERIV'
12969 ! include 'COMMON.NAMES'
12970 ! include 'COMMON.INTERACT'
12971 ! include 'COMMON.IOUNITS'
12972 ! include 'COMMON.CALC'
12974 !el integer :: icall
12975 !el common /srutu/ icall
12976 ! double precision rrsave(maxdim)
12978 !el local variables
12979 integer :: iint,itypi,itypi1,itypj
12980 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
12981 real(kind=8) :: sss,e1,e2,evdw
12983 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
12985 ! if (icall.eq.0) then
12991 do i=iatsc_s,iatsc_e
12993 if (itypi.eq.ntyp1) cycle
12994 itypi1=itype(i+1,1)
12998 dxi=dc_norm(1,nres+i)
12999 dyi=dc_norm(2,nres+i)
13000 dzi=dc_norm(3,nres+i)
13001 ! dsci_inv=dsc_inv(itypi)
13002 dsci_inv=vbld_inv(i+nres)
13004 ! Calculate SC interaction energy.
13006 do iint=1,nint_gr(i)
13007 do j=istart(i,iint),iend(i,iint)
13010 if (itypj.eq.ntyp1) cycle
13011 ! dscj_inv=dsc_inv(itypj)
13012 dscj_inv=vbld_inv(j+nres)
13013 chi1=chi(itypi,itypj)
13014 chi2=chi(itypj,itypi)
13021 alf12=0.5D0*(alf1+alf2)
13025 dxj=dc_norm(1,nres+j)
13026 dyj=dc_norm(2,nres+j)
13027 dzj=dc_norm(3,nres+j)
13028 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13030 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13032 if (sss.gt.0.0d0) then
13034 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
13036 ! Calculate whole angle-dependent part of epsilon and contributions
13037 ! to its derivatives
13038 fac=(rrij*sigsq)**expon2
13039 e1=fac*fac*aa_aq(itypi,itypj)
13040 e2=fac*bb_aq(itypi,itypj)
13041 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13042 eps2der=evdwij*eps3rt
13043 eps3der=evdwij*eps2rt
13044 evdwij=evdwij*eps2rt*eps3rt
13045 evdw=evdw+evdwij*sss
13047 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13048 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13049 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
13050 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13051 !d & epsi,sigm,chi1,chi2,chip1,chip2,
13052 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
13053 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
13056 ! Calculate gradient components.
13057 e1=e1*eps1*eps2rt**2*eps3rt**2
13058 fac=-expon*(e1+evdwij)
13061 ! Calculate radial part of the gradient
13065 ! Calculate the angular part of the gradient and sum add the contributions
13066 ! to the appropriate components of the Cartesian gradient.
13067 call sc_grad_scale(sss)
13074 end subroutine ebp_short
13075 !-----------------------------------------------------------------------------
13076 subroutine egb_long(evdw)
13078 ! This subroutine calculates the interaction energy of nonbonded side chains
13079 ! assuming the Gay-Berne potential of interaction.
13082 ! implicit real*8 (a-h,o-z)
13083 ! include 'DIMENSIONS'
13084 ! include 'COMMON.GEO'
13085 ! include 'COMMON.VAR'
13086 ! include 'COMMON.LOCAL'
13087 ! include 'COMMON.CHAIN'
13088 ! include 'COMMON.DERIV'
13089 ! include 'COMMON.NAMES'
13090 ! include 'COMMON.INTERACT'
13091 ! include 'COMMON.IOUNITS'
13092 ! include 'COMMON.CALC'
13093 ! include 'COMMON.CONTROL'
13095 !el local variables
13096 integer :: iint,itypi,itypi1,itypj,subchap
13097 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
13098 real(kind=8) :: sss,e1,e2,evdw,sss_grad
13099 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13100 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13101 ssgradlipi,ssgradlipj
13105 !cccc energy_dec=.false.
13106 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13109 ! if (icall.eq.0) lprn=.false.
13111 do i=iatsc_s,iatsc_e
13113 if (itypi.eq.ntyp1) cycle
13114 itypi1=itype(i+1,1)
13118 xi=mod(xi,boxxsize)
13119 if (xi.lt.0) xi=xi+boxxsize
13120 yi=mod(yi,boxysize)
13121 if (yi.lt.0) yi=yi+boxysize
13122 zi=mod(zi,boxzsize)
13123 if (zi.lt.0) zi=zi+boxzsize
13124 if ((zi.gt.bordlipbot) &
13125 .and.(zi.lt.bordliptop)) then
13126 !C the energy transfer exist
13127 if (zi.lt.buflipbot) then
13128 !C what fraction I am in
13130 ((zi-bordlipbot)/lipbufthick)
13131 !C lipbufthick is thickenes of lipid buffore
13132 sslipi=sscalelip(fracinbuf)
13133 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
13134 elseif (zi.gt.bufliptop) then
13135 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
13136 sslipi=sscalelip(fracinbuf)
13137 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
13147 dxi=dc_norm(1,nres+i)
13148 dyi=dc_norm(2,nres+i)
13149 dzi=dc_norm(3,nres+i)
13150 ! dsci_inv=dsc_inv(itypi)
13151 dsci_inv=vbld_inv(i+nres)
13152 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
13153 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
13155 ! Calculate SC interaction energy.
13157 do iint=1,nint_gr(i)
13158 do j=istart(i,iint),iend(i,iint)
13159 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
13160 ! call dyn_ssbond_ene(i,j,evdwij)
13162 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13163 ! 'evdw',i,j,evdwij,' ss'
13164 ! if (energy_dec) write (iout,*) &
13165 ! 'evdw',i,j,evdwij,' ss'
13166 ! do k=j+1,iend(i,iint)
13167 !C search over all next residues
13168 ! if (dyn_ss_mask(k)) then
13169 !C check if they are cysteins
13170 !C write(iout,*) 'k=',k
13172 !c write(iout,*) "PRZED TRI", evdwij
13173 ! evdwij_przed_tri=evdwij
13174 ! call triple_ssbond_ene(i,j,k,evdwij)
13175 !c if(evdwij_przed_tri.ne.evdwij) then
13176 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
13179 !c write(iout,*) "PO TRI", evdwij
13180 !C call the energy function that removes the artifical triple disulfide
13181 !C bond the soubroutine is located in ssMD.F
13183 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13184 'evdw',i,j,evdwij,'tss'
13185 ! endif!dyn_ss_mask(k)
13191 if (itypj.eq.ntyp1) cycle
13192 ! dscj_inv=dsc_inv(itypj)
13193 dscj_inv=vbld_inv(j+nres)
13194 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
13195 ! & 1.0d0/vbld(j+nres)
13196 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
13197 sig0ij=sigma(itypi,itypj)
13198 chi1=chi(itypi,itypj)
13199 chi2=chi(itypj,itypi)
13206 alf12=0.5D0*(alf1+alf2)
13210 ! Searching for nearest neighbour
13211 xj=mod(xj,boxxsize)
13212 if (xj.lt.0) xj=xj+boxxsize
13213 yj=mod(yj,boxysize)
13214 if (yj.lt.0) yj=yj+boxysize
13215 zj=mod(zj,boxzsize)
13216 if (zj.lt.0) zj=zj+boxzsize
13217 if ((zj.gt.bordlipbot) &
13218 .and.(zj.lt.bordliptop)) then
13219 !C the energy transfer exist
13220 if (zj.lt.buflipbot) then
13221 !C what fraction I am in
13223 ((zj-bordlipbot)/lipbufthick)
13224 !C lipbufthick is thickenes of lipid buffore
13225 sslipj=sscalelip(fracinbuf)
13226 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
13227 elseif (zj.gt.bufliptop) then
13228 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
13229 sslipj=sscalelip(fracinbuf)
13230 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13239 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13240 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13241 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13242 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13244 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13252 xj=xj_safe+xshift*boxxsize
13253 yj=yj_safe+yshift*boxysize
13254 zj=zj_safe+zshift*boxzsize
13255 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13256 if(dist_temp.lt.dist_init) then
13257 dist_init=dist_temp
13266 if (subchap.eq.1) then
13276 dxj=dc_norm(1,nres+j)
13277 dyj=dc_norm(2,nres+j)
13278 dzj=dc_norm(3,nres+j)
13279 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13281 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13282 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
13283 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
13284 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13285 if (sss_ele_cut.le.0.0) cycle
13286 if (sss.lt.1.0d0) then
13288 ! Calculate angle-dependent terms of energy and contributions to their
13292 sig=sig0ij*dsqrt(sigsq)
13293 rij_shift=1.0D0/rij-sig+sig0ij
13294 ! for diagnostics; uncomment
13295 ! rij_shift=1.2*sig0ij
13296 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13297 if (rij_shift.le.0.0D0) then
13299 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13300 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13301 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13305 !---------------------------------------------------------------
13306 rij_shift=1.0D0/rij_shift
13307 fac=rij_shift**expon
13310 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13311 eps2der=evdwij*eps3rt
13312 eps3der=evdwij*eps2rt
13313 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13314 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13315 evdwij=evdwij*eps2rt*eps3rt
13316 evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
13318 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13319 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13320 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13321 restyp(itypi,1),i,restyp(itypj,1),j,&
13322 epsi,sigm,chi1,chi2,chip1,chip2,&
13323 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13324 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13328 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13330 ! if (energy_dec) write (iout,*) &
13331 ! 'evdw',i,j,evdwij,"egb_long"
13333 ! Calculate gradient components.
13334 e1=e1*eps1*eps2rt**2*eps3rt**2
13335 fac=-expon*(e1+evdwij)*rij_shift
13338 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13339 /sigma(itypi,itypj)*rij-sss_grad/(1.0-sss)*rij &
13340 /sigmaii(itypi,itypj))
13342 ! Calculate the radial part of the gradient
13346 ! Calculate angular part of the gradient.
13347 call sc_grad_scale(1.0d0-sss)
13353 ! write (iout,*) "Number of loop steps in EGB:",ind
13354 !ccc energy_dec=.false.
13356 end subroutine egb_long
13357 !-----------------------------------------------------------------------------
13358 subroutine egb_short(evdw)
13360 ! This subroutine calculates the interaction energy of nonbonded side chains
13361 ! assuming the Gay-Berne potential of interaction.
13364 ! implicit real*8 (a-h,o-z)
13365 ! include 'DIMENSIONS'
13366 ! include 'COMMON.GEO'
13367 ! include 'COMMON.VAR'
13368 ! include 'COMMON.LOCAL'
13369 ! include 'COMMON.CHAIN'
13370 ! include 'COMMON.DERIV'
13371 ! include 'COMMON.NAMES'
13372 ! include 'COMMON.INTERACT'
13373 ! include 'COMMON.IOUNITS'
13374 ! include 'COMMON.CALC'
13375 ! include 'COMMON.CONTROL'
13377 !el local variables
13378 integer :: iint,itypi,itypi1,itypj,subchap
13379 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
13380 real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad
13381 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13382 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13383 ssgradlipi,ssgradlipj
13385 !cccc energy_dec=.false.
13386 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13389 ! if (icall.eq.0) lprn=.false.
13391 do i=iatsc_s,iatsc_e
13393 if (itypi.eq.ntyp1) cycle
13394 itypi1=itype(i+1,1)
13398 xi=mod(xi,boxxsize)
13399 if (xi.lt.0) xi=xi+boxxsize
13400 yi=mod(yi,boxysize)
13401 if (yi.lt.0) yi=yi+boxysize
13402 zi=mod(zi,boxzsize)
13403 if (zi.lt.0) zi=zi+boxzsize
13404 if ((zi.gt.bordlipbot) &
13405 .and.(zi.lt.bordliptop)) then
13406 !C the energy transfer exist
13407 if (zi.lt.buflipbot) then
13408 !C what fraction I am in
13410 ((zi-bordlipbot)/lipbufthick)
13411 !C lipbufthick is thickenes of lipid buffore
13412 sslipi=sscalelip(fracinbuf)
13413 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
13414 elseif (zi.gt.bufliptop) then
13415 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
13416 sslipi=sscalelip(fracinbuf)
13417 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
13427 dxi=dc_norm(1,nres+i)
13428 dyi=dc_norm(2,nres+i)
13429 dzi=dc_norm(3,nres+i)
13430 ! dsci_inv=dsc_inv(itypi)
13431 dsci_inv=vbld_inv(i+nres)
13433 dxi=dc_norm(1,nres+i)
13434 dyi=dc_norm(2,nres+i)
13435 dzi=dc_norm(3,nres+i)
13436 ! dsci_inv=dsc_inv(itypi)
13437 dsci_inv=vbld_inv(i+nres)
13438 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
13439 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
13441 ! Calculate SC interaction energy.
13443 do iint=1,nint_gr(i)
13444 do j=istart(i,iint),iend(i,iint)
13445 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
13446 call dyn_ssbond_ene(i,j,evdwij)
13448 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13449 'evdw',i,j,evdwij,' ss'
13450 do k=j+1,iend(i,iint)
13451 !C search over all next residues
13452 if (dyn_ss_mask(k)) then
13453 !C check if they are cysteins
13454 !C write(iout,*) 'k=',k
13456 !c write(iout,*) "PRZED TRI", evdwij
13457 ! evdwij_przed_tri=evdwij
13458 call triple_ssbond_ene(i,j,k,evdwij)
13459 !c if(evdwij_przed_tri.ne.evdwij) then
13460 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
13463 !c write(iout,*) "PO TRI", evdwij
13464 !C call the energy function that removes the artifical triple disulfide
13465 !C bond the soubroutine is located in ssMD.F
13467 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13468 'evdw',i,j,evdwij,'tss'
13469 endif!dyn_ss_mask(k)
13472 ! if (energy_dec) write (iout,*) &
13473 ! 'evdw',i,j,evdwij,' ss'
13477 if (itypj.eq.ntyp1) cycle
13478 ! dscj_inv=dsc_inv(itypj)
13479 dscj_inv=vbld_inv(j+nres)
13480 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
13481 ! & 1.0d0/vbld(j+nres)
13482 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
13483 sig0ij=sigma(itypi,itypj)
13484 chi1=chi(itypi,itypj)
13485 chi2=chi(itypj,itypi)
13492 alf12=0.5D0*(alf1+alf2)
13493 ! xj=c(1,nres+j)-xi
13494 ! yj=c(2,nres+j)-yi
13495 ! zj=c(3,nres+j)-zi
13499 ! Searching for nearest neighbour
13500 xj=mod(xj,boxxsize)
13501 if (xj.lt.0) xj=xj+boxxsize
13502 yj=mod(yj,boxysize)
13503 if (yj.lt.0) yj=yj+boxysize
13504 zj=mod(zj,boxzsize)
13505 if (zj.lt.0) zj=zj+boxzsize
13506 if ((zj.gt.bordlipbot) &
13507 .and.(zj.lt.bordliptop)) then
13508 !C the energy transfer exist
13509 if (zj.lt.buflipbot) then
13510 !C what fraction I am in
13512 ((zj-bordlipbot)/lipbufthick)
13513 !C lipbufthick is thickenes of lipid buffore
13514 sslipj=sscalelip(fracinbuf)
13515 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
13516 elseif (zj.gt.bufliptop) then
13517 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
13518 sslipj=sscalelip(fracinbuf)
13519 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13528 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13529 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13530 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13531 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13533 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13542 xj=xj_safe+xshift*boxxsize
13543 yj=yj_safe+yshift*boxysize
13544 zj=zj_safe+zshift*boxzsize
13545 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13546 if(dist_temp.lt.dist_init) then
13547 dist_init=dist_temp
13556 if (subchap.eq.1) then
13566 dxj=dc_norm(1,nres+j)
13567 dyj=dc_norm(2,nres+j)
13568 dzj=dc_norm(3,nres+j)
13569 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13571 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13572 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13573 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
13574 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
13575 if (sss_ele_cut.le.0.0) cycle
13577 if (sss.gt.0.0d0) then
13579 ! Calculate angle-dependent terms of energy and contributions to their
13583 sig=sig0ij*dsqrt(sigsq)
13584 rij_shift=1.0D0/rij-sig+sig0ij
13585 ! for diagnostics; uncomment
13586 ! rij_shift=1.2*sig0ij
13587 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13588 if (rij_shift.le.0.0D0) then
13590 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13591 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13592 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13596 !---------------------------------------------------------------
13597 rij_shift=1.0D0/rij_shift
13598 fac=rij_shift**expon
13601 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13602 eps2der=evdwij*eps3rt
13603 eps3der=evdwij*eps2rt
13604 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13605 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13606 evdwij=evdwij*eps2rt*eps3rt
13607 evdw=evdw+evdwij*sss*sss_ele_cut
13609 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13610 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13611 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13612 restyp(itypi,1),i,restyp(itypj,1),j,&
13613 epsi,sigm,chi1,chi2,chip1,chip2,&
13614 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13615 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13619 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13621 ! if (energy_dec) write (iout,*) &
13622 ! 'evdw',i,j,evdwij,"egb_short"
13624 ! Calculate gradient components.
13625 e1=e1*eps1*eps2rt**2*eps3rt**2
13626 fac=-expon*(e1+evdwij)*rij_shift
13629 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13630 /sigma(itypi,itypj)*rij+sss_grad/sss*rij &
13631 /sigmaii(itypi,itypj))
13634 ! Calculate the radial part of the gradient
13638 ! Calculate angular part of the gradient.
13639 call sc_grad_scale(sss)
13645 ! write (iout,*) "Number of loop steps in EGB:",ind
13646 !ccc energy_dec=.false.
13648 end subroutine egb_short
13649 !-----------------------------------------------------------------------------
13650 subroutine egbv_long(evdw)
13652 ! This subroutine calculates the interaction energy of nonbonded side chains
13653 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13656 ! implicit real*8 (a-h,o-z)
13657 ! include 'DIMENSIONS'
13658 ! include 'COMMON.GEO'
13659 ! include 'COMMON.VAR'
13660 ! include 'COMMON.LOCAL'
13661 ! include 'COMMON.CHAIN'
13662 ! include 'COMMON.DERIV'
13663 ! include 'COMMON.NAMES'
13664 ! include 'COMMON.INTERACT'
13665 ! include 'COMMON.IOUNITS'
13666 ! include 'COMMON.CALC'
13668 !el integer :: icall
13669 !el common /srutu/ icall
13671 !el local variables
13672 integer :: iint,itypi,itypi1,itypj
13673 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
13674 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
13676 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13679 ! if (icall.eq.0) lprn=.true.
13681 do i=iatsc_s,iatsc_e
13683 if (itypi.eq.ntyp1) cycle
13684 itypi1=itype(i+1,1)
13688 dxi=dc_norm(1,nres+i)
13689 dyi=dc_norm(2,nres+i)
13690 dzi=dc_norm(3,nres+i)
13691 ! dsci_inv=dsc_inv(itypi)
13692 dsci_inv=vbld_inv(i+nres)
13694 ! Calculate SC interaction energy.
13696 do iint=1,nint_gr(i)
13697 do j=istart(i,iint),iend(i,iint)
13700 if (itypj.eq.ntyp1) cycle
13701 ! dscj_inv=dsc_inv(itypj)
13702 dscj_inv=vbld_inv(j+nres)
13703 sig0ij=sigma(itypi,itypj)
13704 r0ij=r0(itypi,itypj)
13705 chi1=chi(itypi,itypj)
13706 chi2=chi(itypj,itypi)
13713 alf12=0.5D0*(alf1+alf2)
13717 dxj=dc_norm(1,nres+j)
13718 dyj=dc_norm(2,nres+j)
13719 dzj=dc_norm(3,nres+j)
13720 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13723 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13725 if (sss.lt.1.0d0) then
13727 ! Calculate angle-dependent terms of energy and contributions to their
13731 sig=sig0ij*dsqrt(sigsq)
13732 rij_shift=1.0D0/rij-sig+r0ij
13733 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13734 if (rij_shift.le.0.0D0) then
13739 !---------------------------------------------------------------
13740 rij_shift=1.0D0/rij_shift
13741 fac=rij_shift**expon
13742 e1=fac*fac*aa_aq(itypi,itypj)
13743 e2=fac*bb_aq(itypi,itypj)
13744 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13745 eps2der=evdwij*eps3rt
13746 eps3der=evdwij*eps2rt
13747 fac_augm=rrij**expon
13748 e_augm=augm(itypi,itypj)*fac_augm
13749 evdwij=evdwij*eps2rt*eps3rt
13750 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
13752 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13753 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13754 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13755 restyp(itypi,1),i,restyp(itypj,1),j,&
13756 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13757 chi1,chi2,chip1,chip2,&
13758 eps1,eps2rt**2,eps3rt**2,&
13759 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13762 ! Calculate gradient components.
13763 e1=e1*eps1*eps2rt**2*eps3rt**2
13764 fac=-expon*(e1+evdwij)*rij_shift
13766 fac=rij*fac-2*expon*rrij*e_augm
13767 ! Calculate the radial part of the gradient
13771 ! Calculate angular part of the gradient.
13772 call sc_grad_scale(1.0d0-sss)
13777 end subroutine egbv_long
13778 !-----------------------------------------------------------------------------
13779 subroutine egbv_short(evdw)
13781 ! This subroutine calculates the interaction energy of nonbonded side chains
13782 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13785 ! implicit real*8 (a-h,o-z)
13786 ! include 'DIMENSIONS'
13787 ! include 'COMMON.GEO'
13788 ! include 'COMMON.VAR'
13789 ! include 'COMMON.LOCAL'
13790 ! include 'COMMON.CHAIN'
13791 ! include 'COMMON.DERIV'
13792 ! include 'COMMON.NAMES'
13793 ! include 'COMMON.INTERACT'
13794 ! include 'COMMON.IOUNITS'
13795 ! include 'COMMON.CALC'
13797 !el integer :: icall
13798 !el common /srutu/ icall
13800 !el local variables
13801 integer :: iint,itypi,itypi1,itypj
13802 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
13803 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
13805 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13808 ! if (icall.eq.0) lprn=.true.
13810 do i=iatsc_s,iatsc_e
13812 if (itypi.eq.ntyp1) cycle
13813 itypi1=itype(i+1,1)
13817 dxi=dc_norm(1,nres+i)
13818 dyi=dc_norm(2,nres+i)
13819 dzi=dc_norm(3,nres+i)
13820 ! dsci_inv=dsc_inv(itypi)
13821 dsci_inv=vbld_inv(i+nres)
13823 ! Calculate SC interaction energy.
13825 do iint=1,nint_gr(i)
13826 do j=istart(i,iint),iend(i,iint)
13829 if (itypj.eq.ntyp1) cycle
13830 ! dscj_inv=dsc_inv(itypj)
13831 dscj_inv=vbld_inv(j+nres)
13832 sig0ij=sigma(itypi,itypj)
13833 r0ij=r0(itypi,itypj)
13834 chi1=chi(itypi,itypj)
13835 chi2=chi(itypj,itypi)
13842 alf12=0.5D0*(alf1+alf2)
13846 dxj=dc_norm(1,nres+j)
13847 dyj=dc_norm(2,nres+j)
13848 dzj=dc_norm(3,nres+j)
13849 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13852 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13854 if (sss.gt.0.0d0) then
13856 ! Calculate angle-dependent terms of energy and contributions to their
13860 sig=sig0ij*dsqrt(sigsq)
13861 rij_shift=1.0D0/rij-sig+r0ij
13862 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13863 if (rij_shift.le.0.0D0) then
13868 !---------------------------------------------------------------
13869 rij_shift=1.0D0/rij_shift
13870 fac=rij_shift**expon
13871 e1=fac*fac*aa_aq(itypi,itypj)
13872 e2=fac*bb_aq(itypi,itypj)
13873 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13874 eps2der=evdwij*eps3rt
13875 eps3der=evdwij*eps2rt
13876 fac_augm=rrij**expon
13877 e_augm=augm(itypi,itypj)*fac_augm
13878 evdwij=evdwij*eps2rt*eps3rt
13879 evdw=evdw+(evdwij+e_augm)*sss
13881 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13882 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13883 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13884 restyp(itypi,1),i,restyp(itypj,1),j,&
13885 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13886 chi1,chi2,chip1,chip2,&
13887 eps1,eps2rt**2,eps3rt**2,&
13888 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13891 ! Calculate gradient components.
13892 e1=e1*eps1*eps2rt**2*eps3rt**2
13893 fac=-expon*(e1+evdwij)*rij_shift
13895 fac=rij*fac-2*expon*rrij*e_augm
13896 ! Calculate the radial part of the gradient
13900 ! Calculate angular part of the gradient.
13901 call sc_grad_scale(sss)
13906 end subroutine egbv_short
13907 !-----------------------------------------------------------------------------
13908 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
13910 ! This subroutine calculates the average interaction energy and its gradient
13911 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
13912 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
13913 ! The potential depends both on the distance of peptide-group centers and on
13914 ! the orientation of the CA-CA virtual bonds.
13916 ! implicit real*8 (a-h,o-z)
13922 ! include 'DIMENSIONS'
13923 ! include 'COMMON.CONTROL'
13924 ! include 'COMMON.SETUP'
13925 ! include 'COMMON.IOUNITS'
13926 ! include 'COMMON.GEO'
13927 ! include 'COMMON.VAR'
13928 ! include 'COMMON.LOCAL'
13929 ! include 'COMMON.CHAIN'
13930 ! include 'COMMON.DERIV'
13931 ! include 'COMMON.INTERACT'
13932 ! include 'COMMON.CONTACTS'
13933 ! include 'COMMON.TORSION'
13934 ! include 'COMMON.VECTORS'
13935 ! include 'COMMON.FFIELD'
13936 ! include 'COMMON.TIME1'
13937 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
13938 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
13939 real(kind=8),dimension(2,2) :: acipa !el,a_temp
13940 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
13941 real(kind=8),dimension(4) :: muij
13942 !el integer :: num_conti,j1,j2
13943 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
13944 !el dz_normi,xmedi,ymedi,zmedi
13945 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
13946 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
13947 !el num_conti,j1,j2
13948 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
13950 real(kind=8) :: scal_el=1.0d0
13952 real(kind=8) :: scal_el=0.5d0
13955 ! 13-go grudnia roku pamietnego...
13956 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
13957 0.0d0,1.0d0,0.0d0,&
13958 0.0d0,0.0d0,1.0d0/),shape(unmat))
13959 !el local variables
13961 real(kind=8) :: fac
13962 real(kind=8) :: dxj,dyj,dzj
13963 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
13965 ! allocate(num_cont_hb(nres)) !(maxres)
13966 !d write(iout,*) 'In EELEC'
13968 !d write(iout,*) 'Type',i
13969 !d write(iout,*) 'B1',B1(:,i)
13970 !d write(iout,*) 'B2',B2(:,i)
13971 !d write(iout,*) 'CC',CC(:,:,i)
13972 !d write(iout,*) 'DD',DD(:,:,i)
13973 !d write(iout,*) 'EE',EE(:,:,i)
13975 !d call check_vecgrad
13977 if (icheckgrad.eq.1) then
13979 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
13981 dc_norm(k,i)=dc(k,i)*fac
13983 ! write (iout,*) 'i',i,' fac',fac
13986 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
13987 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
13988 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
13989 ! call vec_and_deriv
13993 ! print *, "before set matrices"
13995 ! print *,"after set martices"
13997 time_mat=time_mat+MPI_Wtime()-time01
14001 !d write (iout,*) 'i=',i
14003 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
14006 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
14007 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
14020 !d print '(a)','Enter EELEC'
14021 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
14022 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
14023 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
14025 gel_loc_loc(i)=0.0d0
14030 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
14032 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
14034 do i=iturn3_start,iturn3_end
14035 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1 &
14036 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
14040 dx_normi=dc_norm(1,i)
14041 dy_normi=dc_norm(2,i)
14042 dz_normi=dc_norm(3,i)
14043 xmedi=c(1,i)+0.5d0*dxi
14044 ymedi=c(2,i)+0.5d0*dyi
14045 zmedi=c(3,i)+0.5d0*dzi
14046 xmedi=dmod(xmedi,boxxsize)
14047 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14048 ymedi=dmod(ymedi,boxysize)
14049 if (ymedi.lt.0) ymedi=ymedi+boxysize
14050 zmedi=dmod(zmedi,boxzsize)
14051 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14053 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
14054 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
14055 num_cont_hb(i)=num_conti
14057 do i=iturn4_start,iturn4_end
14058 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
14059 .or. itype(i+3,1).eq.ntyp1 &
14060 .or. itype(i+4,1).eq.ntyp1) cycle
14064 dx_normi=dc_norm(1,i)
14065 dy_normi=dc_norm(2,i)
14066 dz_normi=dc_norm(3,i)
14067 xmedi=c(1,i)+0.5d0*dxi
14068 ymedi=c(2,i)+0.5d0*dyi
14069 zmedi=c(3,i)+0.5d0*dzi
14070 xmedi=dmod(xmedi,boxxsize)
14071 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14072 ymedi=dmod(ymedi,boxysize)
14073 if (ymedi.lt.0) ymedi=ymedi+boxysize
14074 zmedi=dmod(zmedi,boxzsize)
14075 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14076 num_conti=num_cont_hb(i)
14077 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
14078 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
14079 call eturn4(i,eello_turn4)
14080 num_cont_hb(i)=num_conti
14083 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
14085 do i=iatel_s,iatel_e
14086 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
14090 dx_normi=dc_norm(1,i)
14091 dy_normi=dc_norm(2,i)
14092 dz_normi=dc_norm(3,i)
14093 xmedi=c(1,i)+0.5d0*dxi
14094 ymedi=c(2,i)+0.5d0*dyi
14095 zmedi=c(3,i)+0.5d0*dzi
14096 xmedi=dmod(xmedi,boxxsize)
14097 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14098 ymedi=dmod(ymedi,boxysize)
14099 if (ymedi.lt.0) ymedi=ymedi+boxysize
14100 zmedi=dmod(zmedi,boxzsize)
14101 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14102 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
14103 num_conti=num_cont_hb(i)
14104 do j=ielstart(i),ielend(i)
14105 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
14106 call eelecij_scale(i,j,ees,evdw1,eel_loc)
14108 num_cont_hb(i)=num_conti
14110 ! write (iout,*) "Number of loop steps in EELEC:",ind
14112 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
14113 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
14115 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
14116 !cc eel_loc=eel_loc+eello_turn3
14117 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
14119 end subroutine eelec_scale
14120 !-----------------------------------------------------------------------------
14121 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
14122 ! implicit real*8 (a-h,o-z)
14125 ! include 'DIMENSIONS'
14129 ! include 'COMMON.CONTROL'
14130 ! include 'COMMON.IOUNITS'
14131 ! include 'COMMON.GEO'
14132 ! include 'COMMON.VAR'
14133 ! include 'COMMON.LOCAL'
14134 ! include 'COMMON.CHAIN'
14135 ! include 'COMMON.DERIV'
14136 ! include 'COMMON.INTERACT'
14137 ! include 'COMMON.CONTACTS'
14138 ! include 'COMMON.TORSION'
14139 ! include 'COMMON.VECTORS'
14140 ! include 'COMMON.FFIELD'
14141 ! include 'COMMON.TIME1'
14142 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
14143 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
14144 real(kind=8),dimension(2,2) :: acipa !el,a_temp
14145 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
14146 real(kind=8),dimension(4) :: muij
14147 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14148 dist_temp, dist_init,sss_grad
14149 integer xshift,yshift,zshift
14151 !el integer :: num_conti,j1,j2
14152 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
14153 !el dz_normi,xmedi,ymedi,zmedi
14154 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
14155 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14156 !el num_conti,j1,j2
14157 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14159 real(kind=8) :: scal_el=1.0d0
14161 real(kind=8) :: scal_el=0.5d0
14164 ! 13-go grudnia roku pamietnego...
14165 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
14166 0.0d0,1.0d0,0.0d0,&
14167 0.0d0,0.0d0,1.0d0/),shape(unmat))
14168 !el local variables
14169 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m,isubchap
14170 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
14171 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
14172 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
14173 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
14174 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
14175 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
14176 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
14177 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
14178 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
14179 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
14180 ecosam,ecosbm,ecosgm,ghalf,time00
14181 ! integer :: maxconts
14182 ! maxconts = nres/4
14183 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14184 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14185 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14186 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14187 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14188 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14189 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14190 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14191 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
14192 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
14193 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
14194 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
14195 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
14197 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
14198 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
14203 !d write (iout,*) "eelecij",i,j
14207 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
14208 aaa=app(iteli,itelj)
14209 bbb=bpp(iteli,itelj)
14210 ael6i=ael6(iteli,itelj)
14211 ael3i=ael3(iteli,itelj)
14215 dx_normj=dc_norm(1,j)
14216 dy_normj=dc_norm(2,j)
14217 dz_normj=dc_norm(3,j)
14218 ! xj=c(1,j)+0.5D0*dxj-xmedi
14219 ! yj=c(2,j)+0.5D0*dyj-ymedi
14220 ! zj=c(3,j)+0.5D0*dzj-zmedi
14221 xj=c(1,j)+0.5D0*dxj
14222 yj=c(2,j)+0.5D0*dyj
14223 zj=c(3,j)+0.5D0*dzj
14224 xj=mod(xj,boxxsize)
14225 if (xj.lt.0) xj=xj+boxxsize
14226 yj=mod(yj,boxysize)
14227 if (yj.lt.0) yj=yj+boxysize
14228 zj=mod(zj,boxzsize)
14229 if (zj.lt.0) zj=zj+boxzsize
14231 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14238 xj=xj_safe+xshift*boxxsize
14239 yj=yj_safe+yshift*boxysize
14240 zj=zj_safe+zshift*boxzsize
14241 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14242 if(dist_temp.lt.dist_init) then
14243 dist_init=dist_temp
14252 if (isubchap.eq.1) then
14263 rij=xj*xj+yj*yj+zj*zj
14267 ! For extracting the short-range part of Evdwpp
14268 sss=sscale(rij/rpp(iteli,itelj))
14269 sss_ele_cut=sscale_ele(rij)
14270 sss_ele_grad=sscagrad_ele(rij)
14271 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
14272 ! sss_ele_cut=1.0d0
14273 ! sss_ele_grad=0.0d0
14274 if (sss_ele_cut.le.0.0) go to 128
14278 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
14279 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
14280 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
14281 fac=cosa-3.0D0*cosb*cosg
14283 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
14284 if (j.eq.i+2) ev1=scal_el*ev1
14289 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
14292 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
14293 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
14294 ees=ees+eesij*sss_ele_cut
14295 evdw1=evdw1+evdwij*(1.0d0-sss)*sss_ele_cut
14296 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
14297 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
14298 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
14299 !d & xmedi,ymedi,zmedi,xj,yj,zj
14301 if (energy_dec) then
14302 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
14303 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
14307 ! Calculate contributions to the Cartesian gradient.
14310 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
14311 facel=-3*rrmij*(el1+eesij)*sss_ele_cut
14317 ! Radial derivatives. First process both termini of the fragment (i,j)
14319 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj
14320 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj
14321 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj
14323 ! ghalf=0.5D0*ggg(k)
14324 ! gelc(k,i)=gelc(k,i)+ghalf
14325 ! gelc(k,j)=gelc(k,j)+ghalf
14327 ! 9/28/08 AL Gradient compotents will be summed only at the end
14329 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14330 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14333 ! Loop over residues i+1 thru j-1.
14337 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14340 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*(1.0d0-sss) &
14341 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
14342 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*(1.0d0-sss) &
14343 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
14344 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*(1.0d0-sss) &
14345 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
14347 ! ghalf=0.5D0*ggg(k)
14348 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
14349 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
14351 ! 9/28/08 AL Gradient compotents will be summed only at the end
14353 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14354 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14357 ! Loop over residues i+1 thru j-1.
14361 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
14365 facvdw=(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
14366 facel=(el1+eesij)*sss_ele_cut
14368 fac=-3*rrmij*(facvdw+facvdw+facel)
14373 ! Radial derivatives. First process both termini of the fragment (i,j)
14379 ! ghalf=0.5D0*ggg(k)
14380 ! gelc(k,i)=gelc(k,i)+ghalf
14381 ! gelc(k,j)=gelc(k,j)+ghalf
14383 ! 9/28/08 AL Gradient compotents will be summed only at the end
14385 gelc_long(k,j)=gelc(k,j)+ggg(k)
14386 gelc_long(k,i)=gelc(k,i)-ggg(k)
14389 ! Loop over residues i+1 thru j-1.
14393 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14396 ! 9/28/08 AL Gradient compotents will be summed only at the end
14401 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14402 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14408 ecosa=2.0D0*fac3*fac1+fac4
14411 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
14412 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
14414 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14415 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14417 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
14418 !d & (dcosg(k),k=1,3)
14420 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k) )*sss_ele_cut
14423 ! ghalf=0.5D0*ggg(k)
14424 ! gelc(k,i)=gelc(k,i)+ghalf
14425 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
14426 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14427 ! gelc(k,j)=gelc(k,j)+ghalf
14428 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
14429 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14433 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14437 gelc(k,i)=gelc(k,i) &
14438 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14439 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
14441 gelc(k,j)=gelc(k,j) &
14442 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14443 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14445 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14446 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14448 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
14449 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
14450 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14452 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
14453 ! energy of a peptide unit is assumed in the form of a second-order
14454 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
14455 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
14456 ! are computed for EVERY pair of non-contiguous peptide groups.
14458 if (j.lt.nres-1) then
14469 muij(kkk)=mu(k,i)*mu(l,j)
14472 !d write (iout,*) 'EELEC: i',i,' j',j
14473 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
14474 !d write(iout,*) 'muij',muij
14475 ury=scalar(uy(1,i),erij)
14476 urz=scalar(uz(1,i),erij)
14477 vry=scalar(uy(1,j),erij)
14478 vrz=scalar(uz(1,j),erij)
14479 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
14480 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
14481 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
14482 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
14483 fac=dsqrt(-ael6i)*r3ij
14488 !d write (iout,'(4i5,4f10.5)')
14489 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
14490 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
14491 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
14492 !d & uy(:,j),uz(:,j)
14493 !d write (iout,'(4f10.5)')
14494 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
14495 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
14496 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
14497 !d write (iout,'(9f10.5/)')
14498 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
14499 ! Derivatives of the elements of A in virtual-bond vectors
14500 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
14502 uryg(k,1)=scalar(erder(1,k),uy(1,i))
14503 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
14504 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
14505 urzg(k,1)=scalar(erder(1,k),uz(1,i))
14506 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
14507 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
14508 vryg(k,1)=scalar(erder(1,k),uy(1,j))
14509 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
14510 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
14511 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
14512 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
14513 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
14515 ! Compute radial contributions to the gradient
14533 ! Add the contributions coming from er
14536 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
14537 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
14538 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
14539 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
14542 ! Derivatives in DC(i)
14543 !grad ghalf1=0.5d0*agg(k,1)
14544 !grad ghalf2=0.5d0*agg(k,2)
14545 !grad ghalf3=0.5d0*agg(k,3)
14546 !grad ghalf4=0.5d0*agg(k,4)
14547 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
14548 -3.0d0*uryg(k,2)*vry)!+ghalf1
14549 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
14550 -3.0d0*uryg(k,2)*vrz)!+ghalf2
14551 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
14552 -3.0d0*urzg(k,2)*vry)!+ghalf3
14553 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
14554 -3.0d0*urzg(k,2)*vrz)!+ghalf4
14555 ! Derivatives in DC(i+1)
14556 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
14557 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
14558 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
14559 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
14560 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
14561 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
14562 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
14563 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
14564 ! Derivatives in DC(j)
14565 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
14566 -3.0d0*vryg(k,2)*ury)!+ghalf1
14567 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
14568 -3.0d0*vrzg(k,2)*ury)!+ghalf2
14569 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
14570 -3.0d0*vryg(k,2)*urz)!+ghalf3
14571 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
14572 -3.0d0*vrzg(k,2)*urz)!+ghalf4
14573 ! Derivatives in DC(j+1) or DC(nres-1)
14574 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
14575 -3.0d0*vryg(k,3)*ury)
14576 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
14577 -3.0d0*vrzg(k,3)*ury)
14578 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
14579 -3.0d0*vryg(k,3)*urz)
14580 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
14581 -3.0d0*vrzg(k,3)*urz)
14582 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
14584 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
14597 aggi(k,l)=-aggi(k,l)
14598 aggi1(k,l)=-aggi1(k,l)
14599 aggj(k,l)=-aggj(k,l)
14600 aggj1(k,l)=-aggj1(k,l)
14603 if (j.lt.nres-1) then
14609 aggi(k,l)=-aggi(k,l)
14610 aggi1(k,l)=-aggi1(k,l)
14611 aggj(k,l)=-aggj(k,l)
14612 aggj1(k,l)=-aggj1(k,l)
14623 aggi(k,l)=-aggi(k,l)
14624 aggi1(k,l)=-aggi1(k,l)
14625 aggj(k,l)=-aggj(k,l)
14626 aggj1(k,l)=-aggj1(k,l)
14631 IF (wel_loc.gt.0.0d0) THEN
14632 ! Contribution to the local-electrostatic energy coming from the i-j pair
14633 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
14635 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
14636 ! print *,"EELLOC",i,gel_loc_loc(i-1)
14637 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
14638 'eelloc',i,j,eel_loc_ij
14639 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
14641 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
14642 ! Partial derivatives in virtual-bond dihedral angles gamma
14644 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
14645 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
14646 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
14648 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
14649 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
14650 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
14656 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
14658 ggg(l)=(agg(l,1)*muij(1)+ &
14659 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
14661 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
14663 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
14664 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
14665 !grad ghalf=0.5d0*ggg(l)
14666 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
14667 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
14671 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
14674 ! Remaining derivatives of eello
14676 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
14677 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
14680 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
14681 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))&
14684 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
14685 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
14688 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
14689 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))&
14694 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
14695 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
14696 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
14697 .and. num_conti.le.maxconts) then
14698 ! write (iout,*) i,j," entered corr"
14700 ! Calculate the contact function. The ith column of the array JCONT will
14701 ! contain the numbers of atoms that make contacts with the atom I (of numbers
14702 ! greater than I). The arrays FACONT and GACONT will contain the values of
14703 ! the contact function and its derivative.
14704 ! r0ij=1.02D0*rpp(iteli,itelj)
14705 ! r0ij=1.11D0*rpp(iteli,itelj)
14706 r0ij=2.20D0*rpp(iteli,itelj)
14707 ! r0ij=1.55D0*rpp(iteli,itelj)
14708 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
14709 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14710 if (fcont.gt.0.0D0) then
14711 num_conti=num_conti+1
14712 if (num_conti.gt.maxconts) then
14713 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14714 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
14715 ' will skip next contacts for this conf.',num_conti
14717 jcont_hb(num_conti,i)=j
14718 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
14719 !d & " jcont_hb",jcont_hb(num_conti,i)
14720 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
14721 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14722 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
14724 d_cont(num_conti,i)=rij
14725 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
14726 ! --- Electrostatic-interaction matrix ---
14727 a_chuj(1,1,num_conti,i)=a22
14728 a_chuj(1,2,num_conti,i)=a23
14729 a_chuj(2,1,num_conti,i)=a32
14730 a_chuj(2,2,num_conti,i)=a33
14731 ! --- Gradient of rij
14733 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
14740 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
14741 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
14742 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
14743 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
14744 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
14749 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
14750 ! Calculate contact energies
14752 wij=cosa-3.0D0*cosb*cosg
14755 ! fac3=dsqrt(-ael6i)/r0ij**3
14756 fac3=dsqrt(-ael6i)*r3ij
14757 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
14758 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
14759 if (ees0tmp.gt.0) then
14760 ees0pij=dsqrt(ees0tmp)
14764 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
14765 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
14766 if (ees0tmp.gt.0) then
14767 ees0mij=dsqrt(ees0tmp)
14772 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
14775 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
14778 ! Diagnostics. Comment out or remove after debugging!
14779 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
14780 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
14781 ! ees0m(num_conti,i)=0.0D0
14783 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
14784 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
14785 ! Angular derivatives of the contact function
14786 ees0pij1=fac3/ees0pij
14787 ees0mij1=fac3/ees0mij
14788 fac3p=-3.0D0*fac3*rrmij
14789 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
14790 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
14792 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
14793 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
14794 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
14795 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
14796 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
14797 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
14798 ecosap=ecosa1+ecosa2
14799 ecosbp=ecosb1+ecosb2
14800 ecosgp=ecosg1+ecosg2
14801 ecosam=ecosa1-ecosa2
14802 ecosbm=ecosb1-ecosb2
14803 ecosgm=ecosg1-ecosg2
14812 facont_hb(num_conti,i)=fcont
14813 fprimcont=fprimcont/rij
14814 !d facont_hb(num_conti,i)=1.0D0
14815 ! Following line is for diagnostics.
14818 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14819 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14822 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
14823 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
14825 ! gggp(1)=gggp(1)+ees0pijp*xj
14826 ! gggp(2)=gggp(2)+ees0pijp*yj
14827 ! gggp(3)=gggp(3)+ees0pijp*zj
14828 ! gggm(1)=gggm(1)+ees0mijp*xj
14829 ! gggm(2)=gggm(2)+ees0mijp*yj
14830 ! gggm(3)=gggm(3)+ees0mijp*zj
14831 gggp(1)=gggp(1)+ees0pijp*xj &
14832 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14833 gggp(2)=gggp(2)+ees0pijp*yj &
14834 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14835 gggp(3)=gggp(3)+ees0pijp*zj &
14836 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14838 gggm(1)=gggm(1)+ees0mijp*xj &
14839 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14841 gggm(2)=gggm(2)+ees0mijp*yj &
14842 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14844 gggm(3)=gggm(3)+ees0mijp*zj &
14845 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14847 ! Derivatives due to the contact function
14848 gacont_hbr(1,num_conti,i)=fprimcont*xj
14849 gacont_hbr(2,num_conti,i)=fprimcont*yj
14850 gacont_hbr(3,num_conti,i)=fprimcont*zj
14853 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
14854 ! following the change of gradient-summation algorithm.
14856 !grad ghalfp=0.5D0*gggp(k)
14857 !grad ghalfm=0.5D0*gggm(k)
14858 ! gacontp_hb1(k,num_conti,i)= & !ghalfp
14859 ! +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14860 ! + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14861 ! gacontp_hb2(k,num_conti,i)= & !ghalfp
14862 ! +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14863 ! + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14864 ! gacontp_hb3(k,num_conti,i)=gggp(k)
14865 ! gacontm_hb1(k,num_conti,i)= &!ghalfm
14866 ! +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14867 ! + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14868 ! gacontm_hb2(k,num_conti,i)= & !ghalfm
14869 ! +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14870 ! + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14871 ! gacontm_hb3(k,num_conti,i)=gggm(k)
14872 gacontp_hb1(k,num_conti,i)= & !ghalfp+
14873 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14874 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14877 gacontp_hb2(k,num_conti,i)= & !ghalfp+
14878 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14879 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14882 gacontp_hb3(k,num_conti,i)=gggp(k) &
14885 gacontm_hb1(k,num_conti,i)= & !ghalfm+
14886 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14887 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14890 gacontm_hb2(k,num_conti,i)= & !ghalfm+
14891 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14892 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
14895 gacontm_hb3(k,num_conti,i)=gggm(k) &
14900 endif ! num_conti.le.maxconts
14903 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
14906 ghalf=0.5d0*agg(l,k)
14907 aggi(l,k)=aggi(l,k)+ghalf
14908 aggi1(l,k)=aggi1(l,k)+agg(l,k)
14909 aggj(l,k)=aggj(l,k)+ghalf
14912 if (j.eq.nres-1 .and. i.lt.j-2) then
14915 aggj1(l,k)=aggj1(l,k)+agg(l,k)
14921 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
14923 end subroutine eelecij_scale
14924 !-----------------------------------------------------------------------------
14925 subroutine evdwpp_short(evdw1)
14929 ! implicit real*8 (a-h,o-z)
14930 ! include 'DIMENSIONS'
14931 ! include 'COMMON.CONTROL'
14932 ! include 'COMMON.IOUNITS'
14933 ! include 'COMMON.GEO'
14934 ! include 'COMMON.VAR'
14935 ! include 'COMMON.LOCAL'
14936 ! include 'COMMON.CHAIN'
14937 ! include 'COMMON.DERIV'
14938 ! include 'COMMON.INTERACT'
14939 ! include 'COMMON.CONTACTS'
14940 ! include 'COMMON.TORSION'
14941 ! include 'COMMON.VECTORS'
14942 ! include 'COMMON.FFIELD'
14943 real(kind=8),dimension(3) :: ggg
14944 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14946 real(kind=8) :: scal_el=1.0d0
14948 real(kind=8) :: scal_el=0.5d0
14950 !el local variables
14951 integer :: i,j,k,iteli,itelj,num_conti,isubchap
14952 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
14953 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
14954 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14955 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
14956 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14957 dist_temp, dist_init,sss_grad
14958 integer xshift,yshift,zshift
14962 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
14963 ! & " iatel_e_vdw",iatel_e_vdw
14965 do i=iatel_s_vdw,iatel_e_vdw
14966 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1) cycle
14970 dx_normi=dc_norm(1,i)
14971 dy_normi=dc_norm(2,i)
14972 dz_normi=dc_norm(3,i)
14973 xmedi=c(1,i)+0.5d0*dxi
14974 ymedi=c(2,i)+0.5d0*dyi
14975 zmedi=c(3,i)+0.5d0*dzi
14976 xmedi=dmod(xmedi,boxxsize)
14977 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14978 ymedi=dmod(ymedi,boxysize)
14979 if (ymedi.lt.0) ymedi=ymedi+boxysize
14980 zmedi=dmod(zmedi,boxzsize)
14981 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14983 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
14984 ! & ' ielend',ielend_vdw(i)
14986 do j=ielstart_vdw(i),ielend_vdw(i)
14987 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
14991 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
14992 aaa=app(iteli,itelj)
14993 bbb=bpp(iteli,itelj)
14997 dx_normj=dc_norm(1,j)
14998 dy_normj=dc_norm(2,j)
14999 dz_normj=dc_norm(3,j)
15000 ! xj=c(1,j)+0.5D0*dxj-xmedi
15001 ! yj=c(2,j)+0.5D0*dyj-ymedi
15002 ! zj=c(3,j)+0.5D0*dzj-zmedi
15003 xj=c(1,j)+0.5D0*dxj
15004 yj=c(2,j)+0.5D0*dyj
15005 zj=c(3,j)+0.5D0*dzj
15006 xj=mod(xj,boxxsize)
15007 if (xj.lt.0) xj=xj+boxxsize
15008 yj=mod(yj,boxysize)
15009 if (yj.lt.0) yj=yj+boxysize
15010 zj=mod(zj,boxzsize)
15011 if (zj.lt.0) zj=zj+boxzsize
15013 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15020 xj=xj_safe+xshift*boxxsize
15021 yj=yj_safe+yshift*boxysize
15022 zj=zj_safe+zshift*boxzsize
15023 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15024 if(dist_temp.lt.dist_init) then
15025 dist_init=dist_temp
15034 if (isubchap.eq.1) then
15045 rij=xj*xj+yj*yj+zj*zj
15048 sss=sscale(rij/rpp(iteli,itelj))
15049 sss_ele_cut=sscale_ele(rij)
15050 sss_ele_grad=sscagrad_ele(rij)
15051 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
15052 if (sss_ele_cut.le.0.0) cycle
15053 if (sss.gt.0.0d0) then
15058 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
15059 if (j.eq.i+2) ev1=scal_el*ev1
15062 if (energy_dec) then
15063 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
15065 evdw1=evdw1+evdwij*sss*sss_ele_cut
15067 ! Calculate contributions to the Cartesian gradient.
15069 facvdw=-6*rrmij*(ev1+evdwij)*sss*sss_ele_cut
15073 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*sss &
15074 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
15075 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*sss &
15076 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
15077 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*sss &
15078 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
15081 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
15082 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
15088 end subroutine evdwpp_short
15089 !-----------------------------------------------------------------------------
15090 subroutine escp_long(evdw2,evdw2_14)
15092 ! This subroutine calculates the excluded-volume interaction energy between
15093 ! peptide-group centers and side chains and its gradient in virtual-bond and
15094 ! side-chain vectors.
15096 ! implicit real*8 (a-h,o-z)
15097 ! include 'DIMENSIONS'
15098 ! include 'COMMON.GEO'
15099 ! include 'COMMON.VAR'
15100 ! include 'COMMON.LOCAL'
15101 ! include 'COMMON.CHAIN'
15102 ! include 'COMMON.DERIV'
15103 ! include 'COMMON.INTERACT'
15104 ! include 'COMMON.FFIELD'
15105 ! include 'COMMON.IOUNITS'
15106 ! include 'COMMON.CONTROL'
15107 real(kind=8),dimension(3) :: ggg
15108 !el local variables
15109 integer :: i,iint,j,k,iteli,itypj,subchap
15110 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
15111 real(kind=8) :: evdw2,evdw2_14,evdwij
15112 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15113 dist_temp, dist_init
15117 !d print '(a)','Enter ESCP'
15118 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
15119 do i=iatscp_s,iatscp_e
15120 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
15122 xi=0.5D0*(c(1,i)+c(1,i+1))
15123 yi=0.5D0*(c(2,i)+c(2,i+1))
15124 zi=0.5D0*(c(3,i)+c(3,i+1))
15125 xi=mod(xi,boxxsize)
15126 if (xi.lt.0) xi=xi+boxxsize
15127 yi=mod(yi,boxysize)
15128 if (yi.lt.0) yi=yi+boxysize
15129 zi=mod(zi,boxzsize)
15130 if (zi.lt.0) zi=zi+boxzsize
15132 do iint=1,nscp_gr(i)
15134 do j=iscpstart(i,iint),iscpend(i,iint)
15136 if (itypj.eq.ntyp1) cycle
15137 ! Uncomment following three lines for SC-p interactions
15138 ! xj=c(1,nres+j)-xi
15139 ! yj=c(2,nres+j)-yi
15140 ! zj=c(3,nres+j)-zi
15141 ! Uncomment following three lines for Ca-p interactions
15145 xj=mod(xj,boxxsize)
15146 if (xj.lt.0) xj=xj+boxxsize
15147 yj=mod(yj,boxysize)
15148 if (yj.lt.0) yj=yj+boxysize
15149 zj=mod(zj,boxzsize)
15150 if (zj.lt.0) zj=zj+boxzsize
15151 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15159 xj=xj_safe+xshift*boxxsize
15160 yj=yj_safe+yshift*boxysize
15161 zj=zj_safe+zshift*boxzsize
15162 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15163 if(dist_temp.lt.dist_init) then
15164 dist_init=dist_temp
15173 if (subchap.eq.1) then
15182 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15184 rij=dsqrt(1.0d0/rrij)
15185 sss_ele_cut=sscale_ele(rij)
15186 sss_ele_grad=sscagrad_ele(rij)
15187 ! print *,sss_ele_cut,sss_ele_grad,&
15188 ! (rij),r_cut_ele,rlamb_ele
15189 if (sss_ele_cut.le.0.0) cycle
15190 sss=sscale((rij/rscp(itypj,iteli)))
15191 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
15192 if (sss.lt.1.0d0) then
15195 e1=fac*fac*aad(itypj,iteli)
15196 e2=fac*bad(itypj,iteli)
15197 if (iabs(j-i) .le. 2) then
15200 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)*sss_ele_cut
15203 evdw2=evdw2+evdwij*(1.0d0-sss)*sss_ele_cut
15204 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15205 'evdw2',i,j,sss,evdwij
15207 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15209 fac=-(evdwij+e1)*rrij*(1.0d0-sss)*sss_ele_cut
15210 fac=fac+evdwij*sss_ele_grad/rij/expon*(1.0d0-sss)&
15211 -evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15215 ! Uncomment following three lines for SC-p interactions
15217 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15219 ! Uncomment following line for SC-p interactions
15220 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15222 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15223 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15232 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15233 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15234 gradx_scp(j,i)=expon*gradx_scp(j,i)
15237 !******************************************************************************
15241 ! To save time the factor EXPON has been extracted from ALL components
15242 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15245 !******************************************************************************
15247 end subroutine escp_long
15248 !-----------------------------------------------------------------------------
15249 subroutine escp_short(evdw2,evdw2_14)
15251 ! This subroutine calculates the excluded-volume interaction energy between
15252 ! peptide-group centers and side chains and its gradient in virtual-bond and
15253 ! side-chain vectors.
15255 ! implicit real*8 (a-h,o-z)
15256 ! include 'DIMENSIONS'
15257 ! include 'COMMON.GEO'
15258 ! include 'COMMON.VAR'
15259 ! include 'COMMON.LOCAL'
15260 ! include 'COMMON.CHAIN'
15261 ! include 'COMMON.DERIV'
15262 ! include 'COMMON.INTERACT'
15263 ! include 'COMMON.FFIELD'
15264 ! include 'COMMON.IOUNITS'
15265 ! include 'COMMON.CONTROL'
15266 real(kind=8),dimension(3) :: ggg
15267 !el local variables
15268 integer :: i,iint,j,k,iteli,itypj,subchap
15269 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
15270 real(kind=8) :: evdw2,evdw2_14,evdwij
15271 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15272 dist_temp, dist_init
15276 !d print '(a)','Enter ESCP'
15277 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
15278 do i=iatscp_s,iatscp_e
15279 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
15281 xi=0.5D0*(c(1,i)+c(1,i+1))
15282 yi=0.5D0*(c(2,i)+c(2,i+1))
15283 zi=0.5D0*(c(3,i)+c(3,i+1))
15284 xi=mod(xi,boxxsize)
15285 if (xi.lt.0) xi=xi+boxxsize
15286 yi=mod(yi,boxysize)
15287 if (yi.lt.0) yi=yi+boxysize
15288 zi=mod(zi,boxzsize)
15289 if (zi.lt.0) zi=zi+boxzsize
15291 do iint=1,nscp_gr(i)
15293 do j=iscpstart(i,iint),iscpend(i,iint)
15295 if (itypj.eq.ntyp1) cycle
15296 ! Uncomment following three lines for SC-p interactions
15297 ! xj=c(1,nres+j)-xi
15298 ! yj=c(2,nres+j)-yi
15299 ! zj=c(3,nres+j)-zi
15300 ! Uncomment following three lines for Ca-p interactions
15307 xj=mod(xj,boxxsize)
15308 if (xj.lt.0) xj=xj+boxxsize
15309 yj=mod(yj,boxysize)
15310 if (yj.lt.0) yj=yj+boxysize
15311 zj=mod(zj,boxzsize)
15312 if (zj.lt.0) zj=zj+boxzsize
15313 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15321 xj=xj_safe+xshift*boxxsize
15322 yj=yj_safe+yshift*boxysize
15323 zj=zj_safe+zshift*boxzsize
15324 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15325 if(dist_temp.lt.dist_init) then
15326 dist_init=dist_temp
15335 if (subchap.eq.1) then
15345 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15346 rij=dsqrt(1.0d0/rrij)
15347 sss_ele_cut=sscale_ele(rij)
15348 sss_ele_grad=sscagrad_ele(rij)
15349 ! print *,sss_ele_cut,sss_ele_grad,&
15350 ! (rij),r_cut_ele,rlamb_ele
15351 if (sss_ele_cut.le.0.0) cycle
15352 sss=sscale(rij/rscp(itypj,iteli))
15353 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
15354 if (sss.gt.0.0d0) then
15357 e1=fac*fac*aad(itypj,iteli)
15358 e2=fac*bad(itypj,iteli)
15359 if (iabs(j-i) .le. 2) then
15362 evdw2_14=evdw2_14+(e1+e2)*sss*sss_ele_cut
15365 evdw2=evdw2+evdwij*sss*sss_ele_cut
15366 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15367 'evdw2',i,j,sss,evdwij
15369 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15371 fac=-(evdwij+e1)*rrij*sss*sss_ele_cut
15372 fac=fac+evdwij*sss_ele_grad/rij/expon*sss &
15373 +evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15378 ! Uncomment following three lines for SC-p interactions
15380 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15382 ! Uncomment following line for SC-p interactions
15383 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15385 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15386 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15395 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15396 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15397 gradx_scp(j,i)=expon*gradx_scp(j,i)
15400 !******************************************************************************
15404 ! To save time the factor EXPON has been extracted from ALL components
15405 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15408 !******************************************************************************
15410 end subroutine escp_short
15411 !-----------------------------------------------------------------------------
15412 ! energy_p_new-sep_barrier.F
15413 !-----------------------------------------------------------------------------
15414 subroutine sc_grad_scale(scalfac)
15415 ! implicit real*8 (a-h,o-z)
15417 ! include 'DIMENSIONS'
15418 ! include 'COMMON.CHAIN'
15419 ! include 'COMMON.DERIV'
15420 ! include 'COMMON.CALC'
15421 ! include 'COMMON.IOUNITS'
15422 real(kind=8),dimension(3) :: dcosom1,dcosom2
15423 real(kind=8) :: scalfac
15424 !el local variables
15425 ! integer :: i,j,k,l
15427 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
15428 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
15429 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
15430 -2.0D0*alf12*eps3der+sigder*sigsq_om12
15434 ! eom12=evdwij*eps1_om12
15436 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
15437 ! & " sigder",sigder
15438 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
15439 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
15441 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
15442 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
15445 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac&
15448 ! write (iout,*) "gg",(gg(k),k=1,3)
15450 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
15451 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
15452 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
15454 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
15455 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
15456 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac&
15458 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
15459 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
15460 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
15461 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
15464 ! Calculate the components of the gradient in DC and X
15467 gvdwc(l,i)=gvdwc(l,i)-gg(l)
15468 gvdwc(l,j)=gvdwc(l,j)+gg(l)
15471 end subroutine sc_grad_scale
15472 !-----------------------------------------------------------------------------
15473 ! energy_split-sep.F
15474 !-----------------------------------------------------------------------------
15475 subroutine etotal_long(energia)
15477 ! Compute the long-range slow-varying contributions to the energy
15479 ! implicit real*8 (a-h,o-z)
15480 ! include 'DIMENSIONS'
15481 use MD_data, only: totT,usampl,eq_time
15485 !MS$ATTRIBUTES C :: proc_proc
15490 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
15492 ! include 'COMMON.SETUP'
15493 ! include 'COMMON.IOUNITS'
15494 ! include 'COMMON.FFIELD'
15495 ! include 'COMMON.DERIV'
15496 ! include 'COMMON.INTERACT'
15497 ! include 'COMMON.SBRIDGE'
15498 ! include 'COMMON.CHAIN'
15499 ! include 'COMMON.VAR'
15500 ! include 'COMMON.LOCAL'
15501 ! include 'COMMON.MD'
15502 real(kind=8),dimension(0:n_ene) :: energia
15503 !el local variables
15504 integer :: i,n_corr,n_corr1,ierror,ierr
15505 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
15506 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
15507 ecorr,ecorr5,ecorr6,eturn6,time00
15508 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
15509 !elwrite(iout,*)"in etotal long"
15511 if (modecalc.eq.12.or.modecalc.eq.14) then
15513 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
15515 call int_from_cart1(.false.)
15518 !elwrite(iout,*)"in etotal long"
15521 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
15522 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15524 if (nfgtasks.gt.1) then
15526 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15527 if (fg_rank.eq.0) then
15528 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
15529 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15531 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15532 ! FG slaves as WEIGHTS array.
15539 weights_(7)=wel_loc
15542 weights_(10)=wturn6
15544 weights_(12)=wscloc
15546 weights_(14)=wtor_d
15547 weights_(15)=wstrain
15548 weights_(16)=wvdwpp
15550 weights_(18)=scal14
15551 weights_(21)=wsccor
15552 ! FG Master broadcasts the WEIGHTS_ array
15553 call MPI_Bcast(weights_(1),n_ene,&
15554 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15556 ! FG slaves receive the WEIGHTS array
15557 call MPI_Bcast(weights(1),n_ene,&
15558 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15573 wstrain=weights(15)
15579 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
15581 time_Bcast=time_Bcast+MPI_Wtime()-time00
15582 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
15583 ! call chainbuild_cart
15584 ! call int_from_cart1(.false.)
15586 ! write (iout,*) 'Processor',myrank,
15587 ! & ' calling etotal_short ipot=',ipot
15589 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15591 !d print *,'nnt=',nnt,' nct=',nct
15593 !elwrite(iout,*)"in etotal long"
15594 ! Compute the side-chain and electrostatic interaction energy
15596 goto (101,102,103,104,105,106) ipot
15597 ! Lennard-Jones potential.
15598 101 call elj_long(evdw)
15599 !d print '(a)','Exit ELJ'
15601 ! Lennard-Jones-Kihara potential (shifted).
15602 102 call eljk_long(evdw)
15604 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15605 103 call ebp_long(evdw)
15607 ! Gay-Berne potential (shifted LJ, angular dependence).
15608 104 call egb_long(evdw)
15610 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15611 105 call egbv_long(evdw)
15613 ! Soft-sphere potential
15614 106 call e_softsphere(evdw)
15616 ! Calculate electrostatic (H-bonding) energy of the main chain.
15620 if (ipot.lt.6) then
15622 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
15623 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15624 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15625 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15627 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
15628 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15629 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15630 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15632 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
15641 ! write (iout,*) "Soft-spheer ELEC potential"
15642 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
15646 ! Calculate excluded-volume interaction energy between peptide groups
15649 if (ipot.lt.6) then
15650 if(wscp.gt.0d0) then
15651 call escp_long(evdw2,evdw2_14)
15657 call escp_soft_sphere(evdw2,evdw2_14)
15660 ! 12/1/95 Multi-body terms
15664 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
15665 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
15666 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
15667 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
15668 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
15675 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
15676 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
15679 ! If performing constraint dynamics, call the constraint energy
15680 ! after the equilibration time
15681 if(usampl.and.totT.gt.eq_time) then
15696 energia(2)=evdw2-evdw2_14
15697 energia(18)=evdw2_14
15706 energia(3)=ees+evdw1
15713 energia(8)=eello_turn3
15714 energia(9)=eello_turn4
15716 energia(20)=Uconst+Uconst_back
15717 call sum_energy(energia,.true.)
15718 ! write (iout,*) "Exit ETOTAL_LONG"
15721 end subroutine etotal_long
15722 !-----------------------------------------------------------------------------
15723 subroutine etotal_short(energia)
15725 ! Compute the short-range fast-varying contributions to the energy
15727 ! implicit real*8 (a-h,o-z)
15728 ! include 'DIMENSIONS'
15732 !MS$ATTRIBUTES C :: proc_proc
15737 integer :: ierror,ierr
15738 real(kind=8),dimension(n_ene) :: weights_
15739 real(kind=8) :: time00
15741 ! include 'COMMON.SETUP'
15742 ! include 'COMMON.IOUNITS'
15743 ! include 'COMMON.FFIELD'
15744 ! include 'COMMON.DERIV'
15745 ! include 'COMMON.INTERACT'
15746 ! include 'COMMON.SBRIDGE'
15747 ! include 'COMMON.CHAIN'
15748 ! include 'COMMON.VAR'
15749 ! include 'COMMON.LOCAL'
15750 real(kind=8),dimension(0:n_ene) :: energia
15751 !el local variables
15753 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
15754 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr
15757 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
15759 if (modecalc.eq.12.or.modecalc.eq.14) then
15761 if (fg_rank.eq.0) call int_from_cart1(.false.)
15763 call int_from_cart1(.false.)
15767 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
15768 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15770 if (nfgtasks.gt.1) then
15772 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15773 if (fg_rank.eq.0) then
15774 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
15775 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15777 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15778 ! FG slaves as WEIGHTS array.
15785 weights_(7)=wel_loc
15788 weights_(10)=wturn6
15790 weights_(12)=wscloc
15792 weights_(14)=wtor_d
15793 weights_(15)=wstrain
15794 weights_(16)=wvdwpp
15796 weights_(18)=scal14
15797 weights_(21)=wsccor
15798 ! FG Master broadcasts the WEIGHTS_ array
15799 call MPI_Bcast(weights_(1),n_ene,&
15800 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15802 ! FG slaves receive the WEIGHTS array
15803 call MPI_Bcast(weights(1),n_ene,&
15804 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15819 wstrain=weights(15)
15825 ! write (iout,*),"Processor",myrank," BROADCAST weights"
15826 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
15828 ! write (iout,*) "Processor",myrank," BROADCAST c"
15829 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
15831 ! write (iout,*) "Processor",myrank," BROADCAST dc"
15832 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
15834 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
15835 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
15837 ! write (iout,*) "Processor",myrank," BROADCAST theta"
15838 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
15840 ! write (iout,*) "Processor",myrank," BROADCAST phi"
15841 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
15843 ! write (iout,*) "Processor",myrank," BROADCAST alph"
15844 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
15846 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
15847 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
15849 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
15850 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
15852 time_Bcast=time_Bcast+MPI_Wtime()-time00
15853 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
15855 ! write (iout,*) 'Processor',myrank,
15856 ! & ' calling etotal_short ipot=',ipot
15858 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15860 ! call int_from_cart1(.false.)
15862 ! Compute the side-chain and electrostatic interaction energy
15864 goto (101,102,103,104,105,106) ipot
15865 ! Lennard-Jones potential.
15866 101 call elj_short(evdw)
15867 !d print '(a)','Exit ELJ'
15869 ! Lennard-Jones-Kihara potential (shifted).
15870 102 call eljk_short(evdw)
15872 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15873 103 call ebp_short(evdw)
15875 ! Gay-Berne potential (shifted LJ, angular dependence).
15876 104 call egb_short(evdw)
15878 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15879 105 call egbv_short(evdw)
15881 ! Soft-sphere potential - already dealt with in the long-range part
15883 ! 106 call e_softsphere_short(evdw)
15885 ! Calculate electrostatic (H-bonding) energy of the main chain.
15889 ! Calculate the short-range part of Evdwpp
15891 call evdwpp_short(evdw1)
15893 ! Calculate the short-range part of ESCp
15895 if (ipot.lt.6) then
15896 call escp_short(evdw2,evdw2_14)
15899 ! Calculate the bond-stretching energy
15903 ! Calculate the disulfide-bridge and other energy and the contributions
15904 ! from other distance constraints.
15907 ! Calculate the virtual-bond-angle energy.
15909 call ebend(ebe,ethetacnstr)
15911 ! Calculate the SC local energy.
15916 ! Calculate the virtual-bond torsional energy.
15918 call etor(etors,edihcnstr)
15920 ! 6/23/01 Calculate double-torsional energy
15922 call etor_d(etors_d)
15924 ! 21/5/07 Calculate local sicdechain correlation energy
15926 if (wsccor.gt.0.0d0) then
15927 call eback_sc_corr(esccor)
15932 ! Put energy components into an array
15939 energia(2)=evdw2-evdw2_14
15940 energia(18)=evdw2_14
15953 energia(14)=etors_d
15956 energia(19)=edihcnstr
15958 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
15960 call sum_energy(energia,.true.)
15961 ! write (iout,*) "Exit ETOTAL_SHORT"
15964 end subroutine etotal_short
15965 !-----------------------------------------------------------------------------
15967 !-----------------------------------------------------------------------------
15968 real(kind=8) function gnmr1(y,ymin,ymax)
15970 real(kind=8) :: y,ymin,ymax
15971 real(kind=8) :: wykl=4.0d0
15972 if (y.lt.ymin) then
15973 gnmr1=(ymin-y)**wykl/wykl
15974 else if (y.gt.ymax) then
15975 gnmr1=(y-ymax)**wykl/wykl
15981 !-----------------------------------------------------------------------------
15982 real(kind=8) function gnmr1prim(y,ymin,ymax)
15984 real(kind=8) :: y,ymin,ymax
15985 real(kind=8) :: wykl=4.0d0
15986 if (y.lt.ymin) then
15987 gnmr1prim=-(ymin-y)**(wykl-1)
15988 else if (y.gt.ymax) then
15989 gnmr1prim=(y-ymax)**(wykl-1)
15994 end function gnmr1prim
15995 !----------------------------------------------------------------------------
15996 real(kind=8) function rlornmr1(y,ymin,ymax,sigma)
15997 real(kind=8) y,ymin,ymax,sigma
15998 real(kind=8) wykl /4.0d0/
15999 if (y.lt.ymin) then
16000 rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl)
16001 else if (y.gt.ymax) then
16002 rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
16007 end function rlornmr1
16008 !------------------------------------------------------------------------------
16009 real(kind=8) function rlornmr1prim(y,ymin,ymax,sigma)
16010 real(kind=8) y,ymin,ymax,sigma
16011 real(kind=8) wykl /4.0d0/
16012 if (y.lt.ymin) then
16013 rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ &
16014 ((ymin-y)**wykl+sigma**wykl)**2
16015 else if (y.gt.ymax) then
16016 rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ &
16017 ((y-ymax)**wykl+sigma**wykl)**2
16022 end function rlornmr1prim
16024 real(kind=8) function harmonic(y,ymax)
16026 real(kind=8) :: y,ymax
16027 real(kind=8) :: wykl=2.0d0
16028 harmonic=(y-ymax)**wykl
16030 end function harmonic
16031 !-----------------------------------------------------------------------------
16032 real(kind=8) function harmonicprim(y,ymax)
16033 real(kind=8) :: y,ymin,ymax
16034 real(kind=8) :: wykl=2.0d0
16035 harmonicprim=(y-ymax)*wykl
16037 end function harmonicprim
16038 !-----------------------------------------------------------------------------
16040 !-----------------------------------------------------------------------------
16041 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
16043 use io_base, only:intout,briefout
16044 ! implicit real*8 (a-h,o-z)
16045 ! include 'DIMENSIONS'
16046 ! include 'COMMON.CHAIN'
16047 ! include 'COMMON.DERIV'
16048 ! include 'COMMON.VAR'
16049 ! include 'COMMON.INTERACT'
16050 ! include 'COMMON.FFIELD'
16051 ! include 'COMMON.MD'
16052 ! include 'COMMON.IOUNITS'
16053 real(kind=8),external :: ufparm
16054 integer :: uiparm(1)
16055 real(kind=8) :: urparm(1)
16056 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
16057 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
16058 integer :: n,nf,ind,ind1,i,k,j
16060 ! This subroutine calculates total internal coordinate gradient.
16061 ! Depending on the number of function evaluations, either whole energy
16062 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
16063 ! internal coordinates are reevaluated or only the cartesian-in-internal
16064 ! coordinate derivatives are evaluated. The subroutine was designed to work
16070 !d print *,'grad',nf,icg
16071 if (nf-nfl+1) 20,30,40
16072 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
16073 ! write (iout,*) 'grad 20'
16074 if (nf.eq.0) return
16076 30 call var_to_geom(n,x)
16078 ! write (iout,*) 'grad 30'
16080 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
16083 ! write (iout,*) 'grad 40'
16084 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
16086 ! Convert the Cartesian gradient into internal-coordinate gradient.
16096 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
16098 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
16101 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
16107 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
16109 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
16110 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
16113 if (i.gt.1) g(i-1)=gphii
16114 if (n.gt.nphi) g(nphi+i)=gthetai
16116 if (n.le.nphi+ntheta) goto 10
16118 if (itype(i,1).ne.10) then
16122 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
16125 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
16127 g(ialph(i,1))=galphai
16128 g(ialph(i,1)+nside)=gomegai
16132 ! Add the components corresponding to local energy terms.
16136 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
16137 g(i)=g(i)+gloc(i,icg)
16139 ! Uncomment following three lines for diagnostics.
16141 !elwrite(iout,*) "in gradient after calling intout"
16142 !d call briefout(0,0.0d0)
16143 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
16145 end subroutine gradient
16146 !-----------------------------------------------------------------------------
16147 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
16150 ! implicit real*8 (a-h,o-z)
16151 ! include 'DIMENSIONS'
16152 ! include 'COMMON.DERIV'
16153 ! include 'COMMON.IOUNITS'
16154 ! include 'COMMON.GEO'
16157 !el common /chuju/ jjj
16158 real(kind=8) :: energia(0:n_ene)
16159 integer :: uiparm(1)
16160 real(kind=8) :: urparm(1)
16162 real(kind=8),external :: ufparm
16163 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
16164 ! if (jjj.gt.0) then
16165 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
16169 !d print *,'func',nf,nfl,icg
16170 call var_to_geom(n,x)
16173 !d write (iout,*) 'ETOTAL called from FUNC'
16174 call etotal(energia)
16177 ! if (jjj.gt.0) then
16178 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
16179 ! write (iout,*) 'f=',etot
16183 end subroutine func
16184 !-----------------------------------------------------------------------------
16185 subroutine cartgrad
16186 ! implicit real*8 (a-h,o-z)
16187 ! include 'DIMENSIONS'
16189 use MD_data, only: totT,usampl,eq_time
16193 ! include 'COMMON.CHAIN'
16194 ! include 'COMMON.DERIV'
16195 ! include 'COMMON.VAR'
16196 ! include 'COMMON.INTERACT'
16197 ! include 'COMMON.FFIELD'
16198 ! include 'COMMON.MD'
16199 ! include 'COMMON.IOUNITS'
16200 ! include 'COMMON.TIME1'
16204 ! This subrouting calculates total Cartesian coordinate gradient.
16205 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
16215 !el write (iout,*) "After sum_gradient"
16217 !el write (iout,*) "After sum_gradient"
16219 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
16220 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
16223 ! If performing constraint dynamics, add the gradients of the constraint energy
16224 if(usampl.and.totT.gt.eq_time) then
16227 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
16228 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
16232 gloc(i,icg)=gloc(i,icg)+dugamma(i)
16235 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
16238 !elwrite (iout,*) "After sum_gradient"
16243 !elwrite (iout,*) "After sum_gradient"
16245 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
16247 ! call checkintcartgrad
16248 ! write(iout,*) 'calling int_to_cart'
16250 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
16254 gcart(j,i)=gradc(j,i,icg)
16255 gxcart(j,i)=gradx(j,i,icg)
16256 ! if (i.le.2) print *,"gcart_one",gcart(j,i),gradc(j,i,icg)
16259 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
16260 (gxcart(j,i),j=1,3),gloc(i,icg)
16266 ! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
16268 ! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
16271 time_inttocart=time_inttocart+MPI_Wtime()-time01
16274 write (iout,*) "gcart and gxcart after int_to_cart"
16276 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
16277 (gxcart(j,i),j=1,3)
16282 write (iout,*) "CARGRAD"
16286 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
16287 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
16289 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
16290 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
16292 ! Correction: dummy residues
16295 ! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
16296 gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
16299 if (nct.lt.nres) then
16301 ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
16302 gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
16307 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
16311 end subroutine cartgrad
16312 !-----------------------------------------------------------------------------
16313 subroutine zerograd
16314 ! implicit real*8 (a-h,o-z)
16315 ! include 'DIMENSIONS'
16316 ! include 'COMMON.DERIV'
16317 ! include 'COMMON.CHAIN'
16318 ! include 'COMMON.VAR'
16319 ! include 'COMMON.MD'
16320 ! include 'COMMON.SCCOR'
16322 !el local variables
16323 integer :: i,j,intertyp,k
16324 ! Initialize Cartesian-coordinate gradient
16326 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
16327 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
16329 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
16330 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
16331 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
16332 ! allocate(gradcorr_long(3,nres))
16333 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
16334 ! allocate(gcorr6_turn_long(3,nres))
16335 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
16337 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
16339 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
16340 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
16342 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
16343 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
16345 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
16346 ! allocate(gscloc(3,nres)) !(3,maxres)
16347 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
16351 ! common /deriv_scloc/
16352 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
16353 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
16354 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
16356 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
16360 ! gradc(j,i,icg)=0.0d0
16361 ! gradx(j,i,icg)=0.0d0
16363 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
16364 !elwrite(iout,*) "icg",icg
16368 gradx_scp(j,i)=0.0D0
16370 gvdwc_scp(j,i)=0.0D0
16371 gvdwc_scpp(j,i)=0.0d0
16373 gelc_long(j,i)=0.0D0
16378 gel_loc_long(j,i)=0.0d0
16381 gcorr3_turn(j,i)=0.0d0
16382 gcorr4_turn(j,i)=0.0d0
16383 gradcorr(j,i)=0.0d0
16384 gradcorr_long(j,i)=0.0d0
16385 gradcorr5_long(j,i)=0.0d0
16386 gradcorr6_long(j,i)=0.0d0
16387 gcorr6_turn_long(j,i)=0.0d0
16388 gradcorr5(j,i)=0.0d0
16389 gradcorr6(j,i)=0.0d0
16390 gcorr6_turn(j,i)=0.0d0
16393 gradc(j,i,icg)=0.0d0
16394 gradx(j,i,icg)=0.0d0
16397 gliptran(j,i)=0.0d0
16398 gliptranx(j,i)=0.0d0
16399 gliptranc(j,i)=0.0d0
16400 gshieldx(j,i)=0.0d0
16401 gshieldc(j,i)=0.0d0
16402 gshieldc_loc(j,i)=0.0d0
16403 gshieldx_ec(j,i)=0.0d0
16404 gshieldc_ec(j,i)=0.0d0
16405 gshieldc_loc_ec(j,i)=0.0d0
16406 gshieldx_t3(j,i)=0.0d0
16407 gshieldc_t3(j,i)=0.0d0
16408 gshieldc_loc_t3(j,i)=0.0d0
16409 gshieldx_t4(j,i)=0.0d0
16410 gshieldc_t4(j,i)=0.0d0
16411 gshieldc_loc_t4(j,i)=0.0d0
16412 gshieldx_ll(j,i)=0.0d0
16413 gshieldc_ll(j,i)=0.0d0
16414 gshieldc_loc_ll(j,i)=0.0d0
16416 gg_tube_sc(j,i)=0.0d0
16418 gradb_nucl(j,i)=0.0d0
16419 gradbx_nucl(j,i)=0.0d0
16420 gvdwpp_nucl(j,i)=0.0d0
16424 gvdwpsb1(j,i)=0.0d0
16428 gradcorr_nucl(j,i)=0.0d0
16429 gradcorr3_nucl(j,i)=0.0d0
16430 gradxorr_nucl(j,i)=0.0d0
16431 gradxorr3_nucl(j,i)=0.0d0
16435 gradpepcat(j,i)=0.0d0
16436 gradpepcatx(j,i)=0.0d0
16437 gradcatcat(j,i)=0.0d0
16438 gvdwx_scbase(j,i)=0.0d0
16439 gvdwc_scbase(j,i)=0.0d0
16440 gvdwx_pepbase(j,i)=0.0d0
16441 gvdwc_pepbase(j,i)=0.0d0
16442 gvdwx_scpho(j,i)=0.0d0
16443 gvdwc_scpho(j,i)=0.0d0
16444 gvdwc_peppho(j,i)=0.0d0
16450 gloc_sc(intertyp,i,icg)=0.0d0
16459 grad_shield_side(k,j,i)=0.0d0
16460 grad_shield_loc(k,j,i)=0.0d0
16467 ! Initialize the gradient of local energy terms.
16469 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
16470 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
16471 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
16472 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
16473 ! allocate(gel_loc_turn3(nres))
16474 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
16475 ! allocate(gsccor_loc(nres)) !(maxres)
16481 gel_loc_loc(i)=0.0d0
16483 g_corr5_loc(i)=0.0d0
16484 g_corr6_loc(i)=0.0d0
16485 gel_loc_turn3(i)=0.0d0
16486 gel_loc_turn4(i)=0.0d0
16487 gel_loc_turn6(i)=0.0d0
16488 gsccor_loc(i)=0.0d0
16490 ! initialize gcart and gxcart
16491 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
16499 end subroutine zerograd
16500 !-----------------------------------------------------------------------------
16501 real(kind=8) function fdum()
16505 !-----------------------------------------------------------------------------
16507 !-----------------------------------------------------------------------------
16508 subroutine intcartderiv
16509 ! implicit real*8 (a-h,o-z)
16510 ! include 'DIMENSIONS'
16514 ! include 'COMMON.SETUP'
16515 ! include 'COMMON.CHAIN'
16516 ! include 'COMMON.VAR'
16517 ! include 'COMMON.GEO'
16518 ! include 'COMMON.INTERACT'
16519 ! include 'COMMON.DERIV'
16520 ! include 'COMMON.IOUNITS'
16521 ! include 'COMMON.LOCAL'
16522 ! include 'COMMON.SCCOR'
16523 real(kind=8) :: pi4,pi34
16524 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
16525 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
16526 dcosomega,dsinomega !(3,3,maxres)
16527 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
16530 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
16531 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
16532 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
16533 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
16537 !el from module energy-------------
16538 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
16539 !el allocate(dsintau(3,3,3,itau_start:itau_end))
16540 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
16542 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
16543 !el allocate(dsintau(3,3,3,0:nres2))
16544 !el allocate(dtauangle(3,3,3,0:nres2))
16545 !el allocate(domicron(3,2,2,0:nres2))
16546 !el allocate(dcosomicron(3,2,2,0:nres2))
16550 #if defined(MPI) && defined(PARINTDER)
16551 if (nfgtasks.gt.1 .and. me.eq.king) &
16552 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
16557 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
16558 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
16560 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
16563 dtheta(j,1,i)=0.0d0
16564 dtheta(j,2,i)=0.0d0
16570 ! Derivatives of theta's
16571 #if defined(MPI) && defined(PARINTDER)
16572 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16573 do i=max0(ithet_start-1,3),ithet_end
16577 cost=dcos(theta(i))
16578 sint=sqrt(1-cost*cost)
16580 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
16582 if (itype(i-1,1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
16583 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
16585 if (itype(i-1,1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
16588 #if defined(MPI) && defined(PARINTDER)
16589 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16590 do i=max0(ithet_start-1,3),ithet_end
16594 if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1)) then
16595 cost1=dcos(omicron(1,i))
16596 sint1=sqrt(1-cost1*cost1)
16597 cost2=dcos(omicron(2,i))
16598 sint2=sqrt(1-cost2*cost2)
16600 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
16601 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
16602 cost1*dc_norm(j,i-2))/ &
16604 domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i)
16605 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
16606 +cost1*(dc_norm(j,i-1+nres)))/ &
16608 domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i)
16609 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
16610 !C Looks messy but better than if in loop
16611 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
16612 +cost2*dc_norm(j,i-1))/ &
16614 domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i)
16615 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
16616 +cost2*(-dc_norm(j,i-1+nres)))/ &
16618 ! write(iout,*) "vbld", i,itype(i,1),vbld(i-1+nres)
16619 domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i)
16623 !elwrite(iout,*) "after vbld write"
16624 ! Derivatives of phi:
16625 ! If phi is 0 or 180 degrees, then the formulas
16626 ! have to be derived by power series expansion of the
16627 ! conventional formulas around 0 and 180.
16629 do i=iphi1_start,iphi1_end
16633 ! if (itype(i-1,1).eq.21 .or. itype(i-2,1).eq.21 ) cycle
16634 ! the conventional case
16635 sint=dsin(theta(i))
16636 sint1=dsin(theta(i-1))
16638 cost=dcos(theta(i))
16639 cost1=dcos(theta(i-1))
16641 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
16642 fac0=1.0d0/(sint1*sint)
16645 fac3=cosg*cost1/(sint1*sint1)
16646 fac4=cosg*cost/(sint*sint)
16647 ! Obtaining the gamma derivatives from sine derivative
16648 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
16649 phi(i).gt.pi34.and.phi(i).le.pi.or. &
16650 phi(i).ge.-pi.and.phi(i).le.-pi34) then
16651 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16652 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
16653 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16657 cosg_inv=1.0d0/cosg
16658 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
16659 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16660 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
16661 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
16663 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
16664 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16665 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
16666 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
16667 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16668 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16669 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
16671 ! Bug fixed 3/24/05 (AL)
16673 ! Obtaining the gamma derivatives from cosine derivative
16676 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
16677 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16678 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16679 dc_norm(j,i-3))/vbld(i-2)
16680 dphi(j,1,i)=-1/sing*dcosphi(j,1,i)
16681 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16682 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16684 dphi(j,2,i)=-1/sing*dcosphi(j,2,i)
16685 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16686 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16687 dc_norm(j,i-1))/vbld(i)
16688 dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
16693 !alculate derivative of Tauangle
16695 do i=itau_start,itau_end
16698 !elwrite(iout,*) " vecpr",i,nres
16700 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
16701 ! if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10).or.
16702 ! & (itype(i-1,1).eq.ntyp1).or.(itype(i,1).eq.ntyp1)) cycle
16703 !c dtauangle(j,intertyp,dervityp,residue number)
16704 !c INTERTYP=1 SC...Ca...Ca..Ca
16705 ! the conventional case
16706 sint=dsin(theta(i))
16707 sint1=dsin(omicron(2,i-1))
16708 sing=dsin(tauangle(1,i))
16709 cost=dcos(theta(i))
16710 cost1=dcos(omicron(2,i-1))
16711 cosg=dcos(tauangle(1,i))
16712 !elwrite(iout,*) " vecpr5",i,nres
16714 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
16715 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
16716 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16717 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
16719 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
16720 fac0=1.0d0/(sint1*sint)
16723 fac3=cosg*cost1/(sint1*sint1)
16724 fac4=cosg*cost/(sint*sint)
16725 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
16726 ! Obtaining the gamma derivatives from sine derivative
16727 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
16728 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
16729 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
16730 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16731 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
16732 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16736 cosg_inv=1.0d0/cosg
16737 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16738 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
16739 *vbld_inv(i-2+nres)
16740 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
16741 dsintau(j,1,2,i)= &
16742 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
16743 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16744 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
16745 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
16746 ! Bug fixed 3/24/05 (AL)
16747 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
16748 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16749 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16750 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
16752 ! Obtaining the gamma derivatives from cosine derivative
16755 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16756 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16757 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
16758 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
16759 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16760 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16762 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
16763 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16764 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
16765 dc_norm(j,i-1))/vbld(i)
16766 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
16767 ! write (iout,*) "else",i
16771 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
16774 !C Second case Ca...Ca...Ca...SC
16776 do i=itau_start,itau_end
16780 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
16781 (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle
16782 ! the conventional case
16783 sint=dsin(omicron(1,i))
16784 sint1=dsin(theta(i-1))
16785 sing=dsin(tauangle(2,i))
16786 cost=dcos(omicron(1,i))
16787 cost1=dcos(theta(i-1))
16788 cosg=dcos(tauangle(2,i))
16790 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16792 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
16793 fac0=1.0d0/(sint1*sint)
16796 fac3=cosg*cost1/(sint1*sint1)
16797 fac4=cosg*cost/(sint*sint)
16798 ! Obtaining the gamma derivatives from sine derivative
16799 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
16800 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
16801 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
16802 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
16803 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
16804 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16808 cosg_inv=1.0d0/cosg
16809 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16810 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
16811 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
16812 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
16813 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
16814 dsintau(j,2,2,i)= &
16815 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
16816 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16817 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
16818 ! & sing*ctgt*domicron(j,1,2,i),
16819 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16820 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
16821 ! Bug fixed 3/24/05 (AL)
16822 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16823 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
16824 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16825 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
16827 ! Obtaining the gamma derivatives from cosine derivative
16830 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16831 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16832 dc_norm(j,i-3))/vbld(i-2)
16833 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
16834 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16835 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16836 dcosomicron(j,1,1,i)
16837 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
16838 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16839 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16840 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16841 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
16842 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
16847 !CC third case SC...Ca...Ca...SC
16850 do i=itau_start,itau_end
16854 ! the conventional case
16855 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
16856 (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
16857 sint=dsin(omicron(1,i))
16858 sint1=dsin(omicron(2,i-1))
16859 sing=dsin(tauangle(3,i))
16860 cost=dcos(omicron(1,i))
16861 cost1=dcos(omicron(2,i-1))
16862 cosg=dcos(tauangle(3,i))
16864 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16865 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16867 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
16868 fac0=1.0d0/(sint1*sint)
16871 fac3=cosg*cost1/(sint1*sint1)
16872 fac4=cosg*cost/(sint*sint)
16873 ! Obtaining the gamma derivatives from sine derivative
16874 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
16875 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
16876 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
16877 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
16878 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
16879 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16883 cosg_inv=1.0d0/cosg
16884 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16885 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
16886 *vbld_inv(i-2+nres)
16887 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
16888 dsintau(j,3,2,i)= &
16889 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
16890 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16891 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
16892 ! Bug fixed 3/24/05 (AL)
16893 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16894 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
16895 *vbld_inv(i-1+nres)
16896 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16897 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
16899 ! Obtaining the gamma derivatives from cosine derivative
16902 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16903 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16904 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
16905 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
16906 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16907 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16908 dcosomicron(j,1,1,i)
16909 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
16910 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16911 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
16912 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16913 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
16914 ! write(iout,*) "else",i
16920 ! Derivatives of side-chain angles alpha and omega
16921 #if defined(MPI) && defined(PARINTDER)
16922 do i=ibond_start,ibond_end
16926 if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
16927 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
16930 fac8=fac5/vbld(i+1)
16931 fac9=fac5/vbld(i+nres)
16932 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
16933 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
16934 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
16935 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
16936 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
16937 sina=sqrt(1-cosa*cosa)
16939 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
16941 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
16942 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
16943 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
16944 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
16945 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
16946 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
16947 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
16948 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
16950 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
16952 ! obtaining the derivatives of omega from sines
16953 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
16954 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
16955 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
16956 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
16958 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
16959 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
16960 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
16961 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
16962 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
16963 coso_inv=1.0d0/dcos(omeg(i))
16965 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
16966 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
16967 (sino*dc_norm(j,i-1))/vbld(i)
16968 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
16969 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
16970 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
16971 -sino*dc_norm(j,i)/vbld(i+1)
16972 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
16973 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
16974 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
16976 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
16979 ! obtaining the derivatives of omega from cosines
16980 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
16981 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
16986 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
16987 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
16988 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
16989 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
16990 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
16991 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
16992 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
16993 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
16994 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
16995 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
16996 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
16997 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
16998 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
16999 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
17000 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
17006 dalpha(k,j,i)=0.0d0
17007 domega(k,j,i)=0.0d0
17013 #if defined(MPI) && defined(PARINTDER)
17014 if (nfgtasks.gt.1) then
17016 !d write (iout,*) "Gather dtheta"
17017 !d call flush(iout)
17018 write (iout,*) "dtheta before gather"
17020 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
17023 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
17024 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
17025 king,FG_COMM,IERROR)
17027 !d write (iout,*) "Gather dphi"
17028 !d call flush(iout)
17029 write (iout,*) "dphi before gather"
17031 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
17034 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
17035 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
17036 king,FG_COMM,IERROR)
17037 !d write (iout,*) "Gather dalpha"
17038 !d call flush(iout)
17040 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
17041 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
17042 king,FG_COMM,IERROR)
17043 !d write (iout,*) "Gather domega"
17044 !d call flush(iout)
17045 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
17046 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
17047 king,FG_COMM,IERROR)
17052 write (iout,*) "dtheta after gather"
17054 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
17056 write (iout,*) "dphi after gather"
17058 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
17060 write (iout,*) "dalpha after gather"
17062 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
17064 write (iout,*) "domega after gather"
17066 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
17070 end subroutine intcartderiv
17071 !-----------------------------------------------------------------------------
17072 subroutine checkintcartgrad
17073 ! implicit real*8 (a-h,o-z)
17074 ! include 'DIMENSIONS'
17078 ! include 'COMMON.CHAIN'
17079 ! include 'COMMON.VAR'
17080 ! include 'COMMON.GEO'
17081 ! include 'COMMON.INTERACT'
17082 ! include 'COMMON.DERIV'
17083 ! include 'COMMON.IOUNITS'
17084 ! include 'COMMON.SETUP'
17085 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
17086 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
17087 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
17088 real(kind=8),dimension(3) :: dc_norm_s
17089 real(kind=8) :: aincr=1.0d-5
17091 real(kind=8) :: dcji
17094 theta_s(i)=theta(i)
17098 ! Check theta gradient
17100 "Analytical (upper) and numerical (lower) gradient of theta"
17105 dc(j,i-2)=dcji+aincr
17106 call chainbuild_cart
17107 call int_from_cart1(.false.)
17108 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
17111 dc(j,i-1)=dc(j,i-1)+aincr
17112 call chainbuild_cart
17113 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
17116 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
17117 !el (dtheta(j,2,i),j=1,3)
17118 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
17119 !el (dthetanum(j,2,i),j=1,3)
17120 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
17121 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
17122 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
17125 ! Check gamma gradient
17127 "Analytical (upper) and numerical (lower) gradient of gamma"
17131 dc(j,i-3)=dcji+aincr
17132 call chainbuild_cart
17133 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
17136 dc(j,i-2)=dcji+aincr
17137 call chainbuild_cart
17138 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
17141 dc(j,i-1)=dc(j,i-1)+aincr
17142 call chainbuild_cart
17143 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
17146 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
17147 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
17148 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
17149 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
17150 !el write (iout,'(5x,3(3f10.5,5x))') &
17151 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
17152 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
17153 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
17156 ! Check alpha gradient
17158 "Analytical (upper) and numerical (lower) gradient of alpha"
17160 if(itype(i,1).ne.10) then
17163 dc(j,i-1)=dcji+aincr
17164 call chainbuild_cart
17165 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
17170 call chainbuild_cart
17171 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
17175 dc(j,i+nres)=dc(j,i+nres)+aincr
17176 call chainbuild_cart
17177 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
17182 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
17183 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
17184 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
17185 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
17186 !el write (iout,'(5x,3(3f10.5,5x))') &
17187 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
17188 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
17189 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
17192 ! Check omega gradient
17194 "Analytical (upper) and numerical (lower) gradient of omega"
17196 if(itype(i,1).ne.10) then
17199 dc(j,i-1)=dcji+aincr
17200 call chainbuild_cart
17201 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
17206 call chainbuild_cart
17207 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
17211 dc(j,i+nres)=dc(j,i+nres)+aincr
17212 call chainbuild_cart
17213 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
17218 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
17219 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
17220 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
17221 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
17222 !el write (iout,'(5x,3(3f10.5,5x))') &
17223 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
17224 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
17225 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
17229 end subroutine checkintcartgrad
17230 !-----------------------------------------------------------------------------
17232 !-----------------------------------------------------------------------------
17233 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
17234 ! implicit real*8 (a-h,o-z)
17235 ! include 'DIMENSIONS'
17236 ! include 'COMMON.IOUNITS'
17237 ! include 'COMMON.CHAIN'
17238 ! include 'COMMON.INTERACT'
17239 ! include 'COMMON.VAR'
17240 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
17241 integer :: kkk,nsep=3
17242 real(kind=8) :: qm !dist,
17243 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
17244 logical :: lprn=.false.
17246 ! real(kind=8) :: sigm,x
17248 !el sigm(x)=0.25d0*x ! local function
17254 do il=seg1+nsep,seg2
17257 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
17258 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
17259 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17261 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
17262 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17265 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17266 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17267 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17268 dijCM=dist(il+nres,jl+nres)
17269 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
17271 qq = qq+qqij+qqijCM
17277 if((seg3-il).lt.3) then
17284 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17285 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17286 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17288 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
17289 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17292 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17293 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17294 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17295 dijCM=dist(il+nres,jl+nres)
17296 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
17298 qq = qq+qqij+qqijCM
17303 if (qqmax.le.qq) qqmax=qq
17305 qwolynes=1.0d0-qqmax
17307 end function qwolynes
17308 !-----------------------------------------------------------------------------
17309 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
17310 ! implicit real*8 (a-h,o-z)
17311 ! include 'DIMENSIONS'
17312 ! include 'COMMON.IOUNITS'
17313 ! include 'COMMON.CHAIN'
17314 ! include 'COMMON.INTERACT'
17315 ! include 'COMMON.VAR'
17316 ! include 'COMMON.MD'
17317 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
17318 integer :: nsep=3, kkk
17319 !el real(kind=8) :: dist
17320 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
17321 logical :: lprn=.false.
17323 real(kind=8) :: sim,dd0,fac,ddqij
17324 !el sigm(x)=0.25d0*x ! local function
17334 do il=seg1+nsep,seg2
17337 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17338 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17339 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17341 sim = 1.0d0/sigm(d0ij)
17344 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
17346 ddqij = (c(k,il)-c(k,jl))*fac
17347 dqwol(k,il)=dqwol(k,il)+ddqij
17348 dqwol(k,jl)=dqwol(k,jl)-ddqij
17351 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17354 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17355 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17356 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17357 dijCM=dist(il+nres,jl+nres)
17358 sim = 1.0d0/sigm(d0ijCM)
17361 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17363 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17364 dxqwol(k,il)=dxqwol(k,il)+ddqij
17365 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17372 if((seg3-il).lt.3) then
17379 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17380 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17381 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17383 sim = 1.0d0/sigm(d0ij)
17386 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
17388 ddqij = (c(k,il)-c(k,jl))*fac
17389 dqwol(k,il)=dqwol(k,il)+ddqij
17390 dqwol(k,jl)=dqwol(k,jl)-ddqij
17392 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17395 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17396 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17397 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17398 dijCM=dist(il+nres,jl+nres)
17399 sim = 1.0d0/sigm(d0ijCM)
17402 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17404 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17405 dxqwol(k,il)=dxqwol(k,il)+ddqij
17406 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17415 dqwol(j,i)=dqwol(j,i)/nl
17416 dxqwol(j,i)=dxqwol(j,i)/nl
17420 end subroutine qwolynes_prim
17421 !-----------------------------------------------------------------------------
17422 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
17423 ! implicit real*8 (a-h,o-z)
17424 ! include 'DIMENSIONS'
17425 ! include 'COMMON.IOUNITS'
17426 ! include 'COMMON.CHAIN'
17427 ! include 'COMMON.INTERACT'
17428 ! include 'COMMON.VAR'
17429 integer :: seg1,seg2,seg3,seg4
17431 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
17432 real(kind=8),dimension(3,0:2*nres) :: cdummy
17433 real(kind=8) :: q1,q2
17434 real(kind=8) :: delta=1.0d-10
17439 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
17441 c(j,i)=c(j,i)+delta
17442 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
17443 qwolan(j,i)=(q2-q1)/delta
17449 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
17450 cdummy(j,i+nres)=c(j,i+nres)
17451 c(j,i+nres)=c(j,i+nres)+delta
17452 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
17453 qwolxan(j,i)=(q2-q1)/delta
17454 c(j,i+nres)=cdummy(j,i+nres)
17457 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
17459 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
17461 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
17463 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
17466 end subroutine qwol_num
17467 !-----------------------------------------------------------------------------
17468 subroutine EconstrQ
17469 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
17470 ! implicit real*8 (a-h,o-z)
17471 ! include 'DIMENSIONS'
17472 ! include 'COMMON.CONTROL'
17473 ! include 'COMMON.VAR'
17474 ! include 'COMMON.MD'
17477 ! include 'COMMON.LANGEVIN'
17479 ! include 'COMMON.LANGEVIN.lang0'
17481 ! include 'COMMON.CHAIN'
17482 ! include 'COMMON.DERIV'
17483 ! include 'COMMON.GEO'
17484 ! include 'COMMON.LOCAL'
17485 ! include 'COMMON.INTERACT'
17486 ! include 'COMMON.IOUNITS'
17487 ! include 'COMMON.NAMES'
17488 ! include 'COMMON.TIME1'
17489 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
17490 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
17492 integer :: kstart,kend,lstart,lend,idummy
17493 real(kind=8) :: delta=1.0d-7
17494 integer :: i,j,k,ii
17498 dudconst(j,i)=0.0d0
17499 duxconst(j,i)=0.0d0
17500 dudxconst(j,i)=0.0d0
17505 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
17507 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
17508 ! Calculating the derivatives of Constraint energy with respect to Q
17509 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
17511 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
17512 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
17513 ! hmnum=(hm2-hm1)/delta
17514 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
17515 ! & qinfrag(i,iset))
17516 ! write(iout,*) "harmonicnum frag", hmnum
17517 ! Calculating the derivatives of Q with respect to cartesian coordinates
17518 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
17520 ! write(iout,*) "dqwol "
17522 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17524 ! write(iout,*) "dxqwol "
17526 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17528 ! Calculating numerical gradients of dU/dQi and dQi/dxi
17529 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
17530 ! & ,idummy,idummy)
17531 ! The gradients of Uconst in Cs
17534 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
17535 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
17540 kstart=ifrag(1,ipair(1,i,iset),iset)
17541 kend=ifrag(2,ipair(1,i,iset),iset)
17542 lstart=ifrag(1,ipair(2,i,iset),iset)
17543 lend=ifrag(2,ipair(2,i,iset),iset)
17544 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
17545 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
17546 ! Calculating dU/dQ
17547 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
17548 ! hm1=harmonic(qpair(i),qinpair(i,iset))
17549 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
17550 ! hmnum=(hm2-hm1)/delta
17551 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
17552 ! & qinpair(i,iset))
17553 ! write(iout,*) "harmonicnum pair ", hmnum
17554 ! Calculating dQ/dXi
17555 call qwolynes_prim(kstart,kend,.false.,&
17557 ! write(iout,*) "dqwol "
17559 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17561 ! write(iout,*) "dxqwol "
17563 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17565 ! Calculating numerical gradients
17566 ! call qwol_num(kstart,kend,.false.
17568 ! The gradients of Uconst in Cs
17571 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
17572 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
17576 ! write(iout,*) "Uconst inside subroutine ", Uconst
17577 ! Transforming the gradients from Cs to dCs for the backbone
17581 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
17585 ! Transforming the gradients from Cs to dCs for the side chains
17588 dudxconst(j,i)=duxconst(j,i)
17591 ! write(iout,*) "dU/ddc backbone "
17593 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
17595 ! write(iout,*) "dU/ddX side chain "
17597 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
17599 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
17600 ! call dEconstrQ_num
17602 end subroutine EconstrQ
17603 !-----------------------------------------------------------------------------
17604 subroutine dEconstrQ_num
17605 ! Calculating numerical dUconst/ddc and dUconst/ddx
17606 ! implicit real*8 (a-h,o-z)
17607 ! include 'DIMENSIONS'
17608 ! include 'COMMON.CONTROL'
17609 ! include 'COMMON.VAR'
17610 ! include 'COMMON.MD'
17613 ! include 'COMMON.LANGEVIN'
17615 ! include 'COMMON.LANGEVIN.lang0'
17617 ! include 'COMMON.CHAIN'
17618 ! include 'COMMON.DERIV'
17619 ! include 'COMMON.GEO'
17620 ! include 'COMMON.LOCAL'
17621 ! include 'COMMON.INTERACT'
17622 ! include 'COMMON.IOUNITS'
17623 ! include 'COMMON.NAMES'
17624 ! include 'COMMON.TIME1'
17625 real(kind=8) :: uzap1,uzap2
17626 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
17627 integer :: kstart,kend,lstart,lend,idummy
17628 real(kind=8) :: delta=1.0d-7
17629 !el local variables
17635 dUcartan(j,i)=0.0d0
17636 cdummy(j,i)=dc(j,i)
17637 dc(j,i)=dc(j,i)+delta
17638 call chainbuild_cart
17641 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17643 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17647 kstart=ifrag(1,ipair(1,ii,iset),iset)
17648 kend=ifrag(2,ipair(1,ii,iset),iset)
17649 lstart=ifrag(1,ipair(2,ii,iset),iset)
17650 lend=ifrag(2,ipair(2,ii,iset),iset)
17651 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17652 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17655 dc(j,i)=cdummy(j,i)
17656 call chainbuild_cart
17659 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17661 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17665 kstart=ifrag(1,ipair(1,ii,iset),iset)
17666 kend=ifrag(2,ipair(1,ii,iset),iset)
17667 lstart=ifrag(1,ipair(2,ii,iset),iset)
17668 lend=ifrag(2,ipair(2,ii,iset),iset)
17669 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17670 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17673 ducartan(j,i)=(uzap2-uzap1)/(delta)
17676 ! Calculating numerical gradients for dU/ddx
17678 duxcartan(j,i)=0.0d0
17680 cdummy(j,i)=dc(j,i+nres)
17681 dc(j,i+nres)=dc(j,i+nres)+delta
17682 call chainbuild_cart
17685 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17687 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17691 kstart=ifrag(1,ipair(1,ii,iset),iset)
17692 kend=ifrag(2,ipair(1,ii,iset),iset)
17693 lstart=ifrag(1,ipair(2,ii,iset),iset)
17694 lend=ifrag(2,ipair(2,ii,iset),iset)
17695 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17696 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17699 dc(j,i+nres)=cdummy(j,i)
17700 call chainbuild_cart
17703 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
17704 ifrag(2,ii,iset),.true.,idummy,idummy)
17705 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17709 kstart=ifrag(1,ipair(1,ii,iset),iset)
17710 kend=ifrag(2,ipair(1,ii,iset),iset)
17711 lstart=ifrag(1,ipair(2,ii,iset),iset)
17712 lend=ifrag(2,ipair(2,ii,iset),iset)
17713 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17714 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17717 duxcartan(j,i)=(uzap2-uzap1)/(delta)
17720 write(iout,*) "Numerical dUconst/ddc backbone "
17722 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
17724 ! write(iout,*) "Numerical dUconst/ddx side-chain "
17726 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
17729 end subroutine dEconstrQ_num
17730 !-----------------------------------------------------------------------------
17732 !-----------------------------------------------------------------------------
17733 subroutine check_energies
17735 ! use random, only: ran_number
17739 ! include 'DIMENSIONS'
17740 ! include 'COMMON.CHAIN'
17741 ! include 'COMMON.VAR'
17742 ! include 'COMMON.IOUNITS'
17743 ! include 'COMMON.SBRIDGE'
17744 ! include 'COMMON.LOCAL'
17745 ! include 'COMMON.GEO'
17747 ! External functions
17748 !EL double precision ran_number
17749 !EL external ran_number
17752 integer :: i,j,k,l,lmax,p,pmax
17753 real(kind=8) :: rmin,rmax
17754 real(kind=8) :: eij
17757 real(kind=8) :: wi,rij,tj,pj
17779 !t wi=ran_number(0.0D0,pi)
17780 ! wi=ran_number(0.0D0,pi/6.0D0)
17782 !t tj=ran_number(0.0D0,pi)
17783 !t pj=ran_number(0.0D0,pi)
17784 ! pj=ran_number(0.0D0,pi/6.0D0)
17788 !t rij=ran_number(rmin,rmax)
17790 c(1,j)=d*sin(pj)*cos(tj)
17791 c(2,j)=d*sin(pj)*sin(tj)
17797 c(3,i)=-rij-d*cos(wi)
17800 dc(k,nres+i)=c(k,nres+i)-c(k,i)
17801 dc_norm(k,nres+i)=dc(k,nres+i)/d
17802 dc(k,nres+j)=c(k,nres+j)-c(k,j)
17803 dc_norm(k,nres+j)=dc(k,nres+j)/d
17806 call dyn_ssbond_ene(i,j,eij)
17811 end subroutine check_energies
17812 !-----------------------------------------------------------------------------
17813 subroutine dyn_ssbond_ene(resi,resj,eij)
17818 ! include 'DIMENSIONS'
17819 ! include 'COMMON.SBRIDGE'
17820 ! include 'COMMON.CHAIN'
17821 ! include 'COMMON.DERIV'
17822 ! include 'COMMON.LOCAL'
17823 ! include 'COMMON.INTERACT'
17824 ! include 'COMMON.VAR'
17825 ! include 'COMMON.IOUNITS'
17826 ! include 'COMMON.CALC'
17830 ! include 'COMMON.MD'
17831 ! use MD, only: totT,t_bath
17834 ! External functions
17835 !EL double precision h_base
17836 !EL external h_base
17839 integer :: resi,resj
17842 real(kind=8) :: eij
17845 logical :: havebond
17846 integer itypi,itypj
17847 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
17848 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
17849 real(kind=8),dimension(3) :: dcosom1,dcosom2
17851 real(kind=8) :: pom1,pom2
17852 real(kind=8) :: ljA,ljB,ljXs
17853 real(kind=8),dimension(1:3) :: d_ljB
17854 real(kind=8) :: ssA,ssB,ssC,ssXs
17855 real(kind=8) :: ssxm,ljxm,ssm,ljm
17856 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
17857 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
17858 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
17859 !-------FIRST METHOD
17861 real(kind=8),dimension(1:3) :: d_xm
17862 !-------END FIRST METHOD
17863 !-------SECOND METHOD
17864 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
17865 !-------END SECOND METHOD
17867 !-------TESTING CODE
17868 !el logical :: checkstop,transgrad
17869 !el common /sschecks/ checkstop,transgrad
17871 integer :: icheck,nicheck,jcheck,njcheck
17872 real(kind=8),dimension(-1:1) :: echeck
17873 real(kind=8) :: deps,ssx0,ljx0
17874 !-------END TESTING CODE
17880 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
17881 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
17884 dxi=dc_norm(1,nres+i)
17885 dyi=dc_norm(2,nres+i)
17886 dzi=dc_norm(3,nres+i)
17887 dsci_inv=vbld_inv(i+nres)
17890 xj=c(1,nres+j)-c(1,nres+i)
17891 yj=c(2,nres+j)-c(2,nres+i)
17892 zj=c(3,nres+j)-c(3,nres+i)
17893 dxj=dc_norm(1,nres+j)
17894 dyj=dc_norm(2,nres+j)
17895 dzj=dc_norm(3,nres+j)
17896 dscj_inv=vbld_inv(j+nres)
17898 chi1=chi(itypi,itypj)
17899 chi2=chi(itypj,itypi)
17906 alf12=0.5D0*(alf1+alf2)
17908 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
17909 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
17910 ! The following are set in sc_angular
17914 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
17915 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
17916 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
17918 rij=1.0D0/rij ! Reset this so it makes sense
17920 sig0ij=sigma(itypi,itypj)
17921 sig=sig0ij*dsqrt(1.0D0/sigsq)
17924 ljA=eps1*eps2rt**2*eps3rt**2
17925 ljB=ljA*bb_aq(itypi,itypj)
17926 ljA=ljA*aa_aq(itypi,itypj)
17927 ljxm=ljXs+(-2.0D0*aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
17932 deltat12=om2-om1+2.0d0
17933 cosphi=om12-om1*om2
17937 +akth*(deltat1*deltat1+deltat2*deltat2) &
17938 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
17939 ssxm=ssXs-0.5D0*ssB/ssA
17941 !-------TESTING CODE
17942 !$$$c Some extra output
17943 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
17944 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
17945 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
17946 !$$$ if (ssx0.gt.0.0d0) then
17947 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
17951 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
17952 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
17953 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
17955 !-------END TESTING CODE
17957 !-------TESTING CODE
17958 ! Stop and plot energy and derivative as a function of distance
17959 if (checkstop) then
17960 ssm=ssC-0.25D0*ssB*ssB/ssA
17961 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
17962 if (ssm.lt.ljm .and. &
17963 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
17971 if (.not.checkstop) then
17976 do icheck=0,nicheck
17977 do jcheck=-1,njcheck
17978 if (checkstop) rij=(ssxm-1.0d0)+ &
17979 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
17980 !-------END TESTING CODE
17982 if (rij.gt.ljxm) then
17985 fac=(1.0D0/ljd)**expon
17986 e1=fac*fac*aa_aq(itypi,itypj)
17987 e2=fac*bb_aq(itypi,itypj)
17988 eij=eps1*eps2rt*eps3rt*(e1+e2)
17991 eij=eij*eps2rt*eps3rt
17994 e1=e1*eps1*eps2rt**2*eps3rt**2
17995 ed=-expon*(e1+eij)/ljd
17997 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
17998 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
17999 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
18000 -2.0D0*alf12*eps3der+sigder*sigsq_om12
18001 else if (rij.lt.ssxm) then
18004 eij=ssA*ssd*ssd+ssB*ssd+ssC
18006 ed=2*akcm*ssd+akct*deltat12
18008 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
18009 eom1=-2*akth*deltat1-pom1-om2*pom2
18010 eom2= 2*akth*deltat2+pom1-om1*pom2
18013 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
18015 d_ssxm(1)=0.5D0*akct/ssA
18016 d_ssxm(2)=-d_ssxm(1)
18019 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
18020 d_ljxm(2)=d_ljxm(1)*sigsq_om2
18021 d_ljxm(3)=d_ljxm(1)*sigsq_om12
18022 d_ljxm(1)=d_ljxm(1)*sigsq_om1
18024 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
18025 xm=0.5d0*(ssxm+ljxm)
18027 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
18029 if (rij.lt.xm) then
18031 ssm=ssC-0.25D0*ssB*ssB/ssA
18032 d_ssm(1)=0.5D0*akct*ssB/ssA
18033 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
18034 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
18036 f1=(rij-xm)/(ssxm-xm)
18037 f2=(rij-ssxm)/(xm-ssxm)
18041 delta_inv=1.0d0/(xm-ssxm)
18042 deltasq_inv=delta_inv*delta_inv
18044 fac1=deltasq_inv*fac*(xm-rij)
18045 fac2=deltasq_inv*fac*(rij-ssxm)
18046 ed=delta_inv*(Ht*hd2-ssm*hd1)
18047 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
18048 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
18049 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
18052 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
18053 d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
18054 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
18055 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
18057 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
18058 f1=(rij-ljxm)/(xm-ljxm)
18059 f2=(rij-xm)/(ljxm-xm)
18063 delta_inv=1.0d0/(ljxm-xm)
18064 deltasq_inv=delta_inv*delta_inv
18066 fac1=deltasq_inv*fac*(ljxm-rij)
18067 fac2=deltasq_inv*fac*(rij-xm)
18068 ed=delta_inv*(ljm*hd2-Ht*hd1)
18069 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
18070 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
18071 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
18073 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
18075 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
18081 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
18082 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
18083 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
18085 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
18086 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
18087 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
18088 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
18089 !$$$ d_ssm(3)=omega
18091 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
18093 !$$$ d_ljm(k)=ljm*d_ljB(k)
18097 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
18098 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
18099 !$$$ d_ss(2)=akct*ssd
18100 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
18101 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
18104 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
18105 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
18106 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
18108 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
18109 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
18111 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
18113 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
18114 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
18115 !$$$ h1=h_base(f1,hd1)
18116 !$$$ h2=h_base(f2,hd2)
18117 !$$$ eij=ss*h1+ljf*h2
18118 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
18119 !$$$ deltasq_inv=delta_inv*delta_inv
18120 !$$$ fac=ljf*hd2-ss*hd1
18121 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
18122 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
18123 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
18124 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
18125 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
18126 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
18127 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
18129 !$$$ havebond=.false.
18130 !$$$ if (ed.gt.0.0d0) havebond=.true.
18131 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
18138 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
18139 ! write(iout,'(a15,f12.2,f8.1,2i5)')
18140 ! & "SSBOND_E_FORM",totT,t_bath,i,j
18144 dyn_ssbond_ij(i,j)=eij
18145 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
18146 dyn_ssbond_ij(i,j)=1.0d300
18149 ! write(iout,'(a15,f12.2,f8.1,2i5)')
18150 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
18155 !-------TESTING CODE
18156 !el if (checkstop) then
18157 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
18158 "CHECKSTOP",rij,eij,ed
18162 if (checkstop) then
18163 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
18166 if (checkstop) then
18170 !-------END TESTING CODE
18173 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
18174 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
18177 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
18180 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
18181 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
18182 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
18183 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
18184 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
18185 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
18189 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
18194 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18195 gvdwc(l,j)=gvdwc(l,j)+gg(l)
18199 end subroutine dyn_ssbond_ene
18200 !--------------------------------------------------------------------------
18201 subroutine triple_ssbond_ene(resi,resj,resk,eij)
18206 ! include 'DIMENSIONS'
18207 ! include 'COMMON.SBRIDGE'
18208 ! include 'COMMON.CHAIN'
18209 ! include 'COMMON.DERIV'
18210 ! include 'COMMON.LOCAL'
18211 ! include 'COMMON.INTERACT'
18212 ! include 'COMMON.VAR'
18213 ! include 'COMMON.IOUNITS'
18214 ! include 'COMMON.CALC'
18218 ! include 'COMMON.MD'
18219 ! use MD, only: totT,t_bath
18222 double precision h_base
18226 integer resi,resj,resk,m,itypi,itypj,itypk
18228 !c Output arguments
18229 double precision eij,eij1,eij2,eij3
18233 !c integer itypi,itypj,k,l
18234 double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi
18235 double precision rrik,rrjk,rik,rjk,xi,xk,yi,yk,zi,zk,xij,yij,zij
18236 double precision xik,yik,zik,xjk,yjk,zjk,dxk,dyk,dzk
18237 double precision sig0ij,ljd,sig,fac,e1,e2
18238 double precision dcosom1(3),dcosom2(3),ed
18239 double precision pom1,pom2
18240 double precision ljA,ljB,ljXs
18241 double precision d_ljB(1:3)
18242 double precision ssA,ssB,ssC,ssXs
18243 double precision ssxm,ljxm,ssm,ljm
18244 double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3)
18246 if (dtriss.eq.0) return
18250 !C write(iout,*) resi,resj,resk
18252 dxi=dc_norm(1,nres+i)
18253 dyi=dc_norm(2,nres+i)
18254 dzi=dc_norm(3,nres+i)
18255 dsci_inv=vbld_inv(i+nres)
18264 dxj=dc_norm(1,nres+j)
18265 dyj=dc_norm(2,nres+j)
18266 dzj=dc_norm(3,nres+j)
18267 dscj_inv=vbld_inv(j+nres)
18273 dxk=dc_norm(1,nres+k)
18274 dyk=dc_norm(2,nres+k)
18275 dzk=dc_norm(3,nres+k)
18276 dscj_inv=vbld_inv(k+nres)
18286 rrij=(xij*xij+yij*yij+zij*zij)
18287 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
18288 rrik=(xik*xik+yik*yik+zik*zik)
18290 rrjk=(xjk*xjk+yjk*yjk+zjk*zjk)
18292 !C there are three combination of distances for each trisulfide bonds
18293 !C The first case the ith atom is the center
18294 !C Energy function is E=d/(a*(x-y)**2+b*(x+y)**2+c) where x is first
18295 !C distance y is second distance the a,b,c,d are parameters derived for
18296 !C this problem d parameter was set as a penalty currenlty set to 1.
18297 if ((iabs(j-i).le.2).or.(iabs(i-k).le.2)) then
18300 eij1=dtriss/(atriss*(rij-rik)**2+btriss*(rij+rik)**6+ctriss)
18302 !C second case jth atom is center
18303 if ((iabs(j-i).le.2).or.(iabs(j-k).le.2)) then
18306 eij2=dtriss/(atriss*(rij-rjk)**2+btriss*(rij+rjk)**6+ctriss)
18308 !C the third case kth atom is the center
18309 if ((iabs(i-k).le.2).or.(iabs(j-k).le.2)) then
18312 eij3=dtriss/(atriss*(rik-rjk)**2+btriss*(rik+rjk)**6+ctriss)
18318 !C write(iout,*)i,j,k,eij
18319 !C The energy penalty calculated now time for the gradient part
18320 !C derivative over rij
18321 fac=-eij1**2/dtriss*(2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
18322 -eij2**2/dtriss*(2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)
18327 gvdwx(m,i)=gvdwx(m,i)-gg(m)
18328 gvdwx(m,j)=gvdwx(m,j)+gg(m)
18332 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18333 gvdwc(l,j)=gvdwc(l,j)+gg(l)
18335 !C now derivative over rik
18336 fac=-eij1**2/dtriss* &
18337 (-2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
18338 -eij3**2/dtriss*(2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
18343 gvdwx(m,i)=gvdwx(m,i)-gg(m)
18344 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18347 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18348 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18350 !C now derivative over rjk
18351 fac=-eij2**2/dtriss* &
18352 (-2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)- &
18353 eij3**2/dtriss*(-2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
18358 gvdwx(m,j)=gvdwx(m,j)-gg(m)
18359 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18362 gvdwc(l,j)=gvdwc(l,j)-gg(l)
18363 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18366 end subroutine triple_ssbond_ene
18370 !-----------------------------------------------------------------------------
18371 real(kind=8) function h_base(x,deriv)
18372 ! A smooth function going 0->1 in range [0,1]
18373 ! It should NOT be called outside range [0,1], it will not work there.
18380 real(kind=8) :: deriv
18383 real(kind=8) :: xsq
18386 ! Two parabolas put together. First derivative zero at extrema
18387 !$$$ if (x.lt.0.5D0) then
18388 !$$$ h_base=2.0D0*x*x
18392 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
18393 !$$$ deriv=4.0D0*deriv
18396 ! Third degree polynomial. First derivative zero at extrema
18397 h_base=x*x*(3.0d0-2.0d0*x)
18398 deriv=6.0d0*x*(1.0d0-x)
18400 ! Fifth degree polynomial. First and second derivatives zero at extrema
18402 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
18404 !$$$ deriv=deriv*deriv
18405 !$$$ deriv=30.0d0*xsq*deriv
18408 end function h_base
18409 !-----------------------------------------------------------------------------
18410 subroutine dyn_set_nss
18411 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
18413 use MD_data, only: totT,t_bath
18415 ! include 'DIMENSIONS'
18419 ! include 'COMMON.SBRIDGE'
18420 ! include 'COMMON.CHAIN'
18421 ! include 'COMMON.IOUNITS'
18422 ! include 'COMMON.SETUP'
18423 ! include 'COMMON.MD'
18425 real(kind=8) :: emin
18426 integer :: i,j,imin,ierr
18427 integer :: diff,allnss,newnss
18428 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
18431 integer,dimension(0:nfgtasks) :: i_newnss
18432 integer,dimension(0:nfgtasks) :: displ
18433 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
18434 integer :: g_newnss
18439 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
18448 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
18452 if (allflag(i).eq.0 .and. &
18453 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
18454 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
18458 if (emin.lt.1.0d300) then
18461 if (allflag(i).eq.0 .and. &
18462 (allihpb(i).eq.allihpb(imin) .or. &
18463 alljhpb(i).eq.allihpb(imin) .or. &
18464 allihpb(i).eq.alljhpb(imin) .or. &
18465 alljhpb(i).eq.alljhpb(imin))) then
18472 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
18476 if (allflag(i).eq.1) then
18478 newihpb(newnss)=allihpb(i)
18479 newjhpb(newnss)=alljhpb(i)
18484 if (nfgtasks.gt.1)then
18486 call MPI_Reduce(newnss,g_newnss,1,&
18487 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
18488 call MPI_Gather(newnss,1,MPI_INTEGER,&
18489 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
18491 do i=1,nfgtasks-1,1
18492 displ(i)=i_newnss(i-1)+displ(i-1)
18494 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
18495 g_newihpb,i_newnss,displ,MPI_INTEGER,&
18497 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
18498 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
18500 if(fg_rank.eq.0) then
18501 ! print *,'g_newnss',g_newnss
18502 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
18503 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
18506 newihpb(i)=g_newihpb(i)
18507 newjhpb(i)=g_newjhpb(i)
18515 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
18516 ! print *,newnss,nss,maxdim
18522 if (idssb(i).eq.newihpb(j) .and. &
18523 jdssb(i).eq.newjhpb(j)) found=.true.
18527 ! write(iout,*) "found",found,i,j
18528 if (.not.found.and.fg_rank.eq.0) &
18529 write(iout,'(a15,f12.2,f8.1,2i5)') &
18530 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
18539 if (newihpb(i).eq.idssb(j) .and. &
18540 newjhpb(i).eq.jdssb(j)) found=.true.
18544 ! write(iout,*) "found",found,i,j
18545 if (.not.found.and.fg_rank.eq.0) &
18546 write(iout,'(a15,f12.2,f8.1,2i5)') &
18547 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
18554 idssb(i)=newihpb(i)
18555 jdssb(i)=newjhpb(i)
18559 end subroutine dyn_set_nss
18560 ! Lipid transfer energy function
18561 subroutine Eliptransfer(eliptran)
18562 !C this is done by Adasko
18563 !C print *,"wchodze"
18564 !C structure of box:
18566 !C--bordliptop-- buffore starts
18567 !C--bufliptop--- here true lipid starts
18569 !C--buflipbot--- lipid ends buffore starts
18570 !C--bordlipbot--buffore ends
18571 real(kind=8) :: fracinbuf,eliptran,sslip,positi,ssgradlip
18574 ! print *, "I am in eliptran"
18575 do i=ilip_start,ilip_end
18577 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))&
18580 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
18581 if (positi.le.0.0) positi=positi+boxzsize
18583 !C first for peptide groups
18584 !c for each residue check if it is in lipid or lipid water border area
18585 if ((positi.gt.bordlipbot) &
18586 .and.(positi.lt.bordliptop)) then
18587 !C the energy transfer exist
18588 if (positi.lt.buflipbot) then
18589 !C what fraction I am in
18591 ((positi-bordlipbot)/lipbufthick)
18592 !C lipbufthick is thickenes of lipid buffore
18593 sslip=sscalelip(fracinbuf)
18594 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
18595 eliptran=eliptran+sslip*pepliptran
18596 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
18597 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
18598 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
18600 !C print *,"doing sccale for lower part"
18601 !C print *,i,sslip,fracinbuf,ssgradlip
18602 elseif (positi.gt.bufliptop) then
18603 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
18604 sslip=sscalelip(fracinbuf)
18605 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
18606 eliptran=eliptran+sslip*pepliptran
18607 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
18608 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
18609 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
18610 !C print *, "doing sscalefor top part"
18611 !C print *,i,sslip,fracinbuf,ssgradlip
18613 eliptran=eliptran+pepliptran
18614 !C print *,"I am in true lipid"
18617 !C eliptran=elpitran+0.0 ! I am in water
18619 if (energy_dec) write(iout,*) i,"eliptran=",eliptran,positi,sslip
18621 ! here starts the side chain transfer
18622 do i=ilip_start,ilip_end
18623 if (itype(i,1).eq.ntyp1) cycle
18624 positi=(mod(c(3,i+nres),boxzsize))
18625 if (positi.le.0) positi=positi+boxzsize
18626 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18627 !c for each residue check if it is in lipid or lipid water border area
18628 !C respos=mod(c(3,i+nres),boxzsize)
18629 !C print *,positi,bordlipbot,buflipbot
18630 if ((positi.gt.bordlipbot) &
18631 .and.(positi.lt.bordliptop)) then
18632 !C the energy transfer exist
18633 if (positi.lt.buflipbot) then
18635 ((positi-bordlipbot)/lipbufthick)
18636 !C lipbufthick is thickenes of lipid buffore
18637 sslip=sscalelip(fracinbuf)
18638 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
18639 eliptran=eliptran+sslip*liptranene(itype(i,1))
18640 gliptranx(3,i)=gliptranx(3,i) &
18641 +ssgradlip*liptranene(itype(i,1))
18642 gliptranc(3,i-1)= gliptranc(3,i-1) &
18643 +ssgradlip*liptranene(itype(i,1))
18644 !C print *,"doing sccale for lower part"
18645 elseif (positi.gt.bufliptop) then
18647 ((bordliptop-positi)/lipbufthick)
18648 sslip=sscalelip(fracinbuf)
18649 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
18650 eliptran=eliptran+sslip*liptranene(itype(i,1))
18651 gliptranx(3,i)=gliptranx(3,i) &
18652 +ssgradlip*liptranene(itype(i,1))
18653 gliptranc(3,i-1)= gliptranc(3,i-1) &
18654 +ssgradlip*liptranene(itype(i,1))
18655 !C print *, "doing sscalefor top part",sslip,fracinbuf
18657 eliptran=eliptran+liptranene(itype(i,1))
18658 !C print *,"I am in true lipid"
18660 endif ! if in lipid or buffor
18662 !C eliptran=elpitran+0.0 ! I am in water
18663 if (energy_dec) write(iout,*) i,"eliptran=",eliptran
18666 end subroutine Eliptransfer
18667 !----------------------------------NANO FUNCTIONS
18668 !C-----------------------------------------------------------------------
18669 !C-----------------------------------------------------------
18670 !C This subroutine is to mimic the histone like structure but as well can be
18671 !C utilizet to nanostructures (infinit) small modification has to be used to
18672 !C make it finite (z gradient at the ends has to be changes as well as the x,y
18673 !C gradient has to be modified at the ends
18674 !C The energy function is Kihara potential
18675 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
18676 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
18677 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
18678 !C simple Kihara potential
18679 subroutine calctube(Etube)
18680 real(kind=8),dimension(3) :: vectube
18681 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18682 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi, &
18683 sc_aa_tube,sc_bb_tube
18686 do i=itube_start,itube_end
18688 enetube(i+nres)=0.0d0
18690 !C first we calculate the distance from tube center
18692 do i=itube_start,itube_end
18693 !C lets ommit dummy atoms for now
18694 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18695 !C now calculate distance from center of tube and direction vectors
18698 ! Find minimum distance in periodic box
18700 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18701 vectube(1)=vectube(1)+boxxsize*j
18702 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18703 vectube(2)=vectube(2)+boxysize*j
18704 xminact=abs(vectube(1)-tubecenter(1))
18705 yminact=abs(vectube(2)-tubecenter(2))
18706 if (xmin.gt.xminact) then
18710 if (ymin.gt.yminact) then
18717 vectube(1)=vectube(1)-tubecenter(1)
18718 vectube(2)=vectube(2)-tubecenter(2)
18720 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18721 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18723 !C as the tube is infinity we do not calculate the Z-vector use of Z
18726 !C now calculte the distance
18727 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18728 !C now normalize vector
18729 vectube(1)=vectube(1)/tub_r
18730 vectube(2)=vectube(2)/tub_r
18731 !C calculte rdiffrence between r and r0
18734 rdiff6=rdiff**6.0d0
18735 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18736 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
18737 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18738 !C print *,rdiff,rdiff6,pep_aa_tube
18739 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18740 !C now we calculate gradient
18741 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18742 6.0d0*pep_bb_tube)/rdiff6/rdiff
18743 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18745 !C now direction of gg_tube vector
18747 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18748 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18751 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18752 !C print *,gg_tube(1,0),"TU"
18755 do i=itube_start,itube_end
18756 !C Lets not jump over memory as we use many times iti
18758 !C lets ommit dummy atoms for now
18759 if ((iti.eq.ntyp1) &
18760 !C in UNRES uncomment the line below as GLY has no side-chain...
18766 vectube(1)=mod((c(1,i+nres)),boxxsize)
18767 vectube(1)=vectube(1)+boxxsize*j
18768 vectube(2)=mod((c(2,i+nres)),boxysize)
18769 vectube(2)=vectube(2)+boxysize*j
18771 xminact=abs(vectube(1)-tubecenter(1))
18772 yminact=abs(vectube(2)-tubecenter(2))
18773 if (xmin.gt.xminact) then
18777 if (ymin.gt.yminact) then
18784 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
18786 vectube(1)=vectube(1)-tubecenter(1)
18787 vectube(2)=vectube(2)-tubecenter(2)
18789 !C as the tube is infinity we do not calculate the Z-vector use of Z
18792 !C now calculte the distance
18793 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18794 !C now normalize vector
18795 vectube(1)=vectube(1)/tub_r
18796 vectube(2)=vectube(2)/tub_r
18798 !C calculte rdiffrence between r and r0
18801 rdiff6=rdiff**6.0d0
18802 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18803 sc_aa_tube=sc_aa_tube_par(iti)
18804 sc_bb_tube=sc_bb_tube_par(iti)
18805 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
18806 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
18807 6.0d0*sc_bb_tube/rdiff6/rdiff
18808 !C now direction of gg_tube vector
18810 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
18811 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
18814 do i=itube_start,itube_end
18815 Etube=Etube+enetube(i)+enetube(i+nres)
18817 !C print *,"ETUBE", etube
18819 end subroutine calctube
18820 !C TO DO 1) add to total energy
18821 !C 2) add to gradient summation
18822 !C 3) add reading parameters (AND of course oppening of PARAM file)
18823 !C 4) add reading the center of tube
18825 !C 6) add to zerograd
18826 !C 7) allocate matrices
18829 !C-----------------------------------------------------------------------
18830 !C-----------------------------------------------------------
18831 !C This subroutine is to mimic the histone like structure but as well can be
18832 !C utilizet to nanostructures (infinit) small modification has to be used to
18833 !C make it finite (z gradient at the ends has to be changes as well as the x,y
18834 !C gradient has to be modified at the ends
18835 !C The energy function is Kihara potential
18836 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
18837 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
18838 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
18839 !C simple Kihara potential
18840 subroutine calctube2(Etube)
18841 real(kind=8),dimension(3) :: vectube
18842 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18843 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi,fracinbuf,&
18844 sstube,ssgradtube,sc_aa_tube,sc_bb_tube
18847 do i=itube_start,itube_end
18849 enetube(i+nres)=0.0d0
18851 !C first we calculate the distance from tube center
18852 !C first sugare-phosphate group for NARES this would be peptide group
18854 do i=itube_start,itube_end
18855 !C lets ommit dummy atoms for now
18857 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18858 !C now calculate distance from center of tube and direction vectors
18859 !C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18860 !C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
18861 !C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18862 !C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
18866 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18867 vectube(1)=vectube(1)+boxxsize*j
18868 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18869 vectube(2)=vectube(2)+boxysize*j
18871 xminact=abs(vectube(1)-tubecenter(1))
18872 yminact=abs(vectube(2)-tubecenter(2))
18873 if (xmin.gt.xminact) then
18877 if (ymin.gt.yminact) then
18884 vectube(1)=vectube(1)-tubecenter(1)
18885 vectube(2)=vectube(2)-tubecenter(2)
18887 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18888 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18890 !C as the tube is infinity we do not calculate the Z-vector use of Z
18893 !C now calculte the distance
18894 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18895 !C now normalize vector
18896 vectube(1)=vectube(1)/tub_r
18897 vectube(2)=vectube(2)/tub_r
18898 !C calculte rdiffrence between r and r0
18901 rdiff6=rdiff**6.0d0
18902 !C THIS FRAGMENT MAKES TUBE FINITE
18903 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
18904 if (positi.le.0) positi=positi+boxzsize
18905 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18906 !c for each residue check if it is in lipid or lipid water border area
18907 !C respos=mod(c(3,i+nres),boxzsize)
18908 !C print *,positi,bordtubebot,buftubebot,bordtubetop
18909 if ((positi.gt.bordtubebot) &
18910 .and.(positi.lt.bordtubetop)) then
18911 !C the energy transfer exist
18912 if (positi.lt.buftubebot) then
18914 ((positi-bordtubebot)/tubebufthick)
18915 !C lipbufthick is thickenes of lipid buffore
18916 sstube=sscalelip(fracinbuf)
18917 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
18918 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
18919 enetube(i)=enetube(i)+sstube*tubetranenepep
18920 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18921 !C &+ssgradtube*tubetranene(itype(i,1))
18922 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18923 !C &+ssgradtube*tubetranene(itype(i,1))
18924 !C print *,"doing sccale for lower part"
18925 elseif (positi.gt.buftubetop) then
18927 ((bordtubetop-positi)/tubebufthick)
18928 sstube=sscalelip(fracinbuf)
18929 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
18930 enetube(i)=enetube(i)+sstube*tubetranenepep
18931 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18932 !C &+ssgradtube*tubetranene(itype(i,1))
18933 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18934 !C &+ssgradtube*tubetranene(itype(i,1))
18935 !C print *, "doing sscalefor top part",sslip,fracinbuf
18939 enetube(i)=enetube(i)+sstube*tubetranenepep
18940 !C print *,"I am in true lipid"
18944 !C ssgradtube=0.0d0
18946 endif ! if in lipid or buffor
18948 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18949 enetube(i)=enetube(i)+sstube* &
18950 (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
18951 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18952 !C print *,rdiff,rdiff6,pep_aa_tube
18953 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18954 !C now we calculate gradient
18955 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18956 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
18957 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18960 !C now direction of gg_tube vector
18962 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18963 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18965 gg_tube(3,i)=gg_tube(3,i) &
18966 +ssgradtube*enetube(i)/sstube/2.0d0
18967 gg_tube(3,i-1)= gg_tube(3,i-1) &
18968 +ssgradtube*enetube(i)/sstube/2.0d0
18971 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18972 !C print *,gg_tube(1,0),"TU"
18973 do i=itube_start,itube_end
18974 !C Lets not jump over memory as we use many times iti
18976 !C lets ommit dummy atoms for now
18977 if ((iti.eq.ntyp1) &
18978 !!C in UNRES uncomment the line below as GLY has no side-chain...
18981 vectube(1)=c(1,i+nres)
18982 vectube(1)=mod(vectube(1),boxxsize)
18983 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
18984 vectube(2)=c(2,i+nres)
18985 vectube(2)=mod(vectube(2),boxysize)
18986 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
18988 vectube(1)=vectube(1)-tubecenter(1)
18989 vectube(2)=vectube(2)-tubecenter(2)
18990 !C THIS FRAGMENT MAKES TUBE FINITE
18991 positi=(mod(c(3,i+nres),boxzsize))
18992 if (positi.le.0) positi=positi+boxzsize
18993 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18994 !c for each residue check if it is in lipid or lipid water border area
18995 !C respos=mod(c(3,i+nres),boxzsize)
18996 !C print *,positi,bordtubebot,buftubebot,bordtubetop
18998 if ((positi.gt.bordtubebot) &
18999 .and.(positi.lt.bordtubetop)) then
19000 !C the energy transfer exist
19001 if (positi.lt.buftubebot) then
19003 ((positi-bordtubebot)/tubebufthick)
19004 !C lipbufthick is thickenes of lipid buffore
19005 sstube=sscalelip(fracinbuf)
19006 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
19007 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
19008 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19009 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19010 !C &+ssgradtube*tubetranene(itype(i,1))
19011 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19012 !C &+ssgradtube*tubetranene(itype(i,1))
19013 !C print *,"doing sccale for lower part"
19014 elseif (positi.gt.buftubetop) then
19016 ((bordtubetop-positi)/tubebufthick)
19018 sstube=sscalelip(fracinbuf)
19019 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
19020 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19021 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19022 !C &+ssgradtube*tubetranene(itype(i,1))
19023 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19024 !C &+ssgradtube*tubetranene(itype(i,1))
19025 !C print *, "doing sscalefor top part",sslip,fracinbuf
19029 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19030 !C print *,"I am in true lipid"
19034 !C ssgradtube=0.0d0
19036 endif ! if in lipid or buffor
19037 !CEND OF FINITE FRAGMENT
19038 !C as the tube is infinity we do not calculate the Z-vector use of Z
19041 !C now calculte the distance
19042 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19043 !C now normalize vector
19044 vectube(1)=vectube(1)/tub_r
19045 vectube(2)=vectube(2)/tub_r
19046 !C calculte rdiffrence between r and r0
19049 rdiff6=rdiff**6.0d0
19050 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19051 sc_aa_tube=sc_aa_tube_par(iti)
19052 sc_bb_tube=sc_bb_tube_par(iti)
19053 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)&
19054 *sstube+enetube(i+nres)
19055 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19056 !C now we calculate gradient
19057 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-&
19058 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
19059 !C now direction of gg_tube vector
19061 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19062 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19064 gg_tube_SC(3,i)=gg_tube_SC(3,i) &
19065 +ssgradtube*enetube(i+nres)/sstube
19066 gg_tube(3,i-1)= gg_tube(3,i-1) &
19067 +ssgradtube*enetube(i+nres)/sstube
19070 do i=itube_start,itube_end
19071 Etube=Etube+enetube(i)+enetube(i+nres)
19073 !C print *,"ETUBE", etube
19075 end subroutine calctube2
19076 !=====================================================================================================================================
19077 subroutine calcnano(Etube)
19078 real(kind=8),dimension(3) :: vectube
19080 real(kind=8) :: Etube,xtemp,xminact,yminact,&
19081 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,denominator,faccav,&
19082 sc_aa_tube,sc_bb_tube,zmin,ztemp,zminact
19083 integer:: i,j,iti,r
19086 ! print *,itube_start,itube_end,"poczatek"
19087 do i=itube_start,itube_end
19089 enetube(i+nres)=0.0d0
19091 !C first we calculate the distance from tube center
19092 !C first sugare-phosphate group for NARES this would be peptide group
19094 do i=itube_start,itube_end
19095 !C lets ommit dummy atoms for now
19096 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
19097 !C now calculate distance from center of tube and direction vectors
19103 vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19104 vectube(1)=vectube(1)+boxxsize*j
19105 vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19106 vectube(2)=vectube(2)+boxysize*j
19107 vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
19108 vectube(3)=vectube(3)+boxzsize*j
19111 xminact=dabs(vectube(1)-tubecenter(1))
19112 yminact=dabs(vectube(2)-tubecenter(2))
19113 zminact=dabs(vectube(3)-tubecenter(3))
19115 if (xmin.gt.xminact) then
19119 if (ymin.gt.yminact) then
19123 if (zmin.gt.zminact) then
19132 vectube(1)=vectube(1)-tubecenter(1)
19133 vectube(2)=vectube(2)-tubecenter(2)
19134 vectube(3)=vectube(3)-tubecenter(3)
19136 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
19137 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
19138 !C as the tube is infinity we do not calculate the Z-vector use of Z
19140 !C vectube(3)=0.0d0
19141 !C now calculte the distance
19142 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19143 !C now normalize vector
19144 vectube(1)=vectube(1)/tub_r
19145 vectube(2)=vectube(2)/tub_r
19146 vectube(3)=vectube(3)/tub_r
19147 !C calculte rdiffrence between r and r0
19150 rdiff6=rdiff**6.0d0
19151 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19152 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
19153 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
19154 !C print *,rdiff,rdiff6,pep_aa_tube
19155 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19156 !C now we calculate gradient
19157 fac=(-12.0d0*pep_aa_tube/rdiff6- &
19158 6.0d0*pep_bb_tube)/rdiff6/rdiff
19159 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
19161 if (acavtubpep.eq.0.0d0) then
19166 denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
19168 (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
19171 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
19172 *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
19173 +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
19174 /denominator**2.0d0
19179 if (energy_dec) write(iout,*),i,rdiff,enetube(i),enecavtube(i)
19181 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
19182 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
19186 do i=itube_start,itube_end
19187 enecavtube(i)=0.0d0
19188 !C Lets not jump over memory as we use many times iti
19190 !C lets ommit dummy atoms for now
19191 if ((iti.eq.ntyp1) &
19192 !C in UNRES uncomment the line below as GLY has no side-chain...
19199 vectube(1)=dmod((c(1,i+nres)),boxxsize)
19200 vectube(1)=vectube(1)+boxxsize*j
19201 vectube(2)=dmod((c(2,i+nres)),boxysize)
19202 vectube(2)=vectube(2)+boxysize*j
19203 vectube(3)=dmod((c(3,i+nres)),boxzsize)
19204 vectube(3)=vectube(3)+boxzsize*j
19207 xminact=dabs(vectube(1)-tubecenter(1))
19208 yminact=dabs(vectube(2)-tubecenter(2))
19209 zminact=dabs(vectube(3)-tubecenter(3))
19211 if (xmin.gt.xminact) then
19215 if (ymin.gt.yminact) then
19219 if (zmin.gt.zminact) then
19228 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
19230 vectube(1)=vectube(1)-tubecenter(1)
19231 vectube(2)=vectube(2)-tubecenter(2)
19232 vectube(3)=vectube(3)-tubecenter(3)
19233 !C now calculte the distance
19234 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19235 !C now normalize vector
19236 vectube(1)=vectube(1)/tub_r
19237 vectube(2)=vectube(2)/tub_r
19238 vectube(3)=vectube(3)/tub_r
19240 !C calculte rdiffrence between r and r0
19243 rdiff6=rdiff**6.0d0
19244 sc_aa_tube=sc_aa_tube_par(iti)
19245 sc_bb_tube=sc_bb_tube_par(iti)
19246 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19247 !C enetube(i+nres)=0.0d0
19248 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19249 !C now we calculate gradient
19250 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
19251 6.0d0*sc_bb_tube/rdiff6/rdiff
19253 !C now direction of gg_tube vector
19254 !C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
19255 if (acavtub(iti).eq.0.0d0) then
19257 enecavtube(i+nres)=0.0d0
19260 denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
19261 enecavtube(i+nres)= &
19262 (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
19264 !C enecavtube(i)=0.0
19265 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
19266 *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
19267 +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
19268 /denominator**2.0d0
19273 !C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
19274 !C & enecavtube(i),faccav
19275 !C print *,"licz=",
19276 !C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
19277 !C print *,"finene=",enetube(i+nres)+enecavtube(i)
19279 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19280 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19282 if (energy_dec) write(iout,*),i,rdiff,enetube(i+nres),enecavtube(i+nres)
19287 do i=itube_start,itube_end
19288 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) &
19289 +enecavtube(i+nres)
19292 ! print *,"begin", i,"a"
19295 ! rdiff6=rdiff**6.0d0
19296 ! sc_aa_tube=sc_aa_tube_par(i)
19297 ! sc_bb_tube=sc_bb_tube_par(i)
19298 ! enetube(i)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19299 ! denominator=(1.0d0+dcavtub(i)*rdiff6*rdiff6)
19301 ! (bcavtub(i)*rdiff+acavtub(i)*dsqrt(rdiff)+ccavtub(i)) &
19304 ! print '(5(f10.3,1x))',rdiff,enetube(i),enecavtube(i),enecavtube(i)+enetube(i)
19306 ! print *,"end",i,"a"
19308 !C print *,"ETUBE", etube
19310 end subroutine calcnano
19312 !===============================================
19313 !--------------------------------------------------------------------------------
19314 !C first for shielding is setting of function of side-chains
19316 subroutine set_shield_fac2
19317 real(kind=8) :: div77_81=0.974996043d0, &
19318 div4_81=0.2222222222d0
19319 real (kind=8) :: dist_pep_side,dist_side_calf,dist_pept_group, &
19320 scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
19321 short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
19322 sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
19323 !C the vector between center of side_chain and peptide group
19324 real(kind=8),dimension(3) :: pep_side_long,side_calf, &
19325 pept_group,costhet_grad,cosphi_grad_long, &
19326 cosphi_grad_loc,pep_side_norm,side_calf_norm, &
19327 sh_frac_dist_grad,pep_side
19329 !C write(2,*) "ivec",ivec_start,ivec_end
19331 fac_shield(i)=0.0d0
19333 grad_shield(j,i)=0.0d0
19336 do i=ivec_start,ivec_end
19338 !C if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
19340 if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
19341 !Cif there two consequtive dummy atoms there is no peptide group between them
19342 !C the line below has to be changed for FGPROC>1
19345 if ((itype(k,1).eq.ntyp1).or.(itype(k,1).eq.10)) cycle
19349 !C first lets set vector conecting the ithe side-chain with kth side-chain
19350 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
19351 !C pep_side(j)=2.0d0
19352 !C and vector conecting the side-chain with its proper calfa
19353 side_calf(j)=c(j,k+nres)-c(j,k)
19354 !C side_calf(j)=2.0d0
19355 pept_group(j)=c(j,i)-c(j,i+1)
19356 !C lets have their lenght
19357 dist_pep_side=pep_side(j)**2+dist_pep_side
19358 dist_side_calf=dist_side_calf+side_calf(j)**2
19359 dist_pept_group=dist_pept_group+pept_group(j)**2
19361 dist_pep_side=sqrt(dist_pep_side)
19362 dist_pept_group=sqrt(dist_pept_group)
19363 dist_side_calf=sqrt(dist_side_calf)
19365 pep_side_norm(j)=pep_side(j)/dist_pep_side
19366 side_calf_norm(j)=dist_side_calf
19368 !C now sscale fraction
19369 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
19370 !C print *,buff_shield,"buff"
19372 if (sh_frac_dist.le.0.0) cycle
19373 !C print *,ishield_list(i),i
19374 !C If we reach here it means that this side chain reaches the shielding sphere
19375 !C Lets add him to the list for gradient
19376 ishield_list(i)=ishield_list(i)+1
19377 !C ishield_list is a list of non 0 side-chain that contribute to factor gradient
19378 !C this list is essential otherwise problem would be O3
19379 shield_list(ishield_list(i),i)=k
19380 !C Lets have the sscale value
19381 if (sh_frac_dist.gt.1.0) then
19382 scale_fac_dist=1.0d0
19384 sh_frac_dist_grad(j)=0.0d0
19387 scale_fac_dist=-sh_frac_dist*sh_frac_dist &
19388 *(2.0d0*sh_frac_dist-3.0d0)
19389 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
19390 /dist_pep_side/buff_shield*0.5d0
19392 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
19393 !C sh_frac_dist_grad(j)=0.0d0
19394 !C scale_fac_dist=1.0d0
19395 !C print *,"jestem",scale_fac_dist,fac_help_scale,
19396 !C & sh_frac_dist_grad(j)
19399 !C this is what is now we have the distance scaling now volume...
19400 short=short_r_sidechain(itype(k,1))
19401 long=long_r_sidechain(itype(k,1))
19402 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
19403 sinthet=short/dist_pep_side*costhet
19404 !C now costhet_grad
19407 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
19408 !C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
19409 !C & -short/dist_pep_side**2/costhet)
19410 !C costhet_fac=0.0d0
19412 costhet_grad(j)=costhet_fac*pep_side(j)
19414 !C remember for the final gradient multiply costhet_grad(j)
19415 !C for side_chain by factor -2 !
19416 !C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
19417 !C pep_side0pept_group is vector multiplication
19418 pep_side0pept_group=0.0d0
19420 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
19422 cosalfa=(pep_side0pept_group/ &
19423 (dist_pep_side*dist_side_calf))
19424 fac_alfa_sin=1.0d0-cosalfa**2
19425 fac_alfa_sin=dsqrt(fac_alfa_sin)
19426 rkprim=fac_alfa_sin*(long-short)+short
19429 !C now costhet_grad
19430 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
19432 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
19433 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ &
19437 cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
19438 +cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
19439 *(long-short)/fac_alfa_sin*cosalfa/ &
19440 ((dist_pep_side*dist_side_calf))* &
19441 ((side_calf(j))-cosalfa* &
19442 ((pep_side(j)/dist_pep_side)*dist_side_calf))
19443 !C cosphi_grad_long(j)=0.0d0
19444 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
19445 *(long-short)/fac_alfa_sin*cosalfa &
19446 /((dist_pep_side*dist_side_calf))* &
19448 cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
19449 !C cosphi_grad_loc(j)=0.0d0
19451 !C print *,sinphi,sinthet
19452 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) &
19455 !C now the gradient...
19457 grad_shield(j,i)=grad_shield(j,i) &
19458 !C gradient po skalowaniu
19459 +(sh_frac_dist_grad(j)*VofOverlap &
19460 !C gradient po costhet
19461 +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
19462 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
19463 sinphi/sinthet*costhet*costhet_grad(j) &
19464 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
19466 !C grad_shield_side is Cbeta sidechain gradient
19467 grad_shield_side(j,ishield_list(i),i)=&
19468 (sh_frac_dist_grad(j)*-2.0d0&
19470 -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
19471 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(&
19472 sinphi/sinthet*costhet*costhet_grad(j)&
19473 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
19476 grad_shield_loc(j,ishield_list(i),i)= &
19477 scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
19478 (1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(&
19479 sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
19483 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
19485 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
19487 !C write(2,*) "TOTAL VOLUME",i,itype(i,1),fac_shield(i)
19490 end subroutine set_shield_fac2
19491 !----------------------------------------------------------------------------
19492 ! SOUBROUTINE FOR AFM
19493 subroutine AFMvel(Eafmforce)
19494 use MD_data, only:totTafm
19495 real(kind=8),dimension(3) :: diffafm
19496 real(kind=8) :: afmdist,Eafmforce
19498 !C Only for check grad COMMENT if not used for checkgrad
19500 !C--------------------------------------------------------
19501 !C print *,"wchodze"
19505 diffafm(i)=c(i,afmend)-c(i,afmbeg)
19506 afmdist=afmdist+diffafm(i)**2
19508 afmdist=dsqrt(afmdist)
19510 Eafmforce=0.5d0*forceAFMconst &
19511 *(distafminit+totTafm*velAFMconst-afmdist)**2
19512 !C Eafmforce=-forceAFMconst*(dist-distafminit)
19514 gradafm(i,afmend-1)=-forceAFMconst* &
19515 (distafminit+totTafm*velAFMconst-afmdist) &
19516 *diffafm(i)/afmdist
19517 gradafm(i,afmbeg-1)=forceAFMconst* &
19518 (distafminit+totTafm*velAFMconst-afmdist) &
19519 *diffafm(i)/afmdist
19521 ! print *,'AFM',Eafmforce,totTafm*velAFMconst,afmdist
19523 end subroutine AFMvel
19524 !---------------------------------------------------------
19525 subroutine AFMforce(Eafmforce)
19527 real(kind=8),dimension(3) :: diffafm
19528 ! real(kind=8) ::afmdist
19529 real(kind=8) :: afmdist,Eafmforce
19534 diffafm(i)=c(i,afmend)-c(i,afmbeg)
19535 afmdist=afmdist+diffafm(i)**2
19537 afmdist=dsqrt(afmdist)
19538 ! print *,afmdist,distafminit
19539 Eafmforce=-forceAFMconst*(afmdist-distafminit)
19541 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/afmdist
19542 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/afmdist
19544 !C print *,'AFM',Eafmforce
19546 end subroutine AFMforce
19548 !-----------------------------------------------------------------------------
19550 subroutine read_ssHist
19553 ! include 'DIMENSIONS'
19554 ! include "DIMENSIONS.FREE"
19555 ! include 'COMMON.FREE'
19558 character(len=80) :: controlcard
19561 call card_concat(controlcard,.true.)
19562 read(controlcard,*) &
19563 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
19567 end subroutine read_ssHist
19569 !-----------------------------------------------------------------------------
19570 integer function indmat(i,j)
19572 ! get the position of the jth ijth fragment of the chain coordinate system
19573 ! in the fromto array.
19576 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
19578 end function indmat
19579 !-----------------------------------------------------------------------------
19580 real(kind=8) function sigm(x)
19586 !-----------------------------------------------------------------------------
19587 !-----------------------------------------------------------------------------
19588 subroutine alloc_ener_arrays
19589 !EL Allocation of arrays used by module energy
19590 use MD_data, only: mset
19591 !el local variables
19594 if(nres.lt.100) then
19596 elseif(nres.lt.200) then
19597 maxconts=0.8*nres ! Max. number of contacts per residue
19599 maxconts=0.6*nres ! (maxconts=maxres/4)
19601 maxcont=12*nres ! Max. number of SC contacts
19602 maxvar=6*nres ! Max. number of variables
19603 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
19604 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
19605 !----------------------
19606 ! arrays in subroutine init_int_table
19608 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
19609 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
19611 allocate(nint_gr(nres))
19612 allocate(nscp_gr(nres))
19613 allocate(ielstart(nres))
19614 allocate(ielend(nres))
19616 allocate(istart(nres,maxint_gr))
19617 allocate(iend(nres,maxint_gr))
19618 !(maxres,maxint_gr)
19619 allocate(iscpstart(nres,maxint_gr))
19620 allocate(iscpend(nres,maxint_gr))
19621 !(maxres,maxint_gr)
19622 allocate(ielstart_vdw(nres))
19623 allocate(ielend_vdw(nres))
19625 allocate(nint_gr_nucl(nres))
19626 allocate(nscp_gr_nucl(nres))
19627 allocate(ielstart_nucl(nres))
19628 allocate(ielend_nucl(nres))
19630 allocate(istart_nucl(nres,maxint_gr))
19631 allocate(iend_nucl(nres,maxint_gr))
19632 !(maxres,maxint_gr)
19633 allocate(iscpstart_nucl(nres,maxint_gr))
19634 allocate(iscpend_nucl(nres,maxint_gr))
19635 !(maxres,maxint_gr)
19636 allocate(ielstart_vdw_nucl(nres))
19637 allocate(ielend_vdw_nucl(nres))
19639 allocate(lentyp(0:nfgtasks-1))
19641 !----------------------
19643 ! common /contacts/
19644 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
19645 allocate(icont(2,maxcont))
19647 ! common /contacts1/
19648 allocate(num_cont(0:nres+4))
19650 allocate(jcont(maxconts,nres))
19652 allocate(facont(maxconts,nres))
19654 allocate(gacont(3,maxconts,nres))
19655 !(3,maxconts,maxres)
19656 ! common /contacts_hb/
19657 allocate(gacontp_hb1(3,maxconts,nres))
19658 allocate(gacontp_hb2(3,maxconts,nres))
19659 allocate(gacontp_hb3(3,maxconts,nres))
19660 allocate(gacontm_hb1(3,maxconts,nres))
19661 allocate(gacontm_hb2(3,maxconts,nres))
19662 allocate(gacontm_hb3(3,maxconts,nres))
19663 allocate(gacont_hbr(3,maxconts,nres))
19664 allocate(grij_hb_cont(3,maxconts,nres))
19665 !(3,maxconts,maxres)
19666 allocate(facont_hb(maxconts,nres))
19668 allocate(ees0p(maxconts,nres))
19669 allocate(ees0m(maxconts,nres))
19670 allocate(d_cont(maxconts,nres))
19671 allocate(ees0plist(maxconts,nres))
19674 allocate(num_cont_hb(nres))
19676 allocate(jcont_hb(maxconts,nres))
19679 allocate(Ug(2,2,nres))
19680 allocate(Ugder(2,2,nres))
19681 allocate(Ug2(2,2,nres))
19682 allocate(Ug2der(2,2,nres))
19684 allocate(obrot(2,nres))
19685 allocate(obrot2(2,nres))
19686 allocate(obrot_der(2,nres))
19687 allocate(obrot2_der(2,nres))
19689 ! common /precomp1/
19690 allocate(mu(2,nres))
19691 allocate(muder(2,nres))
19692 allocate(Ub2(2,nres))
19695 allocate(Ub2der(2,nres))
19696 allocate(Ctobr(2,nres))
19697 allocate(Ctobrder(2,nres))
19698 allocate(Dtobr2(2,nres))
19699 allocate(Dtobr2der(2,nres))
19701 allocate(EUg(2,2,nres))
19702 allocate(EUgder(2,2,nres))
19703 allocate(CUg(2,2,nres))
19704 allocate(CUgder(2,2,nres))
19705 allocate(DUg(2,2,nres))
19706 allocate(Dugder(2,2,nres))
19707 allocate(DtUg2(2,2,nres))
19708 allocate(DtUg2der(2,2,nres))
19710 ! common /precomp2/
19711 allocate(Ug2Db1t(2,nres))
19712 allocate(Ug2Db1tder(2,nres))
19713 allocate(CUgb2(2,nres))
19714 allocate(CUgb2der(2,nres))
19716 allocate(EUgC(2,2,nres))
19717 allocate(EUgCder(2,2,nres))
19718 allocate(EUgD(2,2,nres))
19719 allocate(EUgDder(2,2,nres))
19720 allocate(DtUg2EUg(2,2,nres))
19721 allocate(Ug2DtEUg(2,2,nres))
19723 allocate(Ug2DtEUgder(2,2,2,nres))
19724 allocate(DtUg2EUgder(2,2,2,nres))
19726 ! common /rotat_old/
19727 allocate(costab(nres))
19728 allocate(sintab(nres))
19729 allocate(costab2(nres))
19730 allocate(sintab2(nres))
19733 allocate(a_chuj(2,2,maxconts,nres))
19734 !(2,2,maxconts,maxres)(maxconts=maxres/4)
19735 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
19736 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
19737 ! common /contdistrib/
19738 allocate(ncont_sent(nres))
19739 allocate(ncont_recv(nres))
19741 allocate(iat_sent(nres))
19743 allocate(iint_sent(4,nres,nres))
19744 allocate(iint_sent_local(4,nres,nres))
19746 allocate(iturn3_sent(4,0:nres+4))
19747 allocate(iturn4_sent(4,0:nres+4))
19748 allocate(iturn3_sent_local(4,nres))
19749 allocate(iturn4_sent_local(4,nres))
19751 allocate(itask_cont_from(0:nfgtasks-1))
19752 allocate(itask_cont_to(0:nfgtasks-1))
19753 !(0:max_fg_procs-1)
19757 !----------------------
19760 allocate(dcdv(6,maxdim))
19761 allocate(dxdv(6,maxdim))
19763 allocate(dxds(6,nres))
19765 allocate(gradx(3,-1:nres,0:2))
19766 allocate(gradc(3,-1:nres,0:2))
19768 allocate(gvdwx(3,-1:nres))
19769 allocate(gvdwc(3,-1:nres))
19770 allocate(gelc(3,-1:nres))
19771 allocate(gelc_long(3,-1:nres))
19772 allocate(gvdwpp(3,-1:nres))
19773 allocate(gvdwc_scpp(3,-1:nres))
19774 allocate(gradx_scp(3,-1:nres))
19775 allocate(gvdwc_scp(3,-1:nres))
19776 allocate(ghpbx(3,-1:nres))
19777 allocate(ghpbc(3,-1:nres))
19778 allocate(gradcorr(3,-1:nres))
19779 allocate(gradcorr_long(3,-1:nres))
19780 allocate(gradcorr5_long(3,-1:nres))
19781 allocate(gradcorr6_long(3,-1:nres))
19782 allocate(gcorr6_turn_long(3,-1:nres))
19783 allocate(gradxorr(3,-1:nres))
19784 allocate(gradcorr5(3,-1:nres))
19785 allocate(gradcorr6(3,-1:nres))
19786 allocate(gliptran(3,-1:nres))
19787 allocate(gliptranc(3,-1:nres))
19788 allocate(gliptranx(3,-1:nres))
19789 allocate(gshieldx(3,-1:nres))
19790 allocate(gshieldc(3,-1:nres))
19791 allocate(gshieldc_loc(3,-1:nres))
19792 allocate(gshieldx_ec(3,-1:nres))
19793 allocate(gshieldc_ec(3,-1:nres))
19794 allocate(gshieldc_loc_ec(3,-1:nres))
19795 allocate(gshieldx_t3(3,-1:nres))
19796 allocate(gshieldc_t3(3,-1:nres))
19797 allocate(gshieldc_loc_t3(3,-1:nres))
19798 allocate(gshieldx_t4(3,-1:nres))
19799 allocate(gshieldc_t4(3,-1:nres))
19800 allocate(gshieldc_loc_t4(3,-1:nres))
19801 allocate(gshieldx_ll(3,-1:nres))
19802 allocate(gshieldc_ll(3,-1:nres))
19803 allocate(gshieldc_loc_ll(3,-1:nres))
19804 allocate(grad_shield(3,-1:nres))
19805 allocate(gg_tube_sc(3,-1:nres))
19806 allocate(gg_tube(3,-1:nres))
19807 allocate(gradafm(3,-1:nres))
19808 allocate(gradb_nucl(3,-1:nres))
19809 allocate(gradbx_nucl(3,-1:nres))
19810 allocate(gvdwpsb1(3,-1:nres))
19811 allocate(gelpp(3,-1:nres))
19812 allocate(gvdwpsb(3,-1:nres))
19813 allocate(gelsbc(3,-1:nres))
19814 allocate(gelsbx(3,-1:nres))
19815 allocate(gvdwsbx(3,-1:nres))
19816 allocate(gvdwsbc(3,-1:nres))
19817 allocate(gsbloc(3,-1:nres))
19818 allocate(gsblocx(3,-1:nres))
19819 allocate(gradcorr_nucl(3,-1:nres))
19820 allocate(gradxorr_nucl(3,-1:nres))
19821 allocate(gradcorr3_nucl(3,-1:nres))
19822 allocate(gradxorr3_nucl(3,-1:nres))
19823 allocate(gvdwpp_nucl(3,-1:nres))
19824 allocate(gradpepcat(3,-1:nres))
19825 allocate(gradpepcatx(3,-1:nres))
19826 allocate(gradcatcat(3,-1:nres))
19828 allocate(grad_shield_side(3,50,nres))
19829 allocate(grad_shield_loc(3,50,nres))
19830 ! grad for shielding surroing
19831 allocate(gloc(0:maxvar,0:2))
19832 allocate(gloc_x(0:maxvar,2))
19834 allocate(gel_loc(3,-1:nres))
19835 allocate(gel_loc_long(3,-1:nres))
19836 allocate(gcorr3_turn(3,-1:nres))
19837 allocate(gcorr4_turn(3,-1:nres))
19838 allocate(gcorr6_turn(3,-1:nres))
19839 allocate(gradb(3,-1:nres))
19840 allocate(gradbx(3,-1:nres))
19842 allocate(gel_loc_loc(maxvar))
19843 allocate(gel_loc_turn3(maxvar))
19844 allocate(gel_loc_turn4(maxvar))
19845 allocate(gel_loc_turn6(maxvar))
19846 allocate(gcorr_loc(maxvar))
19847 allocate(g_corr5_loc(maxvar))
19848 allocate(g_corr6_loc(maxvar))
19850 allocate(gsccorc(3,-1:nres))
19851 allocate(gsccorx(3,-1:nres))
19853 allocate(gsccor_loc(-1:nres))
19855 allocate(gvdwx_scbase(3,-1:nres))
19856 allocate(gvdwc_scbase(3,-1:nres))
19857 allocate(gvdwx_pepbase(3,-1:nres))
19858 allocate(gvdwc_pepbase(3,-1:nres))
19859 allocate(gvdwx_scpho(3,-1:nres))
19860 allocate(gvdwc_scpho(3,-1:nres))
19861 allocate(gvdwc_peppho(3,-1:nres))
19863 allocate(dtheta(3,2,-1:nres))
19865 allocate(gscloc(3,-1:nres))
19866 allocate(gsclocx(3,-1:nres))
19868 allocate(dphi(3,3,-1:nres))
19869 allocate(dalpha(3,3,-1:nres))
19870 allocate(domega(3,3,-1:nres))
19872 ! common /deriv_scloc/
19873 allocate(dXX_C1tab(3,nres))
19874 allocate(dYY_C1tab(3,nres))
19875 allocate(dZZ_C1tab(3,nres))
19876 allocate(dXX_Ctab(3,nres))
19877 allocate(dYY_Ctab(3,nres))
19878 allocate(dZZ_Ctab(3,nres))
19879 allocate(dXX_XYZtab(3,nres))
19880 allocate(dYY_XYZtab(3,nres))
19881 allocate(dZZ_XYZtab(3,nres))
19884 allocate(jgrad_start(nres))
19885 allocate(jgrad_end(nres))
19887 !----------------------
19890 allocate(ibond_displ(0:nfgtasks-1))
19891 allocate(ibond_count(0:nfgtasks-1))
19892 allocate(ithet_displ(0:nfgtasks-1))
19893 allocate(ithet_count(0:nfgtasks-1))
19894 allocate(iphi_displ(0:nfgtasks-1))
19895 allocate(iphi_count(0:nfgtasks-1))
19896 allocate(iphi1_displ(0:nfgtasks-1))
19897 allocate(iphi1_count(0:nfgtasks-1))
19898 allocate(ivec_displ(0:nfgtasks-1))
19899 allocate(ivec_count(0:nfgtasks-1))
19900 allocate(iset_displ(0:nfgtasks-1))
19901 allocate(iset_count(0:nfgtasks-1))
19902 allocate(iint_count(0:nfgtasks-1))
19903 allocate(iint_displ(0:nfgtasks-1))
19904 !(0:max_fg_procs-1)
19905 !----------------------
19908 allocate(gcart(3,-1:nres))
19909 allocate(gxcart(3,-1:nres))
19911 allocate(gradcag(3,-1:nres))
19912 allocate(gradxag(3,-1:nres))
19914 ! common /back_constr/
19915 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
19916 allocate(dutheta(nres))
19917 allocate(dugamma(nres))
19919 allocate(duscdiff(3,nres))
19920 allocate(duscdiffx(3,nres))
19922 !el i io:read_fragments
19923 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
19924 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
19926 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
19927 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
19928 allocate(mset(0:nprocs)) !(maxprocs/20)
19930 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
19931 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
19932 allocate(dUdconst(3,0:nres))
19933 allocate(dUdxconst(3,0:nres))
19934 allocate(dqwol(3,0:nres))
19935 allocate(dxqwol(3,0:nres))
19937 !----------------------
19939 ! common /sbridge/ in io_common: read_bridge
19940 !el allocate((:),allocatable :: iss !(maxss)
19941 ! common /links/ in io_common: read_bridge
19942 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
19943 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
19944 ! common /dyn_ssbond/
19945 ! and side-chain vectors in theta or phi.
19946 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
19950 dyn_ssbond_ij(:,:)=1.0d300
19954 ! if (nss.gt.0) then
19955 allocate(idssb(maxdim),jdssb(maxdim))
19956 ! allocate(newihpb(nss),newjhpb(nss))
19959 allocate(ishield_list(nres))
19960 allocate(shield_list(50,nres))
19961 allocate(dyn_ss_mask(nres))
19962 allocate(fac_shield(nres))
19963 allocate(enetube(nres*2))
19964 allocate(enecavtube(nres*2))
19967 dyn_ss_mask(:)=.false.
19968 !----------------------
19970 ! Parameters of the SCCOR term
19972 !el in io_conf: parmread
19973 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
19974 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
19975 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
19976 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
19977 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
19978 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
19979 ! allocate(vlor1sccor(maxterm_sccor,20,20))
19980 ! allocate(vlor2sccor(maxterm_sccor,20,20))
19981 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
19983 allocate(gloc_sc(3,0:2*nres,0:10))
19984 !(3,0:maxres2,10)maxres2=2*maxres
19985 allocate(dcostau(3,3,3,2*nres))
19986 allocate(dsintau(3,3,3,2*nres))
19987 allocate(dtauangle(3,3,3,2*nres))
19988 allocate(dcosomicron(3,3,3,2*nres))
19989 allocate(domicron(3,3,3,2*nres))
19990 !(3,3,3,maxres2)maxres2=2*maxres
19991 !----------------------
19994 allocate(varall(maxvar))
19995 !(maxvar)(maxvar=6*maxres)
19996 allocate(mask_theta(nres))
19997 allocate(mask_phi(nres))
19998 allocate(mask_side(nres))
20000 !----------------------
20003 allocate(uy(3,nres))
20004 allocate(uz(3,nres))
20006 allocate(uygrad(3,3,2,nres))
20007 allocate(uzgrad(3,3,2,nres))
20011 end subroutine alloc_ener_arrays
20012 !-----------------------------------------------------------------
20013 subroutine ebond_nucl(estr_nucl)
20015 !c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
20018 real(kind=8),dimension(3) :: u,ud
20019 real(kind=8) :: usum,uprod,uprod1,uprod2,usumsqder
20020 real(kind=8) :: estr_nucl,diff
20021 integer :: iti,i,j,k,nbi
20023 !C print *,"I enter ebond"
20025 write (iout,*) "ibondp_start,ibondp_end",&
20026 ibondp_nucl_start,ibondp_nucl_end
20027 do i=ibondp_nucl_start,ibondp_nucl_end
20028 if (itype(i-1,2).eq.ntyp1_molec(2) .or. &
20029 itype(i,2).eq.ntyp1_molec(2)) cycle
20030 ! estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
20032 ! gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
20033 ! & *dc(j,i-1)/vbld(i)
20035 ! if (energy_dec) write(iout,*)
20036 ! & "estr1",i,vbld(i),distchainmax,
20037 ! & gnmr1(vbld(i),-1.0d0,distchainmax)
20039 diff = vbld(i)-vbldp0_nucl
20040 if(energy_dec)write(iout,*) "estr_nucl_bb" , i,vbld(i),&
20041 vbldp0_nucl,diff,AKP_nucl*diff*diff
20042 estr_nucl=estr_nucl+diff*diff
20043 ! print *,estr_nucl
20045 gradb_nucl(j,i-1)=AKP_nucl*diff*dc(j,i-1)/vbld(i)
20047 !c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
20049 estr_nucl=0.5d0*AKP_nucl*estr_nucl
20050 ! print *,"partial sum", estr_nucl,AKP_nucl
20053 write (iout,*) "ibondp_start,ibondp_end",&
20054 ibond_nucl_start,ibond_nucl_end
20056 do i=ibond_nucl_start,ibond_nucl_end
20057 !C print *, "I am stuck",i
20059 if (iti.eq.ntyp1_molec(2)) cycle
20060 nbi=nbondterm_nucl(iti)
20063 diff=vbld(i+nres)-vbldsc0_nucl(1,iti)
20066 write (iout,*) "estr_nucl_sc", i,iti,vbld(i+nres),vbldsc0_nucl(1,iti),diff, &
20067 AKSC_nucl(1,iti),AKSC_nucl(1,iti)*diff*diff
20068 estr_nucl=estr_nucl+0.5d0*AKSC_nucl(1,iti)*diff*diff
20069 ! print *,estr_nucl
20071 gradbx_nucl(j,i)=AKSC_nucl(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
20075 diff=vbld(i+nres)-vbldsc0_nucl(j,iti)
20076 ud(j)=aksc_nucl(j,iti)*diff
20077 u(j)=abond0_nucl(j,iti)+0.5d0*ud(j)*diff
20091 uprod2=uprod2*u(k)*u(k)
20095 usumsqder=usumsqder+ud(j)*uprod2
20097 estr_nucl=estr_nucl+uprod/usum
20099 gradbx_nucl(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
20103 !C print *,"I am about to leave ebond"
20105 end subroutine ebond_nucl
20107 !-----------------------------------------------------------------------------
20108 subroutine ebend_nucl(etheta_nucl)
20109 real(kind=8),dimension(nntheterm_nucl+1) :: coskt,sinkt !mmaxtheterm
20110 real(kind=8),dimension(nsingle_nucl+1) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
20111 real(kind=8),dimension(ndouble_nucl+1,ndouble_nucl+1) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
20112 logical :: lprn=.false., lprn1=.false.
20113 !el local variables
20114 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
20115 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
20116 real(kind=8) :: aux,etheta_nucl,ccl,ssl,scl,csl,ethetacnstr
20117 ! local variables for constrains
20118 real(kind=8) :: difi,thetiii
20121 ! print *,"ithet_start",ithet_nucl_start," ithet_end",ithet_nucl_end,nres
20122 do i=ithet_nucl_start,ithet_nucl_end
20123 if ((itype(i-1,2).eq.ntyp1_molec(2)).or.&
20124 (itype(i-2,2).eq.ntyp1_molec(2)).or. &
20125 (itype(i,2).eq.ntyp1_molec(2))) cycle
20129 theti2=0.5d0*theta(i)
20130 ityp2=ithetyp_nucl(itype(i-1,2))
20131 do k=1,nntheterm_nucl
20132 coskt(k)=dcos(k*theti2)
20133 sinkt(k)=dsin(k*theti2)
20135 if (i.gt.3 .and. itype(i-2,2).ne.ntyp1_molec(2)) then
20138 if (phii.ne.phii) phii=150.0
20142 ityp1=ithetyp_nucl(itype(i-2,2))
20143 do k=1,nsingle_nucl
20144 cosph1(k)=dcos(k*phii)
20145 sinph1(k)=dsin(k*phii)
20149 ityp1=nthetyp_nucl+1
20150 do k=1,nsingle_nucl
20156 if (i.lt.nres .and. itype(i,2).ne.ntyp1_molec(2)) then
20159 if (phii1.ne.phii1) phii1=150.0
20160 phii1=pinorm(phii1)
20164 ityp3=ithetyp_nucl(itype(i,2))
20165 do k=1,nsingle_nucl
20166 cosph2(k)=dcos(k*phii1)
20167 sinph2(k)=dsin(k*phii1)
20171 ityp3=nthetyp_nucl+1
20172 do k=1,nsingle_nucl
20177 ethetai=aa0thet_nucl(ityp1,ityp2,ityp3)
20178 do k=1,ndouble_nucl
20180 ccl=cosph1(l)*cosph2(k-l)
20181 ssl=sinph1(l)*sinph2(k-l)
20182 scl=sinph1(l)*cosph2(k-l)
20183 csl=cosph1(l)*sinph2(k-l)
20184 cosph1ph2(l,k)=ccl-ssl
20185 cosph1ph2(k,l)=ccl+ssl
20186 sinph1ph2(l,k)=scl+csl
20187 sinph1ph2(k,l)=scl-csl
20191 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
20192 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
20193 write (iout,*) "coskt and sinkt",nntheterm_nucl
20194 do k=1,nntheterm_nucl
20195 write (iout,*) k,coskt(k),sinkt(k)
20198 do k=1,ntheterm_nucl
20199 ethetai=ethetai+aathet_nucl(k,ityp1,ityp2,ityp3)*sinkt(k)
20200 dethetai=dethetai+0.5d0*k*aathet_nucl(k,ityp1,ityp2,ityp3)&
20203 write (iout,*) "k",k," aathet",aathet_nucl(k,ityp1,ityp2,ityp3),&
20207 write (iout,*) "cosph and sinph"
20208 do k=1,nsingle_nucl
20209 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
20211 write (iout,*) "cosph1ph2 and sinph2ph2"
20212 do k=2,ndouble_nucl
20214 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
20215 sinph1ph2(l,k),sinph1ph2(k,l)
20218 write(iout,*) "ethetai",ethetai
20220 do m=1,ntheterm2_nucl
20221 do k=1,nsingle_nucl
20222 aux=bbthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)&
20223 +ccthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k)&
20224 +ddthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)&
20225 +eethet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k)
20226 ethetai=ethetai+sinkt(m)*aux
20227 dethetai=dethetai+0.5d0*m*aux*coskt(m)
20228 dephii=dephii+k*sinkt(m)*(&
20229 ccthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)-&
20230 bbthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k))
20231 dephii1=dephii1+k*sinkt(m)*(&
20232 eethet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)-&
20233 ddthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k))
20235 write (iout,*) "m",m," k",k," bbthet",&
20236 bbthet_nucl(k,m,ityp1,ityp2,ityp3)," ccthet",&
20237 ccthet_nucl(k,m,ityp1,ityp2,ityp3)," ddthet",&
20238 ddthet_nucl(k,m,ityp1,ityp2,ityp3)," eethet",&
20239 eethet_nucl(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
20243 write(iout,*) "ethetai",ethetai
20244 do m=1,ntheterm3_nucl
20245 do k=2,ndouble_nucl
20247 aux=ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
20248 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+&
20249 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
20250 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
20251 ethetai=ethetai+sinkt(m)*aux
20252 dethetai=dethetai+0.5d0*m*coskt(m)*aux
20253 dephii=dephii+l*sinkt(m)*(&
20254 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-&
20255 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
20256 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
20257 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
20258 dephii1=dephii1+(k-l)*sinkt(m)*( &
20259 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
20260 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
20261 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-&
20262 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
20264 write (iout,*) "m",m," k",k," l",l," ffthet", &
20265 ffthet_nucl(l,k,m,ityp1,ityp2,ityp3), &
20266 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ggthet",&
20267 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3),&
20268 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
20269 write (iout,*) cosph1ph2(l,k)*sinkt(m), &
20270 cosph1ph2(k,l)*sinkt(m),&
20271 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
20277 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
20278 i,theta(i)*rad2deg,phii*rad2deg, &
20279 phii1*rad2deg,ethetai
20280 etheta_nucl=etheta_nucl+ethetai
20281 ! print *,i,"partial sum",etheta_nucl
20282 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang_nucl*dephii
20283 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang_nucl*dephii1
20284 gloc(nphi+i-2,icg)=wang_nucl*dethetai
20287 end subroutine ebend_nucl
20288 !----------------------------------------------------
20289 subroutine etor_nucl(etors_nucl)
20290 ! implicit real*8 (a-h,o-z)
20291 ! include 'DIMENSIONS'
20292 ! include 'COMMON.VAR'
20293 ! include 'COMMON.GEO'
20294 ! include 'COMMON.LOCAL'
20295 ! include 'COMMON.TORSION'
20296 ! include 'COMMON.INTERACT'
20297 ! include 'COMMON.DERIV'
20298 ! include 'COMMON.CHAIN'
20299 ! include 'COMMON.NAMES'
20300 ! include 'COMMON.IOUNITS'
20301 ! include 'COMMON.FFIELD'
20302 ! include 'COMMON.TORCNSTR'
20303 ! include 'COMMON.CONTROL'
20304 real(kind=8) :: etors_nucl,edihcnstr
20306 !el local variables
20307 integer :: i,j,iblock,itori,itori1
20308 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
20309 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
20310 ! Set lprn=.true. for debugging
20314 ! print *,"iphi_nucl_start/end", iphi_nucl_start,iphi_nucl_end
20315 do i=iphi_nucl_start,iphi_nucl_end
20316 if (itype(i-2,2).eq.ntyp1_molec(2) .or. itype(i-1,2).eq.ntyp1_molec(2) &
20317 .or. itype(i-3,2).eq.ntyp1_molec(2) &
20318 .or. itype(i,2).eq.ntyp1_molec(2)) cycle
20320 itori=itortyp_nucl(itype(i-2,2))
20321 itori1=itortyp_nucl(itype(i-1,2))
20323 ! print *,i,itori,itori1
20325 !C Regular cosine and sine terms
20326 do j=1,nterm_nucl(itori,itori1)
20327 v1ij=v1_nucl(j,itori,itori1)
20328 v2ij=v2_nucl(j,itori,itori1)
20329 cosphi=dcos(j*phii)
20330 sinphi=dsin(j*phii)
20331 etors_nucl=etors_nucl+v1ij*cosphi+v2ij*sinphi
20332 if (energy_dec) etors_ii=etors_ii+&
20333 v1ij*cosphi+v2ij*sinphi
20334 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
20338 !C E = SUM ----------------------------------- - v1
20339 !C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
20341 cosphi=dcos(0.5d0*phii)
20342 sinphi=dsin(0.5d0*phii)
20343 do j=1,nlor_nucl(itori,itori1)
20344 vl1ij=vlor1_nucl(j,itori,itori1)
20345 vl2ij=vlor2_nucl(j,itori,itori1)
20346 vl3ij=vlor3_nucl(j,itori,itori1)
20347 pom=vl2ij*cosphi+vl3ij*sinphi
20348 pom1=1.0d0/(pom*pom+1.0d0)
20349 etors_nucl=etors_nucl+vl1ij*pom1
20350 if (energy_dec) etors_ii=etors_ii+ &
20353 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
20355 !C Subtract the constant term
20356 etors_nucl=etors_nucl-v0_nucl(itori,itori1)
20357 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
20358 'etor',i,etors_ii-v0_nucl(itori,itori1)
20360 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
20361 restyp(itype(i-2,2),2),i-2,restyp(itype(i-1,2),2),i-1,itori,itori1, &
20362 (v1_nucl(j,itori,itori1),j=1,6),(v2_nucl(j,itori,itori1),j=1,6)
20363 gloc(i-3,icg)=gloc(i-3,icg)+wtor_nucl*gloci
20364 !c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
20367 end subroutine etor_nucl
20368 !------------------------------------------------------------
20369 subroutine epp_nucl_sub(evdw1,ees)
20371 !C This subroutine calculates the average interaction energy and its gradient
20372 !C in the virtual-bond vectors between non-adjacent peptide groups, based on
20373 !C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
20374 !C The potential depends both on the distance of peptide-group centers and on
20375 !C the orientation of the CA-CA virtual bonds.
20377 integer :: i,j,k,iteli,itelj,num_conti,isubchap,ind
20378 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
20379 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
20380 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
20381 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
20382 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20383 dist_temp, dist_init,sss_grad,fac,evdw1ij
20384 integer xshift,yshift,zshift
20385 real(kind=8),dimension(3):: ggg,gggp,gggm,erij
20386 real(kind=8) :: ees,eesij
20387 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
20388 real(kind=8) scal_el /0.5d0/
20394 !c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
20396 ! print *,"iatel_s_nucl,iatel_e_nucl",iatel_s_nucl,iatel_e_nucl
20397 do i=iatel_s_nucl,iatel_e_nucl
20398 if (itype(i,2).eq.ntyp1_molec(2) .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
20402 dx_normi=dc_norm(1,i)
20403 dy_normi=dc_norm(2,i)
20404 dz_normi=dc_norm(3,i)
20405 xmedi=c(1,i)+0.5d0*dxi
20406 ymedi=c(2,i)+0.5d0*dyi
20407 zmedi=c(3,i)+0.5d0*dzi
20408 xmedi=dmod(xmedi,boxxsize)
20409 if (xmedi.lt.0) xmedi=xmedi+boxxsize
20410 ymedi=dmod(ymedi,boxysize)
20411 if (ymedi.lt.0) ymedi=ymedi+boxysize
20412 zmedi=dmod(zmedi,boxzsize)
20413 if (zmedi.lt.0) zmedi=zmedi+boxzsize
20415 do j=ielstart_nucl(i),ielend_nucl(i)
20416 if (itype(j,2).eq.ntyp1_molec(2) .or. itype(j+1,2).eq.ntyp1_molec(2)) cycle
20421 ! xj=c(1,j)+0.5D0*dxj-xmedi
20422 ! yj=c(2,j)+0.5D0*dyj-ymedi
20423 ! zj=c(3,j)+0.5D0*dzj-zmedi
20424 xj=c(1,j)+0.5D0*dxj
20425 yj=c(2,j)+0.5D0*dyj
20426 zj=c(3,j)+0.5D0*dzj
20427 xj=mod(xj,boxxsize)
20428 if (xj.lt.0) xj=xj+boxxsize
20429 yj=mod(yj,boxysize)
20430 if (yj.lt.0) yj=yj+boxysize
20431 zj=mod(zj,boxzsize)
20432 if (zj.lt.0) zj=zj+boxzsize
20434 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
20441 xj=xj_safe+xshift*boxxsize
20442 yj=yj_safe+yshift*boxysize
20443 zj=zj_safe+zshift*boxzsize
20444 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
20445 if(dist_temp.lt.dist_init) then
20446 dist_init=dist_temp
20455 if (isubchap.eq.1) then
20466 rij=xj*xj+yj*yj+zj*zj
20467 !c write (2,*)"ij",i,j," r0pp",r0pp," rij",rij," epspp",epspp
20468 fac=(r0pp**2/rij)**3
20472 fac=(-ev1-evdw1ij)/rij
20473 ! write (2,*)"fac",fac," ev1",ev1," ev2",ev2," evdw1ij",evdw1ij
20474 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"evdw1ij",evdw1ij
20475 evdw1=evdw1+evdw1ij
20477 !C Calculate contributions to the Cartesian gradient.
20483 gvdwpp_nucl(k,i)=gvdwpp_nucl(k,i)-ggg(k)
20484 gvdwpp_nucl(k,j)=gvdwpp_nucl(k,j)+ggg(k)
20486 !c phoshate-phosphate electrostatic interactions
20489 eesij=dexp(-BEES*rij)*fac
20490 ! write (2,*)"fac",fac," eesijpp",eesij
20491 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"eesijpp",eesij
20494 fac=-(fac+BEES)*eesij*fac
20498 !c write(2,*) "ggg",i,j,ggg(1),ggg(2),ggg(3)
20499 !c write(2,*) "gelpp",i,(gelpp(k,i),k=1,3)
20500 !c write(2,*) "gelpp",j,(gelpp(k,j),k=1,3)
20502 gelpp(k,i)=gelpp(k,i)-ggg(k)
20503 gelpp(k,j)=gelpp(k,j)+ggg(k)
20510 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
20512 gvdwpp_nucl(k,i)=6*gvdwpp_nucl(k,i)
20513 !c gelpp(k,i)=332.0d0*gelpp(k,i)
20514 gelpp(k,i)=AEES*gelpp(k,i)
20516 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
20518 !c write (2,*) "total EES",ees
20520 end subroutine epp_nucl_sub
20521 !---------------------------------------------------------------------
20522 subroutine epsb(evdwpsb,eelpsb)
20525 !C This subroutine calculates the excluded-volume interaction energy between
20526 !C peptide-group centers and side chains and its gradient in virtual-bond and
20527 !C side-chain vectors.
20529 real(kind=8),dimension(3):: ggg
20530 integer :: i,iint,j,k,iteli,itypj,subchap
20531 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
20532 e1,e2,evdwij,rij,evdwpsb,eelpsb
20533 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20534 dist_temp, dist_init
20535 integer xshift,yshift,zshift
20537 !cd print '(a)','Enter ESCP'
20538 !cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
20541 ! print *,"iatscp_s_nucl,iatscp_e_nucl",iatscp_s_nucl,iatscp_e_nucl
20542 do i=iatscp_s_nucl,iatscp_e_nucl
20543 if (itype(i,2).eq.ntyp1_molec(2) &
20544 .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
20545 xi=0.5D0*(c(1,i)+c(1,i+1))
20546 yi=0.5D0*(c(2,i)+c(2,i+1))
20547 zi=0.5D0*(c(3,i)+c(3,i+1))
20548 xi=mod(xi,boxxsize)
20549 if (xi.lt.0) xi=xi+boxxsize
20550 yi=mod(yi,boxysize)
20551 if (yi.lt.0) yi=yi+boxysize
20552 zi=mod(zi,boxzsize)
20553 if (zi.lt.0) zi=zi+boxzsize
20555 do iint=1,nscp_gr_nucl(i)
20557 do j=iscpstart_nucl(i,iint),iscpend_nucl(i,iint)
20559 if (itypj.eq.ntyp1_molec(2)) cycle
20560 !C Uncomment following three lines for SC-p interactions
20561 !c xj=c(1,nres+j)-xi
20562 !c yj=c(2,nres+j)-yi
20563 !c zj=c(3,nres+j)-zi
20564 !C Uncomment following three lines for Ca-p interactions
20571 xj=mod(xj,boxxsize)
20572 if (xj.lt.0) xj=xj+boxxsize
20573 yj=mod(yj,boxysize)
20574 if (yj.lt.0) yj=yj+boxysize
20575 zj=mod(zj,boxzsize)
20576 if (zj.lt.0) zj=zj+boxzsize
20577 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20585 xj=xj_safe+xshift*boxxsize
20586 yj=yj_safe+yshift*boxysize
20587 zj=zj_safe+zshift*boxzsize
20588 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20589 if(dist_temp.lt.dist_init) then
20590 dist_init=dist_temp
20599 if (subchap.eq.1) then
20609 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
20611 e1=fac*fac*aad_nucl(itypj)
20612 e2=fac*bad_nucl(itypj)
20613 if (iabs(j-i) .le. 2) then
20618 evdwpsb=evdwpsb+evdwij
20619 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a4)') &
20620 'evdw2',i,j,evdwij,"tu4"
20622 !C Calculate contributions to the gradient in the virtual-bond and SC vectors.
20624 fac=-(evdwij+e1)*rrij
20629 gvdwpsb1(k,i)=gvdwpsb1(k,i)-ggg(k)
20630 gvdwpsb(k,j)=gvdwpsb(k,j)+ggg(k)
20638 gvdwpsb(j,i)=expon*gvdwpsb(j,i)
20639 gvdwpsb1(j,i)=expon*gvdwpsb1(j,i)
20643 end subroutine epsb
20645 !------------------------------------------------------
20646 subroutine esb_gb(evdwsb,eelsb)
20649 integer :: iint,itypi,itypi1,itypj,subchap,num_conti2
20650 real(kind=8) :: xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
20651 real(kind=8) :: evdw,sig0iji,evdwsb,eelsb,ecorr,eelij
20652 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20653 dist_temp, dist_init,aa,bb,faclip,sig0ij
20662 ! print *,"iastsc_nucl",iatsc_s_nucl,iatsc_e_nucl
20663 do i=iatsc_s_nucl,iatsc_e_nucl
20667 ! PRINT *,"I=",i,itypi
20668 if (itypi.eq.ntyp1_molec(2)) cycle
20669 itypi1=itype(i+1,2)
20673 xi=dmod(xi,boxxsize)
20674 if (xi.lt.0) xi=xi+boxxsize
20675 yi=dmod(yi,boxysize)
20676 if (yi.lt.0) yi=yi+boxysize
20677 zi=dmod(zi,boxzsize)
20678 if (zi.lt.0) zi=zi+boxzsize
20680 dxi=dc_norm(1,nres+i)
20681 dyi=dc_norm(2,nres+i)
20682 dzi=dc_norm(3,nres+i)
20683 dsci_inv=vbld_inv(i+nres)
20685 !C Calculate SC interaction energy.
20687 do iint=1,nint_gr_nucl(i)
20688 ! print *,"tu?",i,istart_nucl(i,iint),iend_nucl(i,iint)
20689 do j=istart_nucl(i,iint),iend_nucl(i,iint)
20693 if (itypj.eq.ntyp1_molec(2)) cycle
20694 dscj_inv=vbld_inv(j+nres)
20695 sig0ij=sigma_nucl(itypi,itypj)
20696 chi1=chi_nucl(itypi,itypj)
20697 chi2=chi_nucl(itypj,itypi)
20699 chip1=chip_nucl(itypi,itypj)
20700 chip2=chip_nucl(itypj,itypi)
20702 ! xj=c(1,nres+j)-xi
20703 ! yj=c(2,nres+j)-yi
20704 ! zj=c(3,nres+j)-zi
20708 xj=dmod(xj,boxxsize)
20709 if (xj.lt.0) xj=xj+boxxsize
20710 yj=dmod(yj,boxysize)
20711 if (yj.lt.0) yj=yj+boxysize
20712 zj=dmod(zj,boxzsize)
20713 if (zj.lt.0) zj=zj+boxzsize
20714 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20722 xj=xj_safe+xshift*boxxsize
20723 yj=yj_safe+yshift*boxysize
20724 zj=zj_safe+zshift*boxzsize
20725 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20726 if(dist_temp.lt.dist_init) then
20727 dist_init=dist_temp
20736 if (subchap.eq.1) then
20746 dxj=dc_norm(1,nres+j)
20747 dyj=dc_norm(2,nres+j)
20748 dzj=dc_norm(3,nres+j)
20749 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
20751 !C Calculate angle-dependent terms of energy and contributions to their
20756 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
20757 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
20758 om12=dxi*dxj+dyi*dyj+dzi*dzj
20759 call sc_angular_nucl
20761 sig=sig0ij*dsqrt(sigsq)
20762 rij_shift=1.0D0/rij-sig+sig0ij
20763 ! print *,rij_shift,"rij_shift"
20764 !c write (2,*) " rij",1.0D0/rij," sig",sig," sig0ij",sig0ij,
20765 !c & " rij_shift",rij_shift
20766 if (rij_shift.le.0.0D0) then
20771 !c---------------------------------------------------------------
20772 rij_shift=1.0D0/rij_shift
20773 fac=rij_shift**expon
20774 e1=fac*fac*aa_nucl(itypi,itypj)
20775 e2=fac*bb_nucl(itypi,itypj)
20776 evdwij=eps1*eps2rt*(e1+e2)
20777 !c write (2,*) "eps1",eps1," eps2rt",eps2rt,
20778 !c & " e1",e1," e2",e2," evdwij",evdwij
20780 evdwij=evdwij*eps2rt
20781 evdwsb=evdwsb+evdwij
20783 sigm=dabs(aa_nucl(itypi,itypj)/bb_nucl(itypi,itypj))**(1.0D0/6.0D0)
20784 epsi=bb_nucl(itypi,itypj)**2/aa_nucl(itypi,itypj)
20785 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
20786 restyp(itypi,2),i,restyp(itypj,2),j, &
20787 epsi,sigm,chi1,chi2,chip1,chip2, &
20788 eps1,eps2rt**2,sig,sig0ij, &
20789 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
20791 write (iout,*) "aa",aa_nucl(itypi,itypj)," bb",bb_nucl(itypi,itypj)
20794 if (energy_dec) write (iout,'(a6,2i5,e15.3,a4)') &
20795 'evdw',i,j,evdwij,"tu3"
20798 !C Calculate gradient components.
20799 e1=e1*eps1*eps2rt**2
20800 fac=-expon*(e1+evdwij)*rij_shift
20804 !C Calculate the radial part of the gradient
20808 !C Calculate angular part of the gradient.
20810 call eelsbij(eelij,num_conti2)
20811 if (energy_dec .and. &
20812 (j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2)) &
20813 write (istat,'(e14.5)') evdwij
20817 num_cont_hb(i)=num_conti2
20819 !c write (iout,*) "Number of loop steps in EGB:",ind
20820 !cccc energy_dec=.false.
20822 end subroutine esb_gb
20823 !-------------------------------------------------------------------------------
20824 subroutine eelsbij(eesij,num_conti2)
20827 real(kind=8),dimension(3) :: ggg,gggp,gggm,dcosb,dcosg
20828 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
20829 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20830 dist_temp, dist_init,rlocshield,fracinbuf
20831 integer xshift,yshift,zshift,ilist,iresshield,num_conti2
20833 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
20834 real(kind=8) scal_el /0.5d0/
20835 integer :: iteli,itelj,kkk,kkll,m,isubchap
20836 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp,facfac
20837 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i,ael63i,ael32i
20838 real(kind=8) :: dx_normj,dy_normj,dz_normj,&
20839 r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,fac5,fac6,&
20840 el1,el2,el3,el4,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
20841 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
20842 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
20843 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
20844 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
20845 ecosgp,ecosam,ecosbm,ecosgm,ghalf,itypi,itypj
20849 ! print *,i,j,itypi,itypj,istype(i),istype(j),"????"
20850 ael6i=ael6_nucl(itypi,itypj)
20851 ael3i=ael3_nucl(itypi,itypj)
20852 ael63i=ael63_nucl(itypi,itypj)
20853 ael32i=ael32_nucl(itypi,itypj)
20854 !c write (iout,*) "eelecij",i,j,itype(i),itype(j),
20855 !c & ael6i,ael3i,ael63i,al32i,rij,rrij
20859 dx_normi=dc_norm(1,i+nres)
20860 dy_normi=dc_norm(2,i+nres)
20861 dz_normi=dc_norm(3,i+nres)
20862 dx_normj=dc_norm(1,j+nres)
20863 dy_normj=dc_norm(2,j+nres)
20864 dz_normj=dc_norm(3,j+nres)
20865 !c xj=c(1,j)+0.5D0*dxj-xmedi
20866 !c yj=c(2,j)+0.5D0*dyj-ymedi
20867 !c zj=c(3,j)+0.5D0*dzj-zmedi
20868 if (ipot_nucl.ne.2) then
20869 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
20870 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
20871 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
20879 fac=cosa-3.0D0*cosb*cosg
20881 fac1=3.0d0*(cosb*cosb+cosg*cosg)
20886 !c write (iout,*) "r3ij",r3ij," r6ij",r6ij," fac",fac," fac1",fac1,
20887 !c & " fac2",fac2," fac3",fac3," fac4",fac4," fac5",fac5," fac6",fac6
20888 el1=fac3*(4.0D0+facfac-fac1)
20890 el3=fac5*(2.0d0-2.0d0*facfac+fac1)
20892 eesij=el1+el2+el3+el4
20893 !C 12/26/95 - for the evaluation of multi-body H-bonding interactions
20894 ees0ij=4.0D0+facfac-fac1
20896 if (energy_dec) then
20897 if(j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2) &
20898 write (istat,'(2a1,i4,1x,2a1,i4,4f10.5,3e12.5,$)') &
20899 sugartyp(istype(i)),restyp(itypi,2),i,sugartyp(istype(j)),&
20900 restyp(itypj,2),j,1.0d0/rij,cosa,cosb,cosg,fac*r3ij, &
20901 (4.0D0+facfac-fac1)*r6ij,(2.0d0-2.0d0*facfac+fac1)*r6ij
20902 write (iout,'(a6,2i5,e15.3)') 'ees',i,j,eesij
20906 !C Calculate contributions to the Cartesian gradient.
20908 facel=-3.0d0*rrij*(eesij+el1+el3+el4)
20914 !* Radial derivatives. First process both termini of the fragment (i,j)
20920 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
20921 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
20922 gelsbx(k,j)=gelsbx(k,j)+ggg(k)
20923 gelsbx(k,i)=gelsbx(k,i)-ggg(k)
20928 ecosa=2.0D0*fac3*fac1+fac4+(-4.0d0*fac5+2.0d0*fac6)*fac1
20933 ecosb=fac3*(fac1*cosg+cosb)+cosg*fac4+(cosb+2*fac1*cosg)*fac5+&
20935 ecosg=fac3*(fac1*cosb+cosg)+cosb*fac4+(cosg+2*fac1*cosb)*fac5+&
20938 dcosb(k)=rij*(dc_norm(k,i+nres)-erij(k)*cosb)
20939 dcosg(k)=rij*(dc_norm(k,j+nres)-erij(k)*cosg)
20942 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
20945 gelsbx(k,i)=gelsbx(k,i)-ggg(k) &
20946 +(ecosa*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres))&
20947 + ecosb*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
20948 gelsbx(k,j)=gelsbx(k,j)+ggg(k) &
20949 +(ecosa*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
20950 + ecosg*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
20951 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
20952 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
20954 ! IF ( (wcorr_nucl.gt.0.0d0.or.wcorr3_nucl.gt.0.0d0) .and.
20955 IF ( j.gt.i+1 .and.&
20956 num_conti.le.maxconts) THEN
20958 !C Calculate the contact function. The ith column of the array JCONT will
20959 !C contain the numbers of atoms that make contacts with the atom I (of numbers
20960 !C greater than I). The arrays FACONT and GACONT will contain the values of
20961 !C the contact function and its derivative.
20962 r0ij=2.20D0*sigma(itypi,itypj)
20963 !c write (2,*) "ij",i,j," rij",1.0d0/rij," r0ij",r0ij
20964 call gcont(rij,r0ij,1.0D0,0.2d0/r0ij,fcont,fprimcont)
20965 !c write (2,*) "fcont",fcont
20966 if (fcont.gt.0.0D0) then
20967 num_conti=num_conti+1
20968 num_conti2=num_conti2+1
20970 if (num_conti.gt.maxconts) then
20971 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
20972 ' will skip next contacts for this conf.'
20974 jcont_hb(num_conti,i)=j
20975 !c write (iout,*) "num_conti",num_conti,
20976 !c & " jcont_hb",jcont_hb(num_conti,i)
20977 !C Calculate contact energies
20979 wij=cosa-3.0D0*cosb*cosg
20982 fac3=dsqrt(-ael6i)*r3ij
20983 !c write (2,*) "ael6i",ael6i," r3ij",r3ij," fac3",fac3
20984 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
20985 if (ees0tmp.gt.0) then
20986 ees0pij=dsqrt(ees0tmp)
20990 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
20991 if (ees0tmp.gt.0) then
20992 ees0mij=dsqrt(ees0tmp)
20996 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
20997 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
20998 !c write (iout,*) "i",i," j",j,
20999 !c & " ees0m",ees0m(num_conti,i)," ees0p",ees0p(num_conti,i)
21000 ees0pij1=fac3/ees0pij
21001 ees0mij1=fac3/ees0mij
21002 fac3p=-3.0D0*fac3*rrij
21003 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
21004 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
21005 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
21006 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
21007 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
21008 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
21009 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
21010 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
21011 ecosap=ecosa1+ecosa2
21012 ecosbp=ecosb1+ecosb2
21013 ecosgp=ecosg1+ecosg2
21014 ecosam=ecosa1-ecosa2
21015 ecosbm=ecosb1-ecosb2
21016 ecosgm=ecosg1-ecosg2
21018 facont_hb(num_conti,i)=fcont
21019 fprimcont=fprimcont/rij
21021 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
21022 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
21024 gggp(1)=gggp(1)+ees0pijp*xj
21025 gggp(2)=gggp(2)+ees0pijp*yj
21026 gggp(3)=gggp(3)+ees0pijp*zj
21027 gggm(1)=gggm(1)+ees0mijp*xj
21028 gggm(2)=gggm(2)+ees0mijp*yj
21029 gggm(3)=gggm(3)+ees0mijp*zj
21030 !C Derivatives due to the contact function
21031 gacont_hbr(1,num_conti,i)=fprimcont*xj
21032 gacont_hbr(2,num_conti,i)=fprimcont*yj
21033 gacont_hbr(3,num_conti,i)=fprimcont*zj
21036 !c Gradient of the correlation terms
21038 gacontp_hb1(k,num_conti,i)= &
21039 (ecosap*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
21040 + ecosbp*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21041 gacontp_hb2(k,num_conti,i)= &
21042 (ecosap*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres)) &
21043 + ecosgp*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21044 gacontp_hb3(k,num_conti,i)=gggp(k)
21045 gacontm_hb1(k,num_conti,i)= &
21046 (ecosam*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
21047 + ecosbm*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21048 gacontm_hb2(k,num_conti,i)= &
21049 (ecosam*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
21050 + ecosgm*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21051 gacontm_hb3(k,num_conti,i)=gggm(k)
21057 end subroutine eelsbij
21058 !------------------------------------------------------------------
21059 subroutine sc_grad_nucl
21062 real(kind=8),dimension(3) :: dcosom1,dcosom2
21063 eom1=eps2der*eps2rt_om1+sigder*sigsq_om1
21064 eom2=eps2der*eps2rt_om2+sigder*sigsq_om2
21065 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12+sigder*sigsq_om12
21067 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
21068 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
21071 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
21074 gvdwsbx(k,i)=gvdwsbx(k,i)-gg(k) &
21075 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
21076 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
21077 gvdwsbx(k,j)=gvdwsbx(k,j)+gg(k) &
21078 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
21079 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
21082 !C Calculate the components of the gradient in DC and X
21085 gvdwsbc(l,i)=gvdwsbc(l,i)-gg(l)
21086 gvdwsbc(l,j)=gvdwsbc(l,j)+gg(l)
21089 end subroutine sc_grad_nucl
21090 !-----------------------------------------------------------------------
21091 subroutine esb(esbloc)
21092 !C Calculate the local energy of a side chain and its derivatives in the
21093 !C corresponding virtual-bond valence angles THETA and the spherical angles
21094 !C ALPHA and OMEGA derived from AM1 all-atom calculations.
21095 !C added by Urszula Kozlowska. 07/11/2007
21097 real(kind=8),dimension(3):: x_prime,y_prime,z_prime
21098 real(kind=8),dimension(9):: x
21099 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1, &
21100 sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,&
21101 de_dxx,de_dyy,de_dzz,de_dt,s1_t,s1_6_t,s2_t,s2_6_t
21102 real(kind=8),dimension(3):: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,&
21103 dYY_Ci,dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
21104 real(kind=8) :: esbloc,delta,cosfac2,cosfac,sinfac2,sinfac,de_dtt,&
21105 cossc,cossc1,cosfac2xx,sinfac2yy,pom1,pom
21106 integer::it,nlobit,i,j,k
21107 ! common /sccalc/ time11,time12,time112,theti,it,nlobit
21110 do i=loc_start_nucl,loc_end_nucl
21111 if (itype(i,2).eq.ntyp1_molec(2)) cycle
21112 costtab(i+1) =dcos(theta(i+1))
21113 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
21114 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
21115 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
21116 cosfac2=0.5d0/(1.0d0+costtab(i+1))
21117 cosfac=dsqrt(cosfac2)
21118 sinfac2=0.5d0/(1.0d0-costtab(i+1))
21119 sinfac=dsqrt(sinfac2)
21121 if (it.eq.10) goto 1
21124 !C Compute the axes of tghe local cartesian coordinates system; store in
21125 !c x_prime, y_prime and z_prime
21132 !C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
21133 !C & dc_norm(3,i+nres)
21135 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
21136 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
21139 z_prime(j) = -uz(j,i-1)
21147 xx = xx + x_prime(j)*dc_norm(j,i+nres)
21148 yy = yy + y_prime(j)*dc_norm(j,i+nres)
21149 zz = zz + z_prime(j)*dc_norm(j,i+nres)
21157 x(j) = sc_parmin_nucl(j,it)
21160 !Cc diagnostics - remove later
21161 xx1 = dcos(alph(2))
21162 yy1 = dsin(alph(2))*dcos(omeg(2))
21163 zz1 = -dsin(alph(2))*dsin(omeg(2))
21164 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
21165 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
21167 !C," --- ", xx_w,yy_w,zz_w
21170 sumene = enesc_nucl(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21171 esbloc = esbloc + sumene
21172 sumene2= enesc_nucl(x,xx,yy,0.0d0,cost2tab(i+1),sint2tab(i+1))
21173 ! print *,"enecomp",sumene,sumene2
21174 ! if (energy_dec) write(iout,*) "i",i," esbloc",sumene,esbloc,xx,yy,zz
21175 ! if (energy_dec) write(iout,*) "x",(x(k),k=1,9)
21177 write (2,*) "x",(x(k),k=1,9)
21179 !C This section to check the numerical derivatives of the energy of ith side
21180 !C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
21181 !C #define DEBUG in the code to turn it on.
21183 write (2,*) "sumene =",sumene
21187 write (2,*) xx,yy,zz
21188 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21189 de_dxx_num=(sumenep-sumene)/aincr
21191 write (2,*) "xx+ sumene from enesc=",sumenep,sumene
21194 write (2,*) xx,yy,zz
21195 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21196 de_dyy_num=(sumenep-sumene)/aincr
21198 write (2,*) "yy+ sumene from enesc=",sumenep,sumene
21201 write (2,*) xx,yy,zz
21202 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21203 de_dzz_num=(sumenep-sumene)/aincr
21205 write (2,*) "zz+ sumene from enesc=",sumenep,sumene
21206 costsave=cost2tab(i+1)
21207 sintsave=sint2tab(i+1)
21208 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
21209 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
21210 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21211 de_dt_num=(sumenep-sumene)/aincr
21212 write (2,*) " t+ sumene from enesc=",sumenep,sumene
21213 cost2tab(i+1)=costsave
21214 sint2tab(i+1)=sintsave
21215 !C End of diagnostics section.
21218 !C Compute the gradient of esc
21220 de_dxx=x(1)+2*x(4)*xx+x(7)*zz+x(8)*yy
21221 de_dyy=x(2)+2*x(5)*yy+x(8)*xx+x(9)*zz
21222 de_dzz=x(3)+2*x(6)*zz+x(7)*xx+x(9)*yy
21225 write (2,*) "x",(x(k),k=1,9)
21226 write (2,*) "xx",xx," yy",yy," zz",zz
21227 write (2,*) "de_xx ",de_xx," de_yy ",de_yy,&
21228 " de_zz ",de_zz," de_tt ",de_tt
21229 write (2,*) "de_xx_num",de_dxx_num," de_yy_num",de_dyy_num,&
21230 " de_zz_num",de_dzz_num," de_dt_num",de_dt_num
21233 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
21234 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
21235 cosfac2xx=cosfac2*xx
21236 sinfac2yy=sinfac2*yy
21238 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*&
21240 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*&
21242 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
21243 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
21244 !c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
21245 !c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
21246 !c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
21247 !c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
21248 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
21249 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
21250 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
21251 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
21255 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
21256 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
21259 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
21260 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
21261 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
21263 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
21264 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
21268 dXX_Ctab(k,i)=dXX_Ci(k)
21269 dXX_C1tab(k,i)=dXX_Ci1(k)
21270 dYY_Ctab(k,i)=dYY_Ci(k)
21271 dYY_C1tab(k,i)=dYY_Ci1(k)
21272 dZZ_Ctab(k,i)=dZZ_Ci(k)
21273 dZZ_C1tab(k,i)=dZZ_Ci1(k)
21274 dXX_XYZtab(k,i)=dXX_XYZ(k)
21275 dYY_XYZtab(k,i)=dYY_XYZ(k)
21276 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
21279 !c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
21280 !c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
21281 !c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
21282 !c & dyy_ci(k)," dzz_ci",dzz_ci(k)
21283 !c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
21285 !c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
21286 !c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
21287 gsbloc(k,i-1)=gsbloc(k,i-1)+(de_dxx*dxx_ci1(k) &
21288 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k))
21289 gsbloc(k,i)=gsbloc(k,i)+(de_dxx*dxx_Ci(k) &
21290 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k))
21291 gsblocx(k,i)= de_dxx*dxx_XYZ(k)&
21292 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
21293 ! print *,i,de_dxx*dxx_ci1(k)+de_dyy*dyy_ci1(k),de_dzz*dzz_ci1(k)*2
21295 !c write(iout,*) "ENERGY GRAD = ", (gsbloc(k,i-1),k=1,3),
21296 !c & (gsbloc(k,i),k=1,3),(gsblocx(k,i),k=1,3)
21298 !C to check gradient call subroutine check_grad
21304 !=-------------------------------------------------------
21305 real(kind=8) function enesc_nucl(x,xx,yy,zz,cost2,sint2)
21307 real(kind=8),dimension(9):: x(9)
21308 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2, &
21309 sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
21311 !c write (2,*) "enesc"
21312 !c write (2,*) "x",(x(i),i=1,9)
21313 !c write(2,*)"xx",xx," yy",yy," zz",zz," cost2",cost2," sint2",sint2
21314 sumene=x(1)*xx+x(2)*yy+x(3)*zz+x(4)*xx**2 &
21315 + x(5)*yy**2+x(6)*zz**2+x(7)*xx*zz+x(8)*xx*yy &
21319 end function enesc_nucl
21320 !-----------------------------------------------------------------------------
21321 subroutine multibody_hb_nucl(ecorr,ecorr3,n_corr,n_corr1)
21324 integer,parameter :: max_cont=2000
21325 integer,parameter:: max_dim=2*(8*3+6)
21326 integer, parameter :: msglen1=max_cont*max_dim
21327 integer,parameter :: msglen2=2*msglen1
21328 integer source,CorrelType,CorrelID,Error
21329 real(kind=8) :: buffer(max_cont,max_dim)
21330 integer status(MPI_STATUS_SIZE)
21331 integer :: ierror,nbytes
21333 real(kind=8),dimension(3):: gx(3),gx1(3)
21334 real(kind=8) :: time00
21336 integer i,j,i1,j1,jj,kk,num_conti,num_conti1,nn
21337 real(kind=8) ecorr,ecorr3
21338 integer :: n_corr,n_corr1,mm,msglen
21339 !C Set lprn=.true. for debugging
21344 if(.not.allocated(zapas2)) allocate(zapas2(3,maxconts,nres,8))
21346 if (nfgtasks.le.1) goto 30
21348 write (iout,'(a)') 'Contact function values:'
21350 write (iout,'(2i3,50(1x,i2,f5.2))') &
21351 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
21352 j=1,num_cont_hb(i))
21355 !C Caution! Following code assumes that electrostatic interactions concerning
21356 !C a given atom are split among at most two processors!
21366 !c write (*,*) 'MyRank',MyRank,' mm',mm
21369 !c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
21370 if (fg_rank.gt.0) then
21371 !C Send correlation contributions to the preceding processor
21373 nn=num_cont_hb(iatel_s_nucl)
21374 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
21375 !c write (*,*) 'The BUFFER array:'
21377 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
21379 if (ielstart_nucl(iatel_s_nucl).gt.iatel_s_nucl+ispp) then
21381 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
21382 !C Clear the contacts of the atom passed to the neighboring processor
21383 nn=num_cont_hb(iatel_s_nucl+1)
21385 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
21387 num_cont_hb(iatel_s_nucl)=0
21389 !cd write (iout,*) 'Processor ',fg_rank,MyRank,
21390 !cd & ' is sending correlation contribution to processor',fg_rank-1,
21391 !cd & ' msglen=',msglen
21392 !c write (*,*) 'Processor ',fg_rank,MyRank,
21393 !c & ' is sending correlation contribution to processor',fg_rank-1,
21394 !c & ' msglen=',msglen,' CorrelType=',CorrelType
21396 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, &
21397 CorrelType,FG_COMM,IERROR)
21398 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
21399 !cd write (iout,*) 'Processor ',fg_rank,
21400 !cd & ' has sent correlation contribution to processor',fg_rank-1,
21401 !cd & ' msglen=',msglen,' CorrelID=',CorrelID
21402 !c write (*,*) 'Processor ',fg_rank,
21403 !c & ' has sent correlation contribution to processor',fg_rank-1,
21404 !c & ' msglen=',msglen,' CorrelID=',CorrelID
21406 endif ! (fg_rank.gt.0)
21410 !c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
21411 if (fg_rank.lt.nfgtasks-1) then
21412 !C Receive correlation contributions from the next processor
21414 if (ielend_nucl(iatel_e_nucl).lt.nct_molec(2)-1) msglen=msglen2
21415 !cd write (iout,*) 'Processor',fg_rank,
21416 !cd & ' is receiving correlation contribution from processor',fg_rank+1,
21417 !cd & ' msglen=',msglen,' CorrelType=',CorrelType
21418 !c write (*,*) 'Processor',fg_rank,
21419 !c &' is receiving correlation contribution from processor',fg_rank+1,
21420 !c & ' msglen=',msglen,' CorrelType=',CorrelType
21423 do while (nbytes.le.0)
21424 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
21425 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
21427 !c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
21428 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, &
21429 fg_rank+1,CorrelType,FG_COMM,status,IERROR)
21430 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
21431 !c write (*,*) 'Processor',fg_rank,
21432 !c &' has received correlation contribution from processor',fg_rank+1,
21433 !c & ' msglen=',msglen,' nbytes=',nbytes
21434 !c write (*,*) 'The received BUFFER array:'
21436 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
21438 if (msglen.eq.msglen1) then
21439 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,0,buffer)
21440 else if (msglen.eq.msglen2) then
21441 call unpack_buffer(max_cont,max_dim,iatel_e_nucl,0,buffer)
21442 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,30,buffer)
21445 'ERROR!!!! message length changed while processing correlations.'
21447 'ERROR!!!! message length changed while processing correlations.'
21448 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
21449 endif ! msglen.eq.msglen1
21450 endif ! fg_rank.lt.nfgtasks-1
21457 write (iout,'(a)') 'Contact function values:'
21458 do i=nnt_molec(2),nct_molec(2)-1
21459 write (iout,'(2i3,50(1x,i2,f5.2))') &
21460 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
21461 j=1,num_cont_hb(i))
21466 !C Remove the loop below after debugging !!!
21467 ! do i=nnt_molec(2),nct_molec(2)
21469 ! gradcorr_nucl(j,i)=0.0D0
21470 ! gradxorr_nucl(j,i)=0.0D0
21471 ! gradcorr3_nucl(j,i)=0.0D0
21472 ! gradxorr3_nucl(j,i)=0.0D0
21475 ! print *,"iatsc_s_nucl,iatsc_e_nucl",iatsc_s_nucl,iatsc_e_nucl
21476 !C Calculate the local-electrostatic correlation terms
21477 do i=iatsc_s_nucl,iatsc_e_nucl
21479 num_conti=num_cont_hb(i)
21480 num_conti1=num_cont_hb(i+1)
21481 ! print *,i,num_conti,num_conti1
21486 !c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
21487 !c & ' jj=',jj,' kk=',kk
21488 if (j1.eq.j+1 .or. j1.eq.j-1) then
21490 !C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
21491 !C The system gains extra energy.
21492 !C Tentative expression & coefficients; assumed d(stacking)=4.5 A,
21493 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
21494 !C Need to implement full formulas 34 and 35 from Liwo et al., 1998.
21496 ecorr=ecorr+ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
21497 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
21498 'ecorrh',i,j,ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
21500 else if (j1.eq.j) then
21502 !C Contacts I-J and I-(J+1) occur simultaneously.
21503 !C The system loses extra energy.
21504 !C Tentative expression & c?oefficients; assumed d(stacking)=4.5 A,
21505 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
21506 !C Need to implement full formulas 32 from Liwo et al., 1998.
21508 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
21509 !c & ' jj=',jj,' kk=',kk
21510 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i+1,j,jj,kk,0.310D0,-0.155D0)
21515 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
21516 !c & ' jj=',jj,' kk=',kk
21517 if (j1.eq.j+1) then
21518 !C Contacts I-J and (I+1)-J occur simultaneously.
21519 !C The system loses extra energy.
21520 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i,j+1,jj,kk,0.310D0,-0.155D0)
21526 end subroutine multibody_hb_nucl
21527 !-----------------------------------------------------------
21528 real(kind=8) function ehbcorr_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
21529 ! implicit real*8 (a-h,o-z)
21530 ! include 'DIMENSIONS'
21531 ! include 'COMMON.IOUNITS'
21532 ! include 'COMMON.DERIV'
21533 ! include 'COMMON.INTERACT'
21534 ! include 'COMMON.CONTACTS'
21535 real(kind=8),dimension(3) :: gx,gx1
21537 !el local variables
21538 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
21539 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
21540 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
21541 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
21545 eij=facont_hb(jj,i)
21546 ekl=facont_hb(kk,k)
21547 ees0pij=ees0p(jj,i)
21548 ees0pkl=ees0p(kk,k)
21549 ees0mij=ees0m(jj,i)
21550 ees0mkl=ees0m(kk,k)
21552 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
21553 ! print *,"ehbcorr_nucl",ekont,ees
21554 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
21555 !C Following 4 lines for diagnostics.
21560 !cd write (iout,*)'Contacts have occurred for nucleic bases',
21561 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
21562 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
21563 !C Calculate the multi-body contribution to energy.
21564 ! ecorr_nucl=ecorr_nucl+ekont*ees
21565 !C Calculate multi-body contributions to the gradient.
21566 coeffpees0pij=coeffp*ees0pij
21567 coeffmees0mij=coeffm*ees0mij
21568 coeffpees0pkl=coeffp*ees0pkl
21569 coeffmees0mkl=coeffm*ees0mkl
21571 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i) &
21572 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
21573 coeffmees0mkl*gacontm_hb1(ll,jj,i))
21574 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j) &
21575 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+&
21576 coeffmees0mkl*gacontm_hb2(ll,jj,i))
21577 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k) &
21578 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
21579 coeffmees0mij*gacontm_hb1(ll,kk,k))
21580 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l) &
21581 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
21582 coeffmees0mij*gacontm_hb2(ll,kk,k))
21583 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
21584 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
21585 coeffmees0mkl*gacontm_hb3(ll,jj,i))
21586 gradcorr_nucl(ll,j)=gradcorr_nucl(ll,j)+gradlongij
21587 gradcorr_nucl(ll,i)=gradcorr_nucl(ll,i)-gradlongij
21588 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
21589 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
21590 coeffmees0mij*gacontm_hb3(ll,kk,k))
21591 gradcorr_nucl(ll,l)=gradcorr_nucl(ll,l)+gradlongkl
21592 gradcorr_nucl(ll,k)=gradcorr_nucl(ll,k)-gradlongkl
21593 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i)-gradlongij
21594 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j)+gradlongij
21595 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k)-gradlongkl
21596 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l)+gradlongkl
21598 ehbcorr_nucl=ekont*ees
21600 end function ehbcorr_nucl
21601 !-------------------------------------------------------------------------
21603 real(kind=8) function ehbcorr3_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
21604 ! implicit real*8 (a-h,o-z)
21605 ! include 'DIMENSIONS'
21606 ! include 'COMMON.IOUNITS'
21607 ! include 'COMMON.DERIV'
21608 ! include 'COMMON.INTERACT'
21609 ! include 'COMMON.CONTACTS'
21610 real(kind=8),dimension(3) :: gx,gx1
21612 !el local variables
21613 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
21614 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
21615 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
21616 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
21620 eij=facont_hb(jj,i)
21621 ekl=facont_hb(kk,k)
21622 ees0pij=ees0p(jj,i)
21623 ees0pkl=ees0p(kk,k)
21624 ees0mij=ees0m(jj,i)
21625 ees0mkl=ees0m(kk,k)
21627 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
21628 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
21629 !C Following 4 lines for diagnostics.
21634 !cd write (iout,*)'Contacts have occurred for nucleic bases',
21635 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
21636 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
21637 !C Calculate the multi-body contribution to energy.
21638 ! ecorr=ecorr+ekont*ees
21639 !C Calculate multi-body contributions to the gradient.
21640 coeffpees0pij=coeffp*ees0pij
21641 coeffmees0mij=coeffm*ees0mij
21642 coeffpees0pkl=coeffp*ees0pkl
21643 coeffmees0mkl=coeffm*ees0mkl
21645 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i) &
21646 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
21647 coeffmees0mkl*gacontm_hb1(ll,jj,i))
21648 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j) &
21649 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
21650 coeffmees0mkl*gacontm_hb2(ll,jj,i))
21651 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k) &
21652 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ &
21653 coeffmees0mij*gacontm_hb1(ll,kk,k))
21654 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l) &
21655 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
21656 coeffmees0mij*gacontm_hb2(ll,kk,k))
21657 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
21658 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
21659 coeffmees0mkl*gacontm_hb3(ll,jj,i))
21660 gradcorr3_nucl(ll,j)=gradcorr3_nucl(ll,j)+gradlongij
21661 gradcorr3_nucl(ll,i)=gradcorr3_nucl(ll,i)-gradlongij
21662 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
21663 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
21664 coeffmees0mij*gacontm_hb3(ll,kk,k))
21665 gradcorr3_nucl(ll,l)=gradcorr3_nucl(ll,l)+gradlongkl
21666 gradcorr3_nucl(ll,k)=gradcorr3_nucl(ll,k)-gradlongkl
21667 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i)-gradlongij
21668 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j)+gradlongij
21669 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k)-gradlongkl
21670 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l)+gradlongkl
21672 ehbcorr3_nucl=ekont*ees
21674 end function ehbcorr3_nucl
21676 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
21677 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
21678 real(kind=8):: buffer(dimen1,dimen2)
21679 num_kont=num_cont_hb(atom)
21683 buffer(i,indx+(k-1)*3+j)=zapas2(j,i,atom,k)
21686 buffer(i,indx+25)=facont_hb(i,atom)
21687 buffer(i,indx+26)=ees0p(i,atom)
21688 buffer(i,indx+27)=ees0m(i,atom)
21689 buffer(i,indx+28)=d_cont(i,atom)
21690 buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
21692 buffer(1,indx+30)=dfloat(num_kont)
21694 end subroutine pack_buffer
21695 !c------------------------------------------------------------------------------
21696 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
21697 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
21698 real(kind=8):: buffer(dimen1,dimen2)
21699 ! double precision zapas
21700 ! common /contacts_hb/ zapas(3,maxconts,maxres,8),
21701 ! & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
21702 ! & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
21703 ! & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
21704 num_kont=buffer(1,indx+30)
21705 num_kont_old=num_cont_hb(atom)
21706 num_cont_hb(atom)=num_kont+num_kont_old
21711 zapas2(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
21714 facont_hb(ii,atom)=buffer(i,indx+25)
21715 ees0p(ii,atom)=buffer(i,indx+26)
21716 ees0m(ii,atom)=buffer(i,indx+27)
21717 d_cont(i,atom)=buffer(i,indx+28)
21718 jcont_hb(ii,atom)=buffer(i,indx+29)
21721 end subroutine unpack_buffer
21722 !c------------------------------------------------------------------------------
21724 subroutine ecatcat(ecationcation)
21725 integer :: i,j,itmp,xshift,yshift,zshift,subchap,k
21726 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
21727 r7,r4,ecationcation,k0,rcal
21728 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
21729 dist_init,dist_temp,Evan1cat,Evan2cat,Eeleccat
21730 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
21733 ecationcation=0.0d0
21734 if (nres_molec(5).eq.0) return
21739 k0 = 332.0*(2.0*2.0)/80.0
21743 itmp=itmp+nres_molec(i)
21745 ! write(iout,*) "itmp",itmp
21746 do i=itmp+1,itmp+nres_molec(5)-1
21752 xi=mod(xi,boxxsize)
21753 if (xi.lt.0) xi=xi+boxxsize
21754 yi=mod(yi,boxysize)
21755 if (yi.lt.0) yi=yi+boxysize
21756 zi=mod(zi,boxzsize)
21757 if (zi.lt.0) zi=zi+boxzsize
21759 do j=i+1,itmp+nres_molec(5)
21760 ! print *,i,j,'catcat'
21764 xj=dmod(xj,boxxsize)
21765 if (xj.lt.0) xj=xj+boxxsize
21766 yj=dmod(yj,boxysize)
21767 if (yj.lt.0) yj=yj+boxysize
21768 zj=dmod(zj,boxzsize)
21769 if (zj.lt.0) zj=zj+boxzsize
21770 ! write(iout,*) c(1,i),xi,xj,"xy",boxxsize
21771 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21779 xj=xj_safe+xshift*boxxsize
21780 yj=yj_safe+yshift*boxysize
21781 zj=zj_safe+zshift*boxzsize
21782 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21783 if(dist_temp.lt.dist_init) then
21784 dist_init=dist_temp
21793 if (subchap.eq.1) then
21802 rcal =xj**2+yj**2+zj**2
21808 ! k0 = 332*(2*2)/80
21809 Evan1cat=epscalc*(r012/rcal**6)
21810 Evan2cat=epscalc*2*(r06/rcal**3)
21818 dEvan1Cmcat(k)=-12*r(k)*epscalc*r012/r7
21819 dEvan2Cmcat(k)=-12*r(k)*epscalc*r06/r4
21820 dEeleccat(k)=-k0*r(k)/ract**3
21823 gg(k) = dEvan1Cmcat(k)+dEvan2Cmcat(k)+dEeleccat(k)
21824 gradcatcat(k,i)=gradcatcat(k,i)-gg(k)
21825 gradcatcat(k,j)=gradcatcat(k,j)+gg(k)
21828 ! write(iout,*) "ecatcat",i,j, ecationcation,xj,yj,zj
21829 ecationcation=ecationcation+Evan1cat+Evan2cat+Eeleccat
21833 end subroutine ecatcat
21834 !---------------------------------------------------------------------------
21835 subroutine ecat_prot(ecation_prot)
21836 integer i,j,k,subchap,itmp,inum
21837 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
21838 r7,r4,ecationcation
21839 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
21840 dist_init,dist_temp,ecation_prot,rcal,rocal, &
21841 Evan1,Evan2,EC,cm1mag,DASGL,delta,r0p,Epepcat, &
21842 catl,cml,calpl, Etotal_p, Etotal_m,rtab,wdip,wmodquad,wquad1, &
21843 wquad2,wvan1,E1,E2,wconst,wvan2,rcpm,dcmag,sin2thet,sinthet, &
21844 costhet,v1m,v2m,wh2o,wc,rsecp,Ir,Irsecp,Irthrp,Irfourp,Irfiftp,&
21845 Irsistp,Irseven,Irtwelv,Irthir,dE1dr,dE2dr,dEdcos,wquad2p,opt, &
21846 rs,rthrp,rfourp,rsixp,reight,Irsixp,Ireight,Irtw,Irfourt, &
21847 opt1,opt2,opt3,opt4,opt5,opt6,opt7,opt8,opt9,opt10,opt11,opt12,&
21848 opt13,opt14,opt15,opt16,opt17,opt18,opt19, &
21849 Equad1,Equad2,dscmag,v1dpv2,dscmag3,constA,constB,Edip
21850 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
21851 gg,r,EtotalCat,dEtotalCm,dEtotalCalp,dEvan1Cm,dEvan2Cm, &
21852 dEtotalpep,dEtotalcat_num,dEddci,dEtotalcm_num,dEtotalcalp_num, &
21853 tab1,tab2,tab3,diff,cm1,sc,p,tcat,talp,cm,drcp,drcp_norm,vcat, &
21854 v1,v2,v3,myd_norm,dx,vcm,valpha,drdpep,dcosdpep,dcosddci,dEdpep,&
21855 dEcCat,dEdipCm,dEdipCalp,dEquad1Cat,dEquad1Cm,dEquad1Calp, &
21856 dEquad2Cat,dEquad2Cm,dEquad2Calpd,Evan1Cat,dEvan1Calp,dEvan2Cat,&
21857 dEvan2Calp,dEtotalCat,dscvec,dEcCm,dEcCalp,dEdipCat,dEquad2Calp,&
21859 real(kind=8),dimension(6) :: vcatprm
21861 ! first lets calculate interaction with peptide groups
21862 if (nres_molec(5).eq.0) return
21864 wdip =1.092777950857032D2
21866 wmodquad=-2.174122713004870D4
21867 wmodquad=wmodquad/wconst
21868 wquad1 = 3.901232068562804D1
21869 wquad1=wquad1/wconst
21871 wquad2=wquad2/wconst
21876 itmp=itmp+nres_molec(i)
21878 ! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
21879 do i=ibond_start,ibond_end
21881 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle ! leave dummy atoms
21882 xi=0.5d0*(c(1,i)+c(1,i+1))
21883 yi=0.5d0*(c(2,i)+c(2,i+1))
21884 zi=0.5d0*(c(3,i)+c(3,i+1))
21885 xi=mod(xi,boxxsize)
21886 if (xi.lt.0) xi=xi+boxxsize
21887 yi=mod(yi,boxysize)
21888 if (yi.lt.0) yi=yi+boxysize
21889 zi=mod(zi,boxzsize)
21890 if (zi.lt.0) zi=zi+boxzsize
21892 do j=itmp+1,itmp+nres_molec(5)
21896 xj=dmod(xj,boxxsize)
21897 if (xj.lt.0) xj=xj+boxxsize
21898 yj=dmod(yj,boxysize)
21899 if (yj.lt.0) yj=yj+boxysize
21900 zj=dmod(zj,boxzsize)
21901 if (zj.lt.0) zj=zj+boxzsize
21902 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21910 xj=xj_safe+xshift*boxxsize
21911 yj=yj_safe+yshift*boxysize
21912 zj=zj_safe+zshift*boxzsize
21913 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21914 if(dist_temp.lt.dist_init) then
21915 dist_init=dist_temp
21924 if (subchap.eq.1) then
21935 rcpm = sqrt(xj**2+yj**2+zj**2)
21936 drcp_norm(1)=xj/rcpm
21937 drcp_norm(2)=yj/rcpm
21938 drcp_norm(3)=zj/rcpm
21941 dcmag=dcmag+dc(k,i)**2
21945 myd_norm(k)=dc(k,i)/dcmag
21947 costhet=drcp_norm(1)*myd_norm(1)+drcp_norm(2)*myd_norm(2)+&
21948 drcp_norm(3)*myd_norm(3)
21951 Irsecp = 1.0d0/rsecp
21952 Irthrp = Irsecp/rcpm
21953 Irfourp = Irthrp/rcpm
21954 Irfiftp = Irfourp/rcpm
21955 Irsistp=Irfiftp/rcpm
21956 Irseven=Irsistp/rcpm
21957 Irtwelv=Irsistp*Irsistp
21958 Irthir=Irtwelv/rcpm
21959 sin2thet = (1-costhet*costhet)
21960 sinthet=sqrt(sin2thet)
21961 E1 = wdip*Irsecp*costhet+(wmodquad*Irfourp+wquad1*Irthrp)&
21963 E2 = -wquad1*Irthrp*wquad2+wvan1*(wvan2**12*Irtwelv-&
21964 2*wvan2**6*Irsistp)
21965 ecation_prot = ecation_prot+E1+E2
21966 dE1dr = -2*costhet*wdip*Irthrp-&
21967 (4*wmodquad*Irfiftp+3*wquad1*Irfourp)*sin2thet
21968 dE2dr = 3*wquad1*wquad2*Irfourp- &
21969 12*wvan1*wvan2**6*(wvan2**6*Irthir-Irseven)
21970 dEdcos = wdip*Irsecp-2*(wmodquad*Irfourp+wquad1*Irthrp)*costhet
21972 drdpep(k) = -drcp_norm(k)
21973 dcosdpep(k) = Ir*(costhet*drcp_norm(k)-myd_norm(k))
21974 dcosddci(k) = drcp_norm(k)/dcmag-costhet*myd_norm(k)/dcmag
21975 dEdpep(k) = (dE1dr+dE2dr)*drdpep(k)+dEdcos*dcosdpep(k)
21976 dEddci(k) = dEdcos*dcosddci(k)
21979 gradpepcat(k,i)=gradpepcat(k,i)+0.5D0*dEdpep(k)-dEddci(k)
21980 gradpepcat(k,i+1)=gradpepcat(k,i+1)+0.5D0*dEdpep(k)+dEddci(k)
21981 gradpepcat(k,j)=gradpepcat(k,j)-dEdpep(k)
21985 !------------------------------------------sidechains
21986 ! do i=1,nres_molec(1)
21987 do i=ibond_start,ibond_end
21988 if ((itype(i,1).eq.ntyp1)) cycle ! leave dummy atoms
21990 ! print *,i,ecation_prot
21994 xi=mod(xi,boxxsize)
21995 if (xi.lt.0) xi=xi+boxxsize
21996 yi=mod(yi,boxysize)
21997 if (yi.lt.0) yi=yi+boxysize
21998 zi=mod(zi,boxzsize)
21999 if (zi.lt.0) zi=zi+boxzsize
22001 cm1(k)=dc(k,i+nres)
22003 cm1mag=sqrt(cm1(1)**2+cm1(2)**2+cm1(3)**2)
22004 do j=itmp+1,itmp+nres_molec(5)
22008 xj=dmod(xj,boxxsize)
22009 if (xj.lt.0) xj=xj+boxxsize
22010 yj=dmod(yj,boxysize)
22011 if (yj.lt.0) yj=yj+boxysize
22012 zj=dmod(zj,boxzsize)
22013 if (zj.lt.0) zj=zj+boxzsize
22014 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22022 xj=xj_safe+xshift*boxxsize
22023 yj=yj_safe+yshift*boxysize
22024 zj=zj_safe+zshift*boxzsize
22025 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22026 if(dist_temp.lt.dist_init) then
22027 dist_init=dist_temp
22036 if (subchap.eq.1) then
22047 if(itype(i,1).eq.15.or.itype(i,1).eq.16) then
22048 if(itype(i,1).eq.16) then
22054 vcatprm(k)=catprm(k,inum)
22056 dASGL=catprm(7,inum)
22058 vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
22063 dx(k) = vcat(k)-vcm(k)
22066 v1(k)=(vcm(k)-valpha(k))
22067 v2(k)=(vcat(k)-valpha(k))
22069 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
22070 v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
22071 v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
22073 ! The weights of the energy function calculated from
22074 !The quantum mechanical GAMESS simulations of calcium with ASP/GLU
22082 wquad2 = vcatprm(4)
22087 opt = dx(1)**2+dx(2)**2
22088 rsecp = opt+dx(3)**2
22092 rsixp = rfourp*rsecp
22097 Irfourp = Irthrp/rs
22103 opt1 = (4*rs*dx(3)*wdip)
22104 opt2 = 6*rsecp*wquad1*opt
22105 opt3 = wquad1*wquad2p*Irsixp
22106 opt4 = (wvan1*wvan2**12)
22107 opt5 = opt4*12*Irfourt
22108 opt6 = 2*wvan1*wvan2**6
22109 opt7 = 6*opt6*Ireight
22112 opt11 = (rsecp*v2m)**2
22113 opt12 = (rsecp*v1m)**2
22114 opt14 = (v1m*v2m*rsecp)**2
22115 opt15 = -wquad1/v2m**2
22116 opt16 = (rthrp*(v1m*v2m)**2)**2
22117 opt17 = (v1m**2*rthrp)**2
22118 opt18 = -wquad1/rthrp
22119 opt19 = (v1m**2*v2m**2)**2
22122 dEcCat(k) = -(dx(k)*wc)*Irthrp
22123 dEcCm(k)=(dx(k)*wc)*Irthrp
22126 Edip=opt8*(v1dpv2)/(rsecp*v2m)
22128 dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m &
22129 *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
22130 dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m &
22131 *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
22132 dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m &
22133 *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp) &
22136 Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
22138 dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp* &
22139 (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2* &
22140 v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
22141 dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp* &
22142 (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2* &
22143 v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
22144 dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
22145 v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)* &
22148 Equad2=wquad1*wquad2p*Irthrp
22150 dEquad2Cat(k)=-3*dx(k)*rs*opt3
22151 dEquad2Cm(k)=3*dx(k)*rs*opt3
22152 dEquad2Calp(k)=0.0d0
22156 dEvan1Cat(k)=-dx(k)*opt5
22157 dEvan1Cm(k)=dx(k)*opt5
22158 dEvan1Calp(k)=0.0d0
22162 dEvan2Cat(k)=dx(k)*opt7
22163 dEvan2Cm(k)=-dx(k)*opt7
22164 dEvan2Calp(k)=0.0d0
22166 ecation_prot=ecation_prot+Ec+Edip+Equad1+Equad2+Evan1+Evan2
22167 ! print *,ecation_prot,Ec+Edip+Equad1+Equad2+Evan1+Evan2
22170 dEtotalCat(k)=dEcCat(k)+dEdipCat(k)+dEquad1Cat(k)+ &
22171 dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
22172 !c write(*,*) 'dEtotalCat inside', (dEtotalCat(l),l=1,3)
22173 dEtotalCm(k)=dEcCm(k)+dEdipCm(k)+dEquad1Cm(k)+ &
22174 dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
22175 dEtotalCalp(k)=dEcCalp(k)+dEdipCalp(k)+dEquad1Calp(k) &
22176 +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
22180 dscvec(k) = dc(k,i+nres)
22181 dscmag = dscmag+dscvec(k)*dscvec(k)
22184 dscmag = sqrt(dscmag)
22185 dscmag3 = dscmag3*dscmag
22186 constA = 1.0d0+dASGL/dscmag
22189 constB = constB+dscvec(k)*dEtotalCm(k)
22191 constB = constB*dASGL/dscmag3
22193 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
22194 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
22195 constA*dEtotalCm(k)-constB*dscvec(k)
22196 ! print *,j,constA,dEtotalCm(k),constB,dscvec(k)
22197 gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
22198 gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
22200 else if (itype(i,1).eq.13.or.itype(i,1).eq.14) then
22201 if(itype(i,1).eq.14) then
22207 vcatprm(k)=catprm(k,inum)
22209 dASGL=catprm(7,inum)
22211 vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
22217 dx(k) = vcat(k)-vcm(k)
22220 v1(k)=(vcm(k)-valpha(k))
22221 v2(k)=(vcat(k)-valpha(k))
22223 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
22224 v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
22225 v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
22226 ! The weights of the energy function calculated from
22227 !The quantum mechanical GAMESS simulations of ASN/GLN with calcium
22233 wquad2 = vcatprm(4)
22238 opt = dx(1)**2+dx(2)**2
22239 rsecp = opt+dx(3)**2
22243 rsixp = rfourp*rsecp
22248 Irfourp = Irthrp/rs
22254 opt1 = (4*rs*dx(3)*wdip)
22255 opt2 = 6*rsecp*wquad1*opt
22256 opt3 = wquad1*wquad2p*Irsixp
22257 opt4 = (wvan1*wvan2**12)
22258 opt5 = opt4*12*Irfourt
22259 opt6 = 2*wvan1*wvan2**6
22260 opt7 = 6*opt6*Ireight
22263 opt11 = (rsecp*v2m)**2
22264 opt12 = (rsecp*v1m)**2
22265 opt14 = (v1m*v2m*rsecp)**2
22266 opt15 = -wquad1/v2m**2
22267 opt16 = (rthrp*(v1m*v2m)**2)**2
22268 opt17 = (v1m**2*rthrp)**2
22269 opt18 = -wquad1/rthrp
22270 opt19 = (v1m**2*v2m**2)**2
22271 Edip=opt8*(v1dpv2)/(rsecp*v2m)
22273 dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m&
22274 *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
22275 dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m&
22276 *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
22277 dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m&
22278 *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp)&
22281 Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
22283 dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp*&
22284 (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2*&
22285 v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
22286 dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp*&
22287 (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2*&
22288 v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
22289 dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
22290 v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)*&
22293 Equad2=wquad1*wquad2p*Irthrp
22295 dEquad2Cat(k)=-3*dx(k)*rs*opt3
22296 dEquad2Cm(k)=3*dx(k)*rs*opt3
22297 dEquad2Calp(k)=0.0d0
22301 dEvan1Cat(k)=-dx(k)*opt5
22302 dEvan1Cm(k)=dx(k)*opt5
22303 dEvan1Calp(k)=0.0d0
22307 dEvan2Cat(k)=dx(k)*opt7
22308 dEvan2Cm(k)=-dx(k)*opt7
22309 dEvan2Calp(k)=0.0d0
22311 ecation_prot = ecation_prot+Edip+Equad1+Equad2+Evan1+Evan2
22313 dEtotalCat(k)=dEdipCat(k)+dEquad1Cat(k)+ &
22314 dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
22315 dEtotalCm(k)=dEdipCm(k)+dEquad1Cm(k)+ &
22316 dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
22317 dEtotalCalp(k)=dEdipCalp(k)+dEquad1Calp(k) &
22318 +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
22322 dscvec(k) = c(k,i+nres)-c(k,i)
22323 dscmag = dscmag+dscvec(k)*dscvec(k)
22326 dscmag = sqrt(dscmag)
22327 dscmag3 = dscmag3*dscmag
22328 constA = 1+dASGL/dscmag
22331 constB = constB+dscvec(k)*dEtotalCm(k)
22333 constB = constB*dASGL/dscmag3
22335 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
22336 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
22337 constA*dEtotalCm(k)-constB*dscvec(k)
22338 gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
22339 gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
22344 r(k) = c(k,j)-c(k,i+nres)
22345 rcal = rcal+r(k)*r(k)
22350 r0p=0.5*(rocal+sig0(itype(i,1)))
22353 Evan1=epscalc*(r012/rcal**6)
22354 Evan2=epscalc*2*(r06/rcal**3)
22358 dEvan1Cm(k) = 12*r(k)*epscalc*r012/r7
22359 dEvan2Cm(k) = 12*r(k)*epscalc*r06/r4
22362 dEtotalCm(k)=dEvan1Cm(k)+dEvan2Cm(k)
22364 ecation_prot = ecation_prot+ Evan1+Evan2
22366 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
22368 gradpepcat(k,i)=gradpepcat(k,i)+dEtotalCm(k)
22369 gradpepcat(k,j)=gradpepcat(k,j)-dEtotalCm(k)
22371 endif ! 13-16 residues
22375 end subroutine ecat_prot
22377 !----------------------------------------------------------------------------
22378 !-----------------------------------------------------------------------------
22379 !-----------------------------------------------------------------------------
22380 subroutine eprot_sc_base(escbase)
22382 ! implicit real*8 (a-h,o-z)
22383 ! include 'DIMENSIONS'
22384 ! include 'COMMON.GEO'
22385 ! include 'COMMON.VAR'
22386 ! include 'COMMON.LOCAL'
22387 ! include 'COMMON.CHAIN'
22388 ! include 'COMMON.DERIV'
22389 ! include 'COMMON.NAMES'
22390 ! include 'COMMON.INTERACT'
22391 ! include 'COMMON.IOUNITS'
22392 ! include 'COMMON.CALC'
22393 ! include 'COMMON.CONTROL'
22394 ! include 'COMMON.SBRIDGE'
22396 !el local variables
22397 integer :: iint,itypi,itypi1,itypj,subchap
22398 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
22399 real(kind=8) :: evdw,sig0ij
22400 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
22401 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
22402 sslipi,sslipj,faclip
22404 real(kind=8) :: fracinbuf
22405 real (kind=8) :: escbase
22406 real (kind=8),dimension(4):: ener
22407 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
22408 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
22409 sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
22410 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
22411 dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
22412 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
22413 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
22414 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
22415 real(kind=8),dimension(3,2)::chead,erhead_tail
22416 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
22420 ! do i=1,nres_molec(1)
22421 do i=ibond_start,ibond_end
22422 if (itype(i,1).eq.ntyp1_molec(1)) cycle
22424 dxi = dc_norm(1,nres+i)
22425 dyi = dc_norm(2,nres+i)
22426 dzi = dc_norm(3,nres+i)
22427 dsci_inv = vbld_inv(i+nres)
22431 xi=mod(xi,boxxsize)
22432 if (xi.lt.0) xi=xi+boxxsize
22433 yi=mod(yi,boxysize)
22434 if (yi.lt.0) yi=yi+boxysize
22435 zi=mod(zi,boxzsize)
22436 if (zi.lt.0) zi=zi+boxzsize
22437 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
22439 if (itype(j,2).eq.ntyp1_molec(2))cycle
22443 xj=dmod(xj,boxxsize)
22444 if (xj.lt.0) xj=xj+boxxsize
22445 yj=dmod(yj,boxysize)
22446 if (yj.lt.0) yj=yj+boxysize
22447 zj=dmod(zj,boxzsize)
22448 if (zj.lt.0) zj=zj+boxzsize
22449 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22458 xj=xj_safe+xshift*boxxsize
22459 yj=yj_safe+yshift*boxysize
22460 zj=zj_safe+zshift*boxzsize
22461 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22462 if(dist_temp.lt.dist_init) then
22463 dist_init=dist_temp
22472 if (subchap.eq.1) then
22481 dxj = dc_norm( 1, nres+j )
22482 dyj = dc_norm( 2, nres+j )
22483 dzj = dc_norm( 3, nres+j )
22484 ! print *,i,j,itypi,itypj
22485 d1i = dhead_scbasei(itypi,itypj) !this is shift of dipole/charge
22486 d1j = dhead_scbasej(itypi,itypj) !this is shift of dipole/charge
22489 ! BetaT = 1.0d0 / (298.0d0 * Rb)
22491 sig0ij = sigma_scbase( itypi,itypj )
22492 chi1 = chi_scbase( itypi, itypj,1 )
22493 chi2 = chi_scbase( itypi, itypj,2 )
22496 chi12 = chi1 * chi2
22497 chip1 = chipp_scbase( itypi, itypj,1 )
22498 chip2 = chipp_scbase( itypi, itypj,2 )
22501 chip12 = chip1 * chip2
22502 ! not used by momo potential, but needed by sc_angular which is shared
22503 ! by all energy_potential subroutines
22507 a12sq = rborn_scbasei(itypi,itypj) * rborn_scbasej(itypi,itypj)
22508 ! a12sq = a12sq * a12sq
22509 ! charge of amino acid itypi is...
22510 chis1 = chis_scbase(itypi,itypj,1)
22511 chis2 = chis_scbase(itypi,itypj,2)
22512 chis12 = chis1 * chis2
22513 sig1 = sigmap1_scbase(itypi,itypj)
22514 sig2 = sigmap2_scbase(itypi,itypj)
22515 ! write (*,*) "sig1 = ", sig1
22516 ! write (*,*) "sig2 = ", sig2
22517 ! alpha factors from Fcav/Gcav
22518 b1 = alphasur_scbase(1,itypi,itypj)
22520 b2 = alphasur_scbase(2,itypi,itypj)
22521 b3 = alphasur_scbase(3,itypi,itypj)
22522 b4 = alphasur_scbase(4,itypi,itypj)
22523 ! used to determine whether we want to do quadrupole calculations
22525 eps_in = epsintab_scbase(itypi,itypj)
22526 if (eps_in.eq.0.0) eps_in=1.0
22527 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
22528 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
22529 !-------------------------------------------------------------------
22530 ! tail location and distance calculations
22532 ! location of polar head is computed by taking hydrophobic centre
22533 ! and moving by a d1 * dc_norm vector
22534 ! see unres publications for very informative images
22535 chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
22536 chead(k,2) = c(k, j+nres) + d1j * dc_norm(k, j+nres)
22538 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
22539 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
22540 Rhead_distance(k) = chead(k,2) - chead(k,1)
22542 ! pitagoras (root of sum of squares)
22544 (Rhead_distance(1)*Rhead_distance(1)) &
22545 + (Rhead_distance(2)*Rhead_distance(2)) &
22546 + (Rhead_distance(3)*Rhead_distance(3)))
22547 !-------------------------------------------------------------------
22548 ! zero everything that should be zero'ed
22566 dscj_inv = vbld_inv(j+nres)
22567 ! print *,i,j,dscj_inv,dsci_inv
22568 ! rij holds 1/(distance of Calpha atoms)
22569 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
22571 !----------------------------
22573 ! this should be in elgrad_init but om's are calculated by sc_angular
22574 ! which in turn is used by older potentials
22575 ! om = omega, sqom = om^2
22578 sqom12 = om12 * om12
22580 ! now we calculate EGB - Gey-Berne
22581 ! It will be summed up in evdwij and saved in evdw
22582 sigsq = 1.0D0 / sigsq
22583 sig = sig0ij * dsqrt(sigsq)
22584 ! rij_shift = 1.0D0 / rij - sig + sig0ij
22585 rij_shift = 1.0/rij - sig + sig0ij
22586 IF (rij_shift.le.0.0D0) THEN
22590 sigder = -sig * sigsq
22591 rij_shift = 1.0D0 / rij_shift
22592 fac = rij_shift**expon
22593 c1 = fac * fac * aa_scbase(itypi,itypj)
22595 c2 = fac * bb_scbase(itypi,itypj)
22597 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
22598 eps2der = eps3rt * evdwij
22599 eps3der = eps2rt * evdwij
22600 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
22601 evdwij = eps2rt * eps3rt * evdwij
22602 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
22603 fac = -expon * (c1 + evdwij) * rij_shift
22604 sigder = fac * sigder
22606 ! Calculate distance derivative
22610 ! if (b2.gt.0.0) then
22611 fac = chis1 * sqom1 + chis2 * sqom2 &
22612 - 2.0d0 * chis12 * om1 * om2 * om12
22613 ! we will use pom later in Gcav, so dont mess with it!
22614 pom = 1.0d0 - chis1 * chis2 * sqom12
22615 Lambf = (1.0d0 - (fac / pom))
22616 Lambf = dsqrt(Lambf)
22617 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
22618 ! write (*,*) "sparrow = ", sparrow
22619 Chif = 1.0d0/rij * sparrow
22620 ChiLambf = Chif * Lambf
22621 eagle = dsqrt(ChiLambf)
22622 bat = ChiLambf ** 11.0d0
22623 top = b1 * ( eagle + b2 * ChiLambf - b3 )
22624 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
22628 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
22629 dbot = 12.0d0 * b4 * bat * Lambf
22630 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
22632 ! write (*,*) "dFcav/dR = ", dFdR
22633 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
22634 dbot = 12.0d0 * b4 * bat * Chif
22635 eagle = Lambf * pom
22636 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
22637 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
22638 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
22639 * (chis2 * om2 * om12 - om1) / (eagle * pom)
22641 dFdL = ((dtop * bot - top * dbot) / botsq)
22643 dCAVdOM1 = dFdL * ( dFdOM1 )
22644 dCAVdOM2 = dFdL * ( dFdOM2 )
22645 dCAVdOM12 = dFdL * ( dFdOM12 )
22650 ! eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
22651 ! eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
22652 ! eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
22653 ! -2.0D0*alf12*eps3der+sigder*sigsq_om12
22654 ! print *,"EOMY",eom1,eom2,eom12
22655 ! erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
22656 ! erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
22658 ! facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
22659 ! facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
22661 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
22662 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
22664 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
22665 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
22666 - (( dFdR + gg(k) ) * pom)
22667 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
22668 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
22669 ! & - ( dFdR * pom )
22671 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
22672 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
22673 + (( dFdR + gg(k) ) * pom)
22674 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
22675 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
22676 !c! & + ( dFdR * pom )
22678 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
22679 - (( dFdR + gg(k) ) * ertail(k))
22680 !c! & - ( dFdR * ertail(k))
22682 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
22683 + (( dFdR + gg(k) ) * ertail(k))
22684 !c! & + ( dFdR * ertail(k))
22687 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
22688 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
22695 if (wdipdip_scbase(2,itypi,itypj).gt.0.0d0) then
22696 w1 = wdipdip_scbase(1,itypi,itypj)
22697 w2 = -wdipdip_scbase(3,itypi,itypj)/2.0
22698 w3 = wdipdip_scbase(2,itypi,itypj)
22699 !c!-------------------------------------------------------------------
22701 fac = (om12 - 3.0d0 * om1 * om2)
22702 c1 = (w1 / (Rhead**3.0d0)) * fac
22703 c2 = (w2 / Rhead ** 6.0d0) &
22704 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
22705 c3= (w3/ Rhead ** 6.0d0) &
22706 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
22708 !c! write (*,*) "w1 = ", w1
22709 !c! write (*,*) "w2 = ", w2
22710 !c! write (*,*) "om1 = ", om1
22711 !c! write (*,*) "om2 = ", om2
22712 !c! write (*,*) "om12 = ", om12
22713 !c! write (*,*) "fac = ", fac
22714 !c! write (*,*) "c1 = ", c1
22715 !c! write (*,*) "c2 = ", c2
22716 !c! write (*,*) "Ecl = ", Ecl
22717 !c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
22718 !c! write (*,*) "c2_2 = ",
22719 !c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
22720 !c!-------------------------------------------------------------------
22721 !c! dervative of ECL is GCL...
22723 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
22724 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
22725 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
22726 c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
22727 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
22728 dGCLdR = c1 - c2 + c3
22730 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
22731 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
22732 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
22733 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
22734 dGCLdOM1 = c1 - c2 + c3
22736 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
22737 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
22738 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
22739 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
22740 dGCLdOM2 = c1 - c2 + c3
22742 c1 = w1 / (Rhead ** 3.0d0)
22743 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
22744 c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
22745 dGCLdOM12 = c1 - c2 + c3
22747 erhead(k) = Rhead_distance(k)/Rhead
22749 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
22750 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
22751 facd1 = d1i * vbld_inv(i+nres)
22752 facd2 = d1j * vbld_inv(j+nres)
22755 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
22756 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
22758 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
22759 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
22762 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
22763 - dGCLdR * erhead(k)
22764 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
22765 + dGCLdR * erhead(k)
22768 !now charge with dipole eg. ARG-dG
22769 if (wqdip_scbase(2,itypi,itypj).gt.0.0d0) then
22770 alphapol1 = alphapol_scbase(itypi,itypj)
22771 w1 = wqdip_scbase(1,itypi,itypj)
22772 w2 = wqdip_scbase(2,itypi,itypj)
22775 ! pis = sig0head_scbase(itypi,itypj)
22776 ! eps_head = epshead_scbase(itypi,itypj)
22777 !c!-------------------------------------------------------------------
22778 !c! R1 - distance between head of ith side chain and tail of jth sidechain
22781 !c! Calculate head-to-tail distances tail is center of side-chain
22782 R1=R1+(c(k,j+nres)-chead(k,1))**2
22787 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
22788 !c! & +dhead(1,1,itypi,itypj))**2))
22789 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
22790 !c! & +dhead(2,1,itypi,itypj))**2))
22792 !c!-------------------------------------------------------------------
22795 hawk = w2 * (1.0d0 - sqom2)
22796 Ecl = sparrow / Rhead**2.0d0 &
22797 - hawk / Rhead**4.0d0
22798 !c!-------------------------------------------------------------------
22799 !c! derivative of ecl is Gcl
22801 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
22802 + 4.0d0 * hawk / Rhead**5.0d0
22804 dGCLdOM1 = (w1) / (Rhead**2.0d0)
22806 dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
22807 !c--------------------------------------------------------------------
22808 !c Polarization energy
22810 MomoFac1 = (1.0d0 - chi1 * sqom2)
22811 RR1 = R1 * R1 / MomoFac1
22812 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
22813 fgb1 = sqrt( RR1 + a12sq * ee1)
22814 ! eps_inout_fac=0.0d0
22815 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
22816 ! derivative of Epol is Gpol...
22817 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
22819 dFGBdR1 = ( (R1 / MomoFac1) &
22820 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
22822 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
22823 * (2.0d0 - 0.5d0 * ee1) ) &
22825 dPOLdR1 = dPOLdFGB1 * dFGBdR1
22828 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
22830 erhead(k) = Rhead_distance(k)/Rhead
22831 erhead_tail(k,1) = ((c(k,j+nres)-chead(k,1))/R1)
22834 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
22835 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
22836 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
22838 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
22839 facd1 = d1i * vbld_inv(i+nres)
22840 facd2 = d1j * vbld_inv(j+nres)
22841 ! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
22844 hawk = (erhead_tail(k,1) + &
22845 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
22848 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
22849 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
22851 - dPOLdR1 * (erhead_tail(k,1))
22854 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
22855 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
22857 + dPOLdR1 * (erhead_tail(k,1))
22861 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
22862 - dGCLdR * erhead(k) &
22863 - dPOLdR1 * erhead_tail(k,1)
22864 ! & - dGLJdR * erhead(k)
22866 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
22867 + dGCLdR * erhead(k) &
22868 + dPOLdR1 * erhead_tail(k,1)
22869 ! & + dGLJdR * erhead(k)
22873 ! print *,i,j,evdwij,epol,Fcav,ECL
22874 escbase=escbase+evdwij+epol+Fcav+ECL
22875 call sc_grad_scbase
22880 end subroutine eprot_sc_base
22881 SUBROUTINE sc_grad_scbase
22884 real (kind=8) :: dcosom1(3),dcosom2(3)
22886 eps2der * eps2rt_om1 &
22887 - 2.0D0 * alf1 * eps3der &
22888 + sigder * sigsq_om1 &
22894 eps2der * eps2rt_om2 &
22895 + 2.0D0 * alf2 * eps3der &
22896 + sigder * sigsq_om2 &
22902 evdwij * eps1_om12 &
22903 + eps2der * eps2rt_om12 &
22904 - 2.0D0 * alf12 * eps3der &
22905 + sigder *sigsq_om12 &
22909 ! print *,eom1,eom2,eom12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
22910 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
22911 ! gg(1),gg(2),"rozne"
22913 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
22914 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
22915 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
22916 gvdwx_scbase(k,i)= gvdwx_scbase(k,i) - gg(k) &
22917 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
22918 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
22919 gvdwx_scbase(k,j)= gvdwx_scbase(k,j) + gg(k) &
22920 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
22921 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
22922 gvdwc_scbase(k,i)=gvdwc_scbase(k,i)-gg(k)
22923 gvdwc_scbase(k,j)=gvdwc_scbase(k,j)+gg(k)
22926 END SUBROUTINE sc_grad_scbase
22929 subroutine epep_sc_base(epepbase)
22932 !el local variables
22933 integer :: iint,itypi,itypi1,itypj,subchap
22934 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
22935 real(kind=8) :: evdw,sig0ij
22936 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
22937 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
22938 sslipi,sslipj,faclip
22940 real(kind=8) :: fracinbuf
22941 real (kind=8) :: epepbase
22942 real (kind=8),dimension(4):: ener
22943 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
22944 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
22945 sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
22946 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
22947 dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
22948 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
22949 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
22950 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
22951 real(kind=8),dimension(3,2)::chead,erhead_tail
22952 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
22956 ! do i=1,nres_molec(1)-1
22957 do i=ibond_start,ibond_end
22958 if (itype(i,1).eq.ntyp1_molec(1).or.itype(i+1,1).eq.ntyp1_molec(1)) cycle
22959 !C itypi = itype(i,1)
22963 ! print *,dxi,(-c(1,i)+c(1,i+1))*vbld_inv(i+1)
22964 dsci_inv = vbld_inv(i+1)/2.0
22965 xi=(c(1,i)+c(1,i+1))/2.0
22966 yi=(c(2,i)+c(2,i+1))/2.0
22967 zi=(c(3,i)+c(3,i+1))/2.0
22968 xi=mod(xi,boxxsize)
22969 if (xi.lt.0) xi=xi+boxxsize
22970 yi=mod(yi,boxysize)
22971 if (yi.lt.0) yi=yi+boxysize
22972 zi=mod(zi,boxzsize)
22973 if (zi.lt.0) zi=zi+boxzsize
22974 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
22976 if (itype(j,2).eq.ntyp1_molec(2))cycle
22980 xj=dmod(xj,boxxsize)
22981 if (xj.lt.0) xj=xj+boxxsize
22982 yj=dmod(yj,boxysize)
22983 if (yj.lt.0) yj=yj+boxysize
22984 zj=dmod(zj,boxzsize)
22985 if (zj.lt.0) zj=zj+boxzsize
22986 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22995 xj=xj_safe+xshift*boxxsize
22996 yj=yj_safe+yshift*boxysize
22997 zj=zj_safe+zshift*boxzsize
22998 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22999 if(dist_temp.lt.dist_init) then
23000 dist_init=dist_temp
23009 if (subchap.eq.1) then
23018 dxj = dc_norm( 1, nres+j )
23019 dyj = dc_norm( 2, nres+j )
23020 dzj = dc_norm( 3, nres+j )
23021 ! d1i = dhead_scbasei(itypi) !this is shift of dipole/charge
23022 ! d1j = dhead_scbasej(itypi) !this is shift of dipole/charge
23025 sig0ij = sigma_pepbase(itypj )
23026 chi1 = chi_pepbase(itypj,1 )
23027 chi2 = chi_pepbase(itypj,2 )
23030 chi12 = chi1 * chi2
23031 chip1 = chipp_pepbase(itypj,1 )
23032 chip2 = chipp_pepbase(itypj,2 )
23035 chip12 = chip1 * chip2
23036 chis1 = chis_pepbase(itypj,1)
23037 chis2 = chis_pepbase(itypj,2)
23038 chis12 = chis1 * chis2
23039 sig1 = sigmap1_pepbase(itypj)
23040 sig2 = sigmap2_pepbase(itypj)
23041 ! write (*,*) "sig1 = ", sig1
23042 ! write (*,*) "sig2 = ", sig2
23044 ! location of polar head is computed by taking hydrophobic centre
23045 ! and moving by a d1 * dc_norm vector
23046 ! see unres publications for very informative images
23047 chead(k,1) = (c(k,i)+c(k,i+1))/2.0
23048 ! + d1i * dc_norm(k, i+nres)
23049 chead(k,2) = c(k, j+nres)
23050 ! + d1j * dc_norm(k, j+nres)
23052 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
23053 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
23054 Rhead_distance(k) = chead(k,2) - chead(k,1)
23055 ! print *,gvdwc_pepbase(k,i)
23059 (Rhead_distance(1)*Rhead_distance(1)) &
23060 + (Rhead_distance(2)*Rhead_distance(2)) &
23061 + (Rhead_distance(3)*Rhead_distance(3)))
23063 ! alpha factors from Fcav/Gcav
23064 b1 = alphasur_pepbase(1,itypj)
23066 b2 = alphasur_pepbase(2,itypj)
23067 b3 = alphasur_pepbase(3,itypj)
23068 b4 = alphasur_pepbase(4,itypj)
23072 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23075 !----------------------------
23093 dscj_inv = vbld_inv(j+nres)
23095 ! this should be in elgrad_init but om's are calculated by sc_angular
23096 ! which in turn is used by older potentials
23097 ! om = omega, sqom = om^2
23100 sqom12 = om12 * om12
23102 ! now we calculate EGB - Gey-Berne
23103 ! It will be summed up in evdwij and saved in evdw
23104 sigsq = 1.0D0 / sigsq
23105 sig = sig0ij * dsqrt(sigsq)
23106 rij_shift = 1.0/rij - sig + sig0ij
23107 IF (rij_shift.le.0.0D0) THEN
23111 sigder = -sig * sigsq
23112 rij_shift = 1.0D0 / rij_shift
23113 fac = rij_shift**expon
23114 c1 = fac * fac * aa_pepbase(itypj)
23116 c2 = fac * bb_pepbase(itypj)
23118 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
23119 eps2der = eps3rt * evdwij
23120 eps3der = eps2rt * evdwij
23121 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
23122 evdwij = eps2rt * eps3rt * evdwij
23123 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
23124 fac = -expon * (c1 + evdwij) * rij_shift
23125 sigder = fac * sigder
23127 ! Calculate distance derivative
23131 fac = chis1 * sqom1 + chis2 * sqom2 &
23132 - 2.0d0 * chis12 * om1 * om2 * om12
23133 ! we will use pom later in Gcav, so dont mess with it!
23134 pom = 1.0d0 - chis1 * chis2 * sqom12
23135 Lambf = (1.0d0 - (fac / pom))
23136 Lambf = dsqrt(Lambf)
23137 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
23138 ! write (*,*) "sparrow = ", sparrow
23139 Chif = 1.0d0/rij * sparrow
23140 ChiLambf = Chif * Lambf
23141 eagle = dsqrt(ChiLambf)
23142 bat = ChiLambf ** 11.0d0
23143 top = b1 * ( eagle + b2 * ChiLambf - b3 )
23144 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
23148 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
23149 dbot = 12.0d0 * b4 * bat * Lambf
23150 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
23152 ! write (*,*) "dFcav/dR = ", dFdR
23153 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
23154 dbot = 12.0d0 * b4 * bat * Chif
23155 eagle = Lambf * pom
23156 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
23157 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
23158 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
23159 * (chis2 * om2 * om12 - om1) / (eagle * pom)
23161 dFdL = ((dtop * bot - top * dbot) / botsq)
23163 dCAVdOM1 = dFdL * ( dFdOM1 )
23164 dCAVdOM2 = dFdL * ( dFdOM2 )
23165 dCAVdOM12 = dFdL * ( dFdOM12 )
23171 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23172 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23174 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
23175 gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
23176 - (( dFdR + gg(k) ) * pom)/2.0
23177 ! print *,gvdwc_pepbase(k,i),i,(( dFdR + gg(k) ) * pom)/2.0
23178 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
23179 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
23180 ! & - ( dFdR * pom )
23182 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
23183 gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
23184 + (( dFdR + gg(k) ) * pom)
23185 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
23186 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23187 !c! & + ( dFdR * pom )
23189 gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
23190 - (( dFdR + gg(k) ) * ertail(k))/2.0
23191 ! print *,gvdwc_pepbase(k,i+1),i+1,(( dFdR + gg(k) ) * pom)/2.0
23193 !c! & - ( dFdR * ertail(k))
23195 gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
23196 + (( dFdR + gg(k) ) * ertail(k))
23197 !c! & + ( dFdR * ertail(k))
23200 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23201 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23205 w1 = wdipdip_pepbase(1,itypj)
23206 w2 = -wdipdip_pepbase(3,itypj)/2.0
23207 w3 = wdipdip_pepbase(2,itypj)
23210 !c!-------------------------------------------------------------------
23213 fac = (om12 - 3.0d0 * om1 * om2)
23214 c1 = (w1 / (Rhead**3.0d0)) * fac
23215 c2 = (w2 / Rhead ** 6.0d0) &
23216 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
23217 c3= (w3/ Rhead ** 6.0d0) &
23218 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
23222 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
23223 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
23224 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
23225 c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
23226 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
23228 dGCLdR = c1 - c2 + c3
23230 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
23231 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
23232 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
23233 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
23234 dGCLdOM1 = c1 - c2 + c3
23236 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
23237 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
23238 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
23239 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
23241 dGCLdOM2 = c1 - c2 + c3
23243 c1 = w1 / (Rhead ** 3.0d0)
23244 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
23245 c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
23246 dGCLdOM12 = c1 - c2 + c3
23248 erhead(k) = Rhead_distance(k)/Rhead
23250 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
23251 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
23252 ! facd1 = d1 * vbld_inv(i+nres)
23253 ! facd2 = d2 * vbld_inv(j+nres)
23257 !+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
23258 ! gvdwx_pepbase(k,i) = gvdwx_scbase(k,i) &
23261 !+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
23262 gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
23265 gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
23266 - dGCLdR * erhead(k)/2.0d0
23267 ! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
23268 gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
23269 - dGCLdR * erhead(k)/2.0d0
23270 ! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
23271 gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
23272 + dGCLdR * erhead(k)
23274 ! print *,i,j,evdwij,Fcav,ECL,"vdw,cav,ecl"
23275 epepbase=epepbase+evdwij+Fcav+ECL
23276 call sc_grad_pepbase
23279 END SUBROUTINE epep_sc_base
23280 SUBROUTINE sc_grad_pepbase
23283 real (kind=8) :: dcosom1(3),dcosom2(3)
23285 eps2der * eps2rt_om1 &
23286 - 2.0D0 * alf1 * eps3der &
23287 + sigder * sigsq_om1 &
23293 eps2der * eps2rt_om2 &
23294 + 2.0D0 * alf2 * eps3der &
23295 + sigder * sigsq_om2 &
23301 evdwij * eps1_om12 &
23302 + eps2der * eps2rt_om12 &
23303 - 2.0D0 * alf12 * eps3der &
23304 + sigder *sigsq_om12 &
23309 ! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
23310 ! if (i.eq.30) print *,gvdwc_pepbase(k,i),- gg(k),&
23311 ! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
23313 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
23314 ! gg(1),gg(2),"rozne"
23316 dcosom1(k) = rij * (dc_norm(k,i) - om1 * erij(k))
23317 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
23318 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
23319 gvdwc_pepbase(k,i)= gvdwc_pepbase(k,i) +0.5*(- gg(k)) &
23320 + (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
23322 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
23323 gvdwc_pepbase(k,i+1)= gvdwc_pepbase(k,i+1) +0.5*(- gg(k)) &
23324 - (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i))) &
23326 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
23327 ! print *,eom12,eom2,om12,om2
23328 !eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
23329 ! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
23330 gvdwx_pepbase(k,j)= gvdwx_pepbase(k,j) + gg(k) &
23331 + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
23332 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23333 gvdwc_pepbase(k,j)=gvdwc_pepbase(k,j)+gg(k)
23336 END SUBROUTINE sc_grad_pepbase
23337 subroutine eprot_sc_phosphate(escpho)
23339 ! implicit real*8 (a-h,o-z)
23340 ! include 'DIMENSIONS'
23341 ! include 'COMMON.GEO'
23342 ! include 'COMMON.VAR'
23343 ! include 'COMMON.LOCAL'
23344 ! include 'COMMON.CHAIN'
23345 ! include 'COMMON.DERIV'
23346 ! include 'COMMON.NAMES'
23347 ! include 'COMMON.INTERACT'
23348 ! include 'COMMON.IOUNITS'
23349 ! include 'COMMON.CALC'
23350 ! include 'COMMON.CONTROL'
23351 ! include 'COMMON.SBRIDGE'
23353 !el local variables
23354 integer :: iint,itypi,itypi1,itypj,subchap
23355 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
23356 real(kind=8) :: evdw,sig0ij
23357 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
23358 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
23359 sslipi,sslipj,faclip,alpha_sco
23361 real(kind=8) :: fracinbuf
23362 real (kind=8) :: escpho
23363 real (kind=8),dimension(4):: ener
23364 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
23365 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
23366 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
23367 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
23368 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
23369 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
23370 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
23371 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
23372 real(kind=8),dimension(3,2)::chead,erhead_tail
23373 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
23377 ! do i=1,nres_molec(1)
23378 do i=ibond_start,ibond_end
23379 if (itype(i,1).eq.ntyp1_molec(1)) cycle
23381 dxi = dc_norm(1,nres+i)
23382 dyi = dc_norm(2,nres+i)
23383 dzi = dc_norm(3,nres+i)
23384 dsci_inv = vbld_inv(i+nres)
23388 xi=mod(xi,boxxsize)
23389 if (xi.lt.0) xi=xi+boxxsize
23390 yi=mod(yi,boxysize)
23391 if (yi.lt.0) yi=yi+boxysize
23392 zi=mod(zi,boxzsize)
23393 if (zi.lt.0) zi=zi+boxzsize
23394 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
23396 if ((itype(j,2).eq.ntyp1_molec(2)).or.&
23397 (itype(j+1,2).eq.ntyp1_molec(2))) cycle
23398 xj=(c(1,j)+c(1,j+1))/2.0
23399 yj=(c(2,j)+c(2,j+1))/2.0
23400 zj=(c(3,j)+c(3,j+1))/2.0
23401 xj=dmod(xj,boxxsize)
23402 if (xj.lt.0) xj=xj+boxxsize
23403 yj=dmod(yj,boxysize)
23404 if (yj.lt.0) yj=yj+boxysize
23405 zj=dmod(zj,boxzsize)
23406 if (zj.lt.0) zj=zj+boxzsize
23407 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23415 xj=xj_safe+xshift*boxxsize
23416 yj=yj_safe+yshift*boxysize
23417 zj=zj_safe+zshift*boxzsize
23418 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23419 if(dist_temp.lt.dist_init) then
23420 dist_init=dist_temp
23429 if (subchap.eq.1) then
23438 dxj = dc_norm( 1,j )
23439 dyj = dc_norm( 2,j )
23440 dzj = dc_norm( 3,j )
23441 dscj_inv = vbld_inv(j+1)
23444 sig0ij = sigma_scpho(itypi )
23445 chi1 = chi_scpho(itypi,1 )
23446 chi2 = chi_scpho(itypi,2 )
23449 chi12 = chi1 * chi2
23450 chip1 = chipp_scpho(itypi,1 )
23451 chip2 = chipp_scpho(itypi,2 )
23454 chip12 = chip1 * chip2
23455 chis1 = chis_scpho(itypi,1)
23456 chis2 = chis_scpho(itypi,2)
23457 chis12 = chis1 * chis2
23458 sig1 = sigmap1_scpho(itypi)
23459 sig2 = sigmap2_scpho(itypi)
23460 ! write (*,*) "sig1 = ", sig1
23461 ! write (*,*) "sig1 = ", sig1
23462 ! write (*,*) "sig2 = ", sig2
23463 ! alpha factors from Fcav/Gcav
23467 a12sq = rborn_scphoi(itypi) * rborn_scphoj(itypi)
23469 b1 = alphasur_scpho(1,itypi)
23471 b2 = alphasur_scpho(2,itypi)
23472 b3 = alphasur_scpho(3,itypi)
23473 b4 = alphasur_scpho(4,itypi)
23474 ! used to determine whether we want to do quadrupole calculations
23476 eps_in = epsintab_scpho(itypi)
23477 if (eps_in.eq.0.0) eps_in=1.0
23478 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
23479 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
23480 !-------------------------------------------------------------------
23481 ! tail location and distance calculations
23482 d1i = dhead_scphoi(itypi) !this is shift of dipole/charge
23485 ! location of polar head is computed by taking hydrophobic centre
23486 ! and moving by a d1 * dc_norm vector
23487 ! see unres publications for very informative images
23488 chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
23489 chead(k,2) = (c(k, j) + c(k, j+1))/2.0
23491 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
23492 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
23493 Rhead_distance(k) = chead(k,2) - chead(k,1)
23495 ! pitagoras (root of sum of squares)
23497 (Rhead_distance(1)*Rhead_distance(1)) &
23498 + (Rhead_distance(2)*Rhead_distance(2)) &
23499 + (Rhead_distance(3)*Rhead_distance(3)))
23500 Rhead_sq=Rhead**2.0
23501 !-------------------------------------------------------------------
23502 ! zero everything that should be zero'ed
23521 dscj_inv = vbld_inv(j+1)/2.0
23522 !dhead_scbasej(itypi,itypj)
23523 ! print *,i,j,dscj_inv,dsci_inv
23524 ! rij holds 1/(distance of Calpha atoms)
23525 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23527 !----------------------------
23529 ! this should be in elgrad_init but om's are calculated by sc_angular
23530 ! which in turn is used by older potentials
23531 ! om = omega, sqom = om^2
23534 sqom12 = om12 * om12
23536 ! now we calculate EGB - Gey-Berne
23537 ! It will be summed up in evdwij and saved in evdw
23538 sigsq = 1.0D0 / sigsq
23539 sig = sig0ij * dsqrt(sigsq)
23540 ! rij_shift = 1.0D0 / rij - sig + sig0ij
23541 rij_shift = 1.0/rij - sig + sig0ij
23542 IF (rij_shift.le.0.0D0) THEN
23546 sigder = -sig * sigsq
23547 rij_shift = 1.0D0 / rij_shift
23548 fac = rij_shift**expon
23549 c1 = fac * fac * aa_scpho(itypi)
23551 c2 = fac * bb_scpho(itypi)
23553 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
23554 eps2der = eps3rt * evdwij
23555 eps3der = eps2rt * evdwij
23556 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
23557 evdwij = eps2rt * eps3rt * evdwij
23558 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
23559 fac = -expon * (c1 + evdwij) * rij_shift
23560 sigder = fac * sigder
23562 ! Calculate distance derivative
23566 fac = chis1 * sqom1 + chis2 * sqom2 &
23567 - 2.0d0 * chis12 * om1 * om2 * om12
23568 ! we will use pom later in Gcav, so dont mess with it!
23569 pom = 1.0d0 - chis1 * chis2 * sqom12
23570 Lambf = (1.0d0 - (fac / pom))
23571 Lambf = dsqrt(Lambf)
23572 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
23573 ! write (*,*) "sparrow = ", sparrow
23574 Chif = 1.0d0/rij * sparrow
23575 ChiLambf = Chif * Lambf
23576 eagle = dsqrt(ChiLambf)
23577 bat = ChiLambf ** 11.0d0
23578 top = b1 * ( eagle + b2 * ChiLambf - b3 )
23579 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
23582 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
23583 dbot = 12.0d0 * b4 * bat * Lambf
23584 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
23586 ! write (*,*) "dFcav/dR = ", dFdR
23587 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
23588 dbot = 12.0d0 * b4 * bat * Chif
23589 eagle = Lambf * pom
23590 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
23591 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
23592 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
23593 * (chis2 * om2 * om12 - om1) / (eagle * pom)
23595 dFdL = ((dtop * bot - top * dbot) / botsq)
23597 dCAVdOM1 = dFdL * ( dFdOM1 )
23598 dCAVdOM2 = dFdL * ( dFdOM2 )
23599 dCAVdOM12 = dFdL * ( dFdOM12 )
23605 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23606 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23607 ! if (i.eq.3) print *,'decl0',gvdwx_scpho(k,i),i
23610 ! print *,pom,gg(k),dFdR
23611 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
23612 gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
23613 - (( dFdR + gg(k) ) * pom)
23614 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
23615 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
23616 ! & - ( dFdR * pom )
23618 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
23619 ! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
23620 ! + (( dFdR + gg(k) ) * pom)
23621 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
23622 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23623 !c! & + ( dFdR * pom )
23625 gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
23626 - (( dFdR + gg(k) ) * ertail(k))
23627 !c! & - ( dFdR * ertail(k))
23629 gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
23630 + (( dFdR + gg(k) ) * ertail(k))/2.0
23632 gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
23633 + (( dFdR + gg(k) ) * ertail(k))/2.0
23635 !c! & + ( dFdR * ertail(k))
23639 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23640 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23641 ! alphapol1 = alphapol_scpho(itypi)
23642 if (wqq_scpho(itypi).ne.0.0) then
23643 Qij=wqq_scpho(itypi)/eps_in
23644 alpha_sco=1.d0/alphi_scpho(itypi)
23646 Ecl = (332.0d0 * Qij*dexp(-Rhead*alpha_sco)) / Rhead
23647 !c! derivative of Ecl is Gcl...
23648 dGCLdR = (-332.0d0 * Qij*dexp(-Rhead*alpha_sco)* &
23649 (Rhead*alpha_sco+1) ) / Rhead_sq
23650 if (energy_dec) write(iout,*) "ECL",ECL,Rhead,1.0/rij
23651 else if (wqdip_scpho(2,itypi).gt.0.0d0) then
23652 w1 = wqdip_scpho(1,itypi)
23653 w2 = wqdip_scpho(2,itypi)
23656 ! pis = sig0head_scbase(itypi,itypj)
23657 ! eps_head = epshead_scbase(itypi,itypj)
23658 !c!-------------------------------------------------------------------
23660 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
23661 !c! & +dhead(1,1,itypi,itypj))**2))
23662 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
23663 !c! & +dhead(2,1,itypi,itypj))**2))
23665 !c!-------------------------------------------------------------------
23668 hawk = w2 * (1.0d0 - sqom2)
23669 Ecl = sparrow / Rhead**2.0d0 &
23670 - hawk / Rhead**4.0d0
23671 !c!-------------------------------------------------------------------
23672 if (energy_dec) write(iout,*) "ECLdipdip",ECL,Rhead,&
23675 !c! derivative of ecl is Gcl
23677 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
23678 + 4.0d0 * hawk / Rhead**5.0d0
23680 dGCLdOM1 = (w1) / (Rhead**2.0d0)
23682 dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
23685 !c--------------------------------------------------------------------
23686 !c Polarization energy
23690 !c! Calculate head-to-tail distances tail is center of side-chain
23691 R1=R1+((c(k,j)+c(k,j+1))/2.0-chead(k,1))**2
23696 alphapol1 = alphapol_scpho(itypi)
23698 MomoFac1 = (1.0d0 - chi2 * sqom1)
23699 RR1 = R1 * R1 / MomoFac1
23700 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
23701 ! print *,"ee1",ee1,a12sq,alphapol1,eps_inout_fac
23702 fgb1 = sqrt( RR1 + a12sq * ee1)
23703 ! eps_inout_fac=0.0d0
23704 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
23705 ! derivative of Epol is Gpol...
23706 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
23708 dFGBdR1 = ( (R1 / MomoFac1) &
23709 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
23711 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
23712 * (2.0d0 - 0.5d0 * ee1) ) &
23714 dPOLdR1 = dPOLdFGB1 * dFGBdR1
23717 dFGBdOM1 = (((R1 * R1 * chi2 * om1) / (MomoFac1 * MomoFac1)) &
23718 * (2.0d0 - 0.5d0 * ee1) ) &
23721 dPOLdOM1 = dPOLdFGB1 * dFGBdOM1
23724 erhead(k) = Rhead_distance(k)/Rhead
23725 erhead_tail(k,1) = (((c(k,j)+c(k,j+1))/2.0-chead(k,1))/R1)
23728 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
23729 erdxj = scalar( erhead(1), dC_norm(1,j) )
23730 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
23732 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j))
23733 facd1 = d1i * vbld_inv(i+nres)
23734 facd2 = d1j * vbld_inv(j)
23735 ! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
23738 hawk = (erhead_tail(k,1) + &
23739 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
23742 ! if (i.eq.3) print *,'decl1',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i,&
23743 ! pom,(erhead_tail(k,1))
23745 ! print *,'decl',dGCLdR,dPOLdR1,gvdwc_scpho(k,i)
23746 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
23747 gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
23749 - dPOLdR1 * (erhead_tail(k,1))
23752 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
23753 ! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
23755 ! + dPOLdR1 * (erhead_tail(k,1))
23759 gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
23760 - dGCLdR * erhead(k) &
23761 - dPOLdR1 * erhead_tail(k,1)
23762 ! & - dGLJdR * erhead(k)
23764 gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
23765 + (dGCLdR * erhead(k) &
23766 + dPOLdR1 * erhead_tail(k,1))/2.0
23767 gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
23768 + (dGCLdR * erhead(k) &
23769 + dPOLdR1 * erhead_tail(k,1))/2.0
23771 ! & + dGLJdR * erhead(k)
23772 ! if (i.eq.3) print *,'decl2',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i
23775 ! if (i.eq.3) print *,i,j,evdwij,epol,Fcav,ECL
23776 if (energy_dec) write (iout,'(a22,2i5,4f8.3,f16.3)'), &
23777 "escpho:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,escpho
23778 escpho=escpho+evdwij+epol+Fcav+ECL
23785 end subroutine eprot_sc_phosphate
23786 SUBROUTINE sc_grad_scpho
23789 real (kind=8) :: dcosom1(3),dcosom2(3)
23791 eps2der * eps2rt_om1 &
23792 - 2.0D0 * alf1 * eps3der &
23793 + sigder * sigsq_om1 &
23799 eps2der * eps2rt_om2 &
23800 + 2.0D0 * alf2 * eps3der &
23801 + sigder * sigsq_om2 &
23807 evdwij * eps1_om12 &
23808 + eps2der * eps2rt_om12 &
23809 - 2.0D0 * alf12 * eps3der &
23810 + sigder *sigsq_om12 &
23815 ! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
23816 ! if (i.eq.30) print *,gvdwc_scpho(k,i),- gg(k),&
23817 ! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
23819 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
23820 ! gg(1),gg(2),"rozne"
23822 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
23823 dcosom2(k) = rij * (dc_norm(k,j) - om2 * erij(k))
23824 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
23825 gvdwc_scpho(k,j)= gvdwc_scpho(k,j) +0.5*( gg(k)) &
23826 + (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)))&
23828 - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
23829 gvdwc_scpho(k,j+1)= gvdwc_scpho(k,j+1) +0.5*( gg(k)) &
23830 - (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j))) &
23832 + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
23833 gvdwx_scpho(k,i)= gvdwx_scpho(k,i) - gg(k) &
23834 + (eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
23835 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
23837 ! print *,eom12,eom2,om12,om2
23838 !eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
23839 ! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
23840 ! gvdwx_scpho(k,j)= gvdwx_scpho(k,j) + gg(k) &
23841 ! + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
23842 ! + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23843 gvdwc_scpho(k,i)=gvdwc_scpho(k,i)-gg(k)
23846 END SUBROUTINE sc_grad_scpho
23847 subroutine eprot_pep_phosphate(epeppho)
23849 ! implicit real*8 (a-h,o-z)
23850 ! include 'DIMENSIONS'
23851 ! include 'COMMON.GEO'
23852 ! include 'COMMON.VAR'
23853 ! include 'COMMON.LOCAL'
23854 ! include 'COMMON.CHAIN'
23855 ! include 'COMMON.DERIV'
23856 ! include 'COMMON.NAMES'
23857 ! include 'COMMON.INTERACT'
23858 ! include 'COMMON.IOUNITS'
23859 ! include 'COMMON.CALC'
23860 ! include 'COMMON.CONTROL'
23861 ! include 'COMMON.SBRIDGE'
23863 !el local variables
23864 integer :: iint,itypi,itypi1,itypj,subchap
23865 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
23866 real(kind=8) :: evdw,sig0ij
23867 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
23868 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
23869 sslipi,sslipj,faclip
23871 real(kind=8) :: fracinbuf
23872 real (kind=8) :: epeppho
23873 real (kind=8),dimension(4):: ener
23874 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
23875 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
23876 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
23877 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
23878 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
23879 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
23880 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
23881 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
23882 real(kind=8),dimension(3,2)::chead,erhead_tail
23883 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
23885 real (kind=8) :: dcosom1(3),dcosom2(3)
23887 ! do i=1,nres_molec(1)
23888 do i=ibond_start,ibond_end
23889 if (itype(i,1).eq.ntyp1_molec(1)) cycle
23891 dsci_inv = vbld_inv(i+1)/2.0
23895 xi=(c(1,i)+c(1,i+1))/2.0
23896 yi=(c(2,i)+c(2,i+1))/2.0
23897 zi=(c(3,i)+c(3,i+1))/2.0
23898 xi=mod(xi,boxxsize)
23899 if (xi.lt.0) xi=xi+boxxsize
23900 yi=mod(yi,boxysize)
23901 if (yi.lt.0) yi=yi+boxysize
23902 zi=mod(zi,boxzsize)
23903 if (zi.lt.0) zi=zi+boxzsize
23904 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
23906 if ((itype(j,2).eq.ntyp1_molec(2)).or.&
23907 (itype(j+1,2).eq.ntyp1_molec(2))) cycle
23908 xj=(c(1,j)+c(1,j+1))/2.0
23909 yj=(c(2,j)+c(2,j+1))/2.0
23910 zj=(c(3,j)+c(3,j+1))/2.0
23911 xj=dmod(xj,boxxsize)
23912 if (xj.lt.0) xj=xj+boxxsize
23913 yj=dmod(yj,boxysize)
23914 if (yj.lt.0) yj=yj+boxysize
23915 zj=dmod(zj,boxzsize)
23916 if (zj.lt.0) zj=zj+boxzsize
23917 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23925 xj=xj_safe+xshift*boxxsize
23926 yj=yj_safe+yshift*boxysize
23927 zj=zj_safe+zshift*boxzsize
23928 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23929 if(dist_temp.lt.dist_init) then
23930 dist_init=dist_temp
23939 if (subchap.eq.1) then
23948 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23950 dxj = dc_norm( 1,j )
23951 dyj = dc_norm( 2,j )
23952 dzj = dc_norm( 3,j )
23953 dscj_inv = vbld_inv(j+1)/2.0
23955 sig0ij = sigma_peppho
23958 chi12 = chi1 * chi2
23961 chip12 = chip1 * chip2
23964 chis12 = chis1 * chis2
23965 sig1 = sigmap1_peppho
23966 sig2 = sigmap2_peppho
23967 ! write (*,*) "sig1 = ", sig1
23968 ! write (*,*) "sig1 = ", sig1
23969 ! write (*,*) "sig2 = ", sig2
23970 ! alpha factors from Fcav/Gcav
23974 b1 = alphasur_peppho(1)
23976 b2 = alphasur_peppho(2)
23977 b3 = alphasur_peppho(3)
23978 b4 = alphasur_peppho(4)
24000 fac = rij_shift**expon
24001 c1 = fac * fac * aa_peppho
24003 c2 = fac * bb_peppho
24006 ! Now cavity....................
24007 eagle = dsqrt(1.0/rij_shift)
24008 top = b1 * ( eagle + b2 * 1.0/rij_shift - b3 )
24009 bot = 1.0d0 + b4 * (1.0/rij_shift ** 12.0d0)
24012 dtop = b1 * ((1.0/ (2.0d0 * eagle)) + (b2))
24013 dbot = 12.0d0 * b4 * (1.0/rij_shift) ** 11.0d0
24014 dFdR = ((dtop * bot - top * dbot) / botsq)
24015 w1 = wqdip_peppho(1)
24016 w2 = wqdip_peppho(2)
24019 ! pis = sig0head_scbase(itypi,itypj)
24020 ! eps_head = epshead_scbase(itypi,itypj)
24021 !c!-------------------------------------------------------------------
24023 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
24024 !c! & +dhead(1,1,itypi,itypj))**2))
24025 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
24026 !c! & +dhead(2,1,itypi,itypj))**2))
24028 !c!-------------------------------------------------------------------
24031 hawk = w2 * (1.0d0 - sqom1)
24032 Ecl = sparrow * rij_shift**2.0d0 &
24033 - hawk * rij_shift**4.0d0
24034 !c!-------------------------------------------------------------------
24035 !c! derivative of ecl is Gcl
24038 dGCLdR = - 2.0d0 * sparrow * rij_shift**3.0d0 &
24039 + 4.0d0 * hawk * rij_shift**5.0d0
24041 dGCLdOM1 = (w1) * (rij_shift**2.0d0)
24043 dGCLdOM2 = (2.0d0 * w2 * om1) * (rij_shift ** 4.0d0)
24044 eom1 = dGCLdOM1+dGCLdOM2
24047 fac = -expon * (c1 + evdwij) * rij_shift+dFdR+dGCLdR
24053 gvdwc_peppho(k,j) = gvdwc_peppho(k,j) +gg(k)/2.0
24054 gvdwc_peppho(k,j+1) = gvdwc_peppho(k,j+1) +gg(k)/2.0
24055 gvdwc_peppho(k,i) = gvdwc_peppho(k,i) -gg(k)/2.0
24056 gvdwc_peppho(k,i+1) = gvdwc_peppho(k,i+1) -gg(k)/2.0
24061 dcosom1(k) = rij* (dc_norm(k,i) - om1 * erij(k))
24062 dcosom2(k) = rij* (dc_norm(k,j) - om2 * erij(k))
24063 gg(k) = gg(k) + eom1 * dcosom1(k)! + eom2 * dcosom2(k)
24064 gvdwc_peppho(k,j)= gvdwc_peppho(k,j) +0.5*( gg(k)) !&
24065 ! - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
24066 gvdwc_peppho(k,j+1)= gvdwc_peppho(k,j+1) +0.5*( gg(k)) !&
24067 ! + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
24068 gvdwc_peppho(k,i)= gvdwc_peppho(k,i) -0.5*( gg(k)) &
24069 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
24070 gvdwc_peppho(k,i+1)= gvdwc_peppho(k,i+1) - 0.5*( gg(k)) &
24071 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
24073 epeppho=epeppho+evdwij+Fcav+ECL
24074 ! print *,i,j,evdwij,Fcav,ECL,rij_shift
24077 end subroutine eprot_pep_phosphate
24078 !!!!!!!!!!!!!!!!-------------------------------------------------------------
24079 subroutine emomo(evdw)
24082 ! implicit real*8 (a-h,o-z)
24083 ! include 'DIMENSIONS'
24084 ! include 'COMMON.GEO'
24085 ! include 'COMMON.VAR'
24086 ! include 'COMMON.LOCAL'
24087 ! include 'COMMON.CHAIN'
24088 ! include 'COMMON.DERIV'
24089 ! include 'COMMON.NAMES'
24090 ! include 'COMMON.INTERACT'
24091 ! include 'COMMON.IOUNITS'
24092 ! include 'COMMON.CALC'
24093 ! include 'COMMON.CONTROL'
24094 ! include 'COMMON.SBRIDGE'
24096 !el local variables
24097 integer :: iint,itypi1,subchap,isel
24098 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,e1,e2,sigm,epsi
24099 real(kind=8) :: evdw
24100 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
24101 dist_temp, dist_init,ssgradlipi,ssgradlipj, &
24102 sslipi,sslipj,faclip,alpha_sco
24104 real(kind=8) :: fracinbuf
24105 real (kind=8) :: escpho
24106 real (kind=8),dimension(4):: ener
24107 real(kind=8) :: b1,b2,egb
24108 real(kind=8) :: Fisocav,ECL,Elj,Equad,Epol,eheadtail,&
24110 Chif,ChiLambf,Fcav,dFdR,dFdOM1,&
24111 dFdOM2,dFdL,dFdOM12,&
24114 ! real(kind=8),dimension(3,2)::erhead_tail
24115 ! real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead,Rtail_distance
24116 real(kind=8) :: facd4, adler, Fgb, facd3
24117 integer troll,jj,istate
24118 real (kind=8) :: dcosom1(3),dcosom2(3)
24121 ! print *,"EVDW KURW",evdw,nres
24122 do i=iatsc_s,iatsc_e
24123 ! print *,"I am in EVDW",i
24124 itypi=iabs(itype(i,1))
24125 ! if (i.ne.47) cycle
24126 if (itypi.eq.ntyp1) cycle
24127 itypi1=iabs(itype(i+1,1))
24131 xi=dmod(xi,boxxsize)
24132 if (xi.lt.0) xi=xi+boxxsize
24133 yi=dmod(yi,boxysize)
24134 if (yi.lt.0) yi=yi+boxysize
24135 zi=dmod(zi,boxzsize)
24136 if (zi.lt.0) zi=zi+boxzsize
24138 if ((zi.gt.bordlipbot) &
24139 .and.(zi.lt.bordliptop)) then
24140 !C the energy transfer exist
24141 if (zi.lt.buflipbot) then
24142 !C what fraction I am in
24144 ((zi-bordlipbot)/lipbufthick)
24145 !C lipbufthick is thickenes of lipid buffore
24146 sslipi=sscalelip(fracinbuf)
24147 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
24148 elseif (zi.gt.bufliptop) then
24149 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
24150 sslipi=sscalelip(fracinbuf)
24151 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
24160 ! print *, sslipi,ssgradlipi
24161 dxi=dc_norm(1,nres+i)
24162 dyi=dc_norm(2,nres+i)
24163 dzi=dc_norm(3,nres+i)
24164 ! dsci_inv=dsc_inv(itypi)
24165 dsci_inv=vbld_inv(i+nres)
24166 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
24167 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
24169 ! Calculate SC interaction energy.
24171 do iint=1,nint_gr(i)
24172 do j=istart(i,iint),iend(i,iint)
24173 ! print *,"JA PIER",i,j,iint,istart(i,iint),iend(i,iint)
24174 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
24175 call dyn_ssbond_ene(i,j,evdwij)
24177 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
24178 'evdw',i,j,evdwij,' ss'
24179 ! if (energy_dec) write (iout,*) &
24180 ! 'evdw',i,j,evdwij,' ss'
24181 do k=j+1,iend(i,iint)
24182 !C search over all next residues
24183 if (dyn_ss_mask(k)) then
24184 !C check if they are cysteins
24185 !C write(iout,*) 'k=',k
24187 !c write(iout,*) "PRZED TRI", evdwij
24188 ! evdwij_przed_tri=evdwij
24189 call triple_ssbond_ene(i,j,k,evdwij)
24190 !c if(evdwij_przed_tri.ne.evdwij) then
24191 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
24194 !c write(iout,*) "PO TRI", evdwij
24195 !C call the energy function that removes the artifical triple disulfide
24196 !C bond the soubroutine is located in ssMD.F
24198 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
24199 'evdw',i,j,evdwij,'tss'
24200 endif!dyn_ss_mask(k)
24204 itypj=iabs(itype(j,1))
24205 if (itypj.eq.ntyp1) cycle
24206 CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
24208 ! if (j.ne.78) cycle
24209 ! dscj_inv=dsc_inv(itypj)
24210 dscj_inv=vbld_inv(j+nres)
24214 xj=dmod(xj,boxxsize)
24215 if (xj.lt.0) xj=xj+boxxsize
24216 yj=dmod(yj,boxysize)
24217 if (yj.lt.0) yj=yj+boxysize
24218 zj=dmod(zj,boxzsize)
24219 if (zj.lt.0) zj=zj+boxzsize
24220 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
24229 xj=xj_safe+xshift*boxxsize
24230 yj=yj_safe+yshift*boxysize
24231 zj=zj_safe+zshift*boxzsize
24232 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
24233 if(dist_temp.lt.dist_init) then
24234 dist_init=dist_temp
24243 if (subchap.eq.1) then
24252 dxj = dc_norm( 1, nres+j )
24253 dyj = dc_norm( 2, nres+j )
24254 dzj = dc_norm( 3, nres+j )
24255 ! print *,i,j,itypi,itypj
24258 ! BetaT = 1.0d0 / (298.0d0 * Rb)
24260 !1! sig0ij = sigma_scsc( itypi,itypj )
24265 ! not used by momo potential, but needed by sc_angular which is shared
24266 ! by all energy_potential subroutines
24270 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
24271 ! a12sq = a12sq * a12sq
24272 ! charge of amino acid itypi is...
24273 chis1 = chis(itypi,itypj)
24274 chis2 = chis(itypj,itypi)
24275 chis12 = chis1 * chis2
24276 sig1 = sigmap1(itypi,itypj)
24277 sig2 = sigmap2(itypi,itypj)
24278 ! write (*,*) "sig1 = ", sig1
24281 ! chis12 = chis1 * chis2
24284 ! write (*,*) "sig2 = ", sig2
24285 ! alpha factors from Fcav/Gcav
24286 b1cav = alphasur(1,itypi,itypj)
24288 b2cav = alphasur(2,itypi,itypj)
24289 b3cav = alphasur(3,itypi,itypj)
24290 b4cav = alphasur(4,itypi,itypj)
24291 ! used to determine whether we want to do quadrupole calculations
24292 eps_in = epsintab(itypi,itypj)
24293 if (eps_in.eq.0.0) eps_in=1.0
24295 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
24297 ! dtail(1,itypi,itypj)=0.0
24298 ! dtail(2,itypi,itypj)=0.0
24301 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
24302 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
24304 !c! tail distances will be themselves usefull elswhere
24305 !c1 (in Gcav, for example)
24306 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
24307 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
24308 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
24310 (Rtail_distance(1)*Rtail_distance(1)) &
24311 + (Rtail_distance(2)*Rtail_distance(2)) &
24312 + (Rtail_distance(3)*Rtail_distance(3)))
24314 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
24315 !-------------------------------------------------------------------
24316 ! tail location and distance calculations
24317 d1 = dhead(1, 1, itypi, itypj)
24318 d2 = dhead(2, 1, itypi, itypj)
24321 ! location of polar head is computed by taking hydrophobic centre
24322 ! and moving by a d1 * dc_norm vector
24323 ! see unres publications for very informative images
24324 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
24325 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
24327 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
24328 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
24329 Rhead_distance(k) = chead(k,2) - chead(k,1)
24331 ! pitagoras (root of sum of squares)
24333 (Rhead_distance(1)*Rhead_distance(1)) &
24334 + (Rhead_distance(2)*Rhead_distance(2)) &
24335 + (Rhead_distance(3)*Rhead_distance(3)))
24336 !-------------------------------------------------------------------
24337 ! zero everything that should be zero'ed
24355 dscj_inv = vbld_inv(j+nres)
24356 ! print *,i,j,dscj_inv,dsci_inv
24357 ! rij holds 1/(distance of Calpha atoms)
24358 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
24360 !----------------------------
24362 ! this should be in elgrad_init but om's are calculated by sc_angular
24363 ! which in turn is used by older potentials
24364 ! om = omega, sqom = om^2
24367 sqom12 = om12 * om12
24369 ! now we calculate EGB - Gey-Berne
24370 ! It will be summed up in evdwij and saved in evdw
24371 sigsq = 1.0D0 / sigsq
24372 sig = sig0ij * dsqrt(sigsq)
24373 ! rij_shift = 1.0D0 / rij - sig + sig0ij
24374 rij_shift = Rtail - sig + sig0ij
24375 IF (rij_shift.le.0.0D0) THEN
24379 sigder = -sig * sigsq
24380 rij_shift = 1.0D0 / rij_shift
24381 fac = rij_shift**expon
24382 c1 = fac * fac * aa_aq(itypi,itypj)
24383 ! print *,"ADAM",aa_aq(itypi,itypj)
24386 c2 = fac * bb_aq(itypi,itypj)
24388 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
24389 eps2der = eps3rt * evdwij
24390 eps3der = eps2rt * evdwij
24391 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
24392 evdwij = eps2rt * eps3rt * evdwij
24394 ! IF (bb_aq(itypi,itypj).gt.0) THEN
24395 ! evdw_p = evdw_p + evdwij
24397 ! evdw_m = evdw_m + evdwij
24404 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
24405 fac = -expon * (c1 + evdwij) * rij_shift
24406 sigder = fac * sigder
24408 ! Calculate distance derivative
24412 ! if (b2.gt.0.0) then
24413 fac = chis1 * sqom1 + chis2 * sqom2 &
24414 - 2.0d0 * chis12 * om1 * om2 * om12
24415 ! we will use pom later in Gcav, so dont mess with it!
24416 pom = 1.0d0 - chis1 * chis2 * sqom12
24417 Lambf = (1.0d0 - (fac / pom))
24418 ! print *,"fac,pom",fac,pom,Lambf
24419 Lambf = dsqrt(Lambf)
24420 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
24421 ! print *,"sig1,sig2",sig1,sig2,itypi,itypj
24422 ! write (*,*) "sparrow = ", sparrow
24423 Chif = Rtail * sparrow
24424 ! print *,"rij,sparrow",rij , sparrow
24425 ChiLambf = Chif * Lambf
24426 eagle = dsqrt(ChiLambf)
24427 bat = ChiLambf ** 11.0d0
24428 top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
24429 bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
24431 ! print *,top,bot,"bot,top",ChiLambf,Chif
24434 dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
24435 dbot = 12.0d0 * b4cav * bat * Lambf
24436 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
24438 dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
24439 dbot = 12.0d0 * b4cav * bat * Chif
24440 eagle = Lambf * pom
24441 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
24442 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
24443 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
24444 * (chis2 * om2 * om12 - om1) / (eagle * pom)
24446 dFdL = ((dtop * bot - top * dbot) / botsq)
24448 dCAVdOM1 = dFdL * ( dFdOM1 )
24449 dCAVdOM2 = dFdL * ( dFdOM2 )
24450 dCAVdOM12 = dFdL * ( dFdOM12 )
24453 ertail(k) = Rtail_distance(k)/Rtail
24455 erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
24456 erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
24457 facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
24458 facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
24460 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24461 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24462 pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
24463 gvdwx(k,i) = gvdwx(k,i) &
24464 - (( dFdR + gg(k) ) * pom)
24465 !c! & - ( dFdR * pom )
24466 pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
24467 gvdwx(k,j) = gvdwx(k,j) &
24468 + (( dFdR + gg(k) ) * pom)
24469 !c! & + ( dFdR * pom )
24471 gvdwc(k,i) = gvdwc(k,i) &
24472 - (( dFdR + gg(k) ) * ertail(k))
24473 !c! & - ( dFdR * ertail(k))
24475 gvdwc(k,j) = gvdwc(k,j) &
24476 + (( dFdR + gg(k) ) * ertail(k))
24477 !c! & + ( dFdR * ertail(k))
24480 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24481 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24485 !c! Compute head-head and head-tail energies for each state
24487 isel = iabs(Qi) + iabs(Qj)
24489 IF (isel.eq.0) THEN
24490 !c! No charges - do nothing
24493 ELSE IF (isel.eq.4) THEN
24494 !c! Calculate dipole-dipole interactions
24497 ! eheadtail = 0.0d0
24499 ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
24500 !c! Charge-nonpolar interactions
24503 ! eheadtail = 0.0d0
24505 ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
24506 !c! Nonpolar-charge interactions
24509 ! eheadtail = 0.0d0
24511 ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
24512 !c! Charge-dipole interactions
24513 CALL eqd(ecl, elj, epol)
24514 eheadtail = ECL + elj + epol
24515 ! eheadtail = 0.0d0
24517 ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
24518 !c! Dipole-charge interactions
24519 CALL edq(ecl, elj, epol)
24520 eheadtail = ECL + elj + epol
24521 ! eheadtail = 0.0d0
24523 ELSE IF ((isel.eq.2.and. &
24524 iabs(Qi).eq.1).and. &
24525 nstate(itypi,itypj).eq.1) THEN
24526 !c! Same charge-charge interaction ( +/+ or -/- )
24527 CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
24528 eheadtail = ECL + Egb + Epol + Fisocav + Elj
24529 ! eheadtail = 0.0d0
24531 ELSE IF ((isel.eq.2.and. &
24532 iabs(Qi).eq.1).and. &
24533 nstate(itypi,itypj).ne.1) THEN
24534 !c! Different charge-charge interaction ( +/- or -/+ )
24535 CALL energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
24537 END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
24538 evdw = evdw + Fcav + eheadtail
24540 IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
24541 restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
24542 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
24543 Equad,evdwij+Fcav+eheadtail,evdw
24544 ! evdw = evdw + Fcav + eheadtail
24546 iF (nstate(itypi,itypj).eq.1) THEN
24549 !c!-------------------------------------------------------------------
24554 !c write (iout,*) "Number of loop steps in EGB:",ind
24555 !c energy_dec=.false.
24556 ! print *,"EVDW KURW",evdw,nres
24559 END SUBROUTINE emomo
24560 !C------------------------------------------------------------------------------------
24561 SUBROUTINE eqq(Ecl,Egb,Epol,Fisocav,Elj)
24564 real (kind=8) :: facd3, facd4, federmaus, adler,&
24565 Ecl,Egb,Epol,Fisocav,Elj,Fgb
24567 !c! Epol and Gpol analytical parameters
24568 alphapol1 = alphapol(itypi,itypj)
24569 alphapol2 = alphapol(itypj,itypi)
24570 !c! Fisocav and Gisocav analytical parameters
24571 al1 = alphiso(1,itypi,itypj)
24572 al2 = alphiso(2,itypi,itypj)
24573 al3 = alphiso(3,itypi,itypj)
24574 al4 = alphiso(4,itypi,itypj)
24576 / dsqrt(sigiso1(itypi, itypj)**2.0d0 &
24577 + sigiso2(itypi,itypj)**2.0d0))
24579 pis = sig0head(itypi,itypj)
24580 eps_head = epshead(itypi,itypj)
24581 Rhead_sq = Rhead * Rhead
24582 !c! R1 - distance between head of ith side chain and tail of jth sidechain
24583 !c! R2 - distance between head of jth side chain and tail of ith sidechain
24587 !c! Calculate head-to-tail distances needed by Epol
24588 R1=R1+(ctail(k,2)-chead(k,1))**2
24589 R2=R2+(chead(k,2)-ctail(k,1))**2
24595 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
24596 !c! & +dhead(1,1,itypi,itypj))**2))
24597 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
24598 !c! & +dhead(2,1,itypi,itypj))**2))
24600 !c!-------------------------------------------------------------------
24601 !c! Coulomb electrostatic interaction
24602 Ecl = (332.0d0 * Qij) / Rhead
24603 !c! derivative of Ecl is Gcl...
24604 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
24608 ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
24609 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
24610 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
24611 ! print *,"EGB WTF",Qij,eps_inout_fac,Fgb,itypi,itypj,eps_in,eps_out
24612 !c! Derivative of Egb is Ggb...
24613 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
24614 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )/ ( 2.0d0 * Fgb )
24615 dGGBdR = dGGBdFGB * dFGBdR
24616 !c!-------------------------------------------------------------------
24617 !c! Fisocav - isotropic cavity creation term
24618 !c! or "how much energy it costs to put charged head in water"
24620 top = al1 * (dsqrt(pom) + al2 * pom - al3)
24621 bot = (1.0d0 + al4 * pom**12.0d0)
24623 FisoCav = top / bot
24624 ! write (*,*) "Rhead = ",Rhead
24625 ! write (*,*) "csig = ",csig
24626 ! write (*,*) "pom = ",pom
24627 ! write (*,*) "al1 = ",al1
24628 ! write (*,*) "al2 = ",al2
24629 ! write (*,*) "al3 = ",al3
24630 ! write (*,*) "al4 = ",al4
24631 ! write (*,*) "top = ",top
24632 ! write (*,*) "bot = ",bot
24633 !c! Derivative of Fisocav is GCV...
24634 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
24635 dbot = 12.0d0 * al4 * pom ** 11.0d0
24636 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
24637 !c!-------------------------------------------------------------------
24639 !c! Polarization energy - charged heads polarize hydrophobic "neck"
24640 MomoFac1 = (1.0d0 - chi1 * sqom2)
24641 MomoFac2 = (1.0d0 - chi2 * sqom1)
24642 RR1 = ( R1 * R1 ) / MomoFac1
24643 RR2 = ( R2 * R2 ) / MomoFac2
24644 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
24645 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
24646 fgb1 = sqrt( RR1 + a12sq * ee1 )
24647 fgb2 = sqrt( RR2 + a12sq * ee2 )
24648 epol = 332.0d0 * eps_inout_fac * ( &
24649 (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
24651 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
24653 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
24655 dFGBdR1 = ( (R1 / MomoFac1)* ( 2.0d0 - (0.5d0 * ee1) ) )&
24657 dFGBdR2 = ( (R2 / MomoFac2)* ( 2.0d0 - (0.5d0 * ee2) ) )&
24659 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))&
24660 * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 )
24661 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))&
24662 * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 )
24663 dPOLdR1 = dPOLdFGB1 * dFGBdR1
24664 !c! dPOLdR1 = 0.0d0
24665 dPOLdR2 = dPOLdFGB2 * dFGBdR2
24666 !c! dPOLdR2 = 0.0d0
24667 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
24668 !c! dPOLdOM1 = 0.0d0
24669 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
24670 !c! dPOLdOM2 = 0.0d0
24671 !c!-------------------------------------------------------------------
24673 !c! Lennard-Jones 6-12 interaction between heads
24674 pom = (pis / Rhead)**6.0d0
24675 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
24676 !c! derivative of Elj is Glj
24677 dGLJdR = 4.0d0 * eps_head*(((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))&
24678 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
24679 !c!-------------------------------------------------------------------
24680 !c! Return the results
24681 !c! These things do the dRdX derivatives, that is
24682 !c! allow us to change what we see from function that changes with
24683 !c! distance to function that changes with LOCATION (of the interaction
24686 erhead(k) = Rhead_distance(k)/Rhead
24687 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
24688 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
24691 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
24692 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
24693 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
24694 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
24695 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
24696 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
24697 facd1 = d1 * vbld_inv(i+nres)
24698 facd2 = d2 * vbld_inv(j+nres)
24699 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
24700 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
24702 !c! Now we add appropriate partial derivatives (one in each dimension)
24704 hawk = (erhead_tail(k,1) + &
24705 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
24706 condor = (erhead_tail(k,2) + &
24707 facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
24709 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
24710 gvdwx(k,i) = gvdwx(k,i) &
24715 - dPOLdR2 * (erhead_tail(k,2)&
24716 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
24719 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
24720 gvdwx(k,j) = gvdwx(k,j)+ dGCLdR * pom&
24721 + dGGBdR * pom+ dGCVdR * pom&
24722 + dPOLdR1 * (erhead_tail(k,1)&
24723 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))&
24724 + dPOLdR2 * condor + dGLJdR * pom
24726 gvdwc(k,i) = gvdwc(k,i) &
24727 - dGCLdR * erhead(k)&
24728 - dGGBdR * erhead(k)&
24729 - dGCVdR * erhead(k)&
24730 - dPOLdR1 * erhead_tail(k,1)&
24731 - dPOLdR2 * erhead_tail(k,2)&
24732 - dGLJdR * erhead(k)
24734 gvdwc(k,j) = gvdwc(k,j) &
24735 + dGCLdR * erhead(k) &
24736 + dGGBdR * erhead(k) &
24737 + dGCVdR * erhead(k) &
24738 + dPOLdR1 * erhead_tail(k,1) &
24739 + dPOLdR2 * erhead_tail(k,2)&
24740 + dGLJdR * erhead(k)
24745 !c!-------------------------------------------------------------------
24746 SUBROUTINE energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
24750 double precision eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad
24751 double precision ener(4)
24752 double precision dcosom1(3),dcosom2(3)
24753 !c! used in Epol derivatives
24754 double precision facd3, facd4
24755 double precision federmaus, adler
24756 integer istate,ii,jj
24757 real (kind=8) :: Fgb
24758 ! print *,"CALLING EQUAD"
24759 !c! Epol and Gpol analytical parameters
24760 alphapol1 = alphapol(itypi,itypj)
24761 alphapol2 = alphapol(itypj,itypi)
24762 !c! Fisocav and Gisocav analytical parameters
24763 al1 = alphiso(1,itypi,itypj)
24764 al2 = alphiso(2,itypi,itypj)
24765 al3 = alphiso(3,itypi,itypj)
24766 al4 = alphiso(4,itypi,itypj)
24767 csig = (1.0d0 / dsqrt(sigiso1(itypi, itypj)**2.0d0&
24768 + sigiso2(itypi,itypj)**2.0d0))
24770 w1 = wqdip(1,itypi,itypj)
24771 w2 = wqdip(2,itypi,itypj)
24772 pis = sig0head(itypi,itypj)
24773 eps_head = epshead(itypi,itypj)
24774 !c! First things first:
24775 !c! We need to do sc_grad's job with GB and Fcav
24776 eom1 = eps2der * eps2rt_om1 &
24777 - 2.0D0 * alf1 * eps3der&
24778 + sigder * sigsq_om1&
24780 eom2 = eps2der * eps2rt_om2 &
24781 + 2.0D0 * alf2 * eps3der&
24782 + sigder * sigsq_om2&
24784 eom12 = evdwij * eps1_om12 &
24785 + eps2der * eps2rt_om12 &
24786 - 2.0D0 * alf12 * eps3der&
24787 + sigder *sigsq_om12&
24789 !c! now some magical transformations to project gradient into
24790 !c! three cartesian vectors
24792 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
24793 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
24794 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
24795 !c! this acts on hydrophobic center of interaction
24796 gvdwx(k,i)= gvdwx(k,i) - gg(k) &
24797 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
24798 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
24799 gvdwx(k,j)= gvdwx(k,j) + gg(k) &
24800 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))&
24801 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
24802 !c! this acts on Calpha
24803 gvdwc(k,i)=gvdwc(k,i)-gg(k)
24804 gvdwc(k,j)=gvdwc(k,j)+gg(k)
24806 !c! sc_grad is done, now we will compute
24811 DO istate = 1, nstate(itypi,itypj)
24812 !c*************************************************************
24813 IF (istate.ne.1) THEN
24814 IF (istate.lt.3) THEN
24820 d1 = dhead(1,ii,itypi,itypj)
24821 d2 = dhead(2,jj,itypi,itypj)
24823 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
24824 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
24825 Rhead_distance(k) = chead(k,2) - chead(k,1)
24827 !c! pitagoras (root of sum of squares)
24829 (Rhead_distance(1)*Rhead_distance(1)) &
24830 + (Rhead_distance(2)*Rhead_distance(2)) &
24831 + (Rhead_distance(3)*Rhead_distance(3)))
24833 Rhead_sq = Rhead * Rhead
24835 !c! R1 - distance between head of ith side chain and tail of jth sidechain
24836 !c! R2 - distance between head of jth side chain and tail of ith sidechain
24840 !c! Calculate head-to-tail distances
24841 R1=R1+(ctail(k,2)-chead(k,1))**2
24842 R2=R2+(chead(k,2)-ctail(k,1))**2
24847 Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
24849 !c! write (*,*) "Ecl = ", Ecl
24850 !c! derivative of Ecl is Gcl...
24851 dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
24856 !c!-------------------------------------------------------------------
24857 !c! Generalised Born Solvent Polarization
24858 ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
24859 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
24860 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
24862 !c! write (*,*) "a1*a2 = ", a12sq
24863 !c! write (*,*) "Rhead = ", Rhead
24864 !c! write (*,*) "Rhead_sq = ", Rhead_sq
24865 !c! write (*,*) "ee = ", ee
24866 !c! write (*,*) "Fgb = ", Fgb
24867 !c! write (*,*) "fac = ", eps_inout_fac
24868 !c! write (*,*) "Qij = ", Qij
24869 !c! write (*,*) "Egb = ", Egb
24870 !c! Derivative of Egb is Ggb...
24871 !c! dFGBdR is used by Quad's later...
24872 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
24873 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )&
24875 dGGBdR = dGGBdFGB * dFGBdR
24877 !c!-------------------------------------------------------------------
24878 !c! Fisocav - isotropic cavity creation term
24880 top = al1 * (dsqrt(pom) + al2 * pom - al3)
24881 bot = (1.0d0 + al4 * pom**12.0d0)
24883 FisoCav = top / bot
24884 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
24885 dbot = 12.0d0 * al4 * pom ** 11.0d0
24886 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
24888 !c!-------------------------------------------------------------------
24889 !c! Polarization energy
24891 MomoFac1 = (1.0d0 - chi1 * sqom2)
24892 MomoFac2 = (1.0d0 - chi2 * sqom1)
24893 RR1 = ( R1 * R1 ) / MomoFac1
24894 RR2 = ( R2 * R2 ) / MomoFac2
24895 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
24896 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
24897 fgb1 = sqrt( RR1 + a12sq * ee1 )
24898 fgb2 = sqrt( RR2 + a12sq * ee2 )
24899 epol = 332.0d0 * eps_inout_fac * (&
24900 (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
24902 !c! derivative of Epol is Gpol...
24903 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
24905 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
24907 dFGBdR1 = ( (R1 / MomoFac1) &
24908 * ( 2.0d0 - (0.5d0 * ee1) ) )&
24910 dFGBdR2 = ( (R2 / MomoFac2) &
24911 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
24913 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
24914 * ( 2.0d0 - 0.5d0 * ee1) ) &
24916 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
24917 * ( 2.0d0 - 0.5d0 * ee2) ) &
24919 dPOLdR1 = dPOLdFGB1 * dFGBdR1
24920 !c! dPOLdR1 = 0.0d0
24921 dPOLdR2 = dPOLdFGB2 * dFGBdR2
24922 !c! dPOLdR2 = 0.0d0
24923 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
24924 !c! dPOLdOM1 = 0.0d0
24925 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
24926 pom = (pis / Rhead)**6.0d0
24927 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
24929 !c! derivative of Elj is Glj
24930 dGLJdR = 4.0d0 * eps_head &
24931 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
24932 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
24934 !c!-------------------------------------------------------------------
24936 IF (Wqd.ne.0.0d0) THEN
24937 Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0) &
24938 - 37.5d0 * ( sqom1 + sqom2 ) &
24939 + 157.5d0 * ( sqom1 * sqom2 ) &
24940 - 45.0d0 * om1*om2*om12
24941 fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
24942 Equad = fac * Beta1
24944 !c! derivative of Equad...
24945 dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
24946 !c! dQUADdR = 0.0d0
24947 dQUADdOM1 = fac* (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
24948 !c! dQUADdOM1 = 0.0d0
24949 dQUADdOM2 = fac* (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
24950 !c! dQUADdOM2 = 0.0d0
24951 dQUADdOM12 = fac * ( 6.0d0*om12 - 45.0d0*om1*om2 )
24956 !c!-------------------------------------------------------------------
24957 !c! Return the results
24959 eom1 = dPOLdOM1 + dQUADdOM1
24960 eom2 = dPOLdOM2 + dQUADdOM2
24962 !c! now some magical transformations to project gradient into
24963 !c! three cartesian vectors
24965 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
24966 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
24967 tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
24971 erhead(k) = Rhead_distance(k)/Rhead
24972 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
24973 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
24975 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
24976 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
24977 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
24978 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
24979 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
24980 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
24981 facd1 = d1 * vbld_inv(i+nres)
24982 facd2 = d2 * vbld_inv(j+nres)
24983 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
24984 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
24986 hawk = erhead_tail(k,1) + &
24987 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
24988 condor = erhead_tail(k,2) + &
24989 facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
24991 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
24992 !c! this acts on hydrophobic center of interaction
24993 gheadtail(k,1,1) = gheadtail(k,1,1) &
24998 - dPOLdR2 * (erhead_tail(k,2) &
24999 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
25003 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
25004 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
25006 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
25007 !c! this acts on hydrophobic center of interaction
25008 gheadtail(k,2,1) = gheadtail(k,2,1) &
25012 + dPOLdR1 * (erhead_tail(k,1) &
25013 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
25014 + dPOLdR2 * condor &
25018 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
25019 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
25021 !c! this acts on Calpha
25022 gheadtail(k,3,1) = gheadtail(k,3,1) &
25023 - dGCLdR * erhead(k)&
25024 - dGGBdR * erhead(k)&
25025 - dGCVdR * erhead(k)&
25026 - dPOLdR1 * erhead_tail(k,1)&
25027 - dPOLdR2 * erhead_tail(k,2)&
25028 - dGLJdR * erhead(k) &
25029 - dQUADdR * erhead(k)&
25031 !c! this acts on Calpha
25032 gheadtail(k,4,1) = gheadtail(k,4,1) &
25033 + dGCLdR * erhead(k) &
25034 + dGGBdR * erhead(k) &
25035 + dGCVdR * erhead(k) &
25036 + dPOLdR1 * erhead_tail(k,1) &
25037 + dPOLdR2 * erhead_tail(k,2) &
25038 + dGLJdR * erhead(k) &
25039 + dQUADdR * erhead(k)&
25042 ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
25043 eheadtail = eheadtail &
25044 + wstate(istate, itypi, itypj) &
25045 * dexp(-betaT * ener(istate))
25046 !c! foreach cartesian dimension
25048 !c! foreach of two gvdwx and gvdwc
25050 gheadtail(k,l,2) = gheadtail(k,l,2) &
25051 + wstate( istate, itypi, itypj ) &
25052 * dexp(-betaT * ener(istate)) &
25054 gheadtail(k,l,1) = 0.0d0
25058 !c! Here ended the gigantic DO istate = 1, 4, which starts
25059 !c! at the beggining of the subroutine
25063 gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
25065 gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
25066 gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
25067 gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
25068 gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
25070 gheadtail(k,l,1) = 0.0d0
25071 gheadtail(k,l,2) = 0.0d0
25074 eheadtail = (-dlog(eheadtail)) / betaT
25081 END SUBROUTINE energy_quad
25082 !!-----------------------------------------------------------
25083 SUBROUTINE eqn(Epol)
25087 double precision facd4, federmaus,epol
25088 alphapol1 = alphapol(itypi,itypj)
25089 !c! R1 - distance between head of ith side chain and tail of jth sidechain
25092 !c! Calculate head-to-tail distances
25093 R1=R1+(ctail(k,2)-chead(k,1))**2
25098 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
25099 !c! & +dhead(1,1,itypi,itypj))**2))
25100 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
25101 !c! & +dhead(2,1,itypi,itypj))**2))
25102 !c--------------------------------------------------------------------
25103 !c Polarization energy
25105 MomoFac1 = (1.0d0 - chi1 * sqom2)
25106 RR1 = R1 * R1 / MomoFac1
25107 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
25108 fgb1 = sqrt( RR1 + a12sq * ee1)
25109 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
25110 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
25112 dFGBdR1 = ( (R1 / MomoFac1) &
25113 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
25115 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
25116 * (2.0d0 - 0.5d0 * ee1) ) &
25118 dPOLdR1 = dPOLdFGB1 * dFGBdR1
25119 !c! dPOLdR1 = 0.0d0
25121 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
25123 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
25125 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
25126 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
25127 facd1 = d1 * vbld_inv(i+nres)
25128 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
25131 hawk = (erhead_tail(k,1) + &
25132 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
25134 gvdwx(k,i) = gvdwx(k,i) &
25136 gvdwx(k,j) = gvdwx(k,j) &
25137 + dPOLdR1 * (erhead_tail(k,1) &
25138 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
25140 gvdwc(k,i) = gvdwc(k,i) - dPOLdR1 * erhead_tail(k,1)
25141 gvdwc(k,j) = gvdwc(k,j) + dPOLdR1 * erhead_tail(k,1)
25146 SUBROUTINE enq(Epol)
25149 double precision facd3, adler,epol
25150 alphapol2 = alphapol(itypj,itypi)
25151 !c! R2 - distance between head of jth side chain and tail of ith sidechain
25154 !c! Calculate head-to-tail distances
25155 R2=R2+(chead(k,2)-ctail(k,1))**2
25160 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
25161 !c! & +dhead(1,1,itypi,itypj))**2))
25162 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
25163 !c! & +dhead(2,1,itypi,itypj))**2))
25164 !c------------------------------------------------------------------------
25165 !c Polarization energy
25166 MomoFac2 = (1.0d0 - chi2 * sqom1)
25167 RR2 = R2 * R2 / MomoFac2
25168 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
25169 fgb2 = sqrt(RR2 + a12sq * ee2)
25170 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
25171 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
25173 dFGBdR2 = ( (R2 / MomoFac2) &
25174 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
25176 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
25177 * (2.0d0 - 0.5d0 * ee2) ) &
25179 dPOLdR2 = dPOLdFGB2 * dFGBdR2
25180 !c! dPOLdR2 = 0.0d0
25181 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
25182 !c! dPOLdOM1 = 0.0d0
25184 !c!-------------------------------------------------------------------
25185 !c! Return the results
25186 !c! (See comments in Eqq)
25188 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
25190 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
25191 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
25192 facd2 = d2 * vbld_inv(j+nres)
25193 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
25195 condor = (erhead_tail(k,2) &
25196 + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
25198 gvdwx(k,i) = gvdwx(k,i) &
25199 - dPOLdR2 * (erhead_tail(k,2) &
25200 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
25201 gvdwx(k,j) = gvdwx(k,j) &
25204 gvdwc(k,i) = gvdwc(k,i) &
25205 - dPOLdR2 * erhead_tail(k,2)
25206 gvdwc(k,j) = gvdwc(k,j) &
25207 + dPOLdR2 * erhead_tail(k,2)
25212 SUBROUTINE eqd(Ecl,Elj,Epol)
25215 double precision facd4, federmaus,ecl,elj,epol
25216 alphapol1 = alphapol(itypi,itypj)
25217 w1 = wqdip(1,itypi,itypj)
25218 w2 = wqdip(2,itypi,itypj)
25219 pis = sig0head(itypi,itypj)
25220 eps_head = epshead(itypi,itypj)
25221 !c!-------------------------------------------------------------------
25222 !c! R1 - distance between head of ith side chain and tail of jth sidechain
25225 !c! Calculate head-to-tail distances
25226 R1=R1+(ctail(k,2)-chead(k,1))**2
25231 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
25232 !c! & +dhead(1,1,itypi,itypj))**2))
25233 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
25234 !c! & +dhead(2,1,itypi,itypj))**2))
25236 !c!-------------------------------------------------------------------
25238 sparrow = w1 * Qi * om1
25239 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
25240 Ecl = sparrow / Rhead**2.0d0 &
25241 - hawk / Rhead**4.0d0
25242 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
25243 + 4.0d0 * hawk / Rhead**5.0d0
25245 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
25247 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
25248 !c--------------------------------------------------------------------
25249 !c Polarization energy
25251 MomoFac1 = (1.0d0 - chi1 * sqom2)
25252 RR1 = R1 * R1 / MomoFac1
25253 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
25254 fgb1 = sqrt( RR1 + a12sq * ee1)
25255 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
25257 !c!------------------------------------------------------------------
25258 !c! derivative of Epol is Gpol...
25259 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
25261 dFGBdR1 = ( (R1 / MomoFac1) &
25262 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
25264 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
25265 * (2.0d0 - 0.5d0 * ee1) ) &
25267 dPOLdR1 = dPOLdFGB1 * dFGBdR1
25268 !c! dPOLdR1 = 0.0d0
25270 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
25271 !c! dPOLdOM2 = 0.0d0
25272 !c!-------------------------------------------------------------------
25274 pom = (pis / Rhead)**6.0d0
25275 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
25276 !c! derivative of Elj is Glj
25277 dGLJdR = 4.0d0 * eps_head &
25278 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
25279 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
25281 erhead(k) = Rhead_distance(k)/Rhead
25282 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
25285 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
25286 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
25287 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
25288 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
25289 facd1 = d1 * vbld_inv(i+nres)
25290 facd2 = d2 * vbld_inv(j+nres)
25291 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
25294 hawk = (erhead_tail(k,1) + &
25295 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
25297 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
25298 gvdwx(k,i) = gvdwx(k,i) &
25303 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
25304 gvdwx(k,j) = gvdwx(k,j) &
25306 + dPOLdR1 * (erhead_tail(k,1) &
25307 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
25311 gvdwc(k,i) = gvdwc(k,i) &
25312 - dGCLdR * erhead(k) &
25313 - dPOLdR1 * erhead_tail(k,1) &
25314 - dGLJdR * erhead(k)
25316 gvdwc(k,j) = gvdwc(k,j) &
25317 + dGCLdR * erhead(k) &
25318 + dPOLdR1 * erhead_tail(k,1) &
25319 + dGLJdR * erhead(k)
25324 SUBROUTINE edq(Ecl,Elj,Epol)
25329 double precision facd3, adler,ecl,elj,epol
25330 alphapol2 = alphapol(itypj,itypi)
25331 w1 = wqdip(1,itypi,itypj)
25332 w2 = wqdip(2,itypi,itypj)
25333 pis = sig0head(itypi,itypj)
25334 eps_head = epshead(itypi,itypj)
25335 !c!-------------------------------------------------------------------
25336 !c! R2 - distance between head of jth side chain and tail of ith sidechain
25339 !c! Calculate head-to-tail distances
25340 R2=R2+(chead(k,2)-ctail(k,1))**2
25345 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
25346 !c! & +dhead(1,1,itypi,itypj))**2))
25347 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
25348 !c! & +dhead(2,1,itypi,itypj))**2))
25351 !c!-------------------------------------------------------------------
25353 sparrow = w1 * Qi * om1
25354 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
25355 ECL = sparrow / Rhead**2.0d0 &
25356 - hawk / Rhead**4.0d0
25357 !c!-------------------------------------------------------------------
25358 !c! derivative of ecl is Gcl
25360 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
25361 + 4.0d0 * hawk / Rhead**5.0d0
25363 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
25365 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
25366 !c--------------------------------------------------------------------
25367 !c Polarization energy
25369 MomoFac2 = (1.0d0 - chi2 * sqom1)
25370 RR2 = R2 * R2 / MomoFac2
25371 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
25372 fgb2 = sqrt(RR2 + a12sq * ee2)
25373 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
25374 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
25376 dFGBdR2 = ( (R2 / MomoFac2) &
25377 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
25379 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
25380 * (2.0d0 - 0.5d0 * ee2) ) &
25382 dPOLdR2 = dPOLdFGB2 * dFGBdR2
25383 !c! dPOLdR2 = 0.0d0
25384 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
25385 !c! dPOLdOM1 = 0.0d0
25387 !c!-------------------------------------------------------------------
25389 pom = (pis / Rhead)**6.0d0
25390 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
25391 !c! derivative of Elj is Glj
25392 dGLJdR = 4.0d0 * eps_head &
25393 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
25394 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
25395 !c!-------------------------------------------------------------------
25396 !c! Return the results
25397 !c! (see comments in Eqq)
25399 erhead(k) = Rhead_distance(k)/Rhead
25400 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
25402 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
25403 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
25404 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
25405 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
25406 facd1 = d1 * vbld_inv(i+nres)
25407 facd2 = d2 * vbld_inv(j+nres)
25408 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
25410 condor = (erhead_tail(k,2) &
25411 + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
25413 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
25414 gvdwx(k,i) = gvdwx(k,i) &
25416 - dPOLdR2 * (erhead_tail(k,2) &
25417 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) &
25420 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
25421 gvdwx(k,j) = gvdwx(k,j) &
25423 + dPOLdR2 * condor &
25427 gvdwc(k,i) = gvdwc(k,i) &
25428 - dGCLdR * erhead(k) &
25429 - dPOLdR2 * erhead_tail(k,2) &
25430 - dGLJdR * erhead(k)
25432 gvdwc(k,j) = gvdwc(k,j) &
25433 + dGCLdR * erhead(k) &
25434 + dPOLdR2 * erhead_tail(k,2) &
25435 + dGLJdR * erhead(k)
25440 SUBROUTINE edd(ECL)
25445 double precision ecl
25446 !c! csig = sigiso(itypi,itypj)
25447 w1 = wqdip(1,itypi,itypj)
25448 w2 = wqdip(2,itypi,itypj)
25449 !c!-------------------------------------------------------------------
25451 fac = (om12 - 3.0d0 * om1 * om2)
25452 c1 = (w1 / (Rhead**3.0d0)) * fac
25453 c2 = (w2 / Rhead ** 6.0d0) &
25454 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
25456 !c! write (*,*) "w1 = ", w1
25457 !c! write (*,*) "w2 = ", w2
25458 !c! write (*,*) "om1 = ", om1
25459 !c! write (*,*) "om2 = ", om2
25460 !c! write (*,*) "om12 = ", om12
25461 !c! write (*,*) "fac = ", fac
25462 !c! write (*,*) "c1 = ", c1
25463 !c! write (*,*) "c2 = ", c2
25464 !c! write (*,*) "Ecl = ", Ecl
25465 !c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
25466 !c! write (*,*) "c2_2 = ",
25467 !c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
25468 !c!-------------------------------------------------------------------
25469 !c! dervative of ECL is GCL...
25471 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
25472 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
25473 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
25476 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
25477 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
25478 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
25481 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
25482 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
25483 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
25486 c1 = w1 / (Rhead ** 3.0d0)
25487 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
25488 dGCLdOM12 = c1 - c2
25489 !c!-------------------------------------------------------------------
25490 !c! Return the results
25491 !c! (see comments in Eqq)
25493 erhead(k) = Rhead_distance(k)/Rhead
25495 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
25496 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
25497 facd1 = d1 * vbld_inv(i+nres)
25498 facd2 = d2 * vbld_inv(j+nres)
25501 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
25502 gvdwx(k,i) = gvdwx(k,i) - dGCLdR * pom
25503 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
25504 gvdwx(k,j) = gvdwx(k,j) + dGCLdR * pom
25506 gvdwc(k,i) = gvdwc(k,i) - dGCLdR * erhead(k)
25507 gvdwc(k,j) = gvdwc(k,j) + dGCLdR * erhead(k)
25511 SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
25516 real(kind=8) :: eheadtail,Egb,Ecl,Elj,Equad,Epol,Rb
25520 !c! 1/(Gas Constant * Thermostate temperature) = BetaT
25521 !c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
25523 !c! BetaT = 1.0d0 / (t_bath * Rb)i
25525 BetaT = 1.0d0 / (298.0d0 * Rb)
25526 !c! Gay-berne var's
25527 sig0ij = sigma( itypi,itypj )
25528 chi1 = chi( itypi, itypj )
25529 chi2 = chi( itypj, itypi )
25530 chi12 = chi1 * chi2
25531 chip1 = chipp( itypi, itypj )
25532 chip2 = chipp( itypj, itypi )
25533 chip12 = chip1 * chip2
25540 !c! not used by momo potential, but needed by sc_angular which is shared
25541 !c! by all energy_potential subroutines
25545 !c! location, location, location
25546 ! xj = c( 1, nres+j ) - xi
25547 ! yj = c( 2, nres+j ) - yi
25548 ! zj = c( 3, nres+j ) - zi
25549 dxj = dc_norm( 1, nres+j )
25550 dyj = dc_norm( 2, nres+j )
25551 dzj = dc_norm( 3, nres+j )
25552 !c! distance from center of chain(?) to polar/charged head
25553 !c! write (*,*) "istate = ", 1
25554 !c! write (*,*) "ii = ", 1
25555 !c! write (*,*) "jj = ", 1
25556 d1 = dhead(1, 1, itypi, itypj)
25557 d2 = dhead(2, 1, itypi, itypj)
25559 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
25560 !c! a12sq = a12sq * a12sq
25561 !c! charge of amino acid itypi is...
25562 Qi = icharge(itypi)
25563 Qj = icharge(itypj)
25566 chis1 = chis(itypi,itypj)
25567 chis2 = chis(itypj,itypi)
25568 chis12 = chis1 * chis2
25569 sig1 = sigmap1(itypi,itypj)
25570 sig2 = sigmap2(itypi,itypj)
25571 !c! write (*,*) "sig1 = ", sig1
25572 !c! write (*,*) "sig2 = ", sig2
25573 !c! alpha factors from Fcav/Gcav
25574 b1cav = alphasur(1,itypi,itypj)
25576 b2cav = alphasur(2,itypi,itypj)
25577 b3cav = alphasur(3,itypi,itypj)
25578 b4cav = alphasur(4,itypi,itypj)
25579 wqd = wquad(itypi, itypj)
25581 eps_in = epsintab(itypi,itypj)
25582 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
25583 !c! write (*,*) "eps_inout_fac = ", eps_inout_fac
25584 !c!-------------------------------------------------------------------
25585 !c! tail location and distance calculations
25588 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
25589 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
25591 !c! tail distances will be themselves usefull elswhere
25592 !c1 (in Gcav, for example)
25593 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
25594 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
25595 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
25597 (Rtail_distance(1)*Rtail_distance(1)) &
25598 + (Rtail_distance(2)*Rtail_distance(2)) &
25599 + (Rtail_distance(3)*Rtail_distance(3)))
25600 !c!-------------------------------------------------------------------
25601 !c! Calculate location and distance between polar heads
25602 !c! distance between heads
25603 !c! for each one of our three dimensional space...
25604 d1 = dhead(1, 1, itypi, itypj)
25605 d2 = dhead(2, 1, itypi, itypj)
25608 !c! location of polar head is computed by taking hydrophobic centre
25609 !c! and moving by a d1 * dc_norm vector
25610 !c! see unres publications for very informative images
25611 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
25612 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
25614 !c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
25615 !c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
25616 Rhead_distance(k) = chead(k,2) - chead(k,1)
25618 !c! pitagoras (root of sum of squares)
25620 (Rhead_distance(1)*Rhead_distance(1)) &
25621 + (Rhead_distance(2)*Rhead_distance(2)) &
25622 + (Rhead_distance(3)*Rhead_distance(3)))
25623 !c!-------------------------------------------------------------------
25624 !c! zero everything that should be zero'ed
25637 END SUBROUTINE elgrad_init