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).
398 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
399 ! 105 call egbv(evdw)
403 ! Soft-sphere potential
404 ! 106 call e_softsphere(evdw)
406 call e_softsphere(evdw)
408 ! Calculate electrostatic (H-bonding) energy of the main chain.
412 write(iout,*)"Wrong ipot"
417 ! print *,"after EGB"
419 if (shield_mode.eq.2) then
422 ! print *,"AFTER EGB",ipot,evdw
424 !mc Sep-06: egb takes care of dynamic ss bonds too
426 ! if (dyn_ss) call dyn_set_nss
427 ! print *,"Processor",myrank," computed USCSC"
433 time_vec=time_vec+MPI_Wtime()-time01
435 ! print *,"Processor",myrank," left VEC_AND_DERIV"
438 ! print *,"after ipot if", ipot
439 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
440 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
441 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
442 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
444 if (welec.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 ! print *,"just befor eelec call"
450 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
451 ! write (iout,*) "ELEC calc"
460 ! write (iout,*) "Soft-spheer ELEC potential"
461 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
464 ! print *,"Processor",myrank," computed UELEC"
466 ! Calculate excluded-volume interaction energy between peptide groups
469 !elwrite(iout,*) "in etotal calc exc;luded",ipot
473 call escp(evdw2,evdw2_14)
479 ! write (iout,*) "Soft-sphere SCP potential"
480 call escp_soft_sphere(evdw2,evdw2_14)
482 ! write(iout,*) "in etotal before ebond",ipot
485 ! Calculate the bond-stretching energy
488 ! print *,"EBOND",estr
489 ! write(iout,*) "in etotal afer ebond",ipot
492 ! Calculate the disulfide-bridge and other energy and the contributions
493 ! from other distance constraints.
494 ! print *,'Calling EHPB'
496 !elwrite(iout,*) "in etotal afer edis",ipot
497 ! print *,'EHPB exitted succesfully.'
499 ! Calculate the virtual-bond-angle energy.
501 if (wang.gt.0d0) then
502 call ebend(ebe,ethetacnstr)
507 ! print *,"Processor",myrank," computed UB"
509 ! Calculate the SC local energy.
512 !elwrite(iout,*) "in etotal afer esc",ipot
513 ! print *,"Processor",myrank," computed USC"
515 ! Calculate the virtual-bond torsional energy.
517 !d print *,'nterm=',nterm
519 call etor(etors,edihcnstr)
524 ! print *,"Processor",myrank," computed Utor"
526 ! 6/23/01 Calculate double-torsional energy
528 !elwrite(iout,*) "in etotal",ipot
529 if (wtor_d.gt.0) then
534 ! print *,"Processor",myrank," computed Utord"
536 ! 21/5/07 Calculate local sicdechain correlation energy
538 if (wsccor.gt.0.0d0) then
539 call eback_sc_corr(esccor)
543 ! print *,"Processor",myrank," computed Usccorr"
545 ! 12/1/95 Multi-body terms
549 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
550 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
551 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
552 !d write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
553 !d &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
560 !elwrite(iout,*) "in etotal",ipot
561 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
562 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
563 !d write (iout,*) "multibody_hb ecorr",ecorr
565 !elwrite(iout,*) "afeter multibody hb"
567 ! print *,"Processor",myrank," computed Ucorr"
569 ! If performing constraint dynamics, call the constraint energy
570 ! after the equilibration time
571 if(usampl.and.totT.gt.eq_time) then
572 !elwrite(iout,*) "afeter multibody hb"
574 !elwrite(iout,*) "afeter multibody hb"
576 !elwrite(iout,*) "afeter multibody hb"
582 ! write(iout,*) "after Econstr"
584 if (wliptran.gt.0) then
585 ! print *,"PRZED WYWOLANIEM"
586 call Eliptransfer(eliptran)
590 if (fg_rank.eq.0) then
591 if (AFMlog.gt.0) then
592 call AFMforce(Eafmforce)
593 else if (selfguide.gt.0) then
594 call AFMvel(Eafmforce)
597 if (tubemode.eq.1) then
599 else if (tubemode.eq.2) then
600 call calctube2(etube)
601 elseif (tubemode.eq.3) then
606 !--------------------------------------------------------
607 ! write (iout,*) "NRES_MOLEC(2),",nres_molec(2)
608 ! print *,"before",ees,evdw1,ecorr
609 if (nres_molec(2).gt.0) then
610 call ebond_nucl(estr_nucl)
611 call ebend_nucl(ebe_nucl)
612 call etor_nucl(etors_nucl)
613 call esb_gb(evdwsb,eelsb)
614 call epp_nucl_sub(evdwpp,eespp)
615 call epsb(evdwpsb,eelpsb)
617 call multibody_hb_nucl(ecorr_nucl,ecorr3_nucl,n_corr,n_corr1)
625 if (nfgtasks.gt.1) then
626 if (fg_rank.eq.0) then
627 call ecatcat(ecationcation)
630 call ecatcat(ecationcation)
632 call ecat_prot(ecation_prot)
633 if (nres_molec(2).gt.0) then
634 call eprot_sc_base(escbase)
635 call epep_sc_base(epepbase)
636 call eprot_sc_phosphate(escpho)
637 call eprot_pep_phosphate(epeppho)
639 ! call ecatcat(ecationcation)
640 ! print *,"after ebend", ebe_nucl
642 time_enecalc=time_enecalc+MPI_Wtime()-time00
644 ! print *,"Processor",myrank," computed Uconstr"
653 energia(2)=evdw2-evdw2_14
670 energia(8)=eello_turn3
671 energia(9)=eello_turn4
678 energia(19)=edihcnstr
680 energia(20)=Uconst+Uconst_back
683 energia(23)=Eafmforce
684 energia(24)=ethetacnstr
686 !---------------------------------------------------------------
693 energia(32)=estr_nucl
696 energia(35)=etors_nucl
697 energia(36)=etors_d_nucl
698 energia(37)=ecorr_nucl
699 energia(38)=ecorr3_nucl
700 !----------------------------------------------------------------------
701 ! Here are the energies showed per procesor if the are more processors
702 ! per molecule then we sum it up in sum_energy subroutine
703 ! print *," Processor",myrank," calls SUM_ENERGY"
704 energia(41)=ecation_prot
705 energia(42)=ecationcation
710 call sum_energy(energia,.true.)
711 if (dyn_ss) call dyn_set_nss
712 ! print *," Processor",myrank," left SUM_ENERGY"
714 time_sumene=time_sumene+MPI_Wtime()-time00
716 !el call enerprint(energia)
717 !elwrite(iout,*)"finish etotal"
719 end subroutine etotal
720 !-----------------------------------------------------------------------------
721 subroutine sum_energy(energia,reduce)
722 ! implicit real*8 (a-h,o-z)
723 ! include 'DIMENSIONS'
727 !MS$ATTRIBUTES C :: proc_proc
733 ! include 'COMMON.SETUP'
734 ! include 'COMMON.IOUNITS'
735 real(kind=8) :: energia(0:n_ene),enebuff(0:n_ene+1)
736 ! include 'COMMON.FFIELD'
737 ! include 'COMMON.DERIV'
738 ! include 'COMMON.INTERACT'
739 ! include 'COMMON.SBRIDGE'
740 ! include 'COMMON.CHAIN'
741 ! include 'COMMON.VAR'
742 ! include 'COMMON.CONTROL'
743 ! include 'COMMON.TIME1'
745 real(kind=8) :: evdw,evdw2,evdw2_14,ees,evdw1,ecorr,ecorr5,ecorr6
746 real(kind=8) :: eel_loc,eello_turn3,eello_turn4,eturn6,ebe,escloc
747 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,esccor,etot, &
748 eliptran,etube, Eafmforce,ethetacnstr
749 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
750 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
752 real(kind=8) :: ecation_prot,ecationcation
753 real(kind=8) :: escbase,epepbase,escpho,epeppho
757 real(kind=8) :: time00
758 if (nfgtasks.gt.1 .and. reduce) then
761 write (iout,*) "energies before REDUCE"
762 call enerprint(energia)
766 enebuff(i)=energia(i)
769 call MPI_Barrier(FG_COMM,IERR)
770 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
772 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,&
773 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
775 write (iout,*) "energies after REDUCE"
776 call enerprint(energia)
779 time_Reduce=time_Reduce+MPI_Wtime()-time00
781 if (fg_rank.eq.0) then
785 evdw2=energia(2)+energia(18)
801 eello_turn3=energia(8)
802 eello_turn4=energia(9)
809 edihcnstr=energia(19)
814 Eafmforce=energia(23)
815 ethetacnstr=energia(24)
823 estr_nucl=energia(32)
826 etors_nucl=energia(35)
827 etors_d_nucl=energia(36)
828 ecorr_nucl=energia(37)
829 ecorr3_nucl=energia(38)
830 ecation_prot=energia(41)
831 ecationcation=energia(42)
836 ! energia(41)=ecation_prot
837 ! energia(42)=ecationcation
841 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 &
842 +wang*ebe+wtor*etors+wscloc*escloc &
843 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
844 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
845 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
846 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
847 +Eafmforce+ethetacnstr &
848 +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
849 +wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
850 +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
851 +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
852 +wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
853 +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho
855 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) &
856 +wang*ebe+wtor*etors+wscloc*escloc &
857 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
858 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
859 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
860 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
861 +Eafmforce+ethetacnstr &
862 +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
863 +wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
864 +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
865 +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
866 +wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
867 +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho
873 if (isnan(etot).ne.0) energia(0)=1.0d+99
875 if (isnan(etot)) energia(0)=1.0d+99
880 idumm=proc_proc(etot,i)
882 call proc_proc(etot,i)
884 if(i.eq.1)energia(0)=1.0d+99
889 ! call enerprint(energia)
892 end subroutine sum_energy
893 !-----------------------------------------------------------------------------
894 subroutine rescale_weights(t_bath)
895 ! implicit real*8 (a-h,o-z)
899 ! include 'DIMENSIONS'
900 ! include 'COMMON.IOUNITS'
901 ! include 'COMMON.FFIELD'
902 ! include 'COMMON.SBRIDGE'
903 real(kind=8) :: kfac=2.4d0
904 real(kind=8) :: x,x2,x3,x4,x5,licznik=1.12692801104297249644
906 real(kind=8) :: t_bath,facT(6) !,facT2,facT3,facT4,facT5,facT6
907 real(kind=8) :: T0=3.0d2
910 ! facT=2*temp0/(t_bath+temp0)
911 if (rescale_mode.eq.0) then
918 else if (rescale_mode.eq.1) then
919 facT(1)=kfac/(kfac-1.0d0+t_bath/temp0)
920 facT(2)=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
921 facT(3)=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
922 facT(4)=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
923 facT(5)=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
925 !#if defined(WHAM_RUN) || defined(CLUSTER)
927 ! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
928 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
935 else if (rescale_mode.eq.2) then
941 facT(1)=licznik/dlog(dexp(x)+dexp(-x))
942 facT(2)=licznik/dlog(dexp(x2)+dexp(-x2))
943 facT(3)=licznik/dlog(dexp(x3)+dexp(-x3))
944 facT(4)=licznik/dlog(dexp(x4)+dexp(-x4))
945 facT(5)=licznik/dlog(dexp(x5)+dexp(-x5))
947 !#if defined(WHAM_RUN) || defined(CLUSTER)
949 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
957 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
958 write (*,*) "Wrong RESCALE_MODE",rescale_mode
960 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
964 welec=weights(3)*fact(1)
965 wcorr=weights(4)*fact(3)
966 wcorr5=weights(5)*fact(4)
967 wcorr6=weights(6)*fact(5)
968 wel_loc=weights(7)*fact(2)
969 wturn3=weights(8)*fact(2)
970 wturn4=weights(9)*fact(3)
971 wturn6=weights(10)*fact(5)
972 wtor=weights(13)*fact(1)
973 wtor_d=weights(14)*fact(2)
974 wsccor=weights(21)*fact(1)
977 end subroutine rescale_weights
978 !-----------------------------------------------------------------------------
979 subroutine enerprint(energia)
980 ! implicit real*8 (a-h,o-z)
981 ! include 'DIMENSIONS'
982 ! include 'COMMON.IOUNITS'
983 ! include 'COMMON.FFIELD'
984 ! include 'COMMON.SBRIDGE'
985 ! include 'COMMON.MD'
986 real(kind=8) :: energia(0:n_ene)
988 real(kind=8) :: etot,evdw,evdw2,ees,evdw1,ecorr,ecorr5,ecorr6,eel_loc
989 real(kind=8) :: eello_turn6,eello_turn3,eello_turn4,ebe,escloc
990 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,Uconst,esccor,eliptran,&
991 etube,ethetacnstr,Eafmforce
992 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
993 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
995 real(kind=8) :: ecation_prot,ecationcation
996 real(kind=8) :: escbase,epepbase,escpho,epeppho
1002 evdw2=energia(2)+energia(18)
1014 eello_turn3=energia(8)
1015 eello_turn4=energia(9)
1016 eello_turn6=energia(10)
1022 edihcnstr=energia(19)
1026 eliptran=energia(22)
1027 Eafmforce=energia(23)
1028 ethetacnstr=energia(24)
1036 estr_nucl=energia(32)
1037 ebe_nucl=energia(33)
1039 etors_nucl=energia(35)
1040 etors_d_nucl=energia(36)
1041 ecorr_nucl=energia(37)
1042 ecorr3_nucl=energia(38)
1043 ecation_prot=energia(41)
1044 ecationcation=energia(42)
1046 epepbase=energia(47)
1050 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,&
1051 estr,wbond,ebe,wang,&
1052 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
1054 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
1055 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,&
1056 edihcnstr,ethetacnstr,ebr*nss,&
1057 Uconst,eliptran,wliptran,Eafmforce,etube,wtube, & ! till now protein
1058 estr_nucl,wbond_nucl,ebe_nucl,wang_nucl, &
1059 evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb,&
1060 evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl,&
1061 etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
1062 ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, &
1063 escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
1065 10 format (/'Virtual-chain energies:'// &
1066 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
1067 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
1068 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
1069 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ &
1070 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
1071 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
1072 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
1073 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
1074 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
1075 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
1076 ' (SS bridges & dist. cnstr.)'/ &
1077 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1078 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1079 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1080 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
1081 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
1082 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
1083 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
1084 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
1085 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
1086 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
1087 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
1088 'UCONST= ',1pE16.6,' (Constraint energy)'/ &
1089 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/&
1090 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
1091 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
1092 'ESTR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
1093 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
1094 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
1095 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
1096 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
1097 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
1098 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
1099 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
1100 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
1101 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
1102 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
1103 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
1104 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
1105 'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ &
1106 'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ &
1107 'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ &
1108 'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
1109 'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
1110 'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
1111 'ETOT= ',1pE16.6,' (total)')
1113 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,&
1114 estr,wbond,ebe,wang,&
1115 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
1117 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
1118 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,&
1119 ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc, &
1121 estr_nucl,wbond_nucl, ebe_nucl,wang_nucl,&
1122 evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb&
1123 evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl&
1124 etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
1125 ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, &
1126 escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
1128 10 format (/'Virtual-chain energies:'// &
1129 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
1130 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
1131 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
1132 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
1133 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
1134 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
1135 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
1136 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
1137 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
1138 ' (SS bridges & dist. cnstr.)'/ &
1139 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1140 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1141 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1142 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
1143 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
1144 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
1145 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
1146 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
1147 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
1148 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
1149 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
1150 'UCONST=',1pE16.6,' (Constraint energy)'/ &
1151 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ &
1152 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
1153 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
1154 'ESTR_nucl= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
1155 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
1156 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
1157 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
1158 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
1159 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
1160 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
1161 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
1162 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
1163 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
1164 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
1165 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
1166 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
1167 'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ &
1168 'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ &
1169 'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ &
1170 'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
1171 'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
1172 'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
1173 'ETOT= ',1pE16.6,' (total)')
1176 end subroutine enerprint
1177 !-----------------------------------------------------------------------------
1178 subroutine elj(evdw)
1180 ! This subroutine calculates the interaction energy of nonbonded side chains
1181 ! assuming the LJ potential of interaction.
1183 ! implicit real*8 (a-h,o-z)
1184 ! include 'DIMENSIONS'
1185 real(kind=8),parameter :: accur=1.0d-10
1186 ! include 'COMMON.GEO'
1187 ! include 'COMMON.VAR'
1188 ! include 'COMMON.LOCAL'
1189 ! include 'COMMON.CHAIN'
1190 ! include 'COMMON.DERIV'
1191 ! include 'COMMON.INTERACT'
1192 ! include 'COMMON.TORSION'
1193 ! include 'COMMON.SBRIDGE'
1194 ! include 'COMMON.NAMES'
1195 ! include 'COMMON.IOUNITS'
1196 ! include 'COMMON.CONTACTS'
1197 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1198 integer :: num_conti
1200 integer :: i,itypi,iint,j,itypi1,itypj,k
1201 real(kind=8) :: rij,rcut,fcont,fprimcont,rrij
1202 real(kind=8) :: evdw,xi,yi,zi,xj,yj,zj
1203 real(kind=8) :: eps0ij,fac,e1,e2,evdwij,sigij,r0ij
1205 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1207 ! allocate(num_cont(iatsc_s:iatsc_e)) !(maxres) nnt,nct-2
1208 ! allocate(jcont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres) (maxconts=maxres/4)
1209 ! allocate(facont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres)
1210 ! allocate(gacont(3,nres/4,iatsc_s:iatsc_e)) !(3,maxconts,maxres)
1212 do i=iatsc_s,iatsc_e
1213 itypi=iabs(itype(i,1))
1214 if (itypi.eq.ntyp1) cycle
1215 itypi1=iabs(itype(i+1,1))
1222 ! Calculate SC interaction energy.
1224 do iint=1,nint_gr(i)
1225 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1226 !d & 'iend=',iend(i,iint)
1227 do j=istart(i,iint),iend(i,iint)
1228 itypj=iabs(itype(j,1))
1229 if (itypj.eq.ntyp1) cycle
1233 ! Change 12/1/95 to calculate four-body interactions
1234 rij=xj*xj+yj*yj+zj*zj
1236 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1237 eps0ij=eps(itypi,itypj)
1239 e1=fac*fac*aa_aq(itypi,itypj)
1240 e2=fac*bb_aq(itypi,itypj)
1242 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1243 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1244 !d write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1245 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1246 !d & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1247 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1250 ! Calculate the components of the gradient in DC and X
1252 fac=-rrij*(e1+evdwij)
1257 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1258 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1259 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1260 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1264 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1268 ! 12/1/95, revised on 5/20/97
1270 ! Calculate the contact function. The ith column of the array JCONT will
1271 ! contain the numbers of atoms that make contacts with the atom I (of numbers
1272 ! greater than I). The arrays FACONT and GACONT will contain the values of
1273 ! the contact function and its derivative.
1275 ! Uncomment next line, if the correlation interactions include EVDW explicitly.
1276 ! if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1277 ! Uncomment next line, if the correlation interactions are contact function only
1278 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1280 sigij=sigma(itypi,itypj)
1281 r0ij=rs0(itypi,itypj)
1283 ! Check whether the SC's are not too far to make a contact.
1286 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1287 ! Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1289 if (fcont.gt.0.0D0) then
1290 ! If the SC-SC distance if close to sigma, apply spline.
1291 !Adam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1292 !Adam & fcont1,fprimcont1)
1293 !Adam fcont1=1.0d0-fcont1
1294 !Adam if (fcont1.gt.0.0d0) then
1295 !Adam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1296 !Adam fcont=fcont*fcont1
1298 ! Uncomment following 4 lines to have the geometric average of the epsilon0's
1299 !ga eps0ij=1.0d0/dsqrt(eps0ij)
1301 !ga gg(k)=gg(k)*eps0ij
1303 !ga eps0ij=-evdwij*eps0ij
1304 ! Uncomment for AL's type of SC correlation interactions.
1305 !adam eps0ij=-evdwij
1306 num_conti=num_conti+1
1307 jcont(num_conti,i)=j
1308 facont(num_conti,i)=fcont*eps0ij
1309 fprimcont=eps0ij*fprimcont/rij
1311 !Adam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1312 !Adam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1313 !Adam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1314 ! Uncomment following 3 lines for Skolnick's type of SC correlation.
1315 gacont(1,num_conti,i)=-fprimcont*xj
1316 gacont(2,num_conti,i)=-fprimcont*yj
1317 gacont(3,num_conti,i)=-fprimcont*zj
1318 !d write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1319 !d write (iout,'(2i3,3f10.5)')
1320 !d & i,j,(gacont(kk,num_conti,i),kk=1,3)
1326 num_cont(i)=num_conti
1330 gvdwc(j,i)=expon*gvdwc(j,i)
1331 gvdwx(j,i)=expon*gvdwx(j,i)
1334 !******************************************************************************
1338 ! To save time, the factor of EXPON has been extracted from ALL components
1339 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
1342 !******************************************************************************
1345 !-----------------------------------------------------------------------------
1346 subroutine eljk(evdw)
1348 ! This subroutine calculates the interaction energy of nonbonded side chains
1349 ! assuming the LJK potential of interaction.
1351 ! implicit real*8 (a-h,o-z)
1352 ! include 'DIMENSIONS'
1353 ! include 'COMMON.GEO'
1354 ! include 'COMMON.VAR'
1355 ! include 'COMMON.LOCAL'
1356 ! include 'COMMON.CHAIN'
1357 ! include 'COMMON.DERIV'
1358 ! include 'COMMON.INTERACT'
1359 ! include 'COMMON.IOUNITS'
1360 ! include 'COMMON.NAMES'
1361 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1364 integer :: i,iint,j,itypi,itypi1,k,itypj
1365 real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij
1366 real(kind=8) :: evdw,rij,r_shift_inv,fac,e1,e2,evdwij
1368 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1370 do i=iatsc_s,iatsc_e
1371 itypi=iabs(itype(i,1))
1372 if (itypi.eq.ntyp1) cycle
1373 itypi1=iabs(itype(i+1,1))
1378 ! Calculate SC interaction energy.
1380 do iint=1,nint_gr(i)
1381 do j=istart(i,iint),iend(i,iint)
1382 itypj=iabs(itype(j,1))
1383 if (itypj.eq.ntyp1) cycle
1387 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1388 fac_augm=rrij**expon
1389 e_augm=augm(itypi,itypj)*fac_augm
1390 r_inv_ij=dsqrt(rrij)
1392 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1393 fac=r_shift_inv**expon
1394 e1=fac*fac*aa_aq(itypi,itypj)
1395 e2=fac*bb_aq(itypi,itypj)
1397 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1398 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1399 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1400 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1401 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1402 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1403 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1406 ! Calculate the components of the gradient in DC and X
1408 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1413 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1414 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1415 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1416 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1420 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1428 gvdwc(j,i)=expon*gvdwc(j,i)
1429 gvdwx(j,i)=expon*gvdwx(j,i)
1434 !-----------------------------------------------------------------------------
1435 subroutine ebp(evdw)
1437 ! This subroutine calculates the interaction energy of nonbonded side chains
1438 ! assuming the Berne-Pechukas potential of interaction.
1442 ! implicit real*8 (a-h,o-z)
1443 ! include 'DIMENSIONS'
1444 ! include 'COMMON.GEO'
1445 ! include 'COMMON.VAR'
1446 ! include 'COMMON.LOCAL'
1447 ! include 'COMMON.CHAIN'
1448 ! include 'COMMON.DERIV'
1449 ! include 'COMMON.NAMES'
1450 ! include 'COMMON.INTERACT'
1451 ! include 'COMMON.IOUNITS'
1452 ! include 'COMMON.CALC'
1454 !el integer :: icall
1455 !el common /srutu/ icall
1456 ! double precision rrsave(maxdim)
1459 integer :: iint,itypi,itypi1,itypj
1460 real(kind=8) :: rrij,xi,yi,zi
1461 real(kind=8) :: evdw,fac,e1,e2,sigm,epsi
1463 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1465 ! if (icall.eq.0) then
1471 do i=iatsc_s,iatsc_e
1472 itypi=iabs(itype(i,1))
1473 if (itypi.eq.ntyp1) cycle
1474 itypi1=iabs(itype(i+1,1))
1478 dxi=dc_norm(1,nres+i)
1479 dyi=dc_norm(2,nres+i)
1480 dzi=dc_norm(3,nres+i)
1481 ! dsci_inv=dsc_inv(itypi)
1482 dsci_inv=vbld_inv(i+nres)
1484 ! Calculate SC interaction energy.
1486 do iint=1,nint_gr(i)
1487 do j=istart(i,iint),iend(i,iint)
1489 itypj=iabs(itype(j,1))
1490 if (itypj.eq.ntyp1) cycle
1491 ! dscj_inv=dsc_inv(itypj)
1492 dscj_inv=vbld_inv(j+nres)
1493 chi1=chi(itypi,itypj)
1494 chi2=chi(itypj,itypi)
1501 alf12=0.5D0*(alf1+alf2)
1502 ! For diagnostics only!!!
1515 dxj=dc_norm(1,nres+j)
1516 dyj=dc_norm(2,nres+j)
1517 dzj=dc_norm(3,nres+j)
1518 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1519 !d if (icall.eq.0) then
1525 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
1527 ! Calculate whole angle-dependent part of epsilon and contributions
1528 ! to its derivatives
1529 fac=(rrij*sigsq)**expon2
1530 e1=fac*fac*aa_aq(itypi,itypj)
1531 e2=fac*bb_aq(itypi,itypj)
1532 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1533 eps2der=evdwij*eps3rt
1534 eps3der=evdwij*eps2rt
1535 evdwij=evdwij*eps2rt*eps3rt
1538 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1539 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1540 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1541 !d & restyp(itypi,1),i,restyp(itypj,1),j,
1542 !d & epsi,sigm,chi1,chi2,chip1,chip2,
1543 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1544 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
1547 ! Calculate gradient components.
1548 e1=e1*eps1*eps2rt**2*eps3rt**2
1549 fac=-expon*(e1+evdwij)
1552 ! Calculate radial part of the gradient
1556 ! Calculate the angular part of the gradient and sum add the contributions
1557 ! to the appropriate components of the Cartesian gradient.
1565 !-----------------------------------------------------------------------------
1566 subroutine egb(evdw)
1568 ! This subroutine calculates the interaction energy of nonbonded side chains
1569 ! assuming the Gay-Berne potential of interaction.
1572 ! implicit real*8 (a-h,o-z)
1573 ! include 'DIMENSIONS'
1574 ! include 'COMMON.GEO'
1575 ! include 'COMMON.VAR'
1576 ! include 'COMMON.LOCAL'
1577 ! include 'COMMON.CHAIN'
1578 ! include 'COMMON.DERIV'
1579 ! include 'COMMON.NAMES'
1580 ! include 'COMMON.INTERACT'
1581 ! include 'COMMON.IOUNITS'
1582 ! include 'COMMON.CALC'
1583 ! include 'COMMON.CONTROL'
1584 ! include 'COMMON.SBRIDGE'
1587 integer :: iint,itypi,itypi1,itypj,subchap
1588 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
1589 real(kind=8) :: evdw,sig0ij
1590 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
1591 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
1592 sslipi,sslipj,faclip
1594 real(kind=8) :: fracinbuf
1596 !cccc energy_dec=.false.
1597 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1600 ! if (icall.eq.0) lprn=.false.
1602 do i=iatsc_s,iatsc_e
1603 !C print *,"I am in EVDW",i
1604 itypi=iabs(itype(i,1))
1605 ! if (i.ne.47) cycle
1606 if (itypi.eq.ntyp1) cycle
1607 itypi1=iabs(itype(i+1,1))
1611 xi=dmod(xi,boxxsize)
1612 if (xi.lt.0) xi=xi+boxxsize
1613 yi=dmod(yi,boxysize)
1614 if (yi.lt.0) yi=yi+boxysize
1615 zi=dmod(zi,boxzsize)
1616 if (zi.lt.0) zi=zi+boxzsize
1618 if ((zi.gt.bordlipbot) &
1619 .and.(zi.lt.bordliptop)) then
1620 !C the energy transfer exist
1621 if (zi.lt.buflipbot) then
1622 !C what fraction I am in
1624 ((zi-bordlipbot)/lipbufthick)
1625 !C lipbufthick is thickenes of lipid buffore
1626 sslipi=sscalelip(fracinbuf)
1627 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1628 elseif (zi.gt.bufliptop) then
1629 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1630 sslipi=sscalelip(fracinbuf)
1631 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1640 ! print *, sslipi,ssgradlipi
1641 dxi=dc_norm(1,nres+i)
1642 dyi=dc_norm(2,nres+i)
1643 dzi=dc_norm(3,nres+i)
1644 ! dsci_inv=dsc_inv(itypi)
1645 dsci_inv=vbld_inv(i+nres)
1646 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1647 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1649 ! Calculate SC interaction energy.
1651 do iint=1,nint_gr(i)
1652 do j=istart(i,iint),iend(i,iint)
1653 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1654 call dyn_ssbond_ene(i,j,evdwij)
1656 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1657 'evdw',i,j,evdwij,' ss'
1658 ! if (energy_dec) write (iout,*) &
1659 ! 'evdw',i,j,evdwij,' ss'
1660 do k=j+1,iend(i,iint)
1661 !C search over all next residues
1662 if (dyn_ss_mask(k)) then
1663 !C check if they are cysteins
1664 !C write(iout,*) 'k=',k
1666 !c write(iout,*) "PRZED TRI", evdwij
1667 ! evdwij_przed_tri=evdwij
1668 call triple_ssbond_ene(i,j,k,evdwij)
1669 !c if(evdwij_przed_tri.ne.evdwij) then
1670 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1673 !c write(iout,*) "PO TRI", evdwij
1674 !C call the energy function that removes the artifical triple disulfide
1675 !C bond the soubroutine is located in ssMD.F
1677 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1678 'evdw',i,j,evdwij,'tss'
1679 endif!dyn_ss_mask(k)
1683 itypj=iabs(itype(j,1))
1684 if (itypj.eq.ntyp1) cycle
1685 ! if (j.ne.78) cycle
1686 ! dscj_inv=dsc_inv(itypj)
1687 dscj_inv=vbld_inv(j+nres)
1688 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,&
1689 ! 1.0d0/vbld(j+nres) !d
1690 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
1691 sig0ij=sigma(itypi,itypj)
1692 chi1=chi(itypi,itypj)
1693 chi2=chi(itypj,itypi)
1700 alf12=0.5D0*(alf1+alf2)
1701 ! For diagnostics only!!!
1714 xj=dmod(xj,boxxsize)
1715 if (xj.lt.0) xj=xj+boxxsize
1716 yj=dmod(yj,boxysize)
1717 if (yj.lt.0) yj=yj+boxysize
1718 zj=dmod(zj,boxzsize)
1719 if (zj.lt.0) zj=zj+boxzsize
1720 ! print *,"tu",xi,yi,zi,xj,yj,zj
1721 ! print *,"tu2",j,j+nres,c(1,j),c(1,j+nres)
1722 ! this fragment set correct epsilon for lipid phase
1723 if ((zj.gt.bordlipbot) &
1724 .and.(zj.lt.bordliptop)) then
1725 !C the energy transfer exist
1726 if (zj.lt.buflipbot) then
1727 !C what fraction I am in
1729 ((zj-bordlipbot)/lipbufthick)
1730 !C lipbufthick is thickenes of lipid buffore
1731 sslipj=sscalelip(fracinbuf)
1732 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1733 elseif (zj.gt.bufliptop) then
1734 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1735 sslipj=sscalelip(fracinbuf)
1736 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1745 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1746 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1747 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1748 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1749 !------------------------------------------------
1750 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1758 xj=xj_safe+xshift*boxxsize
1759 yj=yj_safe+yshift*boxysize
1760 zj=zj_safe+zshift*boxzsize
1761 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1762 if(dist_temp.lt.dist_init) then
1772 if (subchap.eq.1) then
1781 dxj=dc_norm(1,nres+j)
1782 dyj=dc_norm(2,nres+j)
1783 dzj=dc_norm(3,nres+j)
1784 ! write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1785 ! write (iout,*) "j",j," dc_norm",& !d
1786 ! dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1787 ! write(iout,*)"rrij ",rrij
1788 ! write(iout,*)"xj yj zj ", xj, yj, zj
1789 ! write(iout,*)"xi yi zi ", xi, yi, zi
1790 ! write(iout,*)"c ", c(1,:), c(2,:), c(3,:)
1791 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1793 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
1794 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
1795 ! print *,sss_ele_cut,sss_ele_grad,&
1796 ! 1.0d0/(rij),r_cut_ele,rlamb_ele
1797 if (sss_ele_cut.le.0.0) cycle
1798 ! Calculate angle-dependent terms of energy and contributions to their
1802 sig=sig0ij*dsqrt(sigsq)
1803 rij_shift=1.0D0/rij-sig+sig0ij
1804 ! write(iout,*)" rij_shift",rij_shift," rij",rij," sig",sig,&
1806 ! for diagnostics; uncomment
1807 ! rij_shift=1.2*sig0ij
1808 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1809 if (rij_shift.le.0.0D0) then
1811 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1812 !d & restyp(itypi,1),i,restyp(itypj,1),j,
1813 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1817 !---------------------------------------------------------------
1818 rij_shift=1.0D0/rij_shift
1819 fac=rij_shift**expon
1821 e1=fac*fac*aa!(itypi,itypj)
1822 e2=fac*bb!(itypi,itypj)
1823 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1824 eps2der=evdwij*eps3rt
1825 eps3der=evdwij*eps2rt
1826 ! write(iout,*)"aa, bb ",aa(:,:),bb(:,:)
1827 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,& !d
1828 ! " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2," fac",fac !d
1829 evdwij=evdwij*eps2rt*eps3rt
1830 evdw=evdw+evdwij*sss_ele_cut
1832 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1833 epsi=bb**2/aa!(itypi,itypj)
1834 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1835 restyp(itypi,1),i,restyp(itypj,1),j, &
1836 epsi,sigm,chi1,chi2,chip1,chip2, &
1837 eps1,eps2rt**2,eps3rt**2,sig,sig0ij, &
1838 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, &
1842 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2e10.2,e11.3)')&
1843 'evdw',i,j,evdwij,xi,xj,rij !,"egb"
1844 !C print *,i,j,c(1,i),c(1,j),c(2,i),c(2,j),c(3,i),c(3,j)
1845 ! if (energy_dec) write (iout,*) &
1847 ! print *,"ZALAMKA", evdw
1849 ! Calculate gradient components.
1850 e1=e1*eps1*eps2rt**2*eps3rt**2
1851 fac=-expon*(e1+evdwij)*rij_shift
1854 ! print *,'before fac',fac,rij,evdwij
1855 fac=fac+evdwij*sss_ele_grad/sss_ele_cut&
1856 /sigma(itypi,itypj)*rij
1857 ! print *,'grad part scale',fac, &
1858 ! evdwij*sss_ele_grad/sss_ele_cut &
1859 ! /sigma(itypi,itypj)*rij
1861 ! Calculate the radial part of the gradient
1865 !C Calculate the radial part of the gradient
1866 gg_lipi(3)=eps1*(eps2rt*eps2rt)&
1867 *(eps3rt*eps3rt)*sss_ele_cut/2.0d0*(faclip*faclip*&
1868 (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))&
1869 +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1870 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1871 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1873 ! print *,'before sc_grad', gg(1),gg(2),gg(3)
1874 ! Calculate angular part of the gradient.
1880 ! print *,"ZALAMKA", evdw
1881 ! write (iout,*) "Number of loop steps in EGB:",ind
1882 !ccc energy_dec=.false.
1885 !-----------------------------------------------------------------------------
1886 subroutine egbv(evdw)
1888 ! This subroutine calculates the interaction energy of nonbonded side chains
1889 ! assuming the Gay-Berne-Vorobjev potential of interaction.
1893 ! implicit real*8 (a-h,o-z)
1894 ! include 'DIMENSIONS'
1895 ! include 'COMMON.GEO'
1896 ! include 'COMMON.VAR'
1897 ! include 'COMMON.LOCAL'
1898 ! include 'COMMON.CHAIN'
1899 ! include 'COMMON.DERIV'
1900 ! include 'COMMON.NAMES'
1901 ! include 'COMMON.INTERACT'
1902 ! include 'COMMON.IOUNITS'
1903 ! include 'COMMON.CALC'
1905 !el integer :: icall
1906 !el common /srutu/ icall
1909 integer :: iint,itypi,itypi1,itypj
1910 real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2,sigm
1911 real(kind=8) :: evdw,sig0ij,sig,rij_shift,epsi
1913 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1916 ! if (icall.eq.0) lprn=.true.
1918 do i=iatsc_s,iatsc_e
1919 itypi=iabs(itype(i,1))
1920 if (itypi.eq.ntyp1) cycle
1921 itypi1=iabs(itype(i+1,1))
1925 dxi=dc_norm(1,nres+i)
1926 dyi=dc_norm(2,nres+i)
1927 dzi=dc_norm(3,nres+i)
1928 ! dsci_inv=dsc_inv(itypi)
1929 dsci_inv=vbld_inv(i+nres)
1931 ! Calculate SC interaction energy.
1933 do iint=1,nint_gr(i)
1934 do j=istart(i,iint),iend(i,iint)
1936 itypj=iabs(itype(j,1))
1937 if (itypj.eq.ntyp1) cycle
1938 ! dscj_inv=dsc_inv(itypj)
1939 dscj_inv=vbld_inv(j+nres)
1940 sig0ij=sigma(itypi,itypj)
1941 r0ij=r0(itypi,itypj)
1942 chi1=chi(itypi,itypj)
1943 chi2=chi(itypj,itypi)
1950 alf12=0.5D0*(alf1+alf2)
1951 ! For diagnostics only!!!
1964 dxj=dc_norm(1,nres+j)
1965 dyj=dc_norm(2,nres+j)
1966 dzj=dc_norm(3,nres+j)
1967 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1969 ! Calculate angle-dependent terms of energy and contributions to their
1973 sig=sig0ij*dsqrt(sigsq)
1974 rij_shift=1.0D0/rij-sig+r0ij
1975 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1976 if (rij_shift.le.0.0D0) then
1981 !---------------------------------------------------------------
1982 rij_shift=1.0D0/rij_shift
1983 fac=rij_shift**expon
1984 e1=fac*fac*aa_aq(itypi,itypj)
1985 e2=fac*bb_aq(itypi,itypj)
1986 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1987 eps2der=evdwij*eps3rt
1988 eps3der=evdwij*eps2rt
1989 fac_augm=rrij**expon
1990 e_augm=augm(itypi,itypj)*fac_augm
1991 evdwij=evdwij*eps2rt*eps3rt
1992 evdw=evdw+evdwij+e_augm
1994 sigm=dabs(aa_aq(itypi,itypj)/&
1995 bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1996 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1997 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1998 restyp(itypi,1),i,restyp(itypj,1),j,&
1999 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
2000 chi1,chi2,chip1,chip2,&
2001 eps1,eps2rt**2,eps3rt**2,&
2002 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
2005 ! Calculate gradient components.
2006 e1=e1*eps1*eps2rt**2*eps3rt**2
2007 fac=-expon*(e1+evdwij)*rij_shift
2009 fac=rij*fac-2*expon*rrij*e_augm
2010 ! Calculate the radial part of the gradient
2014 ! Calculate angular part of the gradient.
2020 !-----------------------------------------------------------------------------
2021 !el subroutine sc_angular in module geometry
2022 !-----------------------------------------------------------------------------
2023 subroutine e_softsphere(evdw)
2025 ! This subroutine calculates the interaction energy of nonbonded side chains
2026 ! assuming the LJ potential of interaction.
2028 ! implicit real*8 (a-h,o-z)
2029 ! include 'DIMENSIONS'
2030 real(kind=8),parameter :: accur=1.0d-10
2031 ! include 'COMMON.GEO'
2032 ! include 'COMMON.VAR'
2033 ! include 'COMMON.LOCAL'
2034 ! include 'COMMON.CHAIN'
2035 ! include 'COMMON.DERIV'
2036 ! include 'COMMON.INTERACT'
2037 ! include 'COMMON.TORSION'
2038 ! include 'COMMON.SBRIDGE'
2039 ! include 'COMMON.NAMES'
2040 ! include 'COMMON.IOUNITS'
2041 ! include 'COMMON.CONTACTS'
2042 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
2043 !d print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2045 integer :: i,iint,j,itypi,itypi1,itypj,k
2046 real(kind=8) :: evdw,xj,yj,zj,xi,yi,zi,rij,r0ij,r0ijsq,evdwij
2050 do i=iatsc_s,iatsc_e
2051 itypi=iabs(itype(i,1))
2052 if (itypi.eq.ntyp1) cycle
2053 itypi1=iabs(itype(i+1,1))
2058 ! Calculate SC interaction energy.
2060 do iint=1,nint_gr(i)
2061 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2062 !d & 'iend=',iend(i,iint)
2063 do j=istart(i,iint),iend(i,iint)
2064 itypj=iabs(itype(j,1))
2065 if (itypj.eq.ntyp1) cycle
2069 rij=xj*xj+yj*yj+zj*zj
2070 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2071 r0ij=r0(itypi,itypj)
2073 ! print *,i,j,r0ij,dsqrt(rij)
2074 if (rij.lt.r0ijsq) then
2075 evdwij=0.25d0*(rij-r0ijsq)**2
2083 ! Calculate the components of the gradient in DC and X
2089 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2090 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2091 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2092 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2096 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2103 end subroutine e_softsphere
2104 !-----------------------------------------------------------------------------
2105 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2107 ! Soft-sphere potential of p-p interaction
2109 ! implicit real*8 (a-h,o-z)
2110 ! include 'DIMENSIONS'
2111 ! include 'COMMON.CONTROL'
2112 ! include 'COMMON.IOUNITS'
2113 ! include 'COMMON.GEO'
2114 ! include 'COMMON.VAR'
2115 ! include 'COMMON.LOCAL'
2116 ! include 'COMMON.CHAIN'
2117 ! include 'COMMON.DERIV'
2118 ! include 'COMMON.INTERACT'
2119 ! include 'COMMON.CONTACTS'
2120 ! include 'COMMON.TORSION'
2121 ! include 'COMMON.VECTORS'
2122 ! include 'COMMON.FFIELD'
2123 real(kind=8),dimension(3) :: ggg
2124 !d write(iout,*) 'In EELEC_soft_sphere'
2126 integer :: i,j,k,num_conti,iteli,itelj
2127 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
2128 real(kind=8) :: dxi,dyi,dzi,xmedi,ymedi,zmedi,r0ij,r0ijsq
2129 real(kind=8) :: dxj,dyj,dzj,xj,yj,zj,rij,evdw1ij,fac
2137 do i=iatel_s,iatel_e
2138 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
2142 xmedi=c(1,i)+0.5d0*dxi
2143 ymedi=c(2,i)+0.5d0*dyi
2144 zmedi=c(3,i)+0.5d0*dzi
2146 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2147 do j=ielstart(i),ielend(i)
2148 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
2152 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2153 r0ij=rpp(iteli,itelj)
2158 xj=c(1,j)+0.5D0*dxj-xmedi
2159 yj=c(2,j)+0.5D0*dyj-ymedi
2160 zj=c(3,j)+0.5D0*dzj-zmedi
2161 rij=xj*xj+yj*yj+zj*zj
2162 if (rij.lt.r0ijsq) then
2163 evdw1ij=0.25d0*(rij-r0ijsq)**2
2171 ! Calculate contributions to the Cartesian gradient.
2177 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2178 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2181 ! Loop over residues i+1 thru j-1.
2185 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2190 !grad do i=nnt,nct-1
2192 !grad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2194 !grad do j=i+1,nct-1
2196 !grad gelc(k,i)=gelc(k,i)+gelc(k,j)
2201 end subroutine eelec_soft_sphere
2202 !-----------------------------------------------------------------------------
2203 subroutine vec_and_deriv
2204 ! implicit real*8 (a-h,o-z)
2205 ! include 'DIMENSIONS'
2209 ! include 'COMMON.IOUNITS'
2210 ! include 'COMMON.GEO'
2211 ! include 'COMMON.VAR'
2212 ! include 'COMMON.LOCAL'
2213 ! include 'COMMON.CHAIN'
2214 ! include 'COMMON.VECTORS'
2215 ! include 'COMMON.SETUP'
2216 ! include 'COMMON.TIME1'
2217 real(kind=8),dimension(3,3,2) :: uyder,uzder
2218 real(kind=8),dimension(2) :: vbld_inv_temp
2219 ! Compute the local reference systems. For reference system (i), the
2220 ! X-axis points from CA(i) to CA(i+1), the Y axis is in the
2221 ! CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2224 real(kind=8) :: facy,fac,costh
2227 do i=ivec_start,ivec_end
2231 if (i.eq.nres-1) then
2232 ! Case of the last full residue
2233 ! Compute the Z-axis
2234 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2235 costh=dcos(pi-theta(nres))
2236 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2240 ! Compute the derivatives of uz
2242 uzder(2,1,1)=-dc_norm(3,i-1)
2243 uzder(3,1,1)= dc_norm(2,i-1)
2244 uzder(1,2,1)= dc_norm(3,i-1)
2246 uzder(3,2,1)=-dc_norm(1,i-1)
2247 uzder(1,3,1)=-dc_norm(2,i-1)
2248 uzder(2,3,1)= dc_norm(1,i-1)
2251 uzder(2,1,2)= dc_norm(3,i)
2252 uzder(3,1,2)=-dc_norm(2,i)
2253 uzder(1,2,2)=-dc_norm(3,i)
2255 uzder(3,2,2)= dc_norm(1,i)
2256 uzder(1,3,2)= dc_norm(2,i)
2257 uzder(2,3,2)=-dc_norm(1,i)
2259 ! Compute the Y-axis
2262 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2264 ! Compute the derivatives of uy
2267 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) &
2268 -dc_norm(k,i)*dc_norm(j,i-1)
2269 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2271 uyder(j,j,1)=uyder(j,j,1)-costh
2272 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2277 uygrad(l,k,j,i)=uyder(l,k,j)
2278 uzgrad(l,k,j,i)=uzder(l,k,j)
2282 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2283 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2284 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2285 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2288 ! Compute the Z-axis
2289 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2290 costh=dcos(pi-theta(i+2))
2291 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2295 ! Compute the derivatives of uz
2297 uzder(2,1,1)=-dc_norm(3,i+1)
2298 uzder(3,1,1)= dc_norm(2,i+1)
2299 uzder(1,2,1)= dc_norm(3,i+1)
2301 uzder(3,2,1)=-dc_norm(1,i+1)
2302 uzder(1,3,1)=-dc_norm(2,i+1)
2303 uzder(2,3,1)= dc_norm(1,i+1)
2306 uzder(2,1,2)= dc_norm(3,i)
2307 uzder(3,1,2)=-dc_norm(2,i)
2308 uzder(1,2,2)=-dc_norm(3,i)
2310 uzder(3,2,2)= dc_norm(1,i)
2311 uzder(1,3,2)= dc_norm(2,i)
2312 uzder(2,3,2)=-dc_norm(1,i)
2314 ! Compute the Y-axis
2317 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2319 ! Compute the derivatives of uy
2322 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) &
2323 -dc_norm(k,i)*dc_norm(j,i+1)
2324 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2326 uyder(j,j,1)=uyder(j,j,1)-costh
2327 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2332 uygrad(l,k,j,i)=uyder(l,k,j)
2333 uzgrad(l,k,j,i)=uzder(l,k,j)
2337 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2338 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2339 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2340 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2344 vbld_inv_temp(1)=vbld_inv(i+1)
2345 if (i.lt.nres-1) then
2346 vbld_inv_temp(2)=vbld_inv(i+2)
2348 vbld_inv_temp(2)=vbld_inv(i)
2353 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2354 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2359 #if defined(PARVEC) && defined(MPI)
2360 if (nfgtasks1.gt.1) then
2362 ! print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2363 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2364 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2365 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),&
2366 MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2368 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),&
2369 MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2371 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),&
2372 ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),&
2373 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2374 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),&
2375 ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),&
2376 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2377 time_gather=time_gather+MPI_Wtime()-time00
2379 ! if (fg_rank.eq.0) then
2380 ! write (iout,*) "Arrays UY and UZ"
2382 ! write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2388 end subroutine vec_and_deriv
2389 !-----------------------------------------------------------------------------
2390 subroutine check_vecgrad
2391 ! implicit real*8 (a-h,o-z)
2392 ! include 'DIMENSIONS'
2393 ! include 'COMMON.IOUNITS'
2394 ! include 'COMMON.GEO'
2395 ! include 'COMMON.VAR'
2396 ! include 'COMMON.LOCAL'
2397 ! include 'COMMON.CHAIN'
2398 ! include 'COMMON.VECTORS'
2399 real(kind=8),dimension(3,3,2,nres) :: uygradt,uzgradt !(3,3,2,maxres)
2400 real(kind=8),dimension(3,nres) :: uyt,uzt !(3,maxres)
2401 real(kind=8),dimension(3,3,2) :: uygradn,uzgradn
2402 real(kind=8),dimension(3) :: erij
2403 real(kind=8) :: delta=1.0d-7
2409 !rc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2410 !rc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2411 !rc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2412 !d write(iout,'(2i5,2(3f10.5,5x))') i,1,
2413 !d & (dc_norm(if90,i),if90=1,3)
2414 !d write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2415 !d write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2416 !d write(iout,'(a)')
2422 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2423 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2436 !d write (iout,*) 'i=',i
2438 erij(k)=dc_norm(k,i)
2442 dc_norm(k,i)=erij(k)
2444 dc_norm(j,i)=dc_norm(j,i)+delta
2445 ! fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2447 ! dc_norm(k,i)=dc_norm(k,i)/fac
2449 ! write (iout,*) (dc_norm(k,i),k=1,3)
2450 ! write (iout,*) (erij(k),k=1,3)
2453 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2454 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2455 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2456 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2458 ! write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2459 ! & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2460 ! & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2463 dc_norm(k,i)=erij(k)
2466 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2467 !d & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2468 !d & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2469 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2470 !d & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2471 !d & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2472 !d write (iout,'(a)')
2476 end subroutine check_vecgrad
2477 !-----------------------------------------------------------------------------
2478 subroutine set_matrices
2479 ! implicit real*8 (a-h,o-z)
2480 ! include 'DIMENSIONS'
2483 ! include "COMMON.SETUP"
2485 integer :: status(MPI_STATUS_SIZE)
2487 ! include 'COMMON.IOUNITS'
2488 ! include 'COMMON.GEO'
2489 ! include 'COMMON.VAR'
2490 ! include 'COMMON.LOCAL'
2491 ! include 'COMMON.CHAIN'
2492 ! include 'COMMON.DERIV'
2493 ! include 'COMMON.INTERACT'
2494 ! include 'COMMON.CONTACTS'
2495 ! include 'COMMON.TORSION'
2496 ! include 'COMMON.VECTORS'
2497 ! include 'COMMON.FFIELD'
2498 real(kind=8) :: auxvec(2),auxmat(2,2)
2499 integer :: i,iti1,iti,k,l
2500 real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2
2501 ! print *,"in set matrices"
2503 ! Compute the virtual-bond-torsional-angle dependent quantities needed
2504 ! to calculate the el-loc multibody terms of various order.
2508 do i=ivec_start+2,ivec_end+2
2513 if (i .lt. nres+1) then
2550 if (i .gt. 3 .and. i .lt. nres+1) then
2551 obrot_der(1,i-2)=-sin1
2552 obrot_der(2,i-2)= cos1
2553 Ugder(1,1,i-2)= sin1
2554 Ugder(1,2,i-2)=-cos1
2555 Ugder(2,1,i-2)=-cos1
2556 Ugder(2,2,i-2)=-sin1
2559 obrot2_der(1,i-2)=-dwasin2
2560 obrot2_der(2,i-2)= dwacos2
2561 Ug2der(1,1,i-2)= dwasin2
2562 Ug2der(1,2,i-2)=-dwacos2
2563 Ug2der(2,1,i-2)=-dwacos2
2564 Ug2der(2,2,i-2)=-dwasin2
2566 obrot_der(1,i-2)=0.0d0
2567 obrot_der(2,i-2)=0.0d0
2568 Ugder(1,1,i-2)=0.0d0
2569 Ugder(1,2,i-2)=0.0d0
2570 Ugder(2,1,i-2)=0.0d0
2571 Ugder(2,2,i-2)=0.0d0
2572 obrot2_der(1,i-2)=0.0d0
2573 obrot2_der(2,i-2)=0.0d0
2574 Ug2der(1,1,i-2)=0.0d0
2575 Ug2der(1,2,i-2)=0.0d0
2576 Ug2der(2,1,i-2)=0.0d0
2577 Ug2der(2,2,i-2)=0.0d0
2579 ! if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2580 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2581 if (itype(i-2,1).eq.0) then
2584 iti = itortyp(itype(i-2,1))
2589 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2590 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2591 if (itype(i-1,1).eq.0) then
2594 iti1 = itortyp(itype(i-1,1))
2599 ! print *,iti,i,"iti",iti1,itype(i-1,1),itype(i-2,1)
2600 !d write (iout,*) '*******i',i,' iti1',iti
2601 !d write (iout,*) 'b1',b1(:,iti)
2602 !d write (iout,*) 'b2',b2(:,iti)
2603 !d write (iout,*) 'Ug',Ug(:,:,i-2)
2604 ! if (i .gt. iatel_s+2) then
2605 if (i .gt. nnt+2) then
2606 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2607 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2608 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2610 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2611 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2612 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2613 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2614 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2625 DtUg2(l,k,i-2)=0.0d0
2629 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2630 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2632 muder(k,i-2)=Ub2der(k,i-2)
2634 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2635 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2636 if (itype(i-1,1).eq.0) then
2638 elseif (itype(i-1,1).le.ntyp) then
2639 iti1 = itortyp(itype(i-1,1))
2647 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2649 ! if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2)
2650 ! if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,iti1)
2651 ! if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2)
2652 !d write (iout,*) 'mu1',mu1(:,i-2)
2653 !d write (iout,*) 'mu2',mu2(:,i-2)
2654 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2656 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2657 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2658 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2659 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2660 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2661 ! Vectors and matrices dependent on a single virtual-bond dihedral.
2662 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2663 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2664 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2665 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2666 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2667 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2668 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2669 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2670 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2673 ! Matrices dependent on two consecutive virtual-bond dihedrals.
2674 ! The order of matrices is from left to right.
2675 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2677 ! do i=max0(ivec_start,2),ivec_end
2679 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2680 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2681 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2682 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2683 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2684 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2685 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2686 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2689 #if defined(MPI) && defined(PARMAT)
2691 ! if (fg_rank.eq.0) then
2692 write (iout,*) "Arrays UG and UGDER before GATHER"
2694 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2695 ((ug(l,k,i),l=1,2),k=1,2),&
2696 ((ugder(l,k,i),l=1,2),k=1,2)
2698 write (iout,*) "Arrays UG2 and UG2DER"
2700 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2701 ((ug2(l,k,i),l=1,2),k=1,2),&
2702 ((ug2der(l,k,i),l=1,2),k=1,2)
2704 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2706 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2707 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2708 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2710 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2712 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2713 costab(i),sintab(i),costab2(i),sintab2(i)
2715 write (iout,*) "Array MUDER"
2717 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2721 if (nfgtasks.gt.1) then
2723 ! write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2724 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2725 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2727 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),&
2728 MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2730 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),&
2731 MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2733 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),&
2734 MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2736 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),&
2737 MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2739 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),&
2740 MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2742 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),&
2743 MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2745 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),&
2746 MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),&
2747 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2748 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),&
2749 MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),&
2750 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2751 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),&
2752 MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),&
2753 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2754 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),&
2755 MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),&
2756 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2757 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2759 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),&
2760 MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2762 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),&
2763 MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2765 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),&
2766 MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2768 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),&
2769 MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2771 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),&
2772 MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2774 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),&
2775 ivec_count(fg_rank1),&
2776 MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2778 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),&
2779 MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2781 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),&
2782 MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2784 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),&
2785 MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2787 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),&
2788 MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2790 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),&
2791 MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2793 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),&
2794 MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2796 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),&
2797 MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2799 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),&
2800 ivec_count(fg_rank1),&
2801 MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2803 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),&
2804 MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2806 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),&
2807 MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2809 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),&
2810 MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2812 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),&
2813 MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2815 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),&
2816 ivec_count(fg_rank1),&
2817 MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2819 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),&
2820 ivec_count(fg_rank1),&
2821 MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2823 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),&
2824 ivec_count(fg_rank1),&
2825 MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2826 MPI_MAT2,FG_COMM1,IERR)
2827 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),&
2828 ivec_count(fg_rank1),&
2829 MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2830 MPI_MAT2,FG_COMM1,IERR)
2833 ! Passes matrix info through the ring
2836 if (irecv.lt.0) irecv=nfgtasks1-1
2839 if (inext.ge.nfgtasks1) inext=0
2841 ! write (iout,*) "isend",isend," irecv",irecv
2843 lensend=lentyp(isend)
2844 lenrecv=lentyp(irecv)
2845 ! write (iout,*) "lensend",lensend," lenrecv",lenrecv
2846 ! call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2847 ! & MPI_ROTAT1(lensend),inext,2200+isend,
2848 ! & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2849 ! & iprev,2200+irecv,FG_COMM,status,IERR)
2850 ! write (iout,*) "Gather ROTAT1"
2852 ! call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2853 ! & MPI_ROTAT2(lensend),inext,3300+isend,
2854 ! & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2855 ! & iprev,3300+irecv,FG_COMM,status,IERR)
2856 ! write (iout,*) "Gather ROTAT2"
2858 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,&
2859 MPI_ROTAT_OLD(lensend),inext,4400+isend,&
2860 costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),&
2861 iprev,4400+irecv,FG_COMM,status,IERR)
2862 ! write (iout,*) "Gather ROTAT_OLD"
2864 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,&
2865 MPI_PRECOMP11(lensend),inext,5500+isend,&
2866 mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),&
2867 iprev,5500+irecv,FG_COMM,status,IERR)
2868 ! write (iout,*) "Gather PRECOMP11"
2870 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,&
2871 MPI_PRECOMP12(lensend),inext,6600+isend,&
2872 Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),&
2873 iprev,6600+irecv,FG_COMM,status,IERR)
2874 ! write (iout,*) "Gather PRECOMP12"
2876 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2878 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,&
2879 MPI_ROTAT2(lensend),inext,7700+isend,&
2880 ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),&
2881 iprev,7700+irecv,FG_COMM,status,IERR)
2882 ! write (iout,*) "Gather PRECOMP21"
2884 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,&
2885 MPI_PRECOMP22(lensend),inext,8800+isend,&
2886 EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),&
2887 iprev,8800+irecv,FG_COMM,status,IERR)
2888 ! write (iout,*) "Gather PRECOMP22"
2890 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,&
2891 MPI_PRECOMP23(lensend),inext,9900+isend,&
2892 Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,&
2893 MPI_PRECOMP23(lenrecv),&
2894 iprev,9900+irecv,FG_COMM,status,IERR)
2895 ! write (iout,*) "Gather PRECOMP23"
2900 if (irecv.lt.0) irecv=nfgtasks1-1
2903 time_gather=time_gather+MPI_Wtime()-time00
2906 ! if (fg_rank.eq.0) then
2907 write (iout,*) "Arrays UG and UGDER"
2909 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2910 ((ug(l,k,i),l=1,2),k=1,2),&
2911 ((ugder(l,k,i),l=1,2),k=1,2)
2913 write (iout,*) "Arrays UG2 and UG2DER"
2915 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2916 ((ug2(l,k,i),l=1,2),k=1,2),&
2917 ((ug2der(l,k,i),l=1,2),k=1,2)
2919 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2921 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2922 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2923 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2925 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2927 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2928 costab(i),sintab(i),costab2(i),sintab2(i)
2930 write (iout,*) "Array MUDER"
2932 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2938 !d iti = itortyp(itype(i,1))
2941 !d write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2942 !d & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2946 end subroutine set_matrices
2947 !-----------------------------------------------------------------------------
2948 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2950 ! This subroutine calculates the average interaction energy and its gradient
2951 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
2952 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2953 ! The potential depends both on the distance of peptide-group centers and on
2954 ! the orientation of the CA-CA virtual bonds.
2957 ! implicit real*8 (a-h,o-z)
2961 ! include 'DIMENSIONS'
2962 ! include 'COMMON.CONTROL'
2963 ! include 'COMMON.SETUP'
2964 ! include 'COMMON.IOUNITS'
2965 ! include 'COMMON.GEO'
2966 ! include 'COMMON.VAR'
2967 ! include 'COMMON.LOCAL'
2968 ! include 'COMMON.CHAIN'
2969 ! include 'COMMON.DERIV'
2970 ! include 'COMMON.INTERACT'
2971 ! include 'COMMON.CONTACTS'
2972 ! include 'COMMON.TORSION'
2973 ! include 'COMMON.VECTORS'
2974 ! include 'COMMON.FFIELD'
2975 ! include 'COMMON.TIME1'
2976 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
2977 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
2978 real(kind=8),dimension(2,2) :: acipa !el,a_temp
2979 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
2980 real(kind=8),dimension(4) :: muij
2981 !el integer :: num_conti,j1,j2
2982 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
2983 !el dz_normi,xmedi,ymedi,zmedi
2985 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
2986 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
2989 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2991 real(kind=8) :: scal_el=1.0d0
2993 real(kind=8) :: scal_el=0.5d0
2996 ! 13-go grudnia roku pamietnego...
2997 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
2999 0.0d0,0.0d0,1.0d0/),shape(unmat))
3002 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
3003 real(kind=8) :: fac,t_eelecij,fracinbuf
3006 !d write(iout,*) 'In EELEC'
3007 ! print *,"IN EELEC"
3009 !d write(iout,*) 'Type',i
3010 !d write(iout,*) 'B1',B1(:,i)
3011 !d write(iout,*) 'B2',B2(:,i)
3012 !d write(iout,*) 'CC',CC(:,:,i)
3013 !d write(iout,*) 'DD',DD(:,:,i)
3014 !d write(iout,*) 'EE',EE(:,:,i)
3016 !d call check_vecgrad
3031 if (icheckgrad.eq.1) then
3034 ! dc_norm(1,i)=0.0d0
3035 ! dc_norm(2,i)=0.0d0
3036 ! dc_norm(3,i)=0.0d0
3039 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3041 dc_norm(k,i)=dc(k,i)*fac
3043 ! write (iout,*) 'i',i,' fac',fac
3046 ! print *,wel_loc,"wel_loc",wcorr4,wcorr5,wcorr6,wturn3,wturn4, &
3048 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3049 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
3050 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3051 ! call vec_and_deriv
3055 ! print *, "before set matrices"
3057 ! print *, "after set matrices"
3060 time_mat=time_mat+MPI_Wtime()-time01
3063 ! print *, "after set matrices"
3065 !d write (iout,*) 'i=',i
3067 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3070 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3071 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3084 !d print '(a)','Enter EELEC'
3085 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3086 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
3087 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
3089 gel_loc_loc(i)=0.0d0
3094 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3096 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
3100 ! print *,"before iturn3 loop"
3101 do i=iturn3_start,iturn3_end
3102 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
3103 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
3107 dx_normi=dc_norm(1,i)
3108 dy_normi=dc_norm(2,i)
3109 dz_normi=dc_norm(3,i)
3110 xmedi=c(1,i)+0.5d0*dxi
3111 ymedi=c(2,i)+0.5d0*dyi
3112 zmedi=c(3,i)+0.5d0*dzi
3113 xmedi=dmod(xmedi,boxxsize)
3114 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3115 ymedi=dmod(ymedi,boxysize)
3116 if (ymedi.lt.0) ymedi=ymedi+boxysize
3117 zmedi=dmod(zmedi,boxzsize)
3118 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3120 if ((zmedi.gt.bordlipbot) &
3121 .and.(zmedi.lt.bordliptop)) then
3122 !C the energy transfer exist
3123 if (zmedi.lt.buflipbot) then
3124 !C what fraction I am in
3126 ((zmedi-bordlipbot)/lipbufthick)
3127 !C lipbufthick is thickenes of lipid buffore
3128 sslipi=sscalelip(fracinbuf)
3129 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3130 elseif (zmedi.gt.bufliptop) then
3131 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3132 sslipi=sscalelip(fracinbuf)
3133 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3142 ! print *,i,sslipi,ssgradlipi
3143 call eelecij(i,i+2,ees,evdw1,eel_loc)
3144 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3145 num_cont_hb(i)=num_conti
3147 do i=iturn4_start,iturn4_end
3148 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
3149 .or. itype(i+3,1).eq.ntyp1 &
3150 .or. itype(i+4,1).eq.ntyp1) cycle
3154 dx_normi=dc_norm(1,i)
3155 dy_normi=dc_norm(2,i)
3156 dz_normi=dc_norm(3,i)
3157 xmedi=c(1,i)+0.5d0*dxi
3158 ymedi=c(2,i)+0.5d0*dyi
3159 zmedi=c(3,i)+0.5d0*dzi
3160 xmedi=dmod(xmedi,boxxsize)
3161 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3162 ymedi=dmod(ymedi,boxysize)
3163 if (ymedi.lt.0) ymedi=ymedi+boxysize
3164 zmedi=dmod(zmedi,boxzsize)
3165 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3166 if ((zmedi.gt.bordlipbot) &
3167 .and.(zmedi.lt.bordliptop)) then
3168 !C the energy transfer exist
3169 if (zmedi.lt.buflipbot) then
3170 !C what fraction I am in
3172 ((zmedi-bordlipbot)/lipbufthick)
3173 !C lipbufthick is thickenes of lipid buffore
3174 sslipi=sscalelip(fracinbuf)
3175 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3176 elseif (zmedi.gt.bufliptop) then
3177 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3178 sslipi=sscalelip(fracinbuf)
3179 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3189 num_conti=num_cont_hb(i)
3190 call eelecij(i,i+3,ees,evdw1,eel_loc)
3191 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
3192 call eturn4(i,eello_turn4)
3193 num_cont_hb(i)=num_conti
3196 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3198 ! print *,"iatel_s,iatel_e,",iatel_s,iatel_e
3199 do i=iatel_s,iatel_e
3200 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
3204 dx_normi=dc_norm(1,i)
3205 dy_normi=dc_norm(2,i)
3206 dz_normi=dc_norm(3,i)
3207 xmedi=c(1,i)+0.5d0*dxi
3208 ymedi=c(2,i)+0.5d0*dyi
3209 zmedi=c(3,i)+0.5d0*dzi
3210 xmedi=dmod(xmedi,boxxsize)
3211 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3212 ymedi=dmod(ymedi,boxysize)
3213 if (ymedi.lt.0) ymedi=ymedi+boxysize
3214 zmedi=dmod(zmedi,boxzsize)
3215 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3216 if ((zmedi.gt.bordlipbot) &
3217 .and.(zmedi.lt.bordliptop)) then
3218 !C the energy transfer exist
3219 if (zmedi.lt.buflipbot) then
3220 !C what fraction I am in
3222 ((zmedi-bordlipbot)/lipbufthick)
3223 !C lipbufthick is thickenes of lipid buffore
3224 sslipi=sscalelip(fracinbuf)
3225 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3226 elseif (zmedi.gt.bufliptop) then
3227 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3228 sslipi=sscalelip(fracinbuf)
3229 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3239 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3240 num_conti=num_cont_hb(i)
3241 do j=ielstart(i),ielend(i)
3242 ! write (iout,*) i,j,itype(i,1),itype(j,1)
3243 if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
3244 call eelecij(i,j,ees,evdw1,eel_loc)
3246 num_cont_hb(i)=num_conti
3248 ! write (iout,*) "Number of loop steps in EELEC:",ind
3250 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
3251 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3253 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3254 !cc eel_loc=eel_loc+eello_turn3
3255 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
3257 end subroutine eelec
3258 !-----------------------------------------------------------------------------
3259 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3262 ! implicit real*8 (a-h,o-z)
3263 ! include 'DIMENSIONS'
3267 ! include 'COMMON.CONTROL'
3268 ! include 'COMMON.IOUNITS'
3269 ! include 'COMMON.GEO'
3270 ! include 'COMMON.VAR'
3271 ! include 'COMMON.LOCAL'
3272 ! include 'COMMON.CHAIN'
3273 ! include 'COMMON.DERIV'
3274 ! include 'COMMON.INTERACT'
3275 ! include 'COMMON.CONTACTS'
3276 ! include 'COMMON.TORSION'
3277 ! include 'COMMON.VECTORS'
3278 ! include 'COMMON.FFIELD'
3279 ! include 'COMMON.TIME1'
3280 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
3281 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
3282 real(kind=8),dimension(2,2) :: acipa !el,a_temp
3283 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3284 real(kind=8),dimension(4) :: muij
3285 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
3286 dist_temp, dist_init,rlocshield,fracinbuf
3287 integer xshift,yshift,zshift,ilist,iresshield
3288 !el integer :: num_conti,j1,j2
3289 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3290 !el dz_normi,xmedi,ymedi,zmedi
3292 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3293 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3296 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3298 real(kind=8) :: scal_el=1.0d0
3300 real(kind=8) :: scal_el=0.5d0
3303 ! 13-go grudnia roku pamietnego...
3304 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
3306 0.0d0,0.0d0,1.0d0/),shape(unmat))
3307 ! integer :: maxconts=nres/4
3309 integer :: k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap
3310 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
3311 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
3312 real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
3313 rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
3314 evdwij,el1,el2,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
3315 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
3316 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
3317 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
3318 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
3319 ecosgp,ecosam,ecosbm,ecosgm,ghalf
3321 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
3322 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
3324 ! time00=MPI_Wtime()
3325 !d write (iout,*) "eelecij",i,j
3329 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3330 aaa=app(iteli,itelj)
3331 bbb=bpp(iteli,itelj)
3332 ael6i=ael6(iteli,itelj)
3333 ael3i=ael3(iteli,itelj)
3337 dx_normj=dc_norm(1,j)
3338 dy_normj=dc_norm(2,j)
3339 dz_normj=dc_norm(3,j)
3340 ! xj=c(1,j)+0.5D0*dxj-xmedi
3341 ! yj=c(2,j)+0.5D0*dyj-ymedi
3342 ! zj=c(3,j)+0.5D0*dzj-zmedi
3347 if (xj.lt.0) xj=xj+boxxsize
3349 if (yj.lt.0) yj=yj+boxysize
3351 if (zj.lt.0) zj=zj+boxzsize
3352 if ((zj.gt.bordlipbot) &
3353 .and.(zj.lt.bordliptop)) then
3354 !C the energy transfer exist
3355 if (zj.lt.buflipbot) then
3356 !C what fraction I am in
3358 ((zj-bordlipbot)/lipbufthick)
3359 !C lipbufthick is thickenes of lipid buffore
3360 sslipj=sscalelip(fracinbuf)
3361 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
3362 elseif (zj.gt.bufliptop) then
3363 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
3364 sslipj=sscalelip(fracinbuf)
3365 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
3376 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3383 xj=xj_safe+xshift*boxxsize
3384 yj=yj_safe+yshift*boxysize
3385 zj=zj_safe+zshift*boxzsize
3386 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3387 if(dist_temp.lt.dist_init) then
3397 if (isubchap.eq.1) then
3408 rij=xj*xj+yj*yj+zj*zj
3411 !C print *,xmedi,ymedi,zmedi,xj,yj,zj,boxxsize,rij
3412 sss_ele_cut=sscale_ele(rij)
3413 sss_ele_grad=sscagrad_ele(rij)
3415 ! sss_ele_grad=0.0d0
3416 ! print *,sss_ele_cut,sss_ele_grad,&
3417 ! (rij),r_cut_ele,rlamb_ele
3418 ! if (sss_ele_cut.le.0.0) go to 128
3423 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3424 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3425 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3426 fac=cosa-3.0D0*cosb*cosg
3428 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3429 if (j.eq.i+2) ev1=scal_el*ev1
3434 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3437 if (shield_mode.gt.0) then
3438 !C fac_shield(i)=0.4
3439 !C fac_shield(j)=0.6
3440 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3441 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3443 ees=ees+eesij*sss_ele_cut
3444 !C FOR NOW SHIELD IS NOT USED WITH LIPSCALE
3445 !C & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3451 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)*sss_ele_cut
3452 !C print *,"TUCC",(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
3455 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
3456 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3457 ! ees=ees+eesij*sss_ele_cut
3458 evdw1=evdw1+evdwij*sss_ele_cut &
3459 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3460 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3461 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3462 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3463 !d & xmedi,ymedi,zmedi,xj,yj,zj
3465 if (energy_dec) then
3466 ! write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') &
3467 ! 'evdw1',i,j,evdwij,&
3468 ! iteli,itelj,aaa,evdw1
3469 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3470 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3473 ! Calculate contributions to the Cartesian gradient.
3476 facvdw=-6*rrmij*(ev1+evdwij)*sss_ele_cut &
3477 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3478 facel=-3*rrmij*(el1+eesij)*sss_ele_cut &
3479 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3485 ! Radial derivatives. First process both termini of the fragment (i,j)
3487 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj* &
3488 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3489 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj* &
3490 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3491 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj* &
3492 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3494 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3495 (shield_mode.gt.0)) then
3497 do ilist=1,ishield_list(i)
3498 iresshield=shield_list(ilist,i)
3500 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)&
3502 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3504 +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0 &
3506 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3509 do ilist=1,ishield_list(j)
3510 iresshield=shield_list(ilist,j)
3512 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j) &
3514 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3516 +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0 &
3518 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3522 gshieldc(k,i)=gshieldc(k,i)+ &
3523 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3526 gshieldc(k,j)=gshieldc(k,j)+ &
3527 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3530 gshieldc(k,i-1)=gshieldc(k,i-1)+ &
3531 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3534 gshieldc(k,j-1)=gshieldc(k,j-1)+ &
3535 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3543 ! ghalf=0.5D0*ggg(k)
3544 ! gelc(k,i)=gelc(k,i)+ghalf
3545 ! gelc(k,j)=gelc(k,j)+ghalf
3547 ! 9/28/08 AL Gradient compotents will be summed only at the end
3549 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3550 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3552 gelc_long(3,j)=gelc_long(3,j)+ &
3553 ssgradlipj*eesij/2.0d0*lipscale**2&
3556 gelc_long(3,i)=gelc_long(3,i)+ &
3557 ssgradlipi*eesij/2.0d0*lipscale**2&
3562 ! Loop over residues i+1 thru j-1.
3566 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3569 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj &
3570 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3571 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj &
3572 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3573 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj &
3574 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3577 ! ghalf=0.5D0*ggg(k)
3578 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3579 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3581 ! 9/28/08 AL Gradient compotents will be summed only at the end
3583 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3584 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3587 !C Lipidic part for scaling weight
3588 gvdwpp(3,j)=gvdwpp(3,j)+ &
3589 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3590 gvdwpp(3,i)=gvdwpp(3,i)+ &
3591 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3592 !! Loop over residues i+1 thru j-1.
3596 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3600 facvdw=(ev1+evdwij)*sss_ele_cut &
3601 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3603 facel=(el1+eesij)*sss_ele_cut
3605 fac=-3*rrmij*(facvdw+facvdw+facel)
3610 ! Radial derivatives. First process both termini of the fragment (i,j)
3612 ggg(1)=fac*xj+sss_ele_grad*rmij*(eesij+evdwij)*xj
3613 ggg(2)=fac*yj+sss_ele_grad*rmij*(eesij+evdwij)*yj
3614 ggg(3)=fac*zj+sss_ele_grad*rmij*(eesij+evdwij)*zj
3616 ! ghalf=0.5D0*ggg(k)
3617 ! gelc(k,i)=gelc(k,i)+ghalf
3618 ! gelc(k,j)=gelc(k,j)+ghalf
3620 ! 9/28/08 AL Gradient compotents will be summed only at the end
3622 gelc_long(k,j)=gelc(k,j)+ggg(k)
3623 gelc_long(k,i)=gelc(k,i)-ggg(k)
3626 ! Loop over residues i+1 thru j-1.
3630 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3633 ! 9/28/08 AL Gradient compotents will be summed only at the end
3635 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3637 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3639 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3642 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3643 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3645 gvdwpp(3,j)=gvdwpp(3,j)+ &
3646 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3647 gvdwpp(3,i)=gvdwpp(3,i)+ &
3648 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3654 ecosa=2.0D0*fac3*fac1+fac4
3657 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3658 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3660 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3661 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3663 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3664 !d & (dcosg(k),k=1,3)
3666 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*sss_ele_cut &
3667 *fac_shield(i)**2*fac_shield(j)**2 &
3668 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3672 ! ghalf=0.5D0*ggg(k)
3673 ! gelc(k,i)=gelc(k,i)+ghalf
3674 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3675 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3676 ! gelc(k,j)=gelc(k,j)+ghalf
3677 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3678 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3682 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3686 gelc(k,i)=gelc(k,i) &
3687 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3688 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
3690 *fac_shield(i)**2*fac_shield(j)**2 &
3691 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3693 gelc(k,j)=gelc(k,j) &
3694 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3695 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
3697 *fac_shield(i)**2*fac_shield(j)**2 &
3698 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3700 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3701 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3704 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3705 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
3706 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3708 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3709 ! energy of a peptide unit is assumed in the form of a second-order
3710 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3711 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3712 ! are computed for EVERY pair of non-contiguous peptide groups.
3714 if (j.lt.nres-1) then
3725 muij(kkk)=mu(k,i)*mu(l,j)
3728 !d write (iout,*) 'EELEC: i',i,' j',j
3729 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
3730 !d write(iout,*) 'muij',muij
3731 ury=scalar(uy(1,i),erij)
3732 urz=scalar(uz(1,i),erij)
3733 vry=scalar(uy(1,j),erij)
3734 vrz=scalar(uz(1,j),erij)
3735 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3736 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3737 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3738 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3739 fac=dsqrt(-ael6i)*r3ij
3744 !d write (iout,'(4i5,4f10.5)')
3745 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
3746 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3747 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3748 !d & uy(:,j),uz(:,j)
3749 !d write (iout,'(4f10.5)')
3750 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3751 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3752 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
3753 !d write (iout,'(9f10.5/)')
3754 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3755 ! Derivatives of the elements of A in virtual-bond vectors
3756 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3758 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3759 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3760 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3761 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3762 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3763 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3764 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3765 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3766 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3767 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3768 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3769 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3771 ! Compute radial contributions to the gradient
3789 ! Add the contributions coming from er
3792 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3793 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3794 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3795 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3798 ! Derivatives in DC(i)
3799 !grad ghalf1=0.5d0*agg(k,1)
3800 !grad ghalf2=0.5d0*agg(k,2)
3801 !grad ghalf3=0.5d0*agg(k,3)
3802 !grad ghalf4=0.5d0*agg(k,4)
3803 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
3804 -3.0d0*uryg(k,2)*vry)!+ghalf1
3805 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
3806 -3.0d0*uryg(k,2)*vrz)!+ghalf2
3807 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
3808 -3.0d0*urzg(k,2)*vry)!+ghalf3
3809 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
3810 -3.0d0*urzg(k,2)*vrz)!+ghalf4
3811 ! Derivatives in DC(i+1)
3812 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
3813 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3814 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
3815 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3816 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
3817 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3818 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
3819 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3820 ! Derivatives in DC(j)
3821 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
3822 -3.0d0*vryg(k,2)*ury)!+ghalf1
3823 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
3824 -3.0d0*vrzg(k,2)*ury)!+ghalf2
3825 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
3826 -3.0d0*vryg(k,2)*urz)!+ghalf3
3827 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
3828 -3.0d0*vrzg(k,2)*urz)!+ghalf4
3829 ! Derivatives in DC(j+1) or DC(nres-1)
3830 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
3831 -3.0d0*vryg(k,3)*ury)
3832 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
3833 -3.0d0*vrzg(k,3)*ury)
3834 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
3835 -3.0d0*vryg(k,3)*urz)
3836 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
3837 -3.0d0*vrzg(k,3)*urz)
3838 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
3840 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3853 aggi(k,l)=-aggi(k,l)
3854 aggi1(k,l)=-aggi1(k,l)
3855 aggj(k,l)=-aggj(k,l)
3856 aggj1(k,l)=-aggj1(k,l)
3859 if (j.lt.nres-1) then
3865 aggi(k,l)=-aggi(k,l)
3866 aggi1(k,l)=-aggi1(k,l)
3867 aggj(k,l)=-aggj(k,l)
3868 aggj1(k,l)=-aggj1(k,l)
3879 aggi(k,l)=-aggi(k,l)
3880 aggi1(k,l)=-aggi1(k,l)
3881 aggj(k,l)=-aggj(k,l)
3882 aggj1(k,l)=-aggj1(k,l)
3887 IF (wel_loc.gt.0.0d0) THEN
3888 ! Contribution to the local-electrostatic energy coming from the i-j pair
3889 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
3891 if (shield_mode.eq.0) then
3895 eel_loc_ij=eel_loc_ij &
3896 *fac_shield(i)*fac_shield(j) &
3897 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3898 !C Now derivative over eel_loc
3899 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3900 (shield_mode.gt.0)) then
3903 do ilist=1,ishield_list(i)
3904 iresshield=shield_list(ilist,i)
3906 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij &
3909 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
3911 +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i) &
3914 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
3918 do ilist=1,ishield_list(j)
3919 iresshield=shield_list(ilist,j)
3921 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij &
3924 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
3926 +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j) &
3929 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
3936 gshieldc_ll(k,i)=gshieldc_ll(k,i)+ &
3937 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
3939 gshieldc_ll(k,j)=gshieldc_ll(k,j)+ &
3940 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
3942 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+ &
3943 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
3945 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+ &
3946 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
3953 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3955 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3956 'eelloc',i,j,eel_loc_ij
3957 ! if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33
3958 ! if (energy_dec) write (iout,*) "muij",muij
3959 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3961 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
3962 ! Partial derivatives in virtual-bond dihedral angles gamma
3964 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
3965 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
3966 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
3968 *fac_shield(i)*fac_shield(j) &
3969 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3971 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
3972 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
3973 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
3975 *fac_shield(i)*fac_shield(j) &
3976 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3977 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3979 ! ggg(1)=(agg(1,1)*muij(1)+ &
3980 ! agg(1,2)*muij(2)+agg(1,3)*muij(3)+agg(1,4)*muij(4)) &
3982 ! +eel_loc_ij*sss_ele_grad*rmij*xj
3983 ! ggg(2)=(agg(2,1)*muij(1)+ &
3984 ! agg(2,2)*muij(2)+agg(2,3)*muij(3)+agg(2,4)*muij(4)) &
3986 ! +eel_loc_ij*sss_ele_grad*rmij*yj
3987 ! ggg(3)=(agg(3,1)*muij(1)+ &
3988 ! agg(3,2)*muij(2)+agg(3,3)*muij(3)+agg(3,4)*muij(4)) &
3990 ! +eel_loc_ij*sss_ele_grad*rmij*zj
3996 ggg(l)=(agg(l,1)*muij(1)+ &
3997 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
3999 *fac_shield(i)*fac_shield(j) &
4000 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) &
4001 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4004 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4005 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4006 !grad ghalf=0.5d0*ggg(l)
4007 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
4008 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
4010 gel_loc_long(3,j)=gel_loc_long(3,j)+ &
4011 ssgradlipj*eel_loc_ij/2.0d0*lipscale/ &
4012 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
4014 gel_loc_long(3,i)=gel_loc_long(3,i)+ &
4015 ssgradlipi*eel_loc_ij/2.0d0*lipscale/ &
4016 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
4020 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4023 ! Remaining derivatives of eello
4025 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
4026 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
4028 *fac_shield(i)*fac_shield(j) &
4029 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4031 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4032 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
4033 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3) &
4034 +aggi1(l,4)*muij(4))&
4036 *fac_shield(i)*fac_shield(j) &
4037 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4039 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4040 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
4041 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(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,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
4048 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3) &
4049 +aggj1(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)
4057 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
4058 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
4059 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
4060 .and. num_conti.le.maxconts) then
4061 ! write (iout,*) i,j," entered corr"
4063 ! Calculate the contact function. The ith column of the array JCONT will
4064 ! contain the numbers of atoms that make contacts with the atom I (of numbers
4065 ! greater than I). The arrays FACONT and GACONT will contain the values of
4066 ! the contact function and its derivative.
4067 ! r0ij=1.02D0*rpp(iteli,itelj)
4068 ! r0ij=1.11D0*rpp(iteli,itelj)
4069 r0ij=2.20D0*rpp(iteli,itelj)
4070 ! r0ij=1.55D0*rpp(iteli,itelj)
4071 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4072 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
4073 if (fcont.gt.0.0D0) then
4074 num_conti=num_conti+1
4075 if (num_conti.gt.maxconts) then
4076 !el write (iout,*) "esrgresgdsrgdfsrgdswrgaresfgaerwgae"
4077 !el write (iout,*) "num_conti",num_conti, "maxconts",maxconts
4078 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
4079 ' will skip next contacts for this conf.', num_conti
4081 jcont_hb(num_conti,i)=j
4082 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
4083 !d & " jcont_hb",jcont_hb(num_conti,i)
4084 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
4085 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4086 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4088 d_cont(num_conti,i)=rij
4089 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4090 ! --- Electrostatic-interaction matrix ---
4091 a_chuj(1,1,num_conti,i)=a22
4092 a_chuj(1,2,num_conti,i)=a23
4093 a_chuj(2,1,num_conti,i)=a32
4094 a_chuj(2,2,num_conti,i)=a33
4095 ! --- Gradient of rij
4097 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4104 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4105 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4106 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4107 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4108 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4113 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4114 ! Calculate contact energies
4116 wij=cosa-3.0D0*cosb*cosg
4119 ! fac3=dsqrt(-ael6i)/r0ij**3
4120 fac3=dsqrt(-ael6i)*r3ij
4121 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4122 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4123 if (ees0tmp.gt.0) then
4124 ees0pij=dsqrt(ees0tmp)
4128 if (shield_mode.eq.0) then
4132 ees0plist(num_conti,i)=j
4134 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4135 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4136 if (ees0tmp.gt.0) then
4137 ees0mij=dsqrt(ees0tmp)
4142 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
4144 *fac_shield(i)*fac_shield(j)
4146 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
4148 *fac_shield(i)*fac_shield(j)
4150 ! Diagnostics. Comment out or remove after debugging!
4151 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4152 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4153 ! ees0m(num_conti,i)=0.0D0
4155 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4156 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4157 ! Angular derivatives of the contact function
4158 ees0pij1=fac3/ees0pij
4159 ees0mij1=fac3/ees0mij
4160 fac3p=-3.0D0*fac3*rrmij
4161 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4162 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4164 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4165 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4166 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4167 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4168 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4169 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4170 ecosap=ecosa1+ecosa2
4171 ecosbp=ecosb1+ecosb2
4172 ecosgp=ecosg1+ecosg2
4173 ecosam=ecosa1-ecosa2
4174 ecosbm=ecosb1-ecosb2
4175 ecosgm=ecosg1-ecosg2
4184 facont_hb(num_conti,i)=fcont
4185 fprimcont=fprimcont/rij
4186 !d facont_hb(num_conti,i)=1.0D0
4187 ! Following line is for diagnostics.
4190 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4191 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4194 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4195 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4197 gggp(1)=gggp(1)+ees0pijp*xj &
4198 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
4199 gggp(2)=gggp(2)+ees0pijp*yj &
4200 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
4201 gggp(3)=gggp(3)+ees0pijp*zj &
4202 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
4204 gggm(1)=gggm(1)+ees0mijp*xj &
4205 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
4207 gggm(2)=gggm(2)+ees0mijp*yj &
4208 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
4210 gggm(3)=gggm(3)+ees0mijp*zj &
4211 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
4213 ! Derivatives due to the contact function
4214 gacont_hbr(1,num_conti,i)=fprimcont*xj
4215 gacont_hbr(2,num_conti,i)=fprimcont*yj
4216 gacont_hbr(3,num_conti,i)=fprimcont*zj
4219 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
4220 ! following the change of gradient-summation algorithm.
4222 !grad ghalfp=0.5D0*gggp(k)
4223 !grad ghalfm=0.5D0*gggm(k)
4224 gacontp_hb1(k,num_conti,i)= & !ghalfp+
4225 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4226 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
4227 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4229 gacontp_hb2(k,num_conti,i)= & !ghalfp+
4230 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4231 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
4232 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4234 gacontp_hb3(k,num_conti,i)=gggp(k) &
4235 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4237 gacontm_hb1(k,num_conti,i)= & !ghalfm+
4238 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4239 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
4240 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4242 gacontm_hb2(k,num_conti,i)= & !ghalfm+
4243 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4244 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
4245 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4247 gacontm_hb3(k,num_conti,i)=gggm(k) &
4248 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4251 ! Diagnostics. Comment out or remove after debugging!
4253 !diag gacontp_hb1(k,num_conti,i)=0.0D0
4254 !diag gacontp_hb2(k,num_conti,i)=0.0D0
4255 !diag gacontp_hb3(k,num_conti,i)=0.0D0
4256 !diag gacontm_hb1(k,num_conti,i)=0.0D0
4257 !diag gacontm_hb2(k,num_conti,i)=0.0D0
4258 !diag gacontm_hb3(k,num_conti,i)=0.0D0
4261 endif ! num_conti.le.maxconts
4264 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4267 ghalf=0.5d0*agg(l,k)
4268 aggi(l,k)=aggi(l,k)+ghalf
4269 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4270 aggj(l,k)=aggj(l,k)+ghalf
4273 if (j.eq.nres-1 .and. i.lt.j-2) then
4276 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4282 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
4284 end subroutine eelecij
4285 !-----------------------------------------------------------------------------
4286 subroutine eturn3(i,eello_turn3)
4287 ! Third- and fourth-order contributions from turns
4290 ! implicit real*8 (a-h,o-z)
4291 ! include 'DIMENSIONS'
4292 ! include 'COMMON.IOUNITS'
4293 ! include 'COMMON.GEO'
4294 ! include 'COMMON.VAR'
4295 ! include 'COMMON.LOCAL'
4296 ! include 'COMMON.CHAIN'
4297 ! include 'COMMON.DERIV'
4298 ! include 'COMMON.INTERACT'
4299 ! include 'COMMON.CONTACTS'
4300 ! include 'COMMON.TORSION'
4301 ! include 'COMMON.VECTORS'
4302 ! include 'COMMON.FFIELD'
4303 ! include 'COMMON.CONTROL'
4304 real(kind=8),dimension(3) :: ggg
4305 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4306 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
4307 real(kind=8),dimension(2) :: auxvec,auxvec1
4308 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4309 real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
4310 !el integer :: num_conti,j1,j2
4311 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4312 !el dz_normi,xmedi,ymedi,zmedi
4314 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4315 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4318 integer :: i,j,l,k,ilist,iresshield
4319 real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield
4322 ! write (iout,*) "eturn3",i,j,j1,j2
4323 zj=(c(3,j)+c(3,j+1))/2.0d0
4325 if (zj.lt.0) zj=zj+boxzsize
4326 if ((zj.lt.0)) write (*,*) "CHUJ"
4327 if ((zj.gt.bordlipbot) &
4328 .and.(zj.lt.bordliptop)) then
4329 !C the energy transfer exist
4330 if (zj.lt.buflipbot) then
4331 !C what fraction I am in
4333 ((zj-bordlipbot)/lipbufthick)
4334 !C lipbufthick is thickenes of lipid buffore
4335 sslipj=sscalelip(fracinbuf)
4336 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4337 elseif (zj.gt.bufliptop) then
4338 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4339 sslipj=sscalelip(fracinbuf)
4340 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4354 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4356 ! Third-order contributions
4363 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4364 !d call checkint_turn3(i,a_temp,eello_turn3_num)
4365 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4366 call transpose2(auxmat(1,1),auxmat1(1,1))
4367 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4368 if (shield_mode.eq.0) then
4373 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) &
4374 *fac_shield(i)*fac_shield(j) &
4375 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4377 0.5d0*(pizda(1,1)+pizda(2,2)) &
4378 *fac_shield(i)*fac_shield(j)
4380 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4381 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4382 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4383 (shield_mode.gt.0)) then
4386 do ilist=1,ishield_list(i)
4387 iresshield=shield_list(ilist,i)
4389 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4390 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4392 +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4393 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4397 do ilist=1,ishield_list(j)
4398 iresshield=shield_list(ilist,j)
4400 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4401 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4403 +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4404 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4411 gshieldc_t3(k,i)=gshieldc_t3(k,i)+ &
4412 grad_shield(k,i)*eello_t3/fac_shield(i)
4413 gshieldc_t3(k,j)=gshieldc_t3(k,j)+ &
4414 grad_shield(k,j)*eello_t3/fac_shield(j)
4415 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+ &
4416 grad_shield(k,i)*eello_t3/fac_shield(i)
4417 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+ &
4418 grad_shield(k,j)*eello_t3/fac_shield(j)
4422 !d write (2,*) 'i,',i,' j',j,'eello_turn3',
4423 !d & 0.5d0*(pizda(1,1)+pizda(2,2)),
4424 !d & ' eello_turn3_num',4*eello_turn3_num
4425 ! Derivatives in gamma(i)
4426 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4427 call transpose2(auxmat2(1,1),auxmat3(1,1))
4428 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4429 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))&
4430 *fac_shield(i)*fac_shield(j) &
4431 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4432 ! Derivatives in gamma(i+1)
4433 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4434 call transpose2(auxmat2(1,1),auxmat3(1,1))
4435 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4436 gel_loc_turn3(i+1)=gel_loc_turn3(i+1) &
4437 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4438 *fac_shield(i)*fac_shield(j) &
4439 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4441 ! Cartesian derivatives
4443 ! ghalf1=0.5d0*agg(l,1)
4444 ! ghalf2=0.5d0*agg(l,2)
4445 ! ghalf3=0.5d0*agg(l,3)
4446 ! ghalf4=0.5d0*agg(l,4)
4447 a_temp(1,1)=aggi(l,1)!+ghalf1
4448 a_temp(1,2)=aggi(l,2)!+ghalf2
4449 a_temp(2,1)=aggi(l,3)!+ghalf3
4450 a_temp(2,2)=aggi(l,4)!+ghalf4
4451 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4452 gcorr3_turn(l,i)=gcorr3_turn(l,i) &
4453 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4454 *fac_shield(i)*fac_shield(j) &
4455 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4457 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4458 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4459 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4460 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4461 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4462 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) &
4463 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4464 *fac_shield(i)*fac_shield(j) &
4465 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4467 a_temp(1,1)=aggj(l,1)!+ghalf1
4468 a_temp(1,2)=aggj(l,2)!+ghalf2
4469 a_temp(2,1)=aggj(l,3)!+ghalf3
4470 a_temp(2,2)=aggj(l,4)!+ghalf4
4471 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4472 gcorr3_turn(l,j)=gcorr3_turn(l,j) &
4473 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4474 *fac_shield(i)*fac_shield(j) &
4475 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4477 a_temp(1,1)=aggj1(l,1)
4478 a_temp(1,2)=aggj1(l,2)
4479 a_temp(2,1)=aggj1(l,3)
4480 a_temp(2,2)=aggj1(l,4)
4481 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4482 gcorr3_turn(l,j1)=gcorr3_turn(l,j1) &
4483 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4484 *fac_shield(i)*fac_shield(j) &
4485 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4487 gshieldc_t3(3,i)=gshieldc_t3(3,i)+ &
4488 ssgradlipi*eello_t3/4.0d0*lipscale
4489 gshieldc_t3(3,j)=gshieldc_t3(3,j)+ &
4490 ssgradlipj*eello_t3/4.0d0*lipscale
4491 gshieldc_t3(3,i-1)=gshieldc_t3(3,i-1)+ &
4492 ssgradlipi*eello_t3/4.0d0*lipscale
4493 gshieldc_t3(3,j-1)=gshieldc_t3(3,j-1)+ &
4494 ssgradlipj*eello_t3/4.0d0*lipscale
4497 end subroutine eturn3
4498 !-----------------------------------------------------------------------------
4499 subroutine eturn4(i,eello_turn4)
4500 ! Third- and fourth-order contributions from turns
4503 ! implicit real*8 (a-h,o-z)
4504 ! include 'DIMENSIONS'
4505 ! include 'COMMON.IOUNITS'
4506 ! include 'COMMON.GEO'
4507 ! include 'COMMON.VAR'
4508 ! include 'COMMON.LOCAL'
4509 ! include 'COMMON.CHAIN'
4510 ! include 'COMMON.DERIV'
4511 ! include 'COMMON.INTERACT'
4512 ! include 'COMMON.CONTACTS'
4513 ! include 'COMMON.TORSION'
4514 ! include 'COMMON.VECTORS'
4515 ! include 'COMMON.FFIELD'
4516 ! include 'COMMON.CONTROL'
4517 real(kind=8),dimension(3) :: ggg
4518 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4519 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
4520 real(kind=8),dimension(2) :: auxvec,auxvec1
4521 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4522 real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
4523 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4524 !el dz_normi,xmedi,ymedi,zmedi
4525 !el integer :: num_conti,j1,j2
4526 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4527 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4530 integer :: i,j,iti1,iti2,iti3,l,k,ilist,iresshield
4531 real(kind=8) :: eello_turn4,s1,s2,s3,zj,fracinbuf,eello_t4,&
4535 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4537 ! Fourth-order contributions
4545 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4546 !d call checkint_turn4(i,a_temp,eello_turn4_num)
4547 ! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4548 zj=(c(3,j)+c(3,j+1))/2.0d0
4550 if (zj.lt.0) zj=zj+boxzsize
4551 if ((zj.gt.bordlipbot) &
4552 .and.(zj.lt.bordliptop)) then
4553 !C the energy transfer exist
4554 if (zj.lt.buflipbot) then
4555 !C what fraction I am in
4557 ((zj-bordlipbot)/lipbufthick)
4558 !C lipbufthick is thickenes of lipid buffore
4559 sslipj=sscalelip(fracinbuf)
4560 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4561 elseif (zj.gt.bufliptop) then
4562 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4563 sslipj=sscalelip(fracinbuf)
4564 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4578 iti1=itortyp(itype(i+1,1))
4579 iti2=itortyp(itype(i+2,1))
4580 iti3=itortyp(itype(i+3,1))
4581 ! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4582 call transpose2(EUg(1,1,i+1),e1t(1,1))
4583 call transpose2(Eug(1,1,i+2),e2t(1,1))
4584 call transpose2(Eug(1,1,i+3),e3t(1,1))
4585 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4586 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4587 s1=scalar2(b1(1,iti2),auxvec(1))
4588 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4589 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4590 s2=scalar2(b1(1,iti1),auxvec(1))
4591 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4592 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4593 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4594 if (shield_mode.eq.0) then
4599 eello_turn4=eello_turn4-(s1+s2+s3) &
4600 *fac_shield(i)*fac_shield(j) &
4601 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4602 eello_t4=-(s1+s2+s3) &
4603 *fac_shield(i)*fac_shield(j)
4604 !C Now derivative over shield:
4605 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4606 (shield_mode.gt.0)) then
4609 do ilist=1,ishield_list(i)
4610 iresshield=shield_list(ilist,i)
4612 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
4613 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
4615 +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
4616 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
4620 do ilist=1,ishield_list(j)
4621 iresshield=shield_list(ilist,j)
4623 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
4624 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
4626 +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
4627 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
4634 gshieldc_t4(k,i)=gshieldc_t4(k,i)+ &
4635 grad_shield(k,i)*eello_t4/fac_shield(i)
4636 gshieldc_t4(k,j)=gshieldc_t4(k,j)+ &
4637 grad_shield(k,j)*eello_t4/fac_shield(j)
4638 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+ &
4639 grad_shield(k,i)*eello_t4/fac_shield(i)
4640 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+ &
4641 grad_shield(k,j)*eello_t4/fac_shield(j)
4645 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4646 'eturn4',i,j,-(s1+s2+s3)
4647 !d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4648 !d & ' eello_turn4_num',8*eello_turn4_num
4649 ! Derivatives in gamma(i)
4650 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4651 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4652 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4653 s1=scalar2(b1(1,iti2),auxvec(1))
4654 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4655 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4656 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) &
4657 *fac_shield(i)*fac_shield(j) &
4658 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4660 ! Derivatives in gamma(i+1)
4661 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4662 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4663 s2=scalar2(b1(1,iti1),auxvec(1))
4664 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4665 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4666 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4667 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) &
4668 *fac_shield(i)*fac_shield(j) &
4669 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4671 ! Derivatives in gamma(i+2)
4672 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4673 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4674 s1=scalar2(b1(1,iti2),auxvec(1))
4675 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4676 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4677 s2=scalar2(b1(1,iti1),auxvec(1))
4678 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4679 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4680 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4681 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) &
4682 *fac_shield(i)*fac_shield(j) &
4683 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4685 ! Cartesian derivatives
4686 ! Derivatives of this turn contributions in DC(i+2)
4687 if (j.lt.nres-1) then
4689 a_temp(1,1)=agg(l,1)
4690 a_temp(1,2)=agg(l,2)
4691 a_temp(2,1)=agg(l,3)
4692 a_temp(2,2)=agg(l,4)
4693 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4694 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4695 s1=scalar2(b1(1,iti2),auxvec(1))
4696 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4697 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4698 s2=scalar2(b1(1,iti1),auxvec(1))
4699 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4700 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4701 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4703 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)&
4704 *fac_shield(i)*fac_shield(j) &
4705 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4709 ! Remaining derivatives of this turn contribution
4711 a_temp(1,1)=aggi(l,1)
4712 a_temp(1,2)=aggi(l,2)
4713 a_temp(2,1)=aggi(l,3)
4714 a_temp(2,2)=aggi(l,4)
4715 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4716 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4717 s1=scalar2(b1(1,iti2),auxvec(1))
4718 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4719 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4720 s2=scalar2(b1(1,iti1),auxvec(1))
4721 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4722 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4723 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4724 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) &
4725 *fac_shield(i)*fac_shield(j) &
4726 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4729 a_temp(1,1)=aggi1(l,1)
4730 a_temp(1,2)=aggi1(l,2)
4731 a_temp(2,1)=aggi1(l,3)
4732 a_temp(2,2)=aggi1(l,4)
4733 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4734 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4735 s1=scalar2(b1(1,iti2),auxvec(1))
4736 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4737 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4738 s2=scalar2(b1(1,iti1),auxvec(1))
4739 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4740 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4741 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4742 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) &
4743 *fac_shield(i)*fac_shield(j) &
4744 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4747 a_temp(1,1)=aggj(l,1)
4748 a_temp(1,2)=aggj(l,2)
4749 a_temp(2,1)=aggj(l,3)
4750 a_temp(2,2)=aggj(l,4)
4751 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4752 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4753 s1=scalar2(b1(1,iti2),auxvec(1))
4754 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4755 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4756 s2=scalar2(b1(1,iti1),auxvec(1))
4757 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4758 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4759 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4760 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) &
4761 *fac_shield(i)*fac_shield(j) &
4762 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4765 a_temp(1,1)=aggj1(l,1)
4766 a_temp(1,2)=aggj1(l,2)
4767 a_temp(2,1)=aggj1(l,3)
4768 a_temp(2,2)=aggj1(l,4)
4769 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4770 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4771 s1=scalar2(b1(1,iti2),auxvec(1))
4772 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4773 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4774 s2=scalar2(b1(1,iti1),auxvec(1))
4775 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4776 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4777 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4778 ! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4779 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) &
4780 *fac_shield(i)*fac_shield(j) &
4781 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4784 gshieldc_t4(3,i)=gshieldc_t4(3,i)+ &
4785 ssgradlipi*eello_t4/4.0d0*lipscale
4786 gshieldc_t4(3,j)=gshieldc_t4(3,j)+ &
4787 ssgradlipj*eello_t4/4.0d0*lipscale
4788 gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+ &
4789 ssgradlipi*eello_t4/4.0d0*lipscale
4790 gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+ &
4791 ssgradlipj*eello_t4/4.0d0*lipscale
4794 end subroutine eturn4
4795 !-----------------------------------------------------------------------------
4796 subroutine unormderiv(u,ugrad,unorm,ungrad)
4797 ! This subroutine computes the derivatives of a normalized vector u, given
4798 ! the derivatives computed without normalization conditions, ugrad. Returns
4801 real(kind=8),dimension(3) :: u,vec
4802 real(kind=8),dimension(3,3) ::ugrad,ungrad
4803 real(kind=8) :: unorm !,scalar
4805 ! write (2,*) 'ugrad',ugrad
4808 vec(i)=scalar(ugrad(1,i),u(1))
4810 ! write (2,*) 'vec',vec
4813 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4816 ! write (2,*) 'ungrad',ungrad
4818 end subroutine unormderiv
4819 !-----------------------------------------------------------------------------
4820 subroutine escp_soft_sphere(evdw2,evdw2_14)
4822 ! This subroutine calculates the excluded-volume interaction energy between
4823 ! peptide-group centers and side chains and its gradient in virtual-bond and
4824 ! side-chain vectors.
4826 ! implicit real*8 (a-h,o-z)
4827 ! include 'DIMENSIONS'
4828 ! include 'COMMON.GEO'
4829 ! include 'COMMON.VAR'
4830 ! include 'COMMON.LOCAL'
4831 ! include 'COMMON.CHAIN'
4832 ! include 'COMMON.DERIV'
4833 ! include 'COMMON.INTERACT'
4834 ! include 'COMMON.FFIELD'
4835 ! include 'COMMON.IOUNITS'
4836 ! include 'COMMON.CONTROL'
4837 real(kind=8),dimension(3) :: ggg
4839 integer :: i,iint,j,k,iteli,itypj
4840 real(kind=8) :: evdw2,evdw2_14,r0_scp,xi,yi,zi,xj,yj,zj,&
4841 fac,rij,r0ij,r0ijsq,evdwij,e1,e2
4846 !d print '(a)','Enter ESCP'
4847 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4848 do i=iatscp_s,iatscp_e
4849 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
4851 xi=0.5D0*(c(1,i)+c(1,i+1))
4852 yi=0.5D0*(c(2,i)+c(2,i+1))
4853 zi=0.5D0*(c(3,i)+c(3,i+1))
4855 do iint=1,nscp_gr(i)
4857 do j=iscpstart(i,iint),iscpend(i,iint)
4858 if (itype(j,1).eq.ntyp1) cycle
4859 itypj=iabs(itype(j,1))
4860 ! Uncomment following three lines for SC-p interactions
4864 ! Uncomment following three lines for Ca-p interactions
4868 rij=xj*xj+yj*yj+zj*zj
4871 if (rij.lt.r0ijsq) then
4872 evdwij=0.25d0*(rij-r0ijsq)**2
4880 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
4885 !grad if (j.lt.i) then
4886 !d write (iout,*) 'j<i'
4887 ! Uncomment following three lines for SC-p interactions
4889 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4892 !d write (iout,*) 'j>i'
4894 !grad ggg(k)=-ggg(k)
4895 ! Uncomment following line for SC-p interactions
4896 ! gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4900 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4902 !grad kstart=min0(i+1,j)
4903 !grad kend=max0(i-1,j-1)
4904 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4905 !d write (iout,*) ggg(1),ggg(2),ggg(3)
4906 !grad do k=kstart,kend
4908 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4912 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4913 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4920 end subroutine escp_soft_sphere
4921 !-----------------------------------------------------------------------------
4922 subroutine escp(evdw2,evdw2_14)
4924 ! This subroutine calculates the excluded-volume interaction energy between
4925 ! peptide-group centers and side chains and its gradient in virtual-bond and
4926 ! side-chain vectors.
4928 ! implicit real*8 (a-h,o-z)
4929 ! include 'DIMENSIONS'
4930 ! include 'COMMON.GEO'
4931 ! include 'COMMON.VAR'
4932 ! include 'COMMON.LOCAL'
4933 ! include 'COMMON.CHAIN'
4934 ! include 'COMMON.DERIV'
4935 ! include 'COMMON.INTERACT'
4936 ! include 'COMMON.FFIELD'
4937 ! include 'COMMON.IOUNITS'
4938 ! include 'COMMON.CONTROL'
4939 real(kind=8),dimension(3) :: ggg
4941 integer :: i,iint,j,k,iteli,itypj,subchap
4942 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
4944 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
4945 dist_temp, dist_init
4946 integer xshift,yshift,zshift
4950 !d print '(a)','Enter ESCP'
4951 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4952 do i=iatscp_s,iatscp_e
4953 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
4955 xi=0.5D0*(c(1,i)+c(1,i+1))
4956 yi=0.5D0*(c(2,i)+c(2,i+1))
4957 zi=0.5D0*(c(3,i)+c(3,i+1))
4959 if (xi.lt.0) xi=xi+boxxsize
4961 if (yi.lt.0) yi=yi+boxysize
4963 if (zi.lt.0) zi=zi+boxzsize
4965 do iint=1,nscp_gr(i)
4967 do j=iscpstart(i,iint),iscpend(i,iint)
4968 itypj=iabs(itype(j,1))
4969 if (itypj.eq.ntyp1) cycle
4970 ! Uncomment following three lines for SC-p interactions
4974 ! Uncomment following three lines for Ca-p interactions
4982 if (xj.lt.0) xj=xj+boxxsize
4984 if (yj.lt.0) yj=yj+boxysize
4986 if (zj.lt.0) zj=zj+boxzsize
4987 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4995 xj=xj_safe+xshift*boxxsize
4996 yj=yj_safe+yshift*boxysize
4997 zj=zj_safe+zshift*boxzsize
4998 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4999 if(dist_temp.lt.dist_init) then
5009 if (subchap.eq.1) then
5019 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5020 rij=dsqrt(1.0d0/rrij)
5021 sss_ele_cut=sscale_ele(rij)
5022 sss_ele_grad=sscagrad_ele(rij)
5023 ! print *,sss_ele_cut,sss_ele_grad,&
5024 ! (rij),r_cut_ele,rlamb_ele
5025 if (sss_ele_cut.le.0.0) cycle
5027 e1=fac*fac*aad(itypj,iteli)
5028 e2=fac*bad(itypj,iteli)
5029 if (iabs(j-i) .le. 2) then
5032 evdw2_14=evdw2_14+(e1+e2)*sss_ele_cut
5035 evdw2=evdw2+evdwij*sss_ele_cut
5036 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') &
5037 ! 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),&
5038 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
5041 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
5043 fac=-(evdwij+e1)*rrij*sss_ele_cut
5044 fac=fac+evdwij*sss_ele_grad/rij/expon
5048 !grad if (j.lt.i) then
5049 !d write (iout,*) 'j<i'
5050 ! Uncomment following three lines for SC-p interactions
5052 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5055 !d write (iout,*) 'j>i'
5057 !grad ggg(k)=-ggg(k)
5058 ! Uncomment following line for SC-p interactions
5059 !cgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5060 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5064 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5066 !grad kstart=min0(i+1,j)
5067 !grad kend=max0(i-1,j-1)
5068 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5069 !d write (iout,*) ggg(1),ggg(2),ggg(3)
5070 !grad do k=kstart,kend
5072 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5076 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5077 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5085 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5086 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5087 gradx_scp(j,i)=expon*gradx_scp(j,i)
5090 !******************************************************************************
5094 ! To save time the factor EXPON has been extracted from ALL components
5095 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
5098 !******************************************************************************
5101 !-----------------------------------------------------------------------------
5102 subroutine edis(ehpb)
5104 ! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5106 ! implicit real*8 (a-h,o-z)
5107 ! include 'DIMENSIONS'
5108 ! include 'COMMON.SBRIDGE'
5109 ! include 'COMMON.CHAIN'
5110 ! include 'COMMON.DERIV'
5111 ! include 'COMMON.VAR'
5112 ! include 'COMMON.INTERACT'
5113 ! include 'COMMON.IOUNITS'
5114 real(kind=8),dimension(3) :: ggg
5116 integer :: i,j,ii,jj,iii,jjj,k
5117 real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
5120 !d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5121 !d write(iout,*)'link_start=',link_start,' link_end=',link_end
5122 if (link_end.eq.0) return
5123 do i=link_start,link_end
5124 ! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5125 ! CA-CA distance used in regularization of structure.
5128 ! iii and jjj point to the residues for which the distance is assigned.
5129 if (ii.gt.nres) then
5136 ! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5137 ! & dhpb(i),dhpb1(i),forcon(i)
5138 ! 24/11/03 AL: SS bridges handled separately because of introducing a specific
5139 ! distance and angle dependent SS bond potential.
5140 !mc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5141 ! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5142 if (.not.dyn_ss .and. i.le.nss) then
5143 ! 15/02/13 CC dynamic SSbond - additional check
5144 if (ii.gt.nres .and. iabs(itype(iii,1)).eq.1 .and. &
5145 iabs(itype(jjj,1)).eq.1) then
5146 call ssbond_ene(iii,jjj,eij)
5148 !d write (iout,*) "eij",eij
5150 else if (ii.gt.nres .and. jj.gt.nres) then
5151 !c Restraints from contact prediction
5153 if (constr_dist.eq.11) then
5154 ehpb=ehpb+fordepth(i)**4.0d0 &
5155 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5156 fac=fordepth(i)**4.0d0 &
5157 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5158 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
5161 if (dhpb1(i).gt.0.0d0) then
5162 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5163 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5164 !c write (iout,*) "beta nmr",
5165 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5169 !C Get the force constant corresponding to this distance.
5171 !C Calculate the contribution to energy.
5172 ehpb=ehpb+waga*rdis*rdis
5173 !c write (iout,*) "beta reg",dd,waga*rdis*rdis
5175 !C Evaluate gradient.
5181 ggg(j)=fac*(c(j,jj)-c(j,ii))
5184 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5185 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5188 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5189 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5193 if (constr_dist.eq.11) then
5194 ehpb=ehpb+fordepth(i)**4.0d0 &
5195 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5196 fac=fordepth(i)**4.0d0 &
5197 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5198 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
5201 if (dhpb1(i).gt.0.0d0) then
5202 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5203 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5204 !c write (iout,*) "alph nmr",
5205 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5208 !C Get the force constant corresponding to this distance.
5210 !C Calculate the contribution to energy.
5211 ehpb=ehpb+waga*rdis*rdis
5212 !c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5214 !C Evaluate gradient.
5221 ggg(j)=fac*(c(j,jj)-c(j,ii))
5223 !cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5224 !C If this is a SC-SC distance, we need to calculate the contributions to the
5225 !C Cartesian gradient in the SC vectors (ghpbx).
5228 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5229 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5232 !cgrad do j=iii,jjj-1
5234 !cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5238 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5239 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5243 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5247 !-----------------------------------------------------------------------------
5248 subroutine ssbond_ene(i,j,eij)
5250 ! Calculate the distance and angle dependent SS-bond potential energy
5251 ! using a free-energy function derived based on RHF/6-31G** ab initio
5252 ! calculations of diethyl disulfide.
5254 ! A. Liwo and U. Kozlowska, 11/24/03
5256 ! implicit real*8 (a-h,o-z)
5257 ! include 'DIMENSIONS'
5258 ! include 'COMMON.SBRIDGE'
5259 ! include 'COMMON.CHAIN'
5260 ! include 'COMMON.DERIV'
5261 ! include 'COMMON.LOCAL'
5262 ! include 'COMMON.INTERACT'
5263 ! include 'COMMON.VAR'
5264 ! include 'COMMON.IOUNITS'
5265 real(kind=8),dimension(3) :: erij,dcosom1,dcosom2,gg
5267 integer :: i,j,itypi,itypj,k
5268 real(kind=8) :: eij,rij,rrij,xi,yi,zi,dxi,dyi,dzi,dsci_inv,&
5269 xj,yj,zj,dxj,dyj,dzj,om1,om2,om12,deltad,dscj_inv,&
5270 deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,&
5273 itypi=iabs(itype(i,1))
5277 dxi=dc_norm(1,nres+i)
5278 dyi=dc_norm(2,nres+i)
5279 dzi=dc_norm(3,nres+i)
5280 ! dsci_inv=dsc_inv(itypi)
5281 dsci_inv=vbld_inv(nres+i)
5282 itypj=iabs(itype(j,1))
5283 ! dscj_inv=dsc_inv(itypj)
5284 dscj_inv=vbld_inv(nres+j)
5288 dxj=dc_norm(1,nres+j)
5289 dyj=dc_norm(2,nres+j)
5290 dzj=dc_norm(3,nres+j)
5291 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5296 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5297 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5298 om12=dxi*dxj+dyi*dyj+dzi*dzj
5300 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5301 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5307 deltat12=om2-om1+2.0d0
5309 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
5310 +akct*deltad*deltat12 &
5311 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5312 ! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5313 ! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5314 ! & " deltat12",deltat12," eij",eij
5315 ed=2*akcm*deltad+akct*deltat12
5317 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5318 eom1=-2*akth*deltat1-pom1-om2*pom2
5319 eom2= 2*akth*deltat2+pom1-om1*pom2
5322 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5323 ghpbx(k,i)=ghpbx(k,i)-ggk &
5324 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
5325 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5326 ghpbx(k,j)=ghpbx(k,j)+ggk &
5327 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
5328 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5329 ghpbc(k,i)=ghpbc(k,i)-ggk
5330 ghpbc(k,j)=ghpbc(k,j)+ggk
5333 ! Calculate the components of the gradient in DC and X
5337 !grad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5341 end subroutine ssbond_ene
5342 !-----------------------------------------------------------------------------
5343 subroutine ebond(estr)
5345 ! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5347 ! implicit real*8 (a-h,o-z)
5348 ! include 'DIMENSIONS'
5349 ! include 'COMMON.LOCAL'
5350 ! include 'COMMON.GEO'
5351 ! include 'COMMON.INTERACT'
5352 ! include 'COMMON.DERIV'
5353 ! include 'COMMON.VAR'
5354 ! include 'COMMON.CHAIN'
5355 ! include 'COMMON.IOUNITS'
5356 ! include 'COMMON.NAMES'
5357 ! include 'COMMON.FFIELD'
5358 ! include 'COMMON.CONTROL'
5359 ! include 'COMMON.SETUP'
5360 real(kind=8),dimension(3) :: u,ud
5362 integer :: i,j,iti,nbi,k
5363 real(kind=8) :: estr,estr1,diff,uprod,usum,usumsqder,&
5368 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
5369 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
5371 do i=ibondp_start,ibondp_end
5372 if (itype(i-1,1).eq.ntyp1 .and. itype(i,1).eq.ntyp1) cycle
5373 if (itype(i-1,1).eq.ntyp1 .or. itype(i,1).eq.ntyp1) then
5374 !C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5376 !C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) &
5377 !C *dc(j,i-1)/vbld(i)
5379 !C if (energy_dec) write(iout,*) &
5380 !C "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5381 diff = vbld(i)-vbldpDUM
5383 diff = vbld(i)-vbldp0
5385 if (energy_dec) write (iout,'(a7,i5,4f7.3)') &
5386 "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5389 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5391 ! write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5394 estr=0.5d0*AKP*estr+estr1
5395 ! print *,"estr_bb",estr,AKP
5397 ! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5399 do i=ibond_start,ibond_end
5400 iti=iabs(itype(i,1))
5401 if (iti.eq.0) print *,"WARNING WRONG SETTTING",i
5402 if (iti.ne.10 .and. iti.ne.ntyp1) then
5405 diff=vbld(i+nres)-vbldsc0(1,iti)
5406 if (energy_dec) write (iout,*) &
5407 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5408 AKSC(1,iti),AKSC(1,iti)*diff*diff
5409 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5410 ! print *,"estr_sc",estr
5412 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5416 diff=vbld(i+nres)-vbldsc0(j,iti)
5417 ud(j)=aksc(j,iti)*diff
5418 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5432 uprod2=uprod2*u(k)*u(k)
5436 usumsqder=usumsqder+ud(j)*uprod2
5438 estr=estr+uprod/usum
5439 ! print *,"estr_sc",estr,i
5441 if (energy_dec) write (iout,*) &
5442 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5443 AKSC(1,iti),uprod/usum
5445 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5451 end subroutine ebond
5453 !-----------------------------------------------------------------------------
5454 subroutine ebend(etheta)
5456 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5457 ! angles gamma and its derivatives in consecutive thetas and gammas.
5460 ! implicit real*8 (a-h,o-z)
5461 ! include 'DIMENSIONS'
5462 ! include 'COMMON.LOCAL'
5463 ! include 'COMMON.GEO'
5464 ! include 'COMMON.INTERACT'
5465 ! include 'COMMON.DERIV'
5466 ! include 'COMMON.VAR'
5467 ! include 'COMMON.CHAIN'
5468 ! include 'COMMON.IOUNITS'
5469 ! include 'COMMON.NAMES'
5470 ! include 'COMMON.FFIELD'
5471 ! include 'COMMON.CONTROL'
5472 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5473 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5474 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5476 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5477 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5478 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5480 integer :: i,k,ichir1,ichir2,itype1,ichir11,ichir12,itype2,&
5482 real(kind=8) :: etheta,delta,ss,ssd,phii,phii1,thet_pred_mean,&
5483 athetk,bthetk,dthett,dthetg1,dthetg2,f0,fprim0,E_tc0,fprim_tc0,&
5484 f1,fprim1,E_tc1,ethetai,E_theta,E_tc
5485 real(kind=8),dimension(2) :: y,z
5488 ! time11=dexp(-2*time)
5491 ! write (*,'(a,i2)') 'EBEND ICG=',icg
5492 do i=ithet_start,ithet_end
5493 if (itype(i-1,1).eq.ntyp1) cycle
5494 ! Zero the energy function and its derivative at 0 or pi.
5495 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5497 ichir1=isign(1,itype(i-2,1))
5498 ichir2=isign(1,itype(i,1))
5499 if (itype(i-2,1).eq.10) ichir1=isign(1,itype(i-1,1))
5500 if (itype(i,1).eq.10) ichir2=isign(1,itype(i-1,1))
5501 if (itype(i-1,1).eq.10) then
5502 itype1=isign(10,itype(i-2,1))
5503 ichir11=isign(1,itype(i-2,1))
5504 ichir12=isign(1,itype(i-2,1))
5505 itype2=isign(10,itype(i,1))
5506 ichir21=isign(1,itype(i,1))
5507 ichir22=isign(1,itype(i,1))
5510 if (i.gt.3 .and. itype(i-2,1).ne.ntyp1) then
5513 if (phii.ne.phii) phii=150.0
5523 if (i.lt.nres .and. itype(i,1).ne.ntyp1) then
5526 if (phii1.ne.phii1) phii1=150.0
5538 ! Calculate the "mean" value of theta from the part of the distribution
5539 ! dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5540 ! In following comments this theta will be referred to as t_c.
5541 thet_pred_mean=0.0d0
5543 athetk=athet(k,it,ichir1,ichir2)
5544 bthetk=bthet(k,it,ichir1,ichir2)
5546 athetk=athet(k,itype1,ichir11,ichir12)
5547 bthetk=bthet(k,itype2,ichir21,ichir22)
5549 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5551 dthett=thet_pred_mean*ssd
5552 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5553 ! Derivatives of the "mean" values in gamma1 and gamma2.
5554 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) &
5555 +athet(2,it,ichir1,ichir2)*y(1))*ss
5556 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) &
5557 +bthet(2,it,ichir1,ichir2)*z(1))*ss
5559 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) &
5560 +athet(2,itype1,ichir11,ichir12)*y(1))*ss
5561 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) &
5562 +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5564 if (theta(i).gt.pi-delta) then
5565 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,&
5567 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5568 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5569 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,&
5571 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,&
5573 else if (theta(i).lt.delta) then
5574 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5575 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5576 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,&
5578 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5579 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,&
5582 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,&
5585 etheta=etheta+ethetai
5586 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5588 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5589 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5590 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
5592 ! print *,ithetaconstr_start,ithetaconstr_end,"TU"
5594 ! Ufff.... We've done all this!!!
5596 end subroutine ebend
5597 !-----------------------------------------------------------------------------
5598 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
5601 ! implicit real*8 (a-h,o-z)
5602 ! include 'DIMENSIONS'
5603 ! include 'COMMON.LOCAL'
5604 ! include 'COMMON.IOUNITS'
5605 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5606 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5607 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5609 real(kind=8) :: thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc
5611 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5612 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5613 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5615 real(kind=8) :: sig,fac,escloci0,escloci1,esclocbi0,dersc12,&
5616 esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5618 ! Calculate the contributions to both Gaussian lobes.
5619 ! 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5620 ! The "polynomial part" of the "standard deviation" of this part of
5624 sig=sig*thet_pred_mean+polthet(j,it)
5626 ! Derivative of the "interior part" of the "standard deviation of the"
5627 ! gamma-dependent Gaussian lobe in t_c.
5628 sigtc=3*polthet(3,it)
5630 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5633 ! Set the parameters of both Gaussian lobes of the distribution.
5634 ! "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5635 fac=sig*sig+sigc0(it)
5638 ! Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5639 sigsqtc=-4.0D0*sigcsq*sigtc
5640 ! print *,i,sig,sigtc,sigsqtc
5641 ! Following variable (sigtc) is d[sigma(t_c)]/dt_c
5642 sigtc=-sigtc/(fac*fac)
5643 ! Following variable is sigma(t_c)**(-2)
5644 sigcsq=sigcsq*sigcsq
5646 sig0inv=1.0D0/sig0i**2
5647 delthec=thetai-thet_pred_mean
5648 delthe0=thetai-theta0i
5649 term1=-0.5D0*sigcsq*delthec*delthec
5650 term2=-0.5D0*sig0inv*delthe0*delthe0
5651 ! Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5652 ! NaNs in taking the logarithm. We extract the largest exponent which is added
5653 ! to the energy (this being the log of the distribution) at the end of energy
5654 ! term evaluation for this virtual-bond angle.
5655 if (term1.gt.term2) then
5657 term2=dexp(term2-termm)
5661 term1=dexp(term1-termm)
5664 ! The ratio between the gamma-independent and gamma-dependent lobes of
5665 ! the distribution is a Gaussian function of thet_pred_mean too.
5666 diffak=gthet(2,it)-thet_pred_mean
5667 ratak=diffak/gthet(3,it)**2
5668 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5669 ! Let's differentiate it in thet_pred_mean NOW.
5671 ! Now put together the distribution terms to make complete distribution.
5672 termexp=term1+ak*term2
5673 termpre=sigc+ak*sig0i
5674 ! Contribution of the bending energy from this theta is just the -log of
5675 ! the sum of the contributions from the two lobes and the pre-exponential
5676 ! factor. Simple enough, isn't it?
5677 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5678 ! NOW the derivatives!!!
5679 ! 6/6/97 Take into account the deformation.
5680 E_theta=(delthec*sigcsq*term1 &
5681 +ak*delthe0*sig0inv*term2)/termexp
5682 E_tc=((sigtc+aktc*sig0i)/termpre &
5683 -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ &
5684 aktc*term2)/termexp)
5686 end subroutine theteng
5688 !-----------------------------------------------------------------------------
5689 subroutine ebend(etheta,ethetacnstr)
5691 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5692 ! angles gamma and its derivatives in consecutive thetas and gammas.
5693 ! ab initio-derived potentials from
5694 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5696 ! implicit real*8 (a-h,o-z)
5697 ! include 'DIMENSIONS'
5698 ! include 'COMMON.LOCAL'
5699 ! include 'COMMON.GEO'
5700 ! include 'COMMON.INTERACT'
5701 ! include 'COMMON.DERIV'
5702 ! include 'COMMON.VAR'
5703 ! include 'COMMON.CHAIN'
5704 ! include 'COMMON.IOUNITS'
5705 ! include 'COMMON.NAMES'
5706 ! include 'COMMON.FFIELD'
5707 ! include 'COMMON.CONTROL'
5708 real(kind=8),dimension(nntheterm) :: coskt,sinkt !mmaxtheterm
5709 real(kind=8),dimension(nsingle) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
5710 real(kind=8),dimension(ndouble,ndouble) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
5711 logical :: lprn=.false., lprn1=.false.
5713 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
5714 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
5715 real(kind=8) :: aux,etheta,ccl,ssl,scl,csl,ethetacnstr
5716 ! local variables for constrains
5717 real(kind=8) :: difi,thetiii
5721 do i=ithet_start,ithet_end
5722 if (itype(i-1,1).eq.ntyp1) cycle
5723 if (itype(i-2,1).eq.ntyp1.or.itype(i,1).eq.ntyp1) cycle
5724 if (iabs(itype(i+1,1)).eq.20) iblock=2
5725 if (iabs(itype(i+1,1)).ne.20) iblock=1
5729 theti2=0.5d0*theta(i)
5730 ityp2=ithetyp((itype(i-1,1)))
5732 coskt(k)=dcos(k*theti2)
5733 sinkt(k)=dsin(k*theti2)
5735 if (i.gt.3 .and. itype(max0(i-3,1),1).ne.ntyp1) then
5738 if (phii.ne.phii) phii=150.0
5742 ityp1=ithetyp((itype(i-2,1)))
5743 ! propagation of chirality for glycine type
5745 cosph1(k)=dcos(k*phii)
5746 sinph1(k)=dsin(k*phii)
5750 ityp1=ithetyp(itype(i-2,1))
5756 if (i.lt.nres .and. itype(i+1,1).ne.ntyp1) then
5759 if (phii1.ne.phii1) phii1=150.0
5764 ityp3=ithetyp((itype(i,1)))
5766 cosph2(k)=dcos(k*phii1)
5767 sinph2(k)=dsin(k*phii1)
5771 ityp3=ithetyp(itype(i,1))
5777 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5780 ccl=cosph1(l)*cosph2(k-l)
5781 ssl=sinph1(l)*sinph2(k-l)
5782 scl=sinph1(l)*cosph2(k-l)
5783 csl=cosph1(l)*sinph2(k-l)
5784 cosph1ph2(l,k)=ccl-ssl
5785 cosph1ph2(k,l)=ccl+ssl
5786 sinph1ph2(l,k)=scl+csl
5787 sinph1ph2(k,l)=scl-csl
5791 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
5792 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5793 write (iout,*) "coskt and sinkt"
5795 write (iout,*) k,coskt(k),sinkt(k)
5799 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5800 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) &
5803 write (iout,*) "k",k,&
5804 "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),&
5808 write (iout,*) "cosph and sinph"
5810 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5812 write (iout,*) "cosph1ph2 and sinph2ph2"
5815 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
5816 sinph1ph2(l,k),sinph1ph2(k,l)
5819 write(iout,*) "ethetai",ethetai
5823 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) &
5824 +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) &
5825 +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) &
5826 +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5827 ethetai=ethetai+sinkt(m)*aux
5828 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5829 dephii=dephii+k*sinkt(m)* &
5830 (ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- &
5831 bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5832 dephii1=dephii1+k*sinkt(m)* &
5833 (eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- &
5834 ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5836 write (iout,*) "m",m," k",k," bbthet", &
5837 bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", &
5838 ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", &
5839 ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", &
5840 eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5844 write(iout,*) "ethetai",ethetai
5848 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
5849 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ &
5850 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
5851 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5852 ethetai=ethetai+sinkt(m)*aux
5853 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5854 dephii=dephii+l*sinkt(m)* &
5855 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- &
5856 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
5857 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
5858 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5859 dephii1=dephii1+(k-l)*sinkt(m)* &
5860 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
5861 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
5862 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- &
5863 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5865 write (iout,*) "m",m," k",k," l",l," ffthet",&
5866 ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
5867 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",&
5868 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
5869 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),&
5871 write (iout,*) cosph1ph2(l,k)*sinkt(m),&
5872 cosph1ph2(k,l)*sinkt(m),&
5873 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5881 write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
5882 i,theta(i)*rad2deg,phii*rad2deg,&
5883 phii1*rad2deg,ethetai
5885 etheta=etheta+ethetai
5886 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5888 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5889 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5890 gloc(nphi+i-2,icg)=wang*dethetai
5892 !-----------thete constrains
5893 ! if (tor_mode.ne.2) then
5895 ! print *,ithetaconstr_start,ithetaconstr_end,"TU"
5896 do i=ithetaconstr_start,ithetaconstr_end
5897 itheta=itheta_constr(i)
5898 thetiii=theta(itheta)
5899 difi=pinorm(thetiii-theta_constr0(i))
5900 if (difi.gt.theta_drange(i)) then
5901 difi=difi-theta_drange(i)
5902 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5903 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
5904 +for_thet_constr(i)*difi**3
5905 else if (difi.lt.-drange(i)) then
5907 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5908 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
5909 +for_thet_constr(i)*difi**3
5913 if (energy_dec) then
5914 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc", &
5915 i,itheta,rad2deg*thetiii, &
5916 rad2deg*theta_constr0(i), rad2deg*theta_drange(i), &
5917 rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4, &
5918 gloc(itheta+nphi-2,icg)
5924 end subroutine ebend
5927 !-----------------------------------------------------------------------------
5928 subroutine esc(escloc)
5929 ! Calculate the local energy of a side chain and its derivatives in the
5930 ! corresponding virtual-bond valence angles THETA and the spherical angles
5934 ! implicit real*8 (a-h,o-z)
5935 ! include 'DIMENSIONS'
5936 ! include 'COMMON.GEO'
5937 ! include 'COMMON.LOCAL'
5938 ! include 'COMMON.VAR'
5939 ! include 'COMMON.INTERACT'
5940 ! include 'COMMON.DERIV'
5941 ! include 'COMMON.CHAIN'
5942 ! include 'COMMON.IOUNITS'
5943 ! include 'COMMON.NAMES'
5944 ! include 'COMMON.FFIELD'
5945 ! include 'COMMON.CONTROL'
5946 real(kind=8),dimension(3) :: x,dersc,xemp,dersc0,dersc1,&
5947 ddersc0,ddummy,xtemp,temp
5948 !el real(kind=8) :: time11,time12,time112,theti
5949 real(kind=8) :: escloc,delta
5950 !el integer :: it,nlobit
5951 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5954 real(kind=8) :: escloci0,escloci1,escloci,esclocbi0,&
5955 dersc12,esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5958 ! write (iout,'(a)') 'ESC'
5959 do i=loc_start,loc_end
5961 if (it.eq.ntyp1) cycle
5962 if (it.eq.10) goto 1
5963 nlobit=nlob(iabs(it))
5964 ! print *,'i=',i,' it=',it,' nlobit=',nlobit
5965 ! write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5966 theti=theta(i+1)-pipol
5971 if (x(2).gt.pi-delta) then
5975 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5977 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5978 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),&
5980 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
5981 ddersc0(1),dersc(1))
5982 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),&
5983 ddersc0(3),dersc(3))
5985 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5987 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5988 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,&
5989 dersc0(2),esclocbi,dersc02)
5990 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
5992 call splinthet(x(2),0.5d0*delta,ss,ssd)
5997 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5999 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6000 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6002 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6004 ! write (iout,*) escloci
6005 else if (x(2).lt.delta) then
6009 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6011 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6012 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),&
6014 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
6015 ddersc0(1),dersc(1))
6016 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),&
6017 ddersc0(3),dersc(3))
6019 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6021 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6022 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,&
6023 dersc0(2),esclocbi,dersc02)
6024 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
6029 call splinthet(x(2),0.5d0*delta,ss,ssd)
6031 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6033 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6034 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6036 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6037 ! write (iout,*) escloci
6039 call enesc(x,escloci,dersc,ddummy,.false.)
6042 escloc=escloc+escloci
6043 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6045 ! write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6047 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ &
6049 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6050 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6055 !-----------------------------------------------------------------------------
6056 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6059 ! implicit real*8 (a-h,o-z)
6060 ! include 'DIMENSIONS'
6061 ! include 'COMMON.GEO'
6062 ! include 'COMMON.LOCAL'
6063 ! include 'COMMON.IOUNITS'
6064 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6065 real(kind=8),dimension(3) :: x,z,dersc,ddersc
6066 real(kind=8),dimension(3,nlobit,-1:1) :: Ax !(3,maxlob,-1:1)
6067 real(kind=8),dimension(nlobit,-1:1) :: contr !(maxlob,-1:1)
6068 real(kind=8) :: escloci
6071 integer :: j,iii,l,k !el,it,nlobit
6072 real(kind=8) :: escloc_i,x3,Axk,expfac,emin !el,theti,&
6073 !el time11,time12,time112
6074 ! write (iout,*) 'it=',it,' nlobit=',nlobit
6078 if (mixed) ddersc(j)=0.0d0
6082 ! Because of periodicity of the dependence of the SC energy in omega we have
6083 ! to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6084 ! To avoid underflows, first compute & store the exponents.
6092 z(k)=x(k)-censc(k,j,it)
6097 Axk=Axk+gaussc(l,k,j,it)*z(l)
6103 expfac=expfac+Ax(k,j,iii)*z(k)
6111 ! As in the case of ebend, we want to avoid underflows in exponentiation and
6112 ! subsequent NaNs and INFs in energy calculation.
6113 ! Find the largest exponent
6117 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6121 !d print *,'it=',it,' emin=',emin
6123 ! Compute the contribution to SC energy and derivatives
6128 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6129 if(adexp.ne.adexp) adexp=1.0
6132 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6134 !d print *,'j=',j,' expfac=',expfac
6135 escloc_i=escloc_i+expfac
6137 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6141 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) &
6142 +gaussc(k,2,j,it))*expfac
6149 dersc(1)=dersc(1)/cos(theti)**2
6150 ddersc(1)=ddersc(1)/cos(theti)**2
6153 escloci=-(dlog(escloc_i)-emin)
6155 dersc(j)=dersc(j)/escloc_i
6159 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6163 end subroutine enesc
6164 !-----------------------------------------------------------------------------
6165 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6168 ! implicit real*8 (a-h,o-z)
6169 ! include 'DIMENSIONS'
6170 ! include 'COMMON.GEO'
6171 ! include 'COMMON.LOCAL'
6172 ! include 'COMMON.IOUNITS'
6173 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6174 real(kind=8),dimension(3) :: x,z,dersc
6175 real(kind=8),dimension(3,nlobit) :: Ax !(3,maxlob)
6176 real(kind=8),dimension(nlobit) :: contr !(maxlob)
6177 real(kind=8) :: escloci,dersc12,emin
6180 integer :: j,k,l !el,it,nlobit
6181 real(kind=8) :: escloc_i,Axk,expfac !el,time11,time12,time112,theti
6191 z(k)=x(k)-censc(k,j,it)
6197 Axk=Axk+gaussc(l,k,j,it)*z(l)
6203 expfac=expfac+Ax(k,j)*z(k)
6208 ! As in the case of ebend, we want to avoid underflows in exponentiation and
6209 ! subsequent NaNs and INFs in energy calculation.
6210 ! Find the largest exponent
6213 if (emin.gt.contr(j)) emin=contr(j)
6217 ! Compute the contribution to SC energy and derivatives
6221 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6222 escloc_i=escloc_i+expfac
6224 dersc(k)=dersc(k)+Ax(k,j)*expfac
6226 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) &
6227 +gaussc(1,2,j,it))*expfac
6231 dersc(1)=dersc(1)/cos(theti)**2
6232 dersc12=dersc12/cos(theti)**2
6233 escloci=-(dlog(escloc_i)-emin)
6235 dersc(j)=dersc(j)/escloc_i
6237 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6239 end subroutine enesc_bound
6241 !-----------------------------------------------------------------------------
6242 subroutine esc(escloc)
6243 ! Calculate the local energy of a side chain and its derivatives in the
6244 ! corresponding virtual-bond valence angles THETA and the spherical angles
6245 ! ALPHA and OMEGA derived from AM1 all-atom calculations.
6246 ! added by Urszula Kozlowska. 07/11/2007
6249 ! implicit real*8 (a-h,o-z)
6250 ! include 'DIMENSIONS'
6251 ! include 'COMMON.GEO'
6252 ! include 'COMMON.LOCAL'
6253 ! include 'COMMON.VAR'
6254 ! include 'COMMON.SCROT'
6255 ! include 'COMMON.INTERACT'
6256 ! include 'COMMON.DERIV'
6257 ! include 'COMMON.CHAIN'
6258 ! include 'COMMON.IOUNITS'
6259 ! include 'COMMON.NAMES'
6260 ! include 'COMMON.FFIELD'
6261 ! include 'COMMON.CONTROL'
6262 ! include 'COMMON.VECTORS'
6263 real(kind=8),dimension(3) :: x_prime,y_prime,z_prime
6264 real(kind=8),dimension(65) :: x
6265 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1,sumene2,sumene3,&
6266 sumene4,s1,s1_6,s2,s2_6,de_dxx,de_dyy,de_dzz,de_dt
6267 real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
6268 real(kind=8),dimension(3) :: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,dYY_Ci,&
6269 dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
6271 integer :: i,j,k !el,it,nlobit
6272 real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
6273 !el real(kind=8) :: time11,time12,time112,theti
6274 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6275 real(kind=8) :: dscp1,dscp2,pom_s1,pom_s16,pom_s2,pom_s26,&
6276 pom,pom_dx,pom_dy,pom_dt1,pom_dt2,pom1,pom2,&
6277 sumene1x,sumene2x,sumene3x,sumene4x,&
6278 sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,&
6281 real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,&
6282 de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,&
6285 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
6289 do i=loc_start,loc_end
6290 if (itype(i,1).eq.ntyp1) cycle
6291 costtab(i+1) =dcos(theta(i+1))
6292 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6293 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6294 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6295 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6296 cosfac=dsqrt(cosfac2)
6297 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6298 sinfac=dsqrt(sinfac2)
6300 if (it.eq.10) goto 1
6302 ! Compute the axes of tghe local cartesian coordinates system; store in
6303 ! x_prime, y_prime and z_prime
6310 ! write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6311 ! & dc_norm(3,i+nres)
6313 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6314 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6317 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i,1)))
6320 ! write (2,*) "x_prime",(x_prime(j),j=1,3)
6321 ! write (2,*) "y_prime",(y_prime(j),j=1,3)
6322 ! write (2,*) "z_prime",(z_prime(j),j=1,3)
6323 ! write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6324 ! & " xy",scalar(x_prime(1),y_prime(1)),
6325 ! & " xz",scalar(x_prime(1),z_prime(1)),
6326 ! & " yy",scalar(y_prime(1),y_prime(1)),
6327 ! & " yz",scalar(y_prime(1),z_prime(1)),
6328 ! & " zz",scalar(z_prime(1),z_prime(1))
6330 ! Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6331 ! to local coordinate system. Store in xx, yy, zz.
6337 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6338 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6339 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6346 ! Compute the energy of the ith side cbain
6348 ! write (2,*) "xx",xx," yy",yy," zz",zz
6351 x(j) = sc_parmin(j,it)
6354 !c diagnostics - remove later
6356 yy1 = dsin(alph(2))*dcos(omeg(2))
6357 zz1 = -dsign(1.0,dfloat(itype(i,1)))*dsin(alph(2))*dsin(omeg(2))
6358 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
6359 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
6361 !," --- ", xx_w,yy_w,zz_w
6364 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6365 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6367 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6368 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6370 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6371 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6372 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6373 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6374 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6376 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6377 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6378 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6379 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6380 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6382 dsc_i = 0.743d0+x(61)
6384 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6385 *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6386 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6387 *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6388 s1=(1+x(63))/(0.1d0 + dscp1)
6389 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6390 s2=(1+x(65))/(0.1d0 + dscp2)
6391 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6392 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) &
6393 + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6394 ! write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6396 ! & dscp1,dscp2,sumene
6397 ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6398 escloc = escloc + sumene
6399 ! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i,1)
6404 ! This section to check the numerical derivatives of the energy of ith side
6405 ! chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6406 ! #define DEBUG in the code to turn it on.
6408 write (2,*) "sumene =",sumene
6412 write (2,*) xx,yy,zz
6413 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6414 de_dxx_num=(sumenep-sumene)/aincr
6416 write (2,*) "xx+ sumene from enesc=",sumenep
6419 write (2,*) xx,yy,zz
6420 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6421 de_dyy_num=(sumenep-sumene)/aincr
6423 write (2,*) "yy+ sumene from enesc=",sumenep
6426 write (2,*) xx,yy,zz
6427 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6428 de_dzz_num=(sumenep-sumene)/aincr
6430 write (2,*) "zz+ sumene from enesc=",sumenep
6431 costsave=cost2tab(i+1)
6432 sintsave=sint2tab(i+1)
6433 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6434 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6435 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6436 de_dt_num=(sumenep-sumene)/aincr
6437 write (2,*) " t+ sumene from enesc=",sumenep
6438 cost2tab(i+1)=costsave
6439 sint2tab(i+1)=sintsave
6440 ! End of diagnostics section.
6443 ! Compute the gradient of esc
6445 ! zz=zz*dsign(1.0,dfloat(itype(i,1)))
6446 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6447 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6448 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6449 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6450 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6451 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6452 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6453 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6454 pom1=(sumene3*sint2tab(i+1)+sumene1) &
6455 *(pom_s1/dscp1+pom_s16*dscp1**4)
6456 pom2=(sumene4*cost2tab(i+1)+sumene2) &
6457 *(pom_s2/dscp2+pom_s26*dscp2**4)
6458 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6459 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 &
6460 +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) &
6462 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6463 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 &
6464 +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) &
6466 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) &
6467 +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
6470 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i,1)
6473 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6474 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 &
6475 +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) &
6477 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6478 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz &
6479 +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz &
6480 +x(59)*zz**2 +x(60)*xx*zz
6481 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) &
6482 +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
6485 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i,1)
6488 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
6489 +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx &
6490 +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) &
6491 +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) &
6492 +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 &
6493 +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy &
6494 +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
6495 + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6497 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i,1)
6500 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
6501 -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
6502 +pom1*pom_dt1+pom2*pom_dt2
6504 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i,1)
6508 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6509 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6510 cosfac2xx=cosfac2*xx
6511 sinfac2yy=sinfac2*yy
6513 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* &
6515 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* &
6517 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6518 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6519 ! write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6520 ! & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6521 ! write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6522 ! & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6523 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6524 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6525 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6526 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6530 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
6531 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
6532 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
6533 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
6536 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6537 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6538 dZZ_XYZ(k)=vbld_inv(i+nres)* &
6539 (z_prime(k)-zz*dC_norm(k,i+nres))
6541 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6542 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6546 dXX_Ctab(k,i)=dXX_Ci(k)
6547 dXX_C1tab(k,i)=dXX_Ci1(k)
6548 dYY_Ctab(k,i)=dYY_Ci(k)
6549 dYY_C1tab(k,i)=dYY_Ci1(k)
6550 dZZ_Ctab(k,i)=dZZ_Ci(k)
6551 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6552 dXX_XYZtab(k,i)=dXX_XYZ(k)
6553 dYY_XYZtab(k,i)=dYY_XYZ(k)
6554 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6558 ! write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6559 ! & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6560 ! write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6561 ! & dyy_ci(k)," dzz_ci",dzz_ci(k)
6562 ! write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6564 ! write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6565 ! & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6566 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) &
6567 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6568 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) &
6569 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6570 gsclocx(k,i)= de_dxx*dxx_XYZ(k) &
6571 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6573 ! write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6574 ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6576 ! to check gradient call subroutine check_grad
6582 !-----------------------------------------------------------------------------
6583 real(kind=8) function enesc(x,xx,yy,zz,cost2,sint2)
6585 real(kind=8),dimension(65) :: x
6586 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2,sumene3,&
6587 sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6589 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6590 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6592 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6593 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6595 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6596 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6597 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6598 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6599 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6601 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6602 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6603 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6604 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6605 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6607 dsc_i = 0.743d0+x(61)
6609 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6610 *(xx*cost2+yy*sint2))
6611 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6612 *(xx*cost2-yy*sint2))
6613 s1=(1+x(63))/(0.1d0 + dscp1)
6614 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6615 s2=(1+x(65))/(0.1d0 + dscp2)
6616 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6617 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) &
6618 + (sumene4*cost2 +sumene2)*(s2+s2_6)
6623 !-----------------------------------------------------------------------------
6624 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6626 ! This procedure calculates two-body contact function g(rij) and its derivative:
6629 ! g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6632 ! where x=(rij-r0ij)/delta
6634 ! rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6637 real(kind=8) :: rij,r0ij,eps0ij,fcont,fprimcont
6638 real(kind=8) :: x,x2,x4,delta
6642 if (x.lt.-1.0D0) then
6645 else if (x.le.1.0D0) then
6648 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6649 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6655 end subroutine gcont
6656 !-----------------------------------------------------------------------------
6657 subroutine splinthet(theti,delta,ss,ssder)
6658 ! implicit real*8 (a-h,o-z)
6659 ! include 'DIMENSIONS'
6660 ! include 'COMMON.VAR'
6661 ! include 'COMMON.GEO'
6662 real(kind=8) :: theti,delta,ss,ssder
6663 real(kind=8) :: thetup,thetlow
6666 if (theti.gt.pipol) then
6667 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6669 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6673 end subroutine splinthet
6674 !-----------------------------------------------------------------------------
6675 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6677 real(kind=8) :: x,x0,delta,f0,f1,fprim0,f,fprim
6678 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6679 a1=fprim0*delta/(f1-f0)
6685 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6686 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6688 end subroutine spline1
6689 !-----------------------------------------------------------------------------
6690 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6692 real(kind=8) :: x,x0,delta,f0x,f1x,fprim0x,fx
6693 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6698 a2=3*(f1x-f0x)-2*fprim0x*delta
6699 a3=fprim0x*delta-2*(f1x-f0x)
6700 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6702 end subroutine spline2
6703 !-----------------------------------------------------------------------------
6705 !-----------------------------------------------------------------------------
6706 subroutine etor(etors,edihcnstr)
6707 ! implicit real*8 (a-h,o-z)
6708 ! include 'DIMENSIONS'
6709 ! include 'COMMON.VAR'
6710 ! include 'COMMON.GEO'
6711 ! include 'COMMON.LOCAL'
6712 ! include 'COMMON.TORSION'
6713 ! include 'COMMON.INTERACT'
6714 ! include 'COMMON.DERIV'
6715 ! include 'COMMON.CHAIN'
6716 ! include 'COMMON.NAMES'
6717 ! include 'COMMON.IOUNITS'
6718 ! include 'COMMON.FFIELD'
6719 ! include 'COMMON.TORCNSTR'
6720 ! include 'COMMON.CONTROL'
6721 real(kind=8) :: etors,edihcnstr
6725 real(kind=8) :: phii,fac,etors_ii
6727 ! Set lprn=.true. for debugging
6731 do i=iphi_start,iphi_end
6733 if (itype(i-2,1).eq.ntyp1.or. itype(i-1,1).eq.ntyp1 &
6734 .or. itype(i,1).eq.ntyp1) cycle
6735 itori=itortyp(itype(i-2,1))
6736 itori1=itortyp(itype(i-1,1))
6739 ! Proline-Proline pair is a special case...
6740 if (itori.eq.3 .and. itori1.eq.3) then
6741 if (phii.gt.-dwapi3) then
6743 fac=1.0D0/(1.0D0-cosphi)
6744 etorsi=v1(1,3,3)*fac
6745 etorsi=etorsi+etorsi
6746 etors=etors+etorsi-v1(1,3,3)
6747 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6748 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6751 v1ij=v1(j+1,itori,itori1)
6752 v2ij=v2(j+1,itori,itori1)
6755 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6756 if (energy_dec) etors_ii=etors_ii+ &
6757 v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6758 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6762 v1ij=v1(j,itori,itori1)
6763 v2ij=v2(j,itori,itori1)
6766 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6767 if (energy_dec) etors_ii=etors_ii+ &
6768 v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6769 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6772 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6775 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6776 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
6777 (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6778 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6779 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6781 ! 6/20/98 - dihedral angle constraints
6784 itori=idih_constr(i)
6787 if (difi.gt.drange(i)) then
6789 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6790 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6791 else if (difi.lt.-drange(i)) then
6793 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6794 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6796 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6797 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6799 ! write (iout,*) 'edihcnstr',edihcnstr
6802 !-----------------------------------------------------------------------------
6803 subroutine etor_d(etors_d)
6804 real(kind=8) :: etors_d
6807 end subroutine etor_d
6809 !-----------------------------------------------------------------------------
6810 subroutine etor(etors,edihcnstr)
6811 ! implicit real*8 (a-h,o-z)
6812 ! include 'DIMENSIONS'
6813 ! include 'COMMON.VAR'
6814 ! include 'COMMON.GEO'
6815 ! include 'COMMON.LOCAL'
6816 ! include 'COMMON.TORSION'
6817 ! include 'COMMON.INTERACT'
6818 ! include 'COMMON.DERIV'
6819 ! include 'COMMON.CHAIN'
6820 ! include 'COMMON.NAMES'
6821 ! include 'COMMON.IOUNITS'
6822 ! include 'COMMON.FFIELD'
6823 ! include 'COMMON.TORCNSTR'
6824 ! include 'COMMON.CONTROL'
6825 real(kind=8) :: etors,edihcnstr
6828 integer :: i,j,iblock,itori,itori1
6829 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
6830 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
6831 ! Set lprn=.true. for debugging
6835 do i=iphi_start,iphi_end
6836 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
6837 .or. itype(i-3,1).eq.ntyp1 &
6838 .or. itype(i,1).eq.ntyp1) cycle
6840 if (iabs(itype(i,1)).eq.20) then
6845 itori=itortyp(itype(i-2,1))
6846 itori1=itortyp(itype(i-1,1))
6849 ! Regular cosine and sine terms
6850 do j=1,nterm(itori,itori1,iblock)
6851 v1ij=v1(j,itori,itori1,iblock)
6852 v2ij=v2(j,itori,itori1,iblock)
6855 etors=etors+v1ij*cosphi+v2ij*sinphi
6856 if (energy_dec) etors_ii=etors_ii+ &
6857 v1ij*cosphi+v2ij*sinphi
6858 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6862 ! E = SUM ----------------------------------- - v1
6863 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6865 cosphi=dcos(0.5d0*phii)
6866 sinphi=dsin(0.5d0*phii)
6867 do j=1,nlor(itori,itori1,iblock)
6868 vl1ij=vlor1(j,itori,itori1)
6869 vl2ij=vlor2(j,itori,itori1)
6870 vl3ij=vlor3(j,itori,itori1)
6871 pom=vl2ij*cosphi+vl3ij*sinphi
6872 pom1=1.0d0/(pom*pom+1.0d0)
6873 etors=etors+vl1ij*pom1
6874 if (energy_dec) etors_ii=etors_ii+ &
6877 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6879 ! Subtract the constant term
6880 etors=etors-v0(itori,itori1,iblock)
6881 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6882 'etor',i,etors_ii-v0(itori,itori1,iblock)
6884 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6885 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
6886 (v1(j,itori,itori1,iblock),j=1,6),&
6887 (v2(j,itori,itori1,iblock),j=1,6)
6888 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6889 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6891 ! 6/20/98 - dihedral angle constraints
6893 ! do i=1,ndih_constr
6894 do i=idihconstr_start,idihconstr_end
6895 itori=idih_constr(i)
6897 difi=pinorm(phii-phi0(i))
6898 if (difi.gt.drange(i)) then
6900 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6901 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6902 else if (difi.lt.-drange(i)) then
6904 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6905 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6909 !d write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6910 !d & rad2deg*phi0(i), rad2deg*drange(i),
6911 !d & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6913 !d write (iout,*) 'edihcnstr',edihcnstr
6916 !-----------------------------------------------------------------------------
6917 subroutine etor_d(etors_d)
6918 ! 6/23/01 Compute double torsional energy
6919 ! implicit real*8 (a-h,o-z)
6920 ! include 'DIMENSIONS'
6921 ! include 'COMMON.VAR'
6922 ! include 'COMMON.GEO'
6923 ! include 'COMMON.LOCAL'
6924 ! include 'COMMON.TORSION'
6925 ! include 'COMMON.INTERACT'
6926 ! include 'COMMON.DERIV'
6927 ! include 'COMMON.CHAIN'
6928 ! include 'COMMON.NAMES'
6929 ! include 'COMMON.IOUNITS'
6930 ! include 'COMMON.FFIELD'
6931 ! include 'COMMON.TORCNSTR'
6932 real(kind=8) :: etors_d,etors_d_ii
6935 integer :: i,j,k,l,itori,itori1,itori2,iblock
6936 real(kind=8) :: phii,phii1,gloci1,gloci2,&
6937 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
6938 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
6939 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
6940 ! Set lprn=.true. for debugging
6944 ! write(iout,*) "a tu??"
6945 do i=iphid_start,iphid_end
6947 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
6948 .or. itype(i-3,1).eq.ntyp1 &
6949 .or. itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
6950 itori=itortyp(itype(i-2,1))
6951 itori1=itortyp(itype(i-1,1))
6952 itori2=itortyp(itype(i,1))
6958 if (iabs(itype(i+1,1)).eq.20) iblock=2
6960 ! Regular cosine and sine terms
6961 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6962 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6963 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6964 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6965 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6966 cosphi1=dcos(j*phii)
6967 sinphi1=dsin(j*phii)
6968 cosphi2=dcos(j*phii1)
6969 sinphi2=dsin(j*phii1)
6970 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
6971 v2cij*cosphi2+v2sij*sinphi2
6972 if (energy_dec) etors_d_ii=etors_d_ii+ &
6973 v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
6974 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6975 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6977 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6979 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6980 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6981 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6982 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6983 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6984 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6985 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6986 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6987 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
6988 v1sdij*sinphi1p2+v2sdij*sinphi1m2
6989 if (energy_dec) etors_d_ii=etors_d_ii+ &
6990 v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
6991 v1sdij*sinphi1p2+v2sdij*sinphi1m2
6992 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
6993 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6994 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
6995 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6998 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6999 'etor_d',i,etors_d_ii
7000 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7001 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7004 end subroutine etor_d
7006 !-----------------------------------------------------------------------------
7007 subroutine eback_sc_corr(esccor)
7008 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
7009 ! conformational states; temporarily implemented as differences
7010 ! between UNRES torsional potentials (dependent on three types of
7011 ! residues) and the torsional potentials dependent on all 20 types
7012 ! of residues computed from AM1 energy surfaces of terminally-blocked
7013 ! amino-acid residues.
7014 ! implicit real*8 (a-h,o-z)
7015 ! include 'DIMENSIONS'
7016 ! include 'COMMON.VAR'
7017 ! include 'COMMON.GEO'
7018 ! include 'COMMON.LOCAL'
7019 ! include 'COMMON.TORSION'
7020 ! include 'COMMON.SCCOR'
7021 ! include 'COMMON.INTERACT'
7022 ! include 'COMMON.DERIV'
7023 ! include 'COMMON.CHAIN'
7024 ! include 'COMMON.NAMES'
7025 ! include 'COMMON.IOUNITS'
7026 ! include 'COMMON.FFIELD'
7027 ! include 'COMMON.CONTROL'
7028 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
7031 integer :: i,interty,j,isccori,isccori1,intertyp
7032 ! Set lprn=.true. for debugging
7035 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7037 do i=itau_start,itau_end
7038 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1)) cycle
7040 isccori=isccortyp(itype(i-2,1))
7041 isccori1=isccortyp(itype(i-1,1))
7043 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7045 do intertyp=1,3 !intertyp
7047 !c Added 09 May 2012 (Adasko)
7048 !c Intertyp means interaction type of backbone mainchain correlation:
7049 ! 1 = SC...Ca...Ca...Ca
7050 ! 2 = Ca...Ca...Ca...SC
7051 ! 3 = SC...Ca...Ca...SCi
7053 if (((intertyp.eq.3).and.((itype(i-2,1).eq.10).or. &
7054 (itype(i-1,1).eq.10).or.(itype(i-2,1).eq.ntyp1).or. &
7055 (itype(i-1,1).eq.ntyp1))) &
7056 .or. ((intertyp.eq.1).and.((itype(i-2,1).eq.10) &
7057 .or.(itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1) &
7058 .or.(itype(i,1).eq.ntyp1))) &
7059 .or.((intertyp.eq.2).and.((itype(i-1,1).eq.10).or. &
7060 (itype(i-1,1).eq.ntyp1).or.(itype(i-2,1).eq.ntyp1).or. &
7061 (itype(i-3,1).eq.ntyp1)))) cycle
7062 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1,1).eq.ntyp1)) cycle
7063 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres,1).eq.ntyp1)) &
7065 do j=1,nterm_sccor(isccori,isccori1)
7066 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7067 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7068 cosphi=dcos(j*tauangle(intertyp,i))
7069 sinphi=dsin(j*tauangle(intertyp,i))
7070 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
7071 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7072 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7074 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
7075 'esccor',i,intertyp,esccor_ii
7076 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7077 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7079 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
7080 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,isccori,isccori1,&
7081 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
7082 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7083 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7088 end subroutine eback_sc_corr
7089 !-----------------------------------------------------------------------------
7090 subroutine multibody(ecorr)
7091 ! This subroutine calculates multi-body contributions to energy following
7092 ! the idea of Skolnick et al. If side chains I and J make a contact and
7093 ! at the same time side chains I+1 and J+1 make a contact, an extra
7094 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7095 ! implicit real*8 (a-h,o-z)
7096 ! include 'DIMENSIONS'
7097 ! include 'COMMON.IOUNITS'
7098 ! include 'COMMON.DERIV'
7099 ! include 'COMMON.INTERACT'
7100 ! include 'COMMON.CONTACTS'
7101 real(kind=8),dimension(3) :: gx,gx1
7103 real(kind=8) :: ecorr
7104 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
7105 ! Set lprn=.true. for debugging
7109 write (iout,'(a)') 'Contact function values:'
7111 write (iout,'(i2,20(1x,i2,f10.5))') &
7112 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7117 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7118 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7130 num_conti=num_cont(i)
7131 num_conti1=num_cont(i1)
7136 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7137 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7138 !d & ' ishift=',ishift
7139 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7140 ! The system gains extra energy.
7141 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7142 endif ! j1==j+-ishift
7150 end subroutine multibody
7151 !-----------------------------------------------------------------------------
7152 real(kind=8) function esccorr(i,j,k,l,jj,kk)
7153 ! implicit real*8 (a-h,o-z)
7154 ! include 'DIMENSIONS'
7155 ! include 'COMMON.IOUNITS'
7156 ! include 'COMMON.DERIV'
7157 ! include 'COMMON.INTERACT'
7158 ! include 'COMMON.CONTACTS'
7159 real(kind=8),dimension(3) :: gx,gx1
7161 integer :: i,j,k,l,jj,kk,m,ll
7162 real(kind=8) :: eij,ekl
7166 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7167 ! Calculate the multi-body contribution to energy.
7168 ! Calculate multi-body contributions to the gradient.
7169 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7170 !d & k,l,(gacont(m,kk,k),m=1,3)
7172 gx(m) =ekl*gacont(m,jj,i)
7173 gx1(m)=eij*gacont(m,kk,k)
7174 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7175 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7176 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7177 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7181 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7186 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7191 end function esccorr
7192 !-----------------------------------------------------------------------------
7193 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7194 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7195 ! implicit real*8 (a-h,o-z)
7196 ! include 'DIMENSIONS'
7197 ! include 'COMMON.IOUNITS'
7200 ! integer :: maxconts !max_cont=maxconts =nres/4
7201 integer,parameter :: max_dim=26
7202 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7203 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7204 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7205 !el common /przechowalnia/ zapas
7206 integer :: status(MPI_STATUS_SIZE)
7207 integer,dimension((nres/4)*2) :: req !maxconts*2
7208 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
7210 ! include 'COMMON.SETUP'
7211 ! include 'COMMON.FFIELD'
7212 ! include 'COMMON.DERIV'
7213 ! include 'COMMON.INTERACT'
7214 ! include 'COMMON.CONTACTS'
7215 ! include 'COMMON.CONTROL'
7216 ! include 'COMMON.LOCAL'
7217 real(kind=8),dimension(3) :: gx,gx1
7218 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
7219 logical :: lprn,ldone
7221 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
7222 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
7224 ! Set lprn=.true. for debugging
7228 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7231 if (nfgtasks.le.1) goto 30
7233 write (iout,'(a)') 'Contact function values before RECEIVE:'
7235 write (iout,'(2i3,50(1x,i2,f5.2))') &
7236 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7241 do i=1,ntask_cont_from
7244 do i=1,ntask_cont_to
7247 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7249 ! Make the list of contacts to send to send to other procesors
7250 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7252 do i=iturn3_start,iturn3_end
7253 ! write (iout,*) "make contact list turn3",i," num_cont",
7255 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7257 do i=iturn4_start,iturn4_end
7258 ! write (iout,*) "make contact list turn4",i," num_cont",
7260 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7264 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7266 do j=1,num_cont_hb(i)
7269 iproc=iint_sent_local(k,jjc,ii)
7270 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7271 if (iproc.gt.0) then
7272 ncont_sent(iproc)=ncont_sent(iproc)+1
7273 nn=ncont_sent(iproc)
7275 zapas(2,nn,iproc)=jjc
7276 zapas(3,nn,iproc)=facont_hb(j,i)
7277 zapas(4,nn,iproc)=ees0p(j,i)
7278 zapas(5,nn,iproc)=ees0m(j,i)
7279 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7280 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7281 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7282 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7283 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7284 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7285 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7286 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7287 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7288 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7289 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7290 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7291 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7292 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7293 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7294 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7295 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7296 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7297 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7298 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7299 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7306 "Numbers of contacts to be sent to other processors",&
7307 (ncont_sent(i),i=1,ntask_cont_to)
7308 write (iout,*) "Contacts sent"
7309 do ii=1,ntask_cont_to
7311 iproc=itask_cont_to(ii)
7312 write (iout,*) nn," contacts to processor",iproc,&
7313 " of CONT_TO_COMM group"
7315 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7323 CorrelID1=nfgtasks+fg_rank+1
7325 ! Receive the numbers of needed contacts from other processors
7326 do ii=1,ntask_cont_from
7327 iproc=itask_cont_from(ii)
7329 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7330 FG_COMM,req(ireq),IERR)
7332 ! write (iout,*) "IRECV ended"
7334 ! Send the number of contacts needed by other processors
7335 do ii=1,ntask_cont_to
7336 iproc=itask_cont_to(ii)
7338 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7339 FG_COMM,req(ireq),IERR)
7341 ! write (iout,*) "ISEND ended"
7342 ! write (iout,*) "number of requests (nn)",ireq
7345 call MPI_Waitall(ireq,req,status_array,ierr)
7347 ! & "Numbers of contacts to be received from other processors",
7348 ! & (ncont_recv(i),i=1,ntask_cont_from)
7352 do ii=1,ntask_cont_from
7353 iproc=itask_cont_from(ii)
7355 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7356 ! & " of CONT_TO_COMM group"
7360 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7361 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7362 ! write (iout,*) "ireq,req",ireq,req(ireq)
7365 ! Send the contacts to processors that need them
7366 do ii=1,ntask_cont_to
7367 iproc=itask_cont_to(ii)
7369 ! write (iout,*) nn," contacts to processor",iproc,
7370 ! & " of CONT_TO_COMM group"
7373 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7374 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7375 ! write (iout,*) "ireq,req",ireq,req(ireq)
7377 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7381 ! write (iout,*) "number of requests (contacts)",ireq
7382 ! write (iout,*) "req",(req(i),i=1,4)
7385 call MPI_Waitall(ireq,req,status_array,ierr)
7386 do iii=1,ntask_cont_from
7387 iproc=itask_cont_from(iii)
7390 write (iout,*) "Received",nn," contacts from processor",iproc,&
7391 " of CONT_FROM_COMM group"
7394 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7399 ii=zapas_recv(1,i,iii)
7400 ! Flag the received contacts to prevent double-counting
7401 jj=-zapas_recv(2,i,iii)
7402 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7404 nnn=num_cont_hb(ii)+1
7407 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7408 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7409 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7410 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7411 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7412 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7413 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7414 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7415 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7416 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7417 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7418 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7419 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7420 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7421 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7422 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7423 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7424 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7425 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7426 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7427 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7428 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7429 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7430 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7435 write (iout,'(a)') 'Contact function values after receive:'
7437 write (iout,'(2i3,50(1x,i3,f5.2))') &
7438 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7446 write (iout,'(a)') 'Contact function values:'
7448 write (iout,'(2i3,50(1x,i3,f5.2))') &
7449 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7455 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7456 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7457 ! Remove the loop below after debugging !!!
7464 ! Calculate the local-electrostatic correlation terms
7465 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7467 num_conti=num_cont_hb(i)
7468 num_conti1=num_cont_hb(i+1)
7475 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
7476 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
7477 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7478 .or. j.lt.0 .and. j1.gt.0) .and. &
7479 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7480 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7481 ! The system gains extra energy.
7482 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7483 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
7484 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7486 else if (j1.eq.j) then
7487 ! Contacts I-J and I-(J+1) occur simultaneously.
7488 ! The system loses extra energy.
7489 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7494 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7495 ! & ' jj=',jj,' kk=',kk
7497 ! Contacts I-J and (I+1)-J occur simultaneously.
7498 ! The system loses extra energy.
7499 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7505 end subroutine multibody_hb
7506 !-----------------------------------------------------------------------------
7507 subroutine add_hb_contact(ii,jj,itask)
7508 ! implicit real*8 (a-h,o-z)
7509 ! include "DIMENSIONS"
7510 ! include "COMMON.IOUNITS"
7511 ! include "COMMON.CONTACTS"
7512 ! integer,parameter :: maxconts=nres/4
7513 integer,parameter :: max_dim=26
7514 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7515 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7516 ! common /przechowalnia/ zapas
7517 integer :: i,j,ii,jj,iproc,nn,jjc
7518 integer,dimension(4) :: itask
7519 ! write (iout,*) "itask",itask
7522 if (iproc.gt.0) then
7523 do j=1,num_cont_hb(ii)
7525 ! write (iout,*) "i",ii," j",jj," jjc",jjc
7527 ncont_sent(iproc)=ncont_sent(iproc)+1
7528 nn=ncont_sent(iproc)
7529 zapas(1,nn,iproc)=ii
7530 zapas(2,nn,iproc)=jjc
7531 zapas(3,nn,iproc)=facont_hb(j,ii)
7532 zapas(4,nn,iproc)=ees0p(j,ii)
7533 zapas(5,nn,iproc)=ees0m(j,ii)
7534 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7535 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7536 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7537 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7538 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7539 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7540 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7541 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7542 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7543 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7544 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7545 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7546 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7547 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7548 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7549 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7550 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7551 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7552 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7553 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7554 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7561 end subroutine add_hb_contact
7562 !-----------------------------------------------------------------------------
7563 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
7564 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7565 ! implicit real*8 (a-h,o-z)
7566 ! include 'DIMENSIONS'
7567 ! include 'COMMON.IOUNITS'
7568 integer,parameter :: max_dim=70
7571 ! integer :: maxconts !max_cont=maxconts=nres/4
7572 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7573 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7574 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7575 ! common /przechowalnia/ zapas
7576 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
7577 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
7580 ! include 'COMMON.SETUP'
7581 ! include 'COMMON.FFIELD'
7582 ! include 'COMMON.DERIV'
7583 ! include 'COMMON.LOCAL'
7584 ! include 'COMMON.INTERACT'
7585 ! include 'COMMON.CONTACTS'
7586 ! include 'COMMON.CHAIN'
7587 ! include 'COMMON.CONTROL'
7588 real(kind=8),dimension(3) :: gx,gx1
7589 integer,dimension(nres) :: num_cont_hb_old
7590 logical :: lprn,ldone
7591 !EL double precision eello4,eello5,eelo6,eello_turn6
7592 !EL external eello4,eello5,eello6,eello_turn6
7594 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
7595 j1,jp1,i1,num_conti1
7596 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
7597 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
7599 ! Set lprn=.true. for debugging
7604 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7606 num_cont_hb_old(i)=num_cont_hb(i)
7610 if (nfgtasks.le.1) goto 30
7612 write (iout,'(a)') 'Contact function values before RECEIVE:'
7614 write (iout,'(2i3,50(1x,i2,f5.2))') &
7615 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7620 do i=1,ntask_cont_from
7623 do i=1,ntask_cont_to
7626 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7628 ! Make the list of contacts to send to send to other procesors
7629 do i=iturn3_start,iturn3_end
7630 ! write (iout,*) "make contact list turn3",i," num_cont",
7632 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7634 do i=iturn4_start,iturn4_end
7635 ! write (iout,*) "make contact list turn4",i," num_cont",
7637 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7641 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7643 do j=1,num_cont_hb(i)
7646 iproc=iint_sent_local(k,jjc,ii)
7647 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7648 if (iproc.ne.0) then
7649 ncont_sent(iproc)=ncont_sent(iproc)+1
7650 nn=ncont_sent(iproc)
7652 zapas(2,nn,iproc)=jjc
7653 zapas(3,nn,iproc)=d_cont(j,i)
7657 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7662 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7670 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7681 "Numbers of contacts to be sent to other processors",&
7682 (ncont_sent(i),i=1,ntask_cont_to)
7683 write (iout,*) "Contacts sent"
7684 do ii=1,ntask_cont_to
7686 iproc=itask_cont_to(ii)
7687 write (iout,*) nn," contacts to processor",iproc,&
7688 " of CONT_TO_COMM group"
7690 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7698 CorrelID1=nfgtasks+fg_rank+1
7700 ! Receive the numbers of needed contacts from other processors
7701 do ii=1,ntask_cont_from
7702 iproc=itask_cont_from(ii)
7704 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7705 FG_COMM,req(ireq),IERR)
7707 ! write (iout,*) "IRECV ended"
7709 ! Send the number of contacts needed by other processors
7710 do ii=1,ntask_cont_to
7711 iproc=itask_cont_to(ii)
7713 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7714 FG_COMM,req(ireq),IERR)
7716 ! write (iout,*) "ISEND ended"
7717 ! write (iout,*) "number of requests (nn)",ireq
7720 call MPI_Waitall(ireq,req,status_array,ierr)
7722 ! & "Numbers of contacts to be received from other processors",
7723 ! & (ncont_recv(i),i=1,ntask_cont_from)
7727 do ii=1,ntask_cont_from
7728 iproc=itask_cont_from(ii)
7730 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7731 ! & " of CONT_TO_COMM group"
7735 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7736 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7737 ! write (iout,*) "ireq,req",ireq,req(ireq)
7740 ! Send the contacts to processors that need them
7741 do ii=1,ntask_cont_to
7742 iproc=itask_cont_to(ii)
7744 ! write (iout,*) nn," contacts to processor",iproc,
7745 ! & " of CONT_TO_COMM group"
7748 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7749 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7750 ! write (iout,*) "ireq,req",ireq,req(ireq)
7752 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7756 ! write (iout,*) "number of requests (contacts)",ireq
7757 ! write (iout,*) "req",(req(i),i=1,4)
7760 call MPI_Waitall(ireq,req,status_array,ierr)
7761 do iii=1,ntask_cont_from
7762 iproc=itask_cont_from(iii)
7765 write (iout,*) "Received",nn," contacts from processor",iproc,&
7766 " of CONT_FROM_COMM group"
7769 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7774 ii=zapas_recv(1,i,iii)
7775 ! Flag the received contacts to prevent double-counting
7776 jj=-zapas_recv(2,i,iii)
7777 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7779 nnn=num_cont_hb(ii)+1
7782 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7786 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7791 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7799 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7808 write (iout,'(a)') 'Contact function values after receive:'
7810 write (iout,'(2i3,50(1x,i3,5f6.3))') &
7811 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
7812 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7819 write (iout,'(a)') 'Contact function values:'
7821 write (iout,'(2i3,50(1x,i2,5f6.3))') &
7822 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
7823 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7830 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7831 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7832 ! Remove the loop below after debugging !!!
7839 ! Calculate the dipole-dipole interaction energies
7840 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7841 do i=iatel_s,iatel_e+1
7842 num_conti=num_cont_hb(i)
7851 ! Calculate the local-electrostatic correlation terms
7852 ! write (iout,*) "gradcorr5 in eello5 before loop"
7854 ! write (iout,'(i5,3f10.5)')
7855 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7857 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7858 ! write (iout,*) "corr loop i",i
7860 num_conti=num_cont_hb(i)
7861 num_conti1=num_cont_hb(i+1)
7868 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7869 ! & ' jj=',jj,' kk=',kk
7870 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
7871 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7872 .or. j.lt.0 .and. j1.gt.0) .and. &
7873 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7874 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7875 ! The system gains extra energy.
7877 sqd1=dsqrt(d_cont(jj,i))
7878 sqd2=dsqrt(d_cont(kk,i1))
7879 sred_geom = sqd1*sqd2
7880 IF (sred_geom.lt.cutoff_corr) THEN
7881 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
7883 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7884 !d & ' jj=',jj,' kk=',kk
7885 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7886 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7888 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7889 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7892 !d write (iout,*) 'sred_geom=',sred_geom,
7893 !d & ' ekont=',ekont,' fprim=',fprimcont,
7894 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7895 !d write (iout,*) "g_contij",g_contij
7896 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7897 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7898 call calc_eello(i,jp,i+1,jp1,jj,kk)
7899 if (wcorr4.gt.0.0d0) &
7900 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7901 if (energy_dec.and.wcorr4.gt.0.0d0) &
7902 write (iout,'(a6,4i5,0pf7.3)') &
7903 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7904 ! write (iout,*) "gradcorr5 before eello5"
7906 ! write (iout,'(i5,3f10.5)')
7907 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7909 if (wcorr5.gt.0.0d0) &
7910 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7911 ! write (iout,*) "gradcorr5 after eello5"
7913 ! write (iout,'(i5,3f10.5)')
7914 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7916 if (energy_dec.and.wcorr5.gt.0.0d0) &
7917 write (iout,'(a6,4i5,0pf7.3)') &
7918 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7919 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7920 !d write(2,*)'ijkl',i,jp,i+1,jp1
7921 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
7922 .or. wturn6.eq.0.0d0))then
7923 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7924 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7925 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
7926 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7927 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7928 !d & 'ecorr6=',ecorr6
7929 !d write (iout,'(4e15.5)') sred_geom,
7930 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7931 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7932 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7933 else if (wturn6.gt.0.0d0 &
7934 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7935 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7936 eturn6=eturn6+eello_turn6(i,jj,kk)
7937 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
7938 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7939 !d write (2,*) 'multibody_eello:eturn6',eturn6
7948 num_cont_hb(i)=num_cont_hb_old(i)
7950 ! write (iout,*) "gradcorr5 in eello5"
7952 ! write (iout,'(i5,3f10.5)')
7953 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7956 end subroutine multibody_eello
7957 !-----------------------------------------------------------------------------
7958 subroutine add_hb_contact_eello(ii,jj,itask)
7959 ! implicit real*8 (a-h,o-z)
7960 ! include "DIMENSIONS"
7961 ! include "COMMON.IOUNITS"
7962 ! include "COMMON.CONTACTS"
7963 ! integer,parameter :: maxconts=nres/4
7964 integer,parameter :: max_dim=70
7965 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7966 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7967 ! common /przechowalnia/ zapas
7969 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
7970 integer,dimension(4) ::itask
7971 ! write (iout,*) "itask",itask
7974 if (iproc.gt.0) then
7975 do j=1,num_cont_hb(ii)
7977 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7979 ncont_sent(iproc)=ncont_sent(iproc)+1
7980 nn=ncont_sent(iproc)
7981 zapas(1,nn,iproc)=ii
7982 zapas(2,nn,iproc)=jjc
7983 zapas(3,nn,iproc)=d_cont(j,ii)
7987 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7992 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8000 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8011 end subroutine add_hb_contact_eello
8012 !-----------------------------------------------------------------------------
8013 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8014 ! implicit real*8 (a-h,o-z)
8015 ! include 'DIMENSIONS'
8016 ! include 'COMMON.IOUNITS'
8017 ! include 'COMMON.DERIV'
8018 ! include 'COMMON.INTERACT'
8019 ! include 'COMMON.CONTACTS'
8020 real(kind=8),dimension(3) :: gx,gx1
8023 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
8024 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
8025 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
8026 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
8037 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8038 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8039 ! Following 4 lines for diagnostics.
8044 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8045 ! & 'Contacts ',i,j,
8046 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8047 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8049 ! Calculate the multi-body contribution to energy.
8050 ! ecorr=ecorr+ekont*ees
8051 ! Calculate multi-body contributions to the gradient.
8052 coeffpees0pij=coeffp*ees0pij
8053 coeffmees0mij=coeffm*ees0mij
8054 coeffpees0pkl=coeffp*ees0pkl
8055 coeffmees0mkl=coeffm*ees0mkl
8057 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8058 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
8059 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
8060 coeffmees0mkl*gacontm_hb1(ll,jj,i))
8061 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
8062 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
8063 coeffmees0mkl*gacontm_hb2(ll,jj,i))
8064 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8065 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
8066 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
8067 coeffmees0mij*gacontm_hb1(ll,kk,k))
8068 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
8069 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
8070 coeffmees0mij*gacontm_hb2(ll,kk,k))
8071 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
8072 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
8073 coeffmees0mkl*gacontm_hb3(ll,jj,i))
8074 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8075 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8076 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
8077 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
8078 coeffmees0mij*gacontm_hb3(ll,kk,k))
8079 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8080 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8081 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8086 !grad gradcorr(ll,m)=gradcorr(ll,m)+
8087 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
8088 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8089 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8094 !grad gradcorr(ll,m)=gradcorr(ll,m)+
8095 !grad & ees*eij*gacont_hbr(ll,kk,k)-
8096 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8097 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8100 ! write (iout,*) "ehbcorr",ekont*ees
8102 if (shield_mode.gt.0) then
8105 !C print *,i,j,fac_shield(i),fac_shield(j),
8106 !C &fac_shield(k),fac_shield(l)
8107 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
8108 (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
8109 do ilist=1,ishield_list(i)
8110 iresshield=shield_list(ilist,i)
8112 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
8113 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8115 +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
8116 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8120 do ilist=1,ishield_list(j)
8121 iresshield=shield_list(ilist,j)
8123 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
8124 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8126 +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
8127 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8132 do ilist=1,ishield_list(k)
8133 iresshield=shield_list(ilist,k)
8135 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
8136 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8138 +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
8139 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8143 do ilist=1,ishield_list(l)
8144 iresshield=shield_list(ilist,l)
8146 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
8147 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8149 +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
8150 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8155 gshieldc_ec(m,i)=gshieldc_ec(m,i)+ &
8156 grad_shield(m,i)*ehbcorr/fac_shield(i)
8157 gshieldc_ec(m,j)=gshieldc_ec(m,j)+ &
8158 grad_shield(m,j)*ehbcorr/fac_shield(j)
8159 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ &
8160 grad_shield(m,i)*ehbcorr/fac_shield(i)
8161 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ &
8162 grad_shield(m,j)*ehbcorr/fac_shield(j)
8164 gshieldc_ec(m,k)=gshieldc_ec(m,k)+ &
8165 grad_shield(m,k)*ehbcorr/fac_shield(k)
8166 gshieldc_ec(m,l)=gshieldc_ec(m,l)+ &
8167 grad_shield(m,l)*ehbcorr/fac_shield(l)
8168 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ &
8169 grad_shield(m,k)*ehbcorr/fac_shield(k)
8170 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ &
8171 grad_shield(m,l)*ehbcorr/fac_shield(l)
8177 end function ehbcorr
8179 !-----------------------------------------------------------------------------
8180 subroutine dipole(i,j,jj)
8181 ! implicit real*8 (a-h,o-z)
8182 ! include 'DIMENSIONS'
8183 ! include 'COMMON.IOUNITS'
8184 ! include 'COMMON.CHAIN'
8185 ! include 'COMMON.FFIELD'
8186 ! include 'COMMON.DERIV'
8187 ! include 'COMMON.INTERACT'
8188 ! include 'COMMON.CONTACTS'
8189 ! include 'COMMON.TORSION'
8190 ! include 'COMMON.VAR'
8191 ! include 'COMMON.GEO'
8192 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
8193 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
8194 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
8196 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
8197 allocate(dipderx(3,5,4,maxconts,nres))
8200 iti1 = itortyp(itype(i+1,1))
8201 if (j.lt.nres-1) then
8202 itj1 = itortyp(itype(j+1,1))
8207 dipi(iii,1)=Ub2(iii,i)
8208 dipderi(iii)=Ub2der(iii,i)
8209 dipi(iii,2)=b1(iii,iti1)
8210 dipj(iii,1)=Ub2(iii,j)
8211 dipderj(iii)=Ub2der(iii,j)
8212 dipj(iii,2)=b1(iii,itj1)
8216 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8219 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8226 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
8230 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8235 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8236 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8238 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8240 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8242 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8245 end subroutine dipole
8247 !-----------------------------------------------------------------------------
8248 subroutine calc_eello(i,j,k,l,jj,kk)
8250 ! This subroutine computes matrices and vectors needed to calculate
8251 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
8254 ! implicit real*8 (a-h,o-z)
8255 ! include 'DIMENSIONS'
8256 ! include 'COMMON.IOUNITS'
8257 ! include 'COMMON.CHAIN'
8258 ! include 'COMMON.DERIV'
8259 ! include 'COMMON.INTERACT'
8260 ! include 'COMMON.CONTACTS'
8261 ! include 'COMMON.TORSION'
8262 ! include 'COMMON.VAR'
8263 ! include 'COMMON.GEO'
8264 ! include 'COMMON.FFIELD'
8265 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
8266 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
8267 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
8270 !el common /kutas/ lprn
8271 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8272 !d & ' jj=',jj,' kk=',kk
8273 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8274 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8275 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8278 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8279 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8282 call transpose2(aa1(1,1),aa1t(1,1))
8283 call transpose2(aa2(1,1),aa2t(1,1))
8286 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
8287 aa1tder(1,1,lll,kkk))
8288 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
8289 aa2tder(1,1,lll,kkk))
8293 ! parallel orientation of the two CA-CA-CA frames.
8295 iti=itortyp(itype(i,1))
8299 itk1=itortyp(itype(k+1,1))
8300 itj=itortyp(itype(j,1))
8301 if (l.lt.nres-1) then
8302 itl1=itortyp(itype(l+1,1))
8306 ! A1 kernel(j+1) A2T
8308 !d write (iout,'(3f10.5,5x,3f10.5)')
8309 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8311 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8312 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
8313 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8314 ! Following matrices are needed only for 6-th order cumulants
8315 IF (wcorr6.gt.0.0d0) THEN
8316 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8317 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
8318 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8319 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8320 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
8321 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8322 ADtEAderx(1,1,1,1,1,1))
8324 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8325 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
8326 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8327 ADtEA1derx(1,1,1,1,1,1))
8329 ! End 6-th order cumulants
8332 !d write (2,*) 'In calc_eello6'
8334 !d write (2,*) 'iii=',iii
8336 !d write (2,*) 'kkk=',kkk
8338 !d write (2,'(3(2f10.5),5x)')
8339 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8344 call transpose2(EUgder(1,1,k),auxmat(1,1))
8345 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8346 call transpose2(EUg(1,1,k),auxmat(1,1))
8347 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8348 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8352 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8353 EAEAderx(1,1,lll,kkk,iii,1))
8357 ! A1T kernel(i+1) A2
8358 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8359 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
8360 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8361 ! Following matrices are needed only for 6-th order cumulants
8362 IF (wcorr6.gt.0.0d0) THEN
8363 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8364 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
8365 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8366 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8367 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
8368 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8369 ADtEAderx(1,1,1,1,1,2))
8370 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8371 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
8372 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8373 ADtEA1derx(1,1,1,1,1,2))
8375 ! End 6-th order cumulants
8376 call transpose2(EUgder(1,1,l),auxmat(1,1))
8377 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8378 call transpose2(EUg(1,1,l),auxmat(1,1))
8379 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8380 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8384 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8385 EAEAderx(1,1,lll,kkk,iii,2))
8390 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8391 ! They are needed only when the fifth- or the sixth-order cumulants are
8393 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8394 call transpose2(AEA(1,1,1),auxmat(1,1))
8395 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8396 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8397 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8398 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8399 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8400 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8401 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8402 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8403 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8404 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8405 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8406 call transpose2(AEA(1,1,2),auxmat(1,1))
8407 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
8408 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8409 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8410 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8411 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
8412 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8413 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
8414 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
8415 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8416 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8417 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8418 ! Calculate the Cartesian derivatives of the vectors.
8422 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8423 call matvec2(auxmat(1,1),b1(1,iti),&
8424 AEAb1derx(1,lll,kkk,iii,1,1))
8425 call matvec2(auxmat(1,1),Ub2(1,i),&
8426 AEAb2derx(1,lll,kkk,iii,1,1))
8427 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8428 AEAb1derx(1,lll,kkk,iii,2,1))
8429 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8430 AEAb2derx(1,lll,kkk,iii,2,1))
8431 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8432 call matvec2(auxmat(1,1),b1(1,itj),&
8433 AEAb1derx(1,lll,kkk,iii,1,2))
8434 call matvec2(auxmat(1,1),Ub2(1,j),&
8435 AEAb2derx(1,lll,kkk,iii,1,2))
8436 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
8437 AEAb1derx(1,lll,kkk,iii,2,2))
8438 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
8439 AEAb2derx(1,lll,kkk,iii,2,2))
8446 ! Antiparallel orientation of the two CA-CA-CA frames.
8448 iti=itortyp(itype(i,1))
8452 itk1=itortyp(itype(k+1,1))
8453 itl=itortyp(itype(l,1))
8454 itj=itortyp(itype(j,1))
8455 if (j.lt.nres-1) then
8456 itj1=itortyp(itype(j+1,1))
8460 ! A2 kernel(j-1)T A1T
8461 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8462 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
8463 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8464 ! Following matrices are needed only for 6-th order cumulants
8465 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8466 j.eq.i+4 .and. l.eq.i+3)) THEN
8467 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8468 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
8469 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8470 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8471 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
8472 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8473 ADtEAderx(1,1,1,1,1,1))
8474 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8475 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
8476 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8477 ADtEA1derx(1,1,1,1,1,1))
8479 ! End 6-th order cumulants
8480 call transpose2(EUgder(1,1,k),auxmat(1,1))
8481 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8482 call transpose2(EUg(1,1,k),auxmat(1,1))
8483 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8484 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8488 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8489 EAEAderx(1,1,lll,kkk,iii,1))
8493 ! A2T kernel(i+1)T A1
8494 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8495 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
8496 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8497 ! Following matrices are needed only for 6-th order cumulants
8498 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8499 j.eq.i+4 .and. l.eq.i+3)) THEN
8500 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8501 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
8502 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8503 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8504 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
8505 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8506 ADtEAderx(1,1,1,1,1,2))
8507 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8508 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
8509 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8510 ADtEA1derx(1,1,1,1,1,2))
8512 ! End 6-th order cumulants
8513 call transpose2(EUgder(1,1,j),auxmat(1,1))
8514 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8515 call transpose2(EUg(1,1,j),auxmat(1,1))
8516 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8517 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8521 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8522 EAEAderx(1,1,lll,kkk,iii,2))
8527 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8528 ! They are needed only when the fifth- or the sixth-order cumulants are
8530 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
8531 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8532 call transpose2(AEA(1,1,1),auxmat(1,1))
8533 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8534 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8535 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8536 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8537 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8538 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8539 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8540 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8541 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8542 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8543 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8544 call transpose2(AEA(1,1,2),auxmat(1,1))
8545 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
8546 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8547 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8548 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8549 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
8550 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8551 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
8552 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
8553 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8554 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8555 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8556 ! Calculate the Cartesian derivatives of the vectors.
8560 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8561 call matvec2(auxmat(1,1),b1(1,iti),&
8562 AEAb1derx(1,lll,kkk,iii,1,1))
8563 call matvec2(auxmat(1,1),Ub2(1,i),&
8564 AEAb2derx(1,lll,kkk,iii,1,1))
8565 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8566 AEAb1derx(1,lll,kkk,iii,2,1))
8567 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8568 AEAb2derx(1,lll,kkk,iii,2,1))
8569 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8570 call matvec2(auxmat(1,1),b1(1,itl),&
8571 AEAb1derx(1,lll,kkk,iii,1,2))
8572 call matvec2(auxmat(1,1),Ub2(1,l),&
8573 AEAb2derx(1,lll,kkk,iii,1,2))
8574 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
8575 AEAb1derx(1,lll,kkk,iii,2,2))
8576 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
8577 AEAb2derx(1,lll,kkk,iii,2,2))
8585 end subroutine calc_eello
8586 !-----------------------------------------------------------------------------
8587 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
8592 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
8593 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
8594 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
8595 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
8596 integer :: iii,kkk,lll
8599 !el common /kutas/ lprn
8600 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8602 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
8605 !d if (lprn) write (2,*) 'In kernel'
8607 !d if (lprn) write (2,*) 'kkk=',kkk
8609 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
8610 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8612 !d write (2,*) 'lll=',lll
8613 !d write (2,*) 'iii=1'
8615 !d write (2,'(3(2f10.5),5x)')
8616 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8619 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
8620 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8622 !d write (2,*) 'lll=',lll
8623 !d write (2,*) 'iii=2'
8625 !d write (2,'(3(2f10.5),5x)')
8626 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8632 end subroutine kernel
8633 !-----------------------------------------------------------------------------
8634 real(kind=8) function eello4(i,j,k,l,jj,kk)
8635 ! implicit real*8 (a-h,o-z)
8636 ! include 'DIMENSIONS'
8637 ! include 'COMMON.IOUNITS'
8638 ! include 'COMMON.CHAIN'
8639 ! include 'COMMON.DERIV'
8640 ! include 'COMMON.INTERACT'
8641 ! include 'COMMON.CONTACTS'
8642 ! include 'COMMON.TORSION'
8643 ! include 'COMMON.VAR'
8644 ! include 'COMMON.GEO'
8645 real(kind=8),dimension(2,2) :: pizda
8646 real(kind=8),dimension(3) :: ggg1,ggg2
8647 real(kind=8) :: eel4,glongij,glongkl
8648 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
8649 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8653 !d print *,'eello4:',i,j,k,l,jj,kk
8654 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
8655 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
8656 !old eij=facont_hb(jj,i)
8657 !old ekl=facont_hb(kk,k)
8659 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8660 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8661 gcorr_loc(k-1)=gcorr_loc(k-1) &
8662 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8664 gcorr_loc(l-1)=gcorr_loc(l-1) &
8665 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8667 gcorr_loc(j-1)=gcorr_loc(j-1) &
8668 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8673 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
8674 -EAEAderx(2,2,lll,kkk,iii,1)
8675 !d derx(lll,kkk,iii)=0.0d0
8679 !d gcorr_loc(l-1)=0.0d0
8680 !d gcorr_loc(j-1)=0.0d0
8681 !d gcorr_loc(k-1)=0.0d0
8683 !d write (iout,*)'Contacts have occurred for peptide groups',
8684 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
8685 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8686 if (j.lt.nres-1) then
8693 if (l.lt.nres-1) then
8701 !grad ggg1(ll)=eel4*g_contij(ll,1)
8702 !grad ggg2(ll)=eel4*g_contij(ll,2)
8703 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8704 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8705 !grad ghalf=0.5d0*ggg1(ll)
8706 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8707 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8708 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8709 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8710 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8711 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8712 !grad ghalf=0.5d0*ggg2(ll)
8713 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8714 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8715 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8716 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8717 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8718 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8722 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8727 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8732 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8737 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8741 !d write (2,*) iii,gcorr_loc(iii)
8744 !d write (2,*) 'ekont',ekont
8745 !d write (iout,*) 'eello4',ekont*eel4
8748 !-----------------------------------------------------------------------------
8749 real(kind=8) function eello5(i,j,k,l,jj,kk)
8750 ! implicit real*8 (a-h,o-z)
8751 ! include 'DIMENSIONS'
8752 ! include 'COMMON.IOUNITS'
8753 ! include 'COMMON.CHAIN'
8754 ! include 'COMMON.DERIV'
8755 ! include 'COMMON.INTERACT'
8756 ! include 'COMMON.CONTACTS'
8757 ! include 'COMMON.TORSION'
8758 ! include 'COMMON.VAR'
8759 ! include 'COMMON.GEO'
8760 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8761 real(kind=8),dimension(2) :: vv
8762 real(kind=8),dimension(3) :: ggg1,ggg2
8763 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
8764 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
8765 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
8766 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8771 ! /l\ / \ \ / \ / \ / C
8772 ! / \ / \ \ / \ / \ / C
8773 ! j| o |l1 | o | o| o | | o |o C
8774 ! \ |/k\| |/ \| / |/ \| |/ \| C
8775 ! \i/ \ / \ / / \ / \ C
8777 ! (I) (II) (III) (IV) C
8779 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8781 ! Antiparallel chains C
8784 ! /j\ / \ \ / \ / \ / C
8785 ! / \ / \ \ / \ / \ / C
8786 ! j1| o |l | o | o| o | | o |o C
8787 ! \ |/k\| |/ \| / |/ \| |/ \| C
8788 ! \i/ \ / \ / / \ / \ C
8790 ! (I) (II) (III) (IV) C
8792 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8794 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
8796 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8797 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8802 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8804 itk=itortyp(itype(k,1))
8805 itl=itortyp(itype(l,1))
8806 itj=itortyp(itype(j,1))
8811 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8812 !d & eel5_3_num,eel5_4_num)
8816 derx(lll,kkk,iii)=0.0d0
8820 !d eij=facont_hb(jj,i)
8821 !d ekl=facont_hb(kk,k)
8823 !d write (iout,*)'Contacts have occurred for peptide groups',
8824 !d & i,j,' fcont:',eij,' eij',' and ',k,l
8826 ! Contribution from the graph I.
8827 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8828 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8829 call transpose2(EUg(1,1,k),auxmat(1,1))
8830 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8831 vv(1)=pizda(1,1)-pizda(2,2)
8832 vv(2)=pizda(1,2)+pizda(2,1)
8833 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
8834 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8835 ! Explicit gradient in virtual-dihedral angles.
8836 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
8837 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
8838 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8839 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8840 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8841 vv(1)=pizda(1,1)-pizda(2,2)
8842 vv(2)=pizda(1,2)+pizda(2,1)
8843 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8844 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
8845 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8846 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8847 vv(1)=pizda(1,1)-pizda(2,2)
8848 vv(2)=pizda(1,2)+pizda(2,1)
8850 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8851 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
8852 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8854 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8855 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
8856 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8858 ! Cartesian gradient
8862 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
8864 vv(1)=pizda(1,1)-pizda(2,2)
8865 vv(2)=pizda(1,2)+pizda(2,1)
8866 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8867 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
8868 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8874 ! Contribution from graph II
8875 call transpose2(EE(1,1,itk),auxmat(1,1))
8876 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8877 vv(1)=pizda(1,1)+pizda(2,2)
8878 vv(2)=pizda(2,1)-pizda(1,2)
8879 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
8880 -0.5d0*scalar2(vv(1),Ctobr(1,k))
8881 ! Explicit gradient in virtual-dihedral angles.
8882 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8883 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8884 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8885 vv(1)=pizda(1,1)+pizda(2,2)
8886 vv(2)=pizda(2,1)-pizda(1,2)
8888 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8889 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
8890 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8892 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8893 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
8894 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8896 ! Cartesian gradient
8900 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8902 vv(1)=pizda(1,1)+pizda(2,2)
8903 vv(2)=pizda(2,1)-pizda(1,2)
8904 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8905 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
8906 -0.5d0*scalar2(vv(1),Ctobr(1,k))
8914 ! Parallel orientation
8915 ! Contribution from graph III
8916 call transpose2(EUg(1,1,l),auxmat(1,1))
8917 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8918 vv(1)=pizda(1,1)-pizda(2,2)
8919 vv(2)=pizda(1,2)+pizda(2,1)
8920 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
8921 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8922 ! Explicit gradient in virtual-dihedral angles.
8923 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8924 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
8925 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8926 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8927 vv(1)=pizda(1,1)-pizda(2,2)
8928 vv(2)=pizda(1,2)+pizda(2,1)
8929 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8930 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
8931 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8932 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8933 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8934 vv(1)=pizda(1,1)-pizda(2,2)
8935 vv(2)=pizda(1,2)+pizda(2,1)
8936 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8937 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
8938 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8939 ! Cartesian gradient
8943 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
8945 vv(1)=pizda(1,1)-pizda(2,2)
8946 vv(2)=pizda(1,2)+pizda(2,1)
8947 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8948 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
8949 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8954 ! Contribution from graph IV
8956 call transpose2(EE(1,1,itl),auxmat(1,1))
8957 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8958 vv(1)=pizda(1,1)+pizda(2,2)
8959 vv(2)=pizda(2,1)-pizda(1,2)
8960 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
8961 -0.5d0*scalar2(vv(1),Ctobr(1,l))
8962 ! Explicit gradient in virtual-dihedral angles.
8963 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8964 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8965 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8966 vv(1)=pizda(1,1)+pizda(2,2)
8967 vv(2)=pizda(2,1)-pizda(1,2)
8968 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8969 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
8970 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8971 ! Cartesian gradient
8975 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8977 vv(1)=pizda(1,1)+pizda(2,2)
8978 vv(2)=pizda(2,1)-pizda(1,2)
8979 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8980 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
8981 -0.5d0*scalar2(vv(1),Ctobr(1,l))
8986 ! Antiparallel orientation
8987 ! Contribution from graph III
8989 call transpose2(EUg(1,1,j),auxmat(1,1))
8990 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8991 vv(1)=pizda(1,1)-pizda(2,2)
8992 vv(2)=pizda(1,2)+pizda(2,1)
8993 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
8994 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8995 ! Explicit gradient in virtual-dihedral angles.
8996 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8997 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
8998 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8999 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9000 vv(1)=pizda(1,1)-pizda(2,2)
9001 vv(2)=pizda(1,2)+pizda(2,1)
9002 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9003 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
9004 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9005 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9006 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9007 vv(1)=pizda(1,1)-pizda(2,2)
9008 vv(2)=pizda(1,2)+pizda(2,1)
9009 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9010 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
9011 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9012 ! Cartesian gradient
9016 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
9018 vv(1)=pizda(1,1)-pizda(2,2)
9019 vv(2)=pizda(1,2)+pizda(2,1)
9020 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
9021 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
9022 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9027 ! Contribution from graph IV
9029 call transpose2(EE(1,1,itj),auxmat(1,1))
9030 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9031 vv(1)=pizda(1,1)+pizda(2,2)
9032 vv(2)=pizda(2,1)-pizda(1,2)
9033 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
9034 -0.5d0*scalar2(vv(1),Ctobr(1,j))
9035 ! Explicit gradient in virtual-dihedral angles.
9036 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9037 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9038 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9039 vv(1)=pizda(1,1)+pizda(2,2)
9040 vv(2)=pizda(2,1)-pizda(1,2)
9041 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9042 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
9043 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9044 ! Cartesian gradient
9048 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
9050 vv(1)=pizda(1,1)+pizda(2,2)
9051 vv(2)=pizda(2,1)-pizda(1,2)
9052 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
9053 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
9054 -0.5d0*scalar2(vv(1),Ctobr(1,j))
9060 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9061 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9062 !d write (2,*) 'ijkl',i,j,k,l
9063 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9064 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
9066 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9067 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9068 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9069 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9070 if (j.lt.nres-1) then
9077 if (l.lt.nres-1) then
9087 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9088 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
9089 ! summed up outside the subrouine as for the other subroutines
9090 ! handling long-range interactions. The old code is commented out
9091 ! with "cgrad" to keep track of changes.
9093 !grad ggg1(ll)=eel5*g_contij(ll,1)
9094 !grad ggg2(ll)=eel5*g_contij(ll,2)
9095 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9096 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9097 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9098 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9099 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9100 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9101 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9102 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9104 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9105 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9106 !grad ghalf=0.5d0*ggg1(ll)
9108 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9109 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9110 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9111 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9112 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9113 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9114 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9115 !grad ghalf=0.5d0*ggg2(ll)
9117 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
9118 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9119 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
9120 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9121 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9122 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9127 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9128 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9133 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9134 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9140 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9145 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9149 !d write (2,*) iii,g_corr5_loc(iii)
9152 !d write (2,*) 'ekont',ekont
9153 !d write (iout,*) 'eello5',ekont*eel5
9156 !-----------------------------------------------------------------------------
9157 real(kind=8) function eello6(i,j,k,l,jj,kk)
9158 ! implicit real*8 (a-h,o-z)
9159 ! include 'DIMENSIONS'
9160 ! include 'COMMON.IOUNITS'
9161 ! include 'COMMON.CHAIN'
9162 ! include 'COMMON.DERIV'
9163 ! include 'COMMON.INTERACT'
9164 ! include 'COMMON.CONTACTS'
9165 ! include 'COMMON.TORSION'
9166 ! include 'COMMON.VAR'
9167 ! include 'COMMON.GEO'
9168 ! include 'COMMON.FFIELD'
9169 real(kind=8),dimension(3) :: ggg1,ggg2
9170 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
9172 real(kind=8) :: gradcorr6ij,gradcorr6kl
9173 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
9174 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9179 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9187 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9188 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9192 derx(lll,kkk,iii)=0.0d0
9196 !d eij=facont_hb(jj,i)
9197 !d ekl=facont_hb(kk,k)
9203 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9204 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9205 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9206 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9207 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9208 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9210 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9211 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9212 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9213 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9214 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9215 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9219 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9221 ! If turn contributions are considered, they will be handled separately.
9222 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9223 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9224 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9225 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9226 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9227 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9228 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9230 if (j.lt.nres-1) then
9237 if (l.lt.nres-1) then
9245 !grad ggg1(ll)=eel6*g_contij(ll,1)
9246 !grad ggg2(ll)=eel6*g_contij(ll,2)
9247 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9248 !grad ghalf=0.5d0*ggg1(ll)
9250 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9251 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9252 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9253 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9254 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9255 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9256 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9257 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9258 !grad ghalf=0.5d0*ggg2(ll)
9259 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9261 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9262 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9263 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9264 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9265 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9266 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9271 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9272 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9277 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9278 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9284 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9289 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9293 !d write (2,*) iii,g_corr6_loc(iii)
9296 !d write (2,*) 'ekont',ekont
9297 !d write (iout,*) 'eello6',ekont*eel6
9300 !-----------------------------------------------------------------------------
9301 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
9303 ! implicit real*8 (a-h,o-z)
9304 ! include 'DIMENSIONS'
9305 ! include 'COMMON.IOUNITS'
9306 ! include 'COMMON.CHAIN'
9307 ! include 'COMMON.DERIV'
9308 ! include 'COMMON.INTERACT'
9309 ! include 'COMMON.CONTACTS'
9310 ! include 'COMMON.TORSION'
9311 ! include 'COMMON.VAR'
9312 ! include 'COMMON.GEO'
9313 real(kind=8),dimension(2) :: vv,vv1
9314 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
9317 !el common /kutas/ lprn
9318 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
9319 real(kind=8) :: s1,s2,s3,s4,s5
9320 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9322 ! Parallel Antiparallel C
9328 ! \ j|/k\| / \ |/k\|l / C
9333 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9334 itk=itortyp(itype(k,1))
9335 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9336 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9337 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9338 call transpose2(EUgC(1,1,k),auxmat(1,1))
9339 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9340 vv1(1)=pizda1(1,1)-pizda1(2,2)
9341 vv1(2)=pizda1(1,2)+pizda1(2,1)
9342 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9343 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
9344 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
9345 s5=scalar2(vv(1),Dtobr2(1,i))
9346 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9347 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9348 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
9349 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
9350 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
9351 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
9352 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
9353 +scalar2(vv(1),Dtobr2der(1,i)))
9354 call matmat2(AEAderg(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 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
9358 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
9360 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
9361 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
9362 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
9363 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
9364 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9366 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
9367 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
9368 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
9369 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
9370 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9372 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9373 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9374 vv1(1)=pizda1(1,1)-pizda1(2,2)
9375 vv1(2)=pizda1(1,2)+pizda1(2,1)
9376 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
9377 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
9378 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
9379 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9388 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9389 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9390 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9391 call transpose2(EUgC(1,1,k),auxmat(1,1))
9392 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
9394 vv1(1)=pizda1(1,1)-pizda1(2,2)
9395 vv1(2)=pizda1(1,2)+pizda1(2,1)
9396 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9397 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
9398 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
9399 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
9400 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
9401 s5=scalar2(vv(1),Dtobr2(1,i))
9402 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9407 end function eello6_graph1
9408 !-----------------------------------------------------------------------------
9409 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
9411 ! implicit real*8 (a-h,o-z)
9412 ! include 'DIMENSIONS'
9413 ! include 'COMMON.IOUNITS'
9414 ! include 'COMMON.CHAIN'
9415 ! include 'COMMON.DERIV'
9416 ! include 'COMMON.INTERACT'
9417 ! include 'COMMON.CONTACTS'
9418 ! include 'COMMON.TORSION'
9419 ! include 'COMMON.VAR'
9420 ! include 'COMMON.GEO'
9422 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
9423 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9425 !el common /kutas/ lprn
9426 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
9427 real(kind=8) :: s2,s3,s4
9428 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9430 ! Parallel Antiparallel C
9436 ! \ j|/k\| \ |/k\|l C
9441 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9442 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9443 ! AL 7/4/01 s1 would occur in the sixth-order moment,
9444 ! but not in a cluster cumulant
9446 s1=dip(1,jj,i)*dip(1,kk,k)
9448 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9449 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9450 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9451 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9452 call transpose2(EUg(1,1,k),auxmat(1,1))
9453 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9454 vv(1)=pizda(1,1)-pizda(2,2)
9455 vv(2)=pizda(1,2)+pizda(2,1)
9456 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9457 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9459 eello6_graph2=-(s1+s2+s3+s4)
9461 eello6_graph2=-(s2+s3+s4)
9464 ! Derivatives in gamma(i-1)
9467 s1=dipderg(1,jj,i)*dip(1,kk,k)
9469 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9470 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9471 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9472 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9474 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9476 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9478 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9480 ! Derivatives in gamma(k-1)
9482 s1=dip(1,jj,i)*dipderg(1,kk,k)
9484 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9485 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9486 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9487 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9488 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9489 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9490 vv(1)=pizda(1,1)-pizda(2,2)
9491 vv(2)=pizda(1,2)+pizda(2,1)
9492 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9494 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9496 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9498 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9499 ! Derivatives in gamma(j-1) or gamma(l-1)
9502 s1=dipderg(3,jj,i)*dip(1,kk,k)
9504 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9505 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9506 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9507 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9508 vv(1)=pizda(1,1)-pizda(2,2)
9509 vv(2)=pizda(1,2)+pizda(2,1)
9510 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9513 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9515 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9518 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9519 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9521 ! Derivatives in gamma(l-1) or gamma(j-1)
9524 s1=dip(1,jj,i)*dipderg(3,kk,k)
9526 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9527 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9528 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9529 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9530 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9531 vv(1)=pizda(1,1)-pizda(2,2)
9532 vv(2)=pizda(1,2)+pizda(2,1)
9533 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9536 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9538 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9541 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9542 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9544 ! Cartesian derivatives.
9546 write (2,*) 'In eello6_graph2'
9548 write (2,*) 'iii=',iii
9550 write (2,*) 'kkk=',kkk
9552 write (2,'(3(2f10.5),5x)') &
9553 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9563 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9565 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9568 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
9570 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9571 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
9573 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9574 call transpose2(EUg(1,1,k),auxmat(1,1))
9575 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
9577 vv(1)=pizda(1,1)-pizda(2,2)
9578 vv(2)=pizda(1,2)+pizda(2,1)
9579 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9580 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9582 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9584 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9587 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9589 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9595 end function eello6_graph2
9596 !-----------------------------------------------------------------------------
9597 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
9598 ! implicit real*8 (a-h,o-z)
9599 ! include 'DIMENSIONS'
9600 ! include 'COMMON.IOUNITS'
9601 ! include 'COMMON.CHAIN'
9602 ! include 'COMMON.DERIV'
9603 ! include 'COMMON.INTERACT'
9604 ! include 'COMMON.CONTACTS'
9605 ! include 'COMMON.TORSION'
9606 ! include 'COMMON.VAR'
9607 ! include 'COMMON.GEO'
9608 real(kind=8),dimension(2) :: vv,auxvec
9609 real(kind=8),dimension(2,2) :: pizda,auxmat
9611 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
9612 real(kind=8) :: s1,s2,s3,s4
9613 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9615 ! Parallel Antiparallel C
9621 ! j|/k\| / |/k\|l / C
9626 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9628 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9629 ! energy moment and not to the cluster cumulant.
9630 iti=itortyp(itype(i,1))
9631 if (j.lt.nres-1) then
9632 itj1=itortyp(itype(j+1,1))
9636 itk=itortyp(itype(k,1))
9637 itk1=itortyp(itype(k+1,1))
9638 if (l.lt.nres-1) then
9639 itl1=itortyp(itype(l+1,1))
9644 s1=dip(4,jj,i)*dip(4,kk,k)
9646 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
9647 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9648 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
9649 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9650 call transpose2(EE(1,1,itk),auxmat(1,1))
9651 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9652 vv(1)=pizda(1,1)+pizda(2,2)
9653 vv(2)=pizda(2,1)-pizda(1,2)
9654 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9655 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9656 !d & "sum",-(s2+s3+s4)
9658 eello6_graph3=-(s1+s2+s3+s4)
9660 eello6_graph3=-(s2+s3+s4)
9663 ! Derivatives in gamma(k-1)
9664 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
9665 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9666 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9667 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9668 ! Derivatives in gamma(l-1)
9669 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
9670 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9671 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9672 vv(1)=pizda(1,1)+pizda(2,2)
9673 vv(2)=pizda(2,1)-pizda(1,2)
9674 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9675 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9676 ! Cartesian derivatives.
9682 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9684 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9687 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
9689 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9690 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
9692 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9693 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
9695 vv(1)=pizda(1,1)+pizda(2,2)
9696 vv(2)=pizda(2,1)-pizda(1,2)
9697 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9699 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9701 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9704 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9706 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9708 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9713 end function eello6_graph3
9714 !-----------------------------------------------------------------------------
9715 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9716 ! implicit real*8 (a-h,o-z)
9717 ! include 'DIMENSIONS'
9718 ! include 'COMMON.IOUNITS'
9719 ! include 'COMMON.CHAIN'
9720 ! include 'COMMON.DERIV'
9721 ! include 'COMMON.INTERACT'
9722 ! include 'COMMON.CONTACTS'
9723 ! include 'COMMON.TORSION'
9724 ! include 'COMMON.VAR'
9725 ! include 'COMMON.GEO'
9726 ! include 'COMMON.FFIELD'
9727 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
9728 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9730 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
9732 real(kind=8) :: s1,s2,s3,s4
9733 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9735 ! Parallel Antiparallel C
9741 ! \ j|/k\| \ |/k\|l C
9746 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9748 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9749 ! energy moment and not to the cluster cumulant.
9750 !d write (2,*) 'eello_graph4: wturn6',wturn6
9751 iti=itortyp(itype(i,1))
9752 itj=itortyp(itype(j,1))
9753 if (j.lt.nres-1) then
9754 itj1=itortyp(itype(j+1,1))
9758 itk=itortyp(itype(k,1))
9759 if (k.lt.nres-1) then
9760 itk1=itortyp(itype(k+1,1))
9764 itl=itortyp(itype(l,1))
9765 if (l.lt.nres-1) then
9766 itl1=itortyp(itype(l+1,1))
9770 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9771 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9772 !d & ' itl',itl,' itl1',itl1
9775 s1=dip(3,jj,i)*dip(3,kk,k)
9777 s1=dip(2,jj,j)*dip(2,kk,l)
9780 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9781 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9783 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9784 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9786 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9787 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9789 call transpose2(EUg(1,1,k),auxmat(1,1))
9790 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9791 vv(1)=pizda(1,1)-pizda(2,2)
9792 vv(2)=pizda(2,1)+pizda(1,2)
9793 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9794 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9796 eello6_graph4=-(s1+s2+s3+s4)
9798 eello6_graph4=-(s2+s3+s4)
9800 ! Derivatives in gamma(i-1)
9804 s1=dipderg(2,jj,i)*dip(3,kk,k)
9806 s1=dipderg(4,jj,j)*dip(2,kk,l)
9809 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9811 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9812 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9814 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9815 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9817 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9818 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9819 !d write (2,*) 'turn6 derivatives'
9821 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9823 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9827 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9829 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9833 ! Derivatives in gamma(k-1)
9836 s1=dip(3,jj,i)*dipderg(2,kk,k)
9838 s1=dip(2,jj,j)*dipderg(4,kk,l)
9841 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9842 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9844 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9845 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9847 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9848 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9850 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9851 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9852 vv(1)=pizda(1,1)-pizda(2,2)
9853 vv(2)=pizda(2,1)+pizda(1,2)
9854 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9855 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9857 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9859 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9863 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9865 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9868 ! Derivatives in gamma(j-1) or gamma(l-1)
9869 if (l.eq.j+1 .and. l.gt.1) then
9870 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9871 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9872 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9873 vv(1)=pizda(1,1)-pizda(2,2)
9874 vv(2)=pizda(2,1)+pizda(1,2)
9875 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9876 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9877 else if (j.gt.1) then
9878 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9879 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9880 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9881 vv(1)=pizda(1,1)-pizda(2,2)
9882 vv(2)=pizda(2,1)+pizda(1,2)
9883 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9884 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9885 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9887 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9890 ! Cartesian derivatives.
9897 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9899 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9903 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9905 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9909 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
9911 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9913 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
9914 b1(1,itj1),auxvec(1))
9915 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9917 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
9918 b1(1,itl1),auxvec(1))
9919 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9921 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
9923 vv(1)=pizda(1,1)-pizda(2,2)
9924 vv(2)=pizda(2,1)+pizda(1,2)
9925 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9927 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9929 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
9932 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
9935 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9938 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9940 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9942 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9946 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9948 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9951 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9953 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9960 end function eello6_graph4
9961 !-----------------------------------------------------------------------------
9962 real(kind=8) function eello_turn6(i,jj,kk)
9963 ! implicit real*8 (a-h,o-z)
9964 ! include 'DIMENSIONS'
9965 ! include 'COMMON.IOUNITS'
9966 ! include 'COMMON.CHAIN'
9967 ! include 'COMMON.DERIV'
9968 ! include 'COMMON.INTERACT'
9969 ! include 'COMMON.CONTACTS'
9970 ! include 'COMMON.TORSION'
9971 ! include 'COMMON.VAR'
9972 ! include 'COMMON.GEO'
9973 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
9974 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
9975 real(kind=8),dimension(3) :: ggg1,ggg2
9976 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
9977 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
9978 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9979 ! the respective energy moment and not to the cluster cumulant.
9981 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
9982 integer :: j1,j2,l1,l2,ll
9983 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
9984 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
9993 iti=itortyp(itype(i,1))
9994 itk=itortyp(itype(k,1))
9995 itk1=itortyp(itype(k+1,1))
9996 itl=itortyp(itype(l,1))
9997 itj=itortyp(itype(j,1))
9998 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9999 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
10000 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10005 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10007 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
10011 derx_turn(lll,kkk,iii)=0.0d0
10018 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10020 !d write (2,*) 'eello6_5',eello6_5
10022 call transpose2(AEA(1,1,1),auxmat(1,1))
10023 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10024 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
10025 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10027 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
10028 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10029 s2 = scalar2(b1(1,itk),vtemp1(1))
10031 call transpose2(AEA(1,1,2),atemp(1,1))
10032 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10033 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10034 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10036 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10037 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10038 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10040 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10041 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10042 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10043 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10044 ss13 = scalar2(b1(1,itk),vtemp4(1))
10045 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10047 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10053 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10054 ! Derivatives in gamma(i+2)
10058 call transpose2(AEA(1,1,1),auxmatd(1,1))
10059 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10060 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10061 call transpose2(AEAderg(1,1,2),atempd(1,1))
10062 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10063 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10065 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10066 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10067 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10073 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10074 ! Derivatives in gamma(i+3)
10076 call transpose2(AEA(1,1,1),auxmatd(1,1))
10077 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10078 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
10079 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10081 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
10082 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10083 s2d = scalar2(b1(1,itk),vtemp1d(1))
10085 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10086 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10088 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10090 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10091 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10092 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10100 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
10101 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10103 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
10104 -0.5d0*ekont*(s2d+s12d)
10106 ! Derivatives in gamma(i+4)
10107 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10108 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10109 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10111 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10112 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10113 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10121 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10123 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10125 ! Derivatives in gamma(i+5)
10127 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10128 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10129 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10131 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
10132 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10133 s2d = scalar2(b1(1,itk),vtemp1d(1))
10135 call transpose2(AEA(1,1,2),atempd(1,1))
10136 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10137 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10139 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10140 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10142 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10143 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10144 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10152 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
10153 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10155 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
10156 -0.5d0*ekont*(s2d+s12d)
10158 ! Cartesian derivatives
10163 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10164 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10165 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10167 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
10168 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
10170 s2d = scalar2(b1(1,itk),vtemp1d(1))
10172 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10173 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10174 s8d = -(atempd(1,1)+atempd(2,2))* &
10175 scalar2(cc(1,1,itl),vtemp2(1))
10177 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
10179 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10180 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10187 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
10190 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
10194 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
10197 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
10206 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
10208 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10209 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10210 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10211 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10212 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
10214 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10215 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10216 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10220 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10221 !d & 16*eel_turn6_num
10223 if (j.lt.nres-1) then
10230 if (l.lt.nres-1) then
10238 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
10239 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
10240 !grad ghalf=0.5d0*ggg1(ll)
10242 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10243 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10244 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
10245 +ekont*derx_turn(ll,2,1)
10246 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10247 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
10248 +ekont*derx_turn(ll,4,1)
10249 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10250 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10251 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10252 !grad ghalf=0.5d0*ggg2(ll)
10254 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
10255 +ekont*derx_turn(ll,2,2)
10256 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10257 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
10258 +ekont*derx_turn(ll,4,2)
10259 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10260 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10261 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10266 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10271 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10277 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10282 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10286 !d write (2,*) iii,g_corr6_loc(iii)
10288 eello_turn6=ekont*eel_turn6
10289 !d write (2,*) 'ekont',ekont
10290 !d write (2,*) 'eel_turn6',ekont*eel_turn6
10292 end function eello_turn6
10293 !-----------------------------------------------------------------------------
10294 subroutine MATVEC2(A1,V1,V2)
10295 !DIR$ INLINEALWAYS MATVEC2
10297 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10299 ! implicit real*8 (a-h,o-z)
10300 ! include 'DIMENSIONS'
10301 real(kind=8),dimension(2) :: V1,V2
10302 real(kind=8),dimension(2,2) :: A1
10303 real(kind=8) :: vaux1,vaux2
10307 ! 3 VI=VI+A1(I,K)*V1(K)
10311 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10312 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10316 end subroutine MATVEC2
10317 !-----------------------------------------------------------------------------
10318 subroutine MATMAT2(A1,A2,A3)
10320 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10322 ! implicit real*8 (a-h,o-z)
10323 ! include 'DIMENSIONS'
10324 real(kind=8),dimension(2,2) :: A1,A2,A3
10325 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
10326 ! DIMENSION AI3(2,2)
10330 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
10336 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10337 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10338 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10339 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10345 end subroutine MATMAT2
10346 !-----------------------------------------------------------------------------
10347 real(kind=8) function scalar2(u,v)
10348 !DIR$ INLINEALWAYS scalar2
10350 real(kind=8),dimension(2) :: u,v
10353 scalar2=u(1)*v(1)+u(2)*v(2)
10355 end function scalar2
10356 !-----------------------------------------------------------------------------
10357 subroutine transpose2(a,at)
10358 !DIR$ INLINEALWAYS transpose2
10360 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
10363 real(kind=8),dimension(2,2) :: a,at
10369 end subroutine transpose2
10370 !-----------------------------------------------------------------------------
10371 subroutine transpose(n,a,at)
10374 real(kind=8),dimension(n,n) :: a,at
10381 end subroutine transpose
10382 !-----------------------------------------------------------------------------
10383 subroutine prodmat3(a1,a2,kk,transp,prod)
10384 !DIR$ INLINEALWAYS prodmat3
10386 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
10390 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
10392 !rc double precision auxmat(2,2),prod_(2,2)
10395 !rc call transpose2(kk(1,1),auxmat(1,1))
10396 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10397 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10399 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
10400 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10401 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
10402 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10403 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
10404 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10405 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
10406 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10409 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10410 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10412 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
10413 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10414 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
10415 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10416 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
10417 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10418 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
10419 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10422 ! call transpose2(a2(1,1),a2t(1,1))
10425 !rc print *,((prod_(i,j),i=1,2),j=1,2)
10426 !rc print *,((prod(i,j),i=1,2),j=1,2)
10429 end subroutine prodmat3
10430 !-----------------------------------------------------------------------------
10431 ! energy_p_new_barrier.F
10432 !-----------------------------------------------------------------------------
10433 subroutine sum_gradient
10434 ! implicit real*8 (a-h,o-z)
10435 use io_base, only: pdbout
10436 ! include 'DIMENSIONS'
10440 !MS$ATTRIBUTES C :: proc_proc
10446 real(kind=8),dimension(3,-1:nres) :: gradbufc,gradbufx,gradbufc_sum,&
10447 gloc_scbuf !(3,maxres)
10449 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
10451 !el local variables
10452 integer :: i,j,k,ierror,ierr
10453 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
10454 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
10455 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
10456 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
10457 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
10458 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
10459 gsccorr_max,gsccorrx_max,time00
10461 ! include 'COMMON.SETUP'
10462 ! include 'COMMON.IOUNITS'
10463 ! include 'COMMON.FFIELD'
10464 ! include 'COMMON.DERIV'
10465 ! include 'COMMON.INTERACT'
10466 ! include 'COMMON.SBRIDGE'
10467 ! include 'COMMON.CHAIN'
10468 ! include 'COMMON.VAR'
10469 ! include 'COMMON.CONTROL'
10470 ! include 'COMMON.TIME1'
10471 ! include 'COMMON.MAXGRAD'
10472 ! include 'COMMON.SCCOR'
10477 write (iout,*) "sum_gradient gvdwc, gvdwx"
10479 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10480 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
10490 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
10491 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
10492 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
10495 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
10496 ! in virtual-bond-vector coordinates
10499 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
10501 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
10502 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
10504 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
10506 ! write (iout,'(i5,3f10.5,2x,f10.5)')
10507 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
10509 write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
10511 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10512 i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
10513 (gvdwc_scpp(j,i),j=1,3)
10515 write (iout,*) "gelc_long gvdwpp gel_loc_long"
10517 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10518 i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
10519 (gelc_loc_long(j,i),j=1,3)
10526 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10527 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10528 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10529 wel_loc*gel_loc_long(j,i)+ &
10530 wcorr*gradcorr_long(j,i)+ &
10531 wcorr5*gradcorr5_long(j,i)+ &
10532 wcorr6*gradcorr6_long(j,i)+ &
10533 wturn6*gcorr6_turn_long(j,i)+ &
10534 wstrain*ghpbc(j,i) &
10535 +wliptran*gliptranc(j,i) &
10537 +welec*gshieldc(j,i) &
10538 +wcorr*gshieldc_ec(j,i) &
10539 +wturn3*gshieldc_t3(j,i)&
10540 +wturn4*gshieldc_t4(j,i)&
10541 +wel_loc*gshieldc_ll(j,i)&
10542 +wtube*gg_tube(j,i) &
10543 +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
10544 wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
10545 wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
10546 wcorr_nucl*gradcorr_nucl(j,i)&
10547 +wcorr3_nucl*gradcorr3_nucl(j,i)+&
10548 wcatprot* gradpepcat(j,i)+ &
10549 wcatcat*gradcatcat(j,i)+ &
10550 wscbase*gvdwc_scbase(j,i)+ &
10551 wpepbase*gvdwc_pepbase(j,i)+&
10552 wscpho*gvdwc_scpho(j,i)+ &
10553 wpeppho*gvdwc_peppho(j,i)
10564 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10565 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10566 welec*gelc_long(j,i)+ &
10567 wbond*gradb(j,i)+ &
10568 wel_loc*gel_loc_long(j,i)+ &
10569 wcorr*gradcorr_long(j,i)+ &
10570 wcorr5*gradcorr5_long(j,i)+ &
10571 wcorr6*gradcorr6_long(j,i)+ &
10572 wturn6*gcorr6_turn_long(j,i)+ &
10573 wstrain*ghpbc(j,i) &
10574 +wliptran*gliptranc(j,i) &
10576 +welec*gshieldc(j,i)&
10577 +wcorr*gshieldc_ec(j,i) &
10578 +wturn4*gshieldc_t4(j,i) &
10579 +wel_loc*gshieldc_ll(j,i)&
10580 +wtube*gg_tube(j,i) &
10581 +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
10582 wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
10583 wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
10584 wcorr_nucl*gradcorr_nucl(j,i) &
10585 +wcorr3_nucl*gradcorr3_nucl(j,i) +&
10586 wcatprot* gradpepcat(j,i)+ &
10587 wcatcat*gradcatcat(j,i)+ &
10588 wscbase*gvdwc_scbase(j,i) &
10589 wpepbase*gvdwc_pepbase(j,i)+&
10590 wscpho*gvdwc_scpho(j,i)+&
10591 wpeppho*gvdwc_peppho(j,i)
10598 if (nfgtasks.gt.1) then
10601 write (iout,*) "gradbufc before allreduce"
10603 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10609 gradbufc_sum(j,i)=gradbufc(j,i)
10612 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
10613 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
10614 ! time_reduce=time_reduce+MPI_Wtime()-time00
10616 ! write (iout,*) "gradbufc_sum after allreduce"
10618 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
10623 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
10627 gradbufc(k,i)=0.0d0
10631 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
10632 write (iout,*) (i," jgrad_start",jgrad_start(i),&
10633 " jgrad_end ",jgrad_end(i),&
10634 i=igrad_start,igrad_end)
10637 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
10638 ! do not parallelize this part.
10640 ! do i=igrad_start,igrad_end
10641 ! do j=jgrad_start(i),jgrad_end(i)
10643 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
10648 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10652 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10656 write (iout,*) "gradbufc after summing"
10658 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10666 write (iout,*) "gradbufc"
10668 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10675 gradbufc_sum(j,i)=gradbufc(j,i)
10676 gradbufc(j,i)=0.0d0
10680 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10684 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10689 ! gradbufc(k,i)=0.0d0
10693 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
10699 write (iout,*) "gradbufc after summing"
10701 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10710 gradbufc(k,nres)=0.0d0
10712 !el----------------
10713 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
10714 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
10715 !el-----------------
10719 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10720 wel_loc*gel_loc(j,i)+ &
10721 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10722 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10723 wel_loc*gel_loc_long(j,i)+ &
10724 wcorr*gradcorr_long(j,i)+ &
10725 wcorr5*gradcorr5_long(j,i)+ &
10726 wcorr6*gradcorr6_long(j,i)+ &
10727 wturn6*gcorr6_turn_long(j,i))+ &
10728 wbond*gradb(j,i)+ &
10729 wcorr*gradcorr(j,i)+ &
10730 wturn3*gcorr3_turn(j,i)+ &
10731 wturn4*gcorr4_turn(j,i)+ &
10732 wcorr5*gradcorr5(j,i)+ &
10733 wcorr6*gradcorr6(j,i)+ &
10734 wturn6*gcorr6_turn(j,i)+ &
10735 wsccor*gsccorc(j,i) &
10736 +wscloc*gscloc(j,i) &
10737 +wliptran*gliptranc(j,i) &
10739 +welec*gshieldc(j,i) &
10740 +welec*gshieldc_loc(j,i) &
10741 +wcorr*gshieldc_ec(j,i) &
10742 +wcorr*gshieldc_loc_ec(j,i) &
10743 +wturn3*gshieldc_t3(j,i) &
10744 +wturn3*gshieldc_loc_t3(j,i) &
10745 +wturn4*gshieldc_t4(j,i) &
10746 +wturn4*gshieldc_loc_t4(j,i) &
10747 +wel_loc*gshieldc_ll(j,i) &
10748 +wel_loc*gshieldc_loc_ll(j,i) &
10749 +wtube*gg_tube(j,i) &
10750 +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
10751 +wvdwpsb*gvdwpsb1(j,i))&
10752 +wbond_nucl*gradb_nucl(j,i)+wsbloc*gsbloc(j,i)
10754 ! if ((i.le.2).and.(i.ge.1))
10755 ! print *,gradc(j,i,icg),&
10756 ! gradbufc(j,i),welec*gelc(j,i), &
10757 ! wel_loc*gel_loc(j,i), &
10758 ! wscp*gvdwc_scpp(j,i), &
10759 ! welec*gelc_long(j,i),wvdwpp*gvdwpp(j,i), &
10760 ! wel_loc*gel_loc_long(j,i), &
10761 ! wcorr*gradcorr_long(j,i), &
10762 ! wcorr5*gradcorr5_long(j,i), &
10763 ! wcorr6*gradcorr6_long(j,i), &
10764 ! wturn6*gcorr6_turn_long(j,i), &
10765 ! wbond*gradb(j,i), &
10766 ! wcorr*gradcorr(j,i), &
10767 ! wturn3*gcorr3_turn(j,i), &
10768 ! wturn4*gcorr4_turn(j,i), &
10769 ! wcorr5*gradcorr5(j,i), &
10770 ! wcorr6*gradcorr6(j,i), &
10771 ! wturn6*gcorr6_turn(j,i), &
10772 ! wsccor*gsccorc(j,i) &
10773 ! ,wscloc*gscloc(j,i) &
10774 ! ,wliptran*gliptranc(j,i) &
10776 ! ,welec*gshieldc(j,i) &
10777 ! ,welec*gshieldc_loc(j,i) &
10778 ! ,wcorr*gshieldc_ec(j,i) &
10779 ! ,wcorr*gshieldc_loc_ec(j,i) &
10780 ! ,wturn3*gshieldc_t3(j,i) &
10781 ! ,wturn3*gshieldc_loc_t3(j,i) &
10782 ! ,wturn4*gshieldc_t4(j,i) &
10783 ! ,wturn4*gshieldc_loc_t4(j,i) &
10784 ! ,wel_loc*gshieldc_ll(j,i) &
10785 ! ,wel_loc*gshieldc_loc_ll(j,i) &
10786 ! ,wtube*gg_tube(j,i) &
10787 ! ,wbond_nucl*gradb_nucl(j,i) &
10788 ! ,wvdwpp_nucl*gvdwpp_nucl(j,i),welpp*gelpp(j,i),&
10789 ! wvdwpsb*gvdwpsb1(j,i)&
10790 ! ,wbond_nucl*gradb_nucl(j,i),wsbloc*gsbloc(j,i)
10794 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10795 wel_loc*gel_loc(j,i)+ &
10796 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10797 welec*gelc_long(j,i)+ &
10798 wel_loc*gel_loc_long(j,i)+ &
10799 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
10800 wcorr5*gradcorr5_long(j,i)+ &
10801 wcorr6*gradcorr6_long(j,i)+ &
10802 wturn6*gcorr6_turn_long(j,i))+ &
10803 wbond*gradb(j,i)+ &
10804 wcorr*gradcorr(j,i)+ &
10805 wturn3*gcorr3_turn(j,i)+ &
10806 wturn4*gcorr4_turn(j,i)+ &
10807 wcorr5*gradcorr5(j,i)+ &
10808 wcorr6*gradcorr6(j,i)+ &
10809 wturn6*gcorr6_turn(j,i)+ &
10810 wsccor*gsccorc(j,i) &
10811 +wscloc*gscloc(j,i) &
10813 +wliptran*gliptranc(j,i) &
10814 +welec*gshieldc(j,i) &
10815 +welec*gshieldc_loc(j,) &
10816 +wcorr*gshieldc_ec(j,i) &
10817 +wcorr*gshieldc_loc_ec(j,i) &
10818 +wturn3*gshieldc_t3(j,i) &
10819 +wturn3*gshieldc_loc_t3(j,i) &
10820 +wturn4*gshieldc_t4(j,i) &
10821 +wturn4*gshieldc_loc_t4(j,i) &
10822 +wel_loc*gshieldc_ll(j,i) &
10823 +wel_loc*gshieldc_loc_ll(j,i) &
10824 +wtube*gg_tube(j,i) &
10825 +wbond_nucl*gradb_nucl(j,i) &
10826 +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
10827 +wvdwpsb*gvdwpsb1(j,i))&
10828 +wsbloc*gsbloc(j,i)
10834 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
10835 wbond*gradbx(j,i)+ &
10836 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
10837 wsccor*gsccorx(j,i) &
10838 +wscloc*gsclocx(j,i) &
10839 +wliptran*gliptranx(j,i) &
10840 +welec*gshieldx(j,i) &
10841 +wcorr*gshieldx_ec(j,i) &
10842 +wturn3*gshieldx_t3(j,i) &
10843 +wturn4*gshieldx_t4(j,i) &
10844 +wel_loc*gshieldx_ll(j,i)&
10845 +wtube*gg_tube_sc(j,i) &
10846 +wbond_nucl*gradbx_nucl(j,i) &
10847 +wvdwsb*gvdwsbx(j,i) &
10848 +welsb*gelsbx(j,i) &
10849 +wcorr_nucl*gradxorr_nucl(j,i)&
10850 +wcorr3_nucl*gradxorr3_nucl(j,i) &
10851 +wsbloc*gsblocx(j,i) &
10852 +wcatprot* gradpepcatx(j,i)&
10853 +wscbase*gvdwx_scbase(j,i) &
10854 +wpepbase*gvdwx_pepbase(j,i)&
10855 +wscpho*gvdwx_scpho(j,i)
10856 ! if (i.eq.3) print *,"tu?", wscpho,gvdwx_scpho(j,i)
10861 write (iout,*) "gloc before adding corr"
10863 write (iout,*) i,gloc(i,icg)
10867 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
10868 +wcorr5*g_corr5_loc(i) &
10869 +wcorr6*g_corr6_loc(i) &
10870 +wturn4*gel_loc_turn4(i) &
10871 +wturn3*gel_loc_turn3(i) &
10872 +wturn6*gel_loc_turn6(i) &
10873 +wel_loc*gel_loc_loc(i)
10876 write (iout,*) "gloc after adding corr"
10878 write (iout,*) i,gloc(i,icg)
10882 if (nfgtasks.gt.1) then
10885 gradbufc(j,i)=gradc(j,i,icg)
10886 gradbufx(j,i)=gradx(j,i,icg)
10890 glocbuf(i)=gloc(i,icg)
10894 write (iout,*) "gloc_sc before reduce"
10897 write (iout,*) i,j,gloc_sc(j,i,icg)
10904 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
10908 call MPI_Barrier(FG_COMM,IERR)
10909 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
10911 call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,&
10912 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10913 call MPI_Reduce(gradbufx(1,0),gradx(1,0,icg),3*nres+3,&
10914 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10915 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
10916 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10917 time_reduce=time_reduce+MPI_Wtime()-time00
10918 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
10919 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10920 time_reduce=time_reduce+MPI_Wtime()-time00
10922 ! print *,"gradbuf",gradbufc(1,1),gradc(1,1,icg)
10924 write (iout,*) "gloc_sc after reduce"
10927 write (iout,*) i,j,gloc_sc(j,i,icg)
10933 write (iout,*) "gloc after reduce"
10935 write (iout,*) i,gloc(i,icg)
10940 if (gnorm_check) then
10942 ! Compute the maximum elements of the gradient
10945 gvdwc_scp_max=0.0d0
10952 gcorr3_turn_max=0.0d0
10953 gcorr4_turn_max=0.0d0
10954 gradcorr5_max=0.0d0
10955 gradcorr6_max=0.0d0
10956 gcorr6_turn_max=0.0d0
10960 gradx_scp_max=0.0d0
10966 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
10967 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
10968 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
10969 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
10970 gvdwc_scp_max=gvdwc_scp_norm
10971 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
10972 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
10973 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
10974 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
10975 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
10976 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
10977 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
10978 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
10979 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
10980 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
10981 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
10982 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
10983 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
10985 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
10986 gcorr3_turn_max=gcorr3_turn_norm
10987 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
10989 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
10990 gcorr4_turn_max=gcorr4_turn_norm
10991 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
10992 if (gradcorr5_norm.gt.gradcorr5_max) &
10993 gradcorr5_max=gradcorr5_norm
10994 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
10995 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
10996 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
10998 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
10999 gcorr6_turn_max=gcorr6_turn_norm
11000 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
11001 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
11002 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
11003 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
11004 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
11005 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
11006 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
11007 if (gradx_scp_norm.gt.gradx_scp_max) &
11008 gradx_scp_max=gradx_scp_norm
11009 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
11010 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
11011 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
11012 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
11013 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
11014 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
11015 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
11016 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
11020 open(istat,file=statname,position="append")
11022 open(istat,file=statname,access="append")
11024 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
11025 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
11026 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
11027 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
11028 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
11029 gsccorx_max,gsclocx_max
11031 if (gvdwc_max.gt.1.0d4) then
11032 write (iout,*) "gvdwc gvdwx gradb gradbx"
11034 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
11035 gradb(j,i),gradbx(j,i),j=1,3)
11037 call pdbout(0.0d0,'cipiszcze',iout)
11044 write (iout,*) "gradc gradx gloc"
11046 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
11047 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
11052 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
11055 end subroutine sum_gradient
11056 !-----------------------------------------------------------------------------
11058 ! implicit real*8 (a-h,o-z)
11060 ! include 'DIMENSIONS'
11061 ! include 'COMMON.CHAIN'
11062 ! include 'COMMON.DERIV'
11063 ! include 'COMMON.CALC'
11064 ! include 'COMMON.IOUNITS'
11065 real(kind=8), dimension(3) :: dcosom1,dcosom2
11066 ! print *,"wchodze"
11067 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
11068 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
11069 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
11070 -2.0D0*alf12*eps3der+sigder*sigsq_om12
11074 ! eom12=evdwij*eps1_om12
11076 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
11078 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
11079 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
11080 !C print *,sss_ele_cut,'in sc_grad'
11082 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
11083 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
11086 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
11087 !C print *,'gg',k,gg(k)
11089 ! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
11090 ! write (iout,*) "gg",(gg(k),k=1,3)
11092 gvdwx(k,i)=gvdwx(k,i)-gg(k) +gg_lipi(k)&
11093 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
11094 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
11097 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)&
11098 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
11099 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv &
11102 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
11103 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
11104 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
11105 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
11108 ! Calculate the components of the gradient in DC and X
11112 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
11116 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
11117 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
11120 end subroutine sc_grad
11122 !-----------------------------------------------------------------------------
11123 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
11126 ! implicit real*8 (a-h,o-z)
11127 ! include 'DIMENSIONS'
11128 ! include 'COMMON.LOCAL'
11129 ! include 'COMMON.IOUNITS'
11130 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
11131 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
11132 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
11133 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
11134 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
11136 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
11137 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
11138 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
11139 !el local variables
11141 delthec=thetai-thet_pred_mean
11142 delthe0=thetai-theta0i
11143 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
11144 t3 = thetai-thet_pred_mean
11148 t14 = t12+t6*sigsqtc
11150 t21 = thetai-theta0i
11156 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
11157 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
11158 *(-t12*t9-ak*sig0inv*t27)
11160 end subroutine mixder
11162 !-----------------------------------------------------------------------------
11164 !-----------------------------------------------------------------------------
11166 !-----------------------------------------------------------------------------
11167 ! This subroutine calculates the derivatives of the consecutive virtual
11168 ! bond vectors and the SC vectors in the virtual-bond angles theta and
11169 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
11170 ! in the angles alpha and omega, describing the location of a side chain
11171 ! in its local coordinate system.
11173 ! The derivatives are stored in the following arrays:
11175 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
11176 ! The structure is as follows:
11178 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
11179 ! 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)
11180 ! . . . . . . . . . . . . . . . . . .
11181 ! 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)
11185 ! 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)
11187 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
11188 ! The structure is same as above.
11190 ! DCDS - the derivatives of the side chain vectors in the local spherical
11191 ! andgles alph and omega:
11193 ! 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)
11194 ! 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)
11198 ! 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)
11200 ! Version of March '95, based on an early version of November '91.
11202 !**********************************************************************
11203 ! implicit real*8 (a-h,o-z)
11204 ! include 'DIMENSIONS'
11205 ! include 'COMMON.VAR'
11206 ! include 'COMMON.CHAIN'
11207 ! include 'COMMON.DERIV'
11208 ! include 'COMMON.GEO'
11209 ! include 'COMMON.LOCAL'
11210 ! include 'COMMON.INTERACT'
11211 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
11212 real(kind=8),dimension(3,3) :: dp,temp
11213 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
11214 real(kind=8),dimension(3) :: xx,xx1
11215 !el local variables
11216 integer :: i,k,l,j,m,ind,ind1,jjj
11217 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
11218 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
11219 sint2,xp,yp,xxp,yyp,zzp,dj
11221 ! common /przechowalnia/ fromto
11222 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
11223 ! get the position of the jth ijth fragment of the chain coordinate system
11224 ! in the fromto array.
11225 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
11227 ! maxdim=(nres-1)*(nres-2)/2
11228 ! allocate(dcdv(6,maxdim),dxds(6,nres))
11229 ! calculate the derivatives of transformation matrix elements in theta
11232 !el call flush(iout) !el
11234 rdt(1,1,i)=-rt(1,2,i)
11235 rdt(1,2,i)= rt(1,1,i)
11237 rdt(2,1,i)=-rt(2,2,i)
11238 rdt(2,2,i)= rt(2,1,i)
11240 rdt(3,1,i)=-rt(3,2,i)
11241 rdt(3,2,i)= rt(3,1,i)
11245 ! derivatives in phi
11251 drt(2,1,i)= rt(3,1,i)
11252 drt(2,2,i)= rt(3,2,i)
11253 drt(2,3,i)= rt(3,3,i)
11254 drt(3,1,i)=-rt(2,1,i)
11255 drt(3,2,i)=-rt(2,2,i)
11256 drt(3,3,i)=-rt(2,3,i)
11259 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
11265 temp(k,l)=rt(k,l,i)
11270 fromto(k,l,ind)=temp(k,l)
11279 dpkl=dpkl+temp(k,m)*rt(m,l,j)
11282 fromto(k,l,ind)=dpkl
11293 ! Calculate derivatives.
11299 ! Derivatives of DC(i+1) in theta(i+2)
11305 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
11308 prordt(j,k,i)=dp(j,k)
11311 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
11314 ! Derivatives of SC(i+1) in theta(i+2)
11316 xx1(1)=-0.5D0*xloc(2,i+1)
11317 xx1(2)= 0.5D0*xloc(1,i+1)
11321 xj=xj+r(j,k,i)*xx1(k)
11328 rj=rj+prod(j,k,i)*xx(k)
11333 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
11334 ! than the other off-diagonal derivatives.
11339 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
11341 dxdv(j,ind1+1)=dxoiij
11343 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
11345 ! Derivatives of DC(i+1) in phi(i+2)
11351 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
11354 prodrt(j,k,i)=dp(j,k)
11356 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
11359 ! Derivatives of SC(i+1) in phi(i+2)
11362 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
11363 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
11367 rj=rj+prod(j,k,i)*xx(k)
11372 ! Derivatives of SC(i+1) in phi(i+3).
11377 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
11379 dxdv(j+3,ind1+1)=dxoiij
11382 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
11383 ! theta(nres) and phi(i+3) thru phi(nres).
11387 ind=indmat(i+1,j+1)
11388 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
11393 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
11398 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
11399 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
11400 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
11401 ! Derivatives of virtual-bond vectors in theta
11403 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
11405 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
11406 ! Derivatives of SC vectors in theta
11410 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
11412 dxdv(k,ind1+1)=dxoijk
11415 !--- Calculate the derivatives in phi
11421 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
11427 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
11432 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
11434 dxdv(k+3,ind1+1)=dxoijk
11439 ! Derivatives in alpha and omega:
11442 ! dsci=dsc(itype(i,1))
11447 if(alphi.ne.alphi) alphi=100.0
11448 if(omegi.ne.omegi) omegi=-100.0
11453 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
11454 cosalphi=dcos(alphi)
11455 sinalphi=dsin(alphi)
11456 cosomegi=dcos(omegi)
11457 sinomegi=dsin(omegi)
11458 temp(1,1)=-dsci*sinalphi
11459 temp(2,1)= dsci*cosalphi*cosomegi
11460 temp(3,1)=-dsci*cosalphi*sinomegi
11462 temp(2,2)=-dsci*sinalphi*sinomegi
11463 temp(3,2)=-dsci*sinalphi*cosomegi
11464 theta2=pi-0.5D0*theta(i+1)
11468 !d print *,((temp(l,k),l=1,3),k=1,2)
11472 xxp= xp*cost2+yp*sint2
11473 yyp=-xp*sint2+yp*cost2
11476 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
11477 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
11481 dj=dj+prod(k,l,i-1)*xx(l)
11489 end subroutine cartder
11490 !-----------------------------------------------------------------------------
11492 !-----------------------------------------------------------------------------
11493 subroutine check_cartgrad
11494 ! Check the gradient of Cartesian coordinates in internal coordinates.
11495 ! implicit real*8 (a-h,o-z)
11496 ! include 'DIMENSIONS'
11497 ! include 'COMMON.IOUNITS'
11498 ! include 'COMMON.VAR'
11499 ! include 'COMMON.CHAIN'
11500 ! include 'COMMON.GEO'
11501 ! include 'COMMON.LOCAL'
11502 ! include 'COMMON.DERIV'
11503 real(kind=8),dimension(6,nres) :: temp
11504 real(kind=8),dimension(3) :: xx,gg
11505 integer :: i,k,j,ii
11506 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
11507 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
11509 ! Check the gradient of the virtual-bond and SC vectors in the internal
11515 write (iout,'(a)') '**************** dx/dalpha'
11519 alph(i)=alph(i)+aincr
11521 temp(k,i)=dc(k,nres+i)
11525 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11526 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
11528 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11529 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
11535 write (iout,'(a)') '**************** dx/domega'
11539 omeg(i)=omeg(i)+aincr
11541 temp(k,i)=dc(k,nres+i)
11545 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11546 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
11547 (aincr*dabs(dxds(k+3,i))+aincr))
11549 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11550 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
11556 write (iout,'(a)') '**************** dx/dtheta'
11560 theta(i)=theta(i)+aincr
11563 temp(k,j)=dc(k,nres+j)
11569 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
11571 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11572 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
11573 (aincr*dabs(dxdv(k,ii))+aincr))
11575 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11576 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
11583 write (iout,'(a)') '***************** dx/dphi'
11586 phi(i)=phi(i)+aincr
11589 temp(k,j)=dc(k,nres+j)
11597 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11598 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
11599 (aincr*dabs(dxdv(k+3,ii))+aincr))
11601 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11602 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11605 phi(i)=phi(i)-aincr
11608 write (iout,'(a)') '****************** ddc/dtheta'
11611 theta(i+2)=thet+aincr
11622 gg(k)=(dc(k,j)-temp(k,j))/aincr
11623 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
11624 (aincr*dabs(dcdv(k,ii))+aincr))
11626 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11627 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
11637 write (iout,'(a)') '******************* ddc/dphi'
11640 phi(i+3)=phii+aincr
11651 gg(k)=(dc(k,j)-temp(k,j))/aincr
11652 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
11653 (aincr*dabs(dcdv(k+3,ii))+aincr))
11655 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11656 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11667 end subroutine check_cartgrad
11668 !-----------------------------------------------------------------------------
11669 subroutine check_ecart
11670 ! Check the gradient of the energy in Cartesian coordinates.
11671 ! implicit real*8 (a-h,o-z)
11672 ! include 'DIMENSIONS'
11673 ! include 'COMMON.CHAIN'
11674 ! include 'COMMON.DERIV'
11675 ! include 'COMMON.IOUNITS'
11676 ! include 'COMMON.VAR'
11677 ! include 'COMMON.CONTACTS'
11679 !el integer :: icall
11680 !el common /srutu/ icall
11681 real(kind=8),dimension(6) :: ggg
11682 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
11683 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11684 real(kind=8),dimension(6,nres) :: grad_s
11685 real(kind=8),dimension(0:n_ene) :: energia,energia1
11686 integer :: uiparm(1)
11687 real(kind=8) :: urparm(1)
11689 integer :: nf,i,j,k
11690 real(kind=8) :: aincr,etot,etot1
11696 print '(a)','CG processor',me,' calling CHECK_CART.',aincr
11699 call geom_to_var(nvar,x)
11700 call etotal(energia)
11702 !el call enerprint(energia)
11703 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
11706 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11710 grad_s(j,i)=gradc(j,i,icg)
11711 grad_s(j+3,i)=gradx(j,i,icg)
11715 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11720 ddx(j)=dc(j,i+nres)
11723 dc(j,i)=dc(j,i)+aincr
11725 c(j,k)=c(j,k)+aincr
11726 c(j,k+nres)=c(j,k+nres)+aincr
11728 call etotal(energia1)
11730 ggg(j)=(etot1-etot)/aincr
11733 c(j,k)=c(j,k)-aincr
11734 c(j,k+nres)=c(j,k+nres)-aincr
11738 c(j,i+nres)=c(j,i+nres)+aincr
11739 dc(j,i+nres)=dc(j,i+nres)+aincr
11740 call etotal(energia1)
11742 ggg(j+3)=(etot1-etot)/aincr
11744 dc(j,i+nres)=ddx(j)
11746 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
11747 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
11750 end subroutine check_ecart
11752 !-----------------------------------------------------------------------------
11753 subroutine check_ecartint
11754 ! Check the gradient of the energy in Cartesian coordinates.
11755 use io_base, only: intout
11756 ! implicit real*8 (a-h,o-z)
11757 ! include 'DIMENSIONS'
11758 ! include 'COMMON.CONTROL'
11759 ! include 'COMMON.CHAIN'
11760 ! include 'COMMON.DERIV'
11761 ! include 'COMMON.IOUNITS'
11762 ! include 'COMMON.VAR'
11763 ! include 'COMMON.CONTACTS'
11764 ! include 'COMMON.MD'
11765 ! include 'COMMON.LOCAL'
11766 ! include 'COMMON.SPLITELE'
11768 !el integer :: icall
11769 !el common /srutu/ icall
11770 real(kind=8),dimension(6) :: ggg,ggg1
11771 real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
11772 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11773 real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
11774 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
11775 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
11776 real(kind=8),dimension(0:n_ene) :: energia,energia1
11777 integer :: uiparm(1)
11778 real(kind=8) :: urparm(1)
11780 integer :: i,j,k,nf
11781 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
11789 ! call intcartderiv
11790 ! call checkintcartgrad
11793 write(iout,*) 'Calling CHECK_ECARTINT.'
11796 write (iout,*) "Before geom_to_var"
11797 call geom_to_var(nvar,x)
11798 write (iout,*) "after geom_to_var"
11799 write (iout,*) "split_ene ",split_ene
11801 if (.not.split_ene) then
11802 write(iout,*) 'Calling CHECK_ECARTINT if'
11803 call etotal(energia)
11804 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11806 write (iout,*) "etot",etot
11808 !el call enerprint(energia)
11809 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11811 write (iout,*) "enter cartgrad"
11814 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11815 write (iout,*) "exit cartgrad"
11819 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11822 grad_s(j,0)=gcart(j,0)
11824 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11827 grad_s(j,i)=gcart(j,i)
11828 grad_s(j+3,i)=gxcart(j,i)
11832 write(iout,*) 'Calling CHECK_ECARTIN else.'
11833 !- split gradient check
11835 call etotal_long(energia)
11836 !el call enerprint(energia)
11838 write (iout,*) "enter cartgrad"
11841 write (iout,*) "exit cartgrad"
11844 write (iout,*) "longrange grad"
11846 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11847 (gxcart(j,i),j=1,3)
11850 grad_s(j,0)=gcart(j,0)
11854 grad_s(j,i)=gcart(j,i)
11855 grad_s(j+3,i)=gxcart(j,i)
11859 call etotal_short(energia)
11860 call enerprint(energia)
11862 write (iout,*) "enter cartgrad"
11865 write (iout,*) "exit cartgrad"
11868 write (iout,*) "shortrange grad"
11870 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11871 (gxcart(j,i),j=1,3)
11874 grad_s1(j,0)=gcart(j,0)
11878 grad_s1(j,i)=gcart(j,i)
11879 grad_s1(j+3,i)=gxcart(j,i)
11883 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11887 if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
11888 if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
11891 dcnorm_safe1(j)=dc_norm(j,i-1)
11892 dcnorm_safe2(j)=dc_norm(j,i)
11893 dxnorm_safe(j)=dc_norm(j,i+nres)
11896 c(j,i)=ddc(j)+aincr
11897 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
11898 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
11899 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11900 dc(j,i)=c(j,i+1)-c(j,i)
11901 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11902 call int_from_cart1(.false.)
11903 if (.not.split_ene) then
11904 call etotal(energia1)
11906 write (iout,*) "ij",i,j," etot1",etot1
11909 call etotal_long(energia1)
11911 call etotal_short(energia1)
11914 !- end split gradient
11915 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11916 c(j,i)=ddc(j)-aincr
11917 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
11918 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
11919 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11920 dc(j,i)=c(j,i+1)-c(j,i)
11921 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11922 call int_from_cart1(.false.)
11923 if (.not.split_ene) then
11924 call etotal(energia1)
11926 write (iout,*) "ij",i,j," etot2",etot2
11927 ggg(j)=(etot1-etot2)/(2*aincr)
11930 call etotal_long(energia1)
11932 ggg(j)=(etot11-etot21)/(2*aincr)
11933 call etotal_short(energia1)
11935 ggg1(j)=(etot12-etot22)/(2*aincr)
11936 !- end split gradient
11937 ! write (iout,*) "etot21",etot21," etot22",etot22
11939 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11941 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
11942 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
11943 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11944 dc(j,i)=c(j,i+1)-c(j,i)
11945 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11946 dc_norm(j,i-1)=dcnorm_safe1(j)
11947 dc_norm(j,i)=dcnorm_safe2(j)
11948 dc_norm(j,i+nres)=dxnorm_safe(j)
11951 c(j,i+nres)=ddx(j)+aincr
11952 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11953 call int_from_cart1(.false.)
11954 if (.not.split_ene) then
11955 call etotal(energia1)
11959 call etotal_long(energia1)
11961 call etotal_short(energia1)
11964 !- end split gradient
11965 c(j,i+nres)=ddx(j)-aincr
11966 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11967 call int_from_cart1(.false.)
11968 if (.not.split_ene) then
11969 call etotal(energia1)
11971 ggg(j+3)=(etot1-etot2)/(2*aincr)
11974 call etotal_long(energia1)
11976 ggg(j+3)=(etot11-etot21)/(2*aincr)
11977 call etotal_short(energia1)
11979 ggg1(j+3)=(etot12-etot22)/(2*aincr)
11980 !- end split gradient
11982 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11984 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11985 dc_norm(j,i+nres)=dxnorm_safe(j)
11986 call int_from_cart1(.false.)
11988 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11989 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
11990 if (split_ene) then
11991 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11992 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
11994 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11995 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
11996 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
12000 end subroutine check_ecartint
12002 !-----------------------------------------------------------------------------
12003 subroutine check_ecartint
12004 ! Check the gradient of the energy in Cartesian coordinates.
12005 use io_base, only: intout
12006 ! implicit real*8 (a-h,o-z)
12007 ! include 'DIMENSIONS'
12008 ! include 'COMMON.CONTROL'
12009 ! include 'COMMON.CHAIN'
12010 ! include 'COMMON.DERIV'
12011 ! include 'COMMON.IOUNITS'
12012 ! include 'COMMON.VAR'
12013 ! include 'COMMON.CONTACTS'
12014 ! include 'COMMON.MD'
12015 ! include 'COMMON.LOCAL'
12016 ! include 'COMMON.SPLITELE'
12018 !el integer :: icall
12019 !el common /srutu/ icall
12020 real(kind=8),dimension(6) :: ggg,ggg1
12021 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
12022 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
12023 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
12024 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
12025 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
12026 real(kind=8),dimension(0:n_ene) :: energia,energia1
12027 integer :: uiparm(1)
12028 real(kind=8) :: urparm(1)
12030 integer :: i,j,k,nf
12031 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
12039 ! call intcartderiv
12040 ! call checkintcartgrad
12043 write(iout,*) 'Calling CHECK_ECARTINT.',aincr
12046 call geom_to_var(nvar,x)
12047 if (.not.split_ene) then
12048 call etotal(energia)
12050 !el call enerprint(energia)
12052 write (iout,*) "enter cartgrad"
12055 write (iout,*) "exit cartgrad"
12059 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
12062 grad_s(j,0)=gcart(j,0)
12066 grad_s(j,i)=gcart(j,i)
12067 ! if (i.le.2) print *,"tu?!",gcart(j,i),grad_s(j,i),gxcart(j,i)
12068 grad_s(j+3,i)=gxcart(j,i)
12072 !- split gradient check
12074 call etotal_long(energia)
12075 !el call enerprint(energia)
12077 write (iout,*) "enter cartgrad"
12080 write (iout,*) "exit cartgrad"
12083 write (iout,*) "longrange grad"
12085 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12086 (gxcart(j,i),j=1,3)
12089 grad_s(j,0)=gcart(j,0)
12093 grad_s(j,i)=gcart(j,i)
12094 grad_s(j+3,i)=gxcart(j,i)
12098 call etotal_short(energia)
12099 !el call enerprint(energia)
12101 write (iout,*) "enter cartgrad"
12104 write (iout,*) "exit cartgrad"
12107 write (iout,*) "shortrange grad"
12109 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12110 (gxcart(j,i),j=1,3)
12113 grad_s1(j,0)=gcart(j,0)
12117 grad_s1(j,i)=gcart(j,i)
12118 grad_s1(j+3,i)=gxcart(j,i)
12122 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
12127 ddx(j)=dc(j,i+nres)
12129 dcnorm_safe(k)=dc_norm(k,i)
12130 dxnorm_safe(k)=dc_norm(k,i+nres)
12134 dc(j,i)=ddc(j)+aincr
12135 call chainbuild_cart
12137 ! Broadcast the order to compute internal coordinates to the slaves.
12138 ! if (nfgtasks.gt.1)
12139 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
12141 ! call int_from_cart1(.false.)
12142 if (.not.split_ene) then
12143 call etotal(energia1)
12145 ! call enerprint(energia1)
12148 call etotal_long(energia1)
12150 call etotal_short(energia1)
12152 ! write (iout,*) "etot11",etot11," etot12",etot12
12154 !- end split gradient
12155 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12156 dc(j,i)=ddc(j)-aincr
12157 call chainbuild_cart
12158 ! call int_from_cart1(.false.)
12159 if (.not.split_ene) then
12160 call etotal(energia1)
12162 ggg(j)=(etot1-etot2)/(2*aincr)
12165 call etotal_long(energia1)
12167 ggg(j)=(etot11-etot21)/(2*aincr)
12168 call etotal_short(energia1)
12170 ggg1(j)=(etot12-etot22)/(2*aincr)
12171 !- end split gradient
12172 ! write (iout,*) "etot21",etot21," etot22",etot22
12174 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12176 call chainbuild_cart
12179 dc(j,i+nres)=ddx(j)+aincr
12180 call chainbuild_cart
12181 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
12182 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
12183 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
12184 ! write (iout,*) "dxnormnorm",dsqrt(
12185 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
12186 ! write (iout,*) "dxnormnormsafe",dsqrt(
12187 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
12189 if (.not.split_ene) then
12190 call etotal(energia1)
12194 call etotal_long(energia1)
12196 call etotal_short(energia1)
12199 !- end split gradient
12200 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12201 dc(j,i+nres)=ddx(j)-aincr
12202 call chainbuild_cart
12203 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
12204 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
12205 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
12207 ! write (iout,*) "dxnormnorm",dsqrt(
12208 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
12209 ! write (iout,*) "dxnormnormsafe",dsqrt(
12210 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
12211 if (.not.split_ene) then
12212 call etotal(energia1)
12214 ggg(j+3)=(etot1-etot2)/(2*aincr)
12217 call etotal_long(energia1)
12219 ggg(j+3)=(etot11-etot21)/(2*aincr)
12220 call etotal_short(energia1)
12222 ggg1(j+3)=(etot12-etot22)/(2*aincr)
12223 !- end split gradient
12225 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12226 dc(j,i+nres)=ddx(j)
12227 call chainbuild_cart
12229 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12230 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
12231 if (split_ene) then
12232 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12233 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
12235 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12236 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
12237 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
12241 end subroutine check_ecartint
12243 !-----------------------------------------------------------------------------
12244 subroutine check_eint
12245 ! Check the gradient of energy in internal coordinates.
12246 ! implicit real*8 (a-h,o-z)
12247 ! include 'DIMENSIONS'
12248 ! include 'COMMON.CHAIN'
12249 ! include 'COMMON.DERIV'
12250 ! include 'COMMON.IOUNITS'
12251 ! include 'COMMON.VAR'
12252 ! include 'COMMON.GEO'
12254 !el integer :: icall
12255 !el common /srutu/ icall
12256 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
12257 integer :: uiparm(1)
12258 real(kind=8) :: urparm(1)
12259 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
12260 character(len=6) :: key
12263 real(kind=8) :: xi,aincr,etot,etot1,etot2
12266 print '(a)','Calling CHECK_INT.'
12270 call geom_to_var(nvar,x)
12271 call var_to_geom(nvar,x)
12274 ! print *,'ICG=',ICG
12275 call etotal(energia)
12277 !el call enerprint(energia)
12278 ! print *,'ICG=',ICG
12280 if (MyID.ne.BossID) then
12281 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
12289 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
12290 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
12291 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
12295 x(i)=xi-0.5D0*aincr
12296 call var_to_geom(nvar,x)
12298 call etotal(energia1)
12300 x(i)=xi+0.5D0*aincr
12301 call var_to_geom(nvar,x)
12303 call etotal(energia2)
12305 gg(i)=(etot2-etot1)/aincr
12306 write (iout,*) i,etot1,etot2
12309 write (iout,'(/2a)')' Variable Numerical Analytical',&
12312 if (i.le.nphi) then
12315 else if (i.le.nphi+ntheta) then
12318 else if (i.le.nphi+ntheta+nside) then
12322 ii=i-(nphi+ntheta+nside)
12325 write (iout,'(i3,a,i3,3(1pd16.6))') &
12326 i,key,ii,gg(i),gana(i),&
12327 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
12330 end subroutine check_eint
12331 !-----------------------------------------------------------------------------
12333 !-----------------------------------------------------------------------------
12334 subroutine Econstr_back
12335 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
12336 ! implicit real*8 (a-h,o-z)
12337 ! include 'DIMENSIONS'
12338 ! include 'COMMON.CONTROL'
12339 ! include 'COMMON.VAR'
12340 ! include 'COMMON.MD'
12343 ! include 'COMMON.LANGEVIN'
12345 ! include 'COMMON.LANGEVIN.lang0'
12347 ! include 'COMMON.CHAIN'
12348 ! include 'COMMON.DERIV'
12349 ! include 'COMMON.GEO'
12350 ! include 'COMMON.LOCAL'
12351 ! include 'COMMON.INTERACT'
12352 ! include 'COMMON.IOUNITS'
12353 ! include 'COMMON.NAMES'
12354 ! include 'COMMON.TIME1'
12355 integer :: i,j,ii,k
12356 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
12358 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
12359 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
12360 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
12367 duscdiff(j,i)=0.0d0
12368 duscdiffx(j,i)=0.0d0
12372 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
12374 ! Deviations from theta angles
12377 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
12378 dtheta_i=theta(j)-thetaref(j)
12379 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
12380 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
12382 utheta(i)=utheta_i/(ii-1)
12384 ! Deviations from gamma angles
12387 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
12388 dgamma_i=pinorm(phi(j)-phiref(j))
12389 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
12390 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
12391 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
12392 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
12394 ugamma(i)=ugamma_i/(ii-2)
12396 ! Deviations from local SC geometry
12399 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
12400 dxx=xxtab(j)-xxref(j)
12401 dyy=yytab(j)-yyref(j)
12402 dzz=zztab(j)-zzref(j)
12403 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
12405 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
12406 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
12408 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
12409 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
12411 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
12412 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
12415 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
12416 ! & xxref(j),yyref(j),zzref(j)
12418 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
12419 ! write (iout,*) i," uscdiff",uscdiff(i)
12421 ! Put together deviations from local geometry
12423 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
12424 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
12425 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
12426 ! & " uconst_back",uconst_back
12427 utheta(i)=dsqrt(utheta(i))
12428 ugamma(i)=dsqrt(ugamma(i))
12429 uscdiff(i)=dsqrt(uscdiff(i))
12432 end subroutine Econstr_back
12433 !-----------------------------------------------------------------------------
12434 ! energy_p_new-sep_barrier.F
12435 !-----------------------------------------------------------------------------
12436 real(kind=8) function sscale(r)
12437 ! include "COMMON.SPLITELE"
12438 real(kind=8) :: r,gamm
12439 if(r.lt.r_cut-rlamb) then
12441 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
12442 gamm=(r-(r_cut-rlamb))/rlamb
12443 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12448 end function sscale
12449 real(kind=8) function sscale_grad(r)
12450 ! include "COMMON.SPLITELE"
12451 real(kind=8) :: r,gamm
12452 if(r.lt.r_cut-rlamb) then
12454 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
12455 gamm=(r-(r_cut-rlamb))/rlamb
12456 sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
12461 end function sscale_grad
12463 !!!!!!!!!! PBCSCALE
12464 real(kind=8) function sscale_ele(r)
12465 ! include "COMMON.SPLITELE"
12466 real(kind=8) :: r,gamm
12467 if(r.lt.r_cut_ele-rlamb_ele) then
12469 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12470 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12471 sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12476 end function sscale_ele
12478 real(kind=8) function sscagrad_ele(r)
12479 real(kind=8) :: r,gamm
12480 ! include "COMMON.SPLITELE"
12481 if(r.lt.r_cut_ele-rlamb_ele) then
12483 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12484 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12485 sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
12490 end function sscagrad_ele
12491 real(kind=8) function sscalelip(r)
12492 real(kind=8) r,gamm
12493 sscalelip=1.0d0+r*r*(2.0d0*r-3.0d0)
12495 end function sscalelip
12496 !C-----------------------------------------------------------------------
12497 real(kind=8) function sscagradlip(r)
12498 real(kind=8) r,gamm
12499 sscagradlip=r*(6.0d0*r-6.0d0)
12501 end function sscagradlip
12504 !-----------------------------------------------------------------------------
12505 subroutine elj_long(evdw)
12507 ! This subroutine calculates the interaction energy of nonbonded side chains
12508 ! assuming the LJ potential of interaction.
12510 ! implicit real*8 (a-h,o-z)
12511 ! include 'DIMENSIONS'
12512 ! include 'COMMON.GEO'
12513 ! include 'COMMON.VAR'
12514 ! include 'COMMON.LOCAL'
12515 ! include 'COMMON.CHAIN'
12516 ! include 'COMMON.DERIV'
12517 ! include 'COMMON.INTERACT'
12518 ! include 'COMMON.TORSION'
12519 ! include 'COMMON.SBRIDGE'
12520 ! include 'COMMON.NAMES'
12521 ! include 'COMMON.IOUNITS'
12522 ! include 'COMMON.CONTACTS'
12523 real(kind=8),parameter :: accur=1.0d-10
12524 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12525 !el local variables
12526 integer :: i,iint,j,k,itypi,itypi1,itypj
12527 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12528 real(kind=8) :: e1,e2,evdwij,evdw
12529 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12531 do i=iatsc_s,iatsc_e
12533 if (itypi.eq.ntyp1) cycle
12534 itypi1=itype(i+1,1)
12539 ! Calculate SC interaction energy.
12541 do iint=1,nint_gr(i)
12542 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12543 !d & 'iend=',iend(i,iint)
12544 do j=istart(i,iint),iend(i,iint)
12546 if (itypj.eq.ntyp1) cycle
12550 rij=xj*xj+yj*yj+zj*zj
12551 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12552 if (sss.lt.1.0d0) then
12554 eps0ij=eps(itypi,itypj)
12556 e1=fac*fac*aa_aq(itypi,itypj)
12557 e2=fac*bb_aq(itypi,itypj)
12559 evdw=evdw+(1.0d0-sss)*evdwij
12561 ! Calculate the components of the gradient in DC and X
12563 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
12568 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12569 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12570 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12571 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12579 gvdwc(j,i)=expon*gvdwc(j,i)
12580 gvdwx(j,i)=expon*gvdwx(j,i)
12583 !******************************************************************************
12587 ! To save time, the factor of EXPON has been extracted from ALL components
12588 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12591 !******************************************************************************
12593 end subroutine elj_long
12594 !-----------------------------------------------------------------------------
12595 subroutine elj_short(evdw)
12597 ! This subroutine calculates the interaction energy of nonbonded side chains
12598 ! assuming the LJ potential of interaction.
12600 ! implicit real*8 (a-h,o-z)
12601 ! include 'DIMENSIONS'
12602 ! include 'COMMON.GEO'
12603 ! include 'COMMON.VAR'
12604 ! include 'COMMON.LOCAL'
12605 ! include 'COMMON.CHAIN'
12606 ! include 'COMMON.DERIV'
12607 ! include 'COMMON.INTERACT'
12608 ! include 'COMMON.TORSION'
12609 ! include 'COMMON.SBRIDGE'
12610 ! include 'COMMON.NAMES'
12611 ! include 'COMMON.IOUNITS'
12612 ! include 'COMMON.CONTACTS'
12613 real(kind=8),parameter :: accur=1.0d-10
12614 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12615 !el local variables
12616 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
12617 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12618 real(kind=8) :: e1,e2,evdwij,evdw
12619 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12621 do i=iatsc_s,iatsc_e
12623 if (itypi.eq.ntyp1) cycle
12624 itypi1=itype(i+1,1)
12631 ! Calculate SC interaction energy.
12633 do iint=1,nint_gr(i)
12634 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12635 !d & 'iend=',iend(i,iint)
12636 do j=istart(i,iint),iend(i,iint)
12638 if (itypj.eq.ntyp1) cycle
12642 ! Change 12/1/95 to calculate four-body interactions
12643 rij=xj*xj+yj*yj+zj*zj
12644 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12645 if (sss.gt.0.0d0) then
12647 eps0ij=eps(itypi,itypj)
12649 e1=fac*fac*aa_aq(itypi,itypj)
12650 e2=fac*bb_aq(itypi,itypj)
12652 evdw=evdw+sss*evdwij
12654 ! Calculate the components of the gradient in DC and X
12656 fac=-rrij*(e1+evdwij)*sss
12661 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12662 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12663 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12664 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12672 gvdwc(j,i)=expon*gvdwc(j,i)
12673 gvdwx(j,i)=expon*gvdwx(j,i)
12676 !******************************************************************************
12680 ! To save time, the factor of EXPON has been extracted from ALL components
12681 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12684 !******************************************************************************
12686 end subroutine elj_short
12687 !-----------------------------------------------------------------------------
12688 subroutine eljk_long(evdw)
12690 ! This subroutine calculates the interaction energy of nonbonded side chains
12691 ! assuming the LJK potential of interaction.
12693 ! implicit real*8 (a-h,o-z)
12694 ! include 'DIMENSIONS'
12695 ! include 'COMMON.GEO'
12696 ! include 'COMMON.VAR'
12697 ! include 'COMMON.LOCAL'
12698 ! include 'COMMON.CHAIN'
12699 ! include 'COMMON.DERIV'
12700 ! include 'COMMON.INTERACT'
12701 ! include 'COMMON.IOUNITS'
12702 ! include 'COMMON.NAMES'
12703 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12705 !el local variables
12706 integer :: i,iint,j,k,itypi,itypi1,itypj
12707 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12708 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12709 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12711 do i=iatsc_s,iatsc_e
12713 if (itypi.eq.ntyp1) cycle
12714 itypi1=itype(i+1,1)
12719 ! Calculate SC interaction energy.
12721 do iint=1,nint_gr(i)
12722 do j=istart(i,iint),iend(i,iint)
12724 if (itypj.eq.ntyp1) cycle
12728 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12729 fac_augm=rrij**expon
12730 e_augm=augm(itypi,itypj)*fac_augm
12731 r_inv_ij=dsqrt(rrij)
12733 sss=sscale(rij/sigma(itypi,itypj))
12734 if (sss.lt.1.0d0) then
12735 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12736 fac=r_shift_inv**expon
12737 e1=fac*fac*aa_aq(itypi,itypj)
12738 e2=fac*bb_aq(itypi,itypj)
12739 evdwij=e_augm+e1+e2
12740 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12741 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12742 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12743 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
12744 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12745 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12746 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12747 evdw=evdw+(1.0d0-sss)*evdwij
12749 ! Calculate the components of the gradient in DC and X
12751 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12752 fac=fac*(1.0d0-sss)
12757 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12758 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12759 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12760 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12768 gvdwc(j,i)=expon*gvdwc(j,i)
12769 gvdwx(j,i)=expon*gvdwx(j,i)
12773 end subroutine eljk_long
12774 !-----------------------------------------------------------------------------
12775 subroutine eljk_short(evdw)
12777 ! This subroutine calculates the interaction energy of nonbonded side chains
12778 ! assuming the LJK potential of interaction.
12780 ! implicit real*8 (a-h,o-z)
12781 ! include 'DIMENSIONS'
12782 ! include 'COMMON.GEO'
12783 ! include 'COMMON.VAR'
12784 ! include 'COMMON.LOCAL'
12785 ! include 'COMMON.CHAIN'
12786 ! include 'COMMON.DERIV'
12787 ! include 'COMMON.INTERACT'
12788 ! include 'COMMON.IOUNITS'
12789 ! include 'COMMON.NAMES'
12790 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12792 !el local variables
12793 integer :: i,iint,j,k,itypi,itypi1,itypj
12794 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12795 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12796 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12798 do i=iatsc_s,iatsc_e
12800 if (itypi.eq.ntyp1) cycle
12801 itypi1=itype(i+1,1)
12806 ! Calculate SC interaction energy.
12808 do iint=1,nint_gr(i)
12809 do j=istart(i,iint),iend(i,iint)
12811 if (itypj.eq.ntyp1) cycle
12815 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12816 fac_augm=rrij**expon
12817 e_augm=augm(itypi,itypj)*fac_augm
12818 r_inv_ij=dsqrt(rrij)
12820 sss=sscale(rij/sigma(itypi,itypj))
12821 if (sss.gt.0.0d0) then
12822 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12823 fac=r_shift_inv**expon
12824 e1=fac*fac*aa_aq(itypi,itypj)
12825 e2=fac*bb_aq(itypi,itypj)
12826 evdwij=e_augm+e1+e2
12827 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12828 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12829 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12830 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
12831 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12832 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12833 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12834 evdw=evdw+sss*evdwij
12836 ! Calculate the components of the gradient in DC and X
12838 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12844 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12845 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12846 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12847 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12855 gvdwc(j,i)=expon*gvdwc(j,i)
12856 gvdwx(j,i)=expon*gvdwx(j,i)
12860 end subroutine eljk_short
12861 !-----------------------------------------------------------------------------
12862 subroutine ebp_long(evdw)
12864 ! This subroutine calculates the interaction energy of nonbonded side chains
12865 ! assuming the Berne-Pechukas potential of interaction.
12868 ! implicit real*8 (a-h,o-z)
12869 ! include 'DIMENSIONS'
12870 ! include 'COMMON.GEO'
12871 ! include 'COMMON.VAR'
12872 ! include 'COMMON.LOCAL'
12873 ! include 'COMMON.CHAIN'
12874 ! include 'COMMON.DERIV'
12875 ! include 'COMMON.NAMES'
12876 ! include 'COMMON.INTERACT'
12877 ! include 'COMMON.IOUNITS'
12878 ! include 'COMMON.CALC'
12880 !el integer :: icall
12881 !el common /srutu/ icall
12882 ! double precision rrsave(maxdim)
12884 !el local variables
12885 integer :: iint,itypi,itypi1,itypj
12886 real(kind=8) :: rrij,xi,yi,zi,fac
12887 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
12889 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
12891 ! if (icall.eq.0) then
12897 do i=iatsc_s,iatsc_e
12899 if (itypi.eq.ntyp1) cycle
12900 itypi1=itype(i+1,1)
12904 dxi=dc_norm(1,nres+i)
12905 dyi=dc_norm(2,nres+i)
12906 dzi=dc_norm(3,nres+i)
12907 ! dsci_inv=dsc_inv(itypi)
12908 dsci_inv=vbld_inv(i+nres)
12910 ! Calculate SC interaction energy.
12912 do iint=1,nint_gr(i)
12913 do j=istart(i,iint),iend(i,iint)
12916 if (itypj.eq.ntyp1) cycle
12917 ! dscj_inv=dsc_inv(itypj)
12918 dscj_inv=vbld_inv(j+nres)
12919 chi1=chi(itypi,itypj)
12920 chi2=chi(itypj,itypi)
12927 alf12=0.5D0*(alf1+alf2)
12931 dxj=dc_norm(1,nres+j)
12932 dyj=dc_norm(2,nres+j)
12933 dzj=dc_norm(3,nres+j)
12934 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12936 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12938 if (sss.lt.1.0d0) then
12940 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
12942 ! Calculate whole angle-dependent part of epsilon and contributions
12943 ! to its derivatives
12944 fac=(rrij*sigsq)**expon2
12945 e1=fac*fac*aa_aq(itypi,itypj)
12946 e2=fac*bb_aq(itypi,itypj)
12947 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12948 eps2der=evdwij*eps3rt
12949 eps3der=evdwij*eps2rt
12950 evdwij=evdwij*eps2rt*eps3rt
12951 evdw=evdw+evdwij*(1.0d0-sss)
12953 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
12954 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
12955 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
12956 !d & restyp(itypi,1),i,restyp(itypj,1),j,
12957 !d & epsi,sigm,chi1,chi2,chip1,chip2,
12958 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
12959 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
12962 ! Calculate gradient components.
12963 e1=e1*eps1*eps2rt**2*eps3rt**2
12964 fac=-expon*(e1+evdwij)
12967 ! Calculate radial part of the gradient
12971 ! Calculate the angular part of the gradient and sum add the contributions
12972 ! to the appropriate components of the Cartesian gradient.
12973 call sc_grad_scale(1.0d0-sss)
12980 end subroutine ebp_long
12981 !-----------------------------------------------------------------------------
12982 subroutine ebp_short(evdw)
12984 ! This subroutine calculates the interaction energy of nonbonded side chains
12985 ! assuming the Berne-Pechukas potential of interaction.
12988 ! implicit real*8 (a-h,o-z)
12989 ! include 'DIMENSIONS'
12990 ! include 'COMMON.GEO'
12991 ! include 'COMMON.VAR'
12992 ! include 'COMMON.LOCAL'
12993 ! include 'COMMON.CHAIN'
12994 ! include 'COMMON.DERIV'
12995 ! include 'COMMON.NAMES'
12996 ! include 'COMMON.INTERACT'
12997 ! include 'COMMON.IOUNITS'
12998 ! include 'COMMON.CALC'
13000 !el integer :: icall
13001 !el common /srutu/ icall
13002 ! double precision rrsave(maxdim)
13004 !el local variables
13005 integer :: iint,itypi,itypi1,itypj
13006 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
13007 real(kind=8) :: sss,e1,e2,evdw
13009 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
13011 ! if (icall.eq.0) then
13017 do i=iatsc_s,iatsc_e
13019 if (itypi.eq.ntyp1) cycle
13020 itypi1=itype(i+1,1)
13024 dxi=dc_norm(1,nres+i)
13025 dyi=dc_norm(2,nres+i)
13026 dzi=dc_norm(3,nres+i)
13027 ! dsci_inv=dsc_inv(itypi)
13028 dsci_inv=vbld_inv(i+nres)
13030 ! Calculate SC interaction energy.
13032 do iint=1,nint_gr(i)
13033 do j=istart(i,iint),iend(i,iint)
13036 if (itypj.eq.ntyp1) cycle
13037 ! dscj_inv=dsc_inv(itypj)
13038 dscj_inv=vbld_inv(j+nres)
13039 chi1=chi(itypi,itypj)
13040 chi2=chi(itypj,itypi)
13047 alf12=0.5D0*(alf1+alf2)
13051 dxj=dc_norm(1,nres+j)
13052 dyj=dc_norm(2,nres+j)
13053 dzj=dc_norm(3,nres+j)
13054 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13056 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13058 if (sss.gt.0.0d0) then
13060 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
13062 ! Calculate whole angle-dependent part of epsilon and contributions
13063 ! to its derivatives
13064 fac=(rrij*sigsq)**expon2
13065 e1=fac*fac*aa_aq(itypi,itypj)
13066 e2=fac*bb_aq(itypi,itypj)
13067 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13068 eps2der=evdwij*eps3rt
13069 eps3der=evdwij*eps2rt
13070 evdwij=evdwij*eps2rt*eps3rt
13071 evdw=evdw+evdwij*sss
13073 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13074 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13075 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
13076 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13077 !d & epsi,sigm,chi1,chi2,chip1,chip2,
13078 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
13079 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
13082 ! Calculate gradient components.
13083 e1=e1*eps1*eps2rt**2*eps3rt**2
13084 fac=-expon*(e1+evdwij)
13087 ! Calculate radial part of the gradient
13091 ! Calculate the angular part of the gradient and sum add the contributions
13092 ! to the appropriate components of the Cartesian gradient.
13093 call sc_grad_scale(sss)
13100 end subroutine ebp_short
13101 !-----------------------------------------------------------------------------
13102 subroutine egb_long(evdw)
13104 ! This subroutine calculates the interaction energy of nonbonded side chains
13105 ! assuming the Gay-Berne potential of interaction.
13108 ! implicit real*8 (a-h,o-z)
13109 ! include 'DIMENSIONS'
13110 ! include 'COMMON.GEO'
13111 ! include 'COMMON.VAR'
13112 ! include 'COMMON.LOCAL'
13113 ! include 'COMMON.CHAIN'
13114 ! include 'COMMON.DERIV'
13115 ! include 'COMMON.NAMES'
13116 ! include 'COMMON.INTERACT'
13117 ! include 'COMMON.IOUNITS'
13118 ! include 'COMMON.CALC'
13119 ! include 'COMMON.CONTROL'
13121 !el local variables
13122 integer :: iint,itypi,itypi1,itypj,subchap
13123 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
13124 real(kind=8) :: sss,e1,e2,evdw,sss_grad
13125 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13126 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13127 ssgradlipi,ssgradlipj
13131 !cccc energy_dec=.false.
13132 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13135 ! if (icall.eq.0) lprn=.false.
13137 do i=iatsc_s,iatsc_e
13139 if (itypi.eq.ntyp1) cycle
13140 itypi1=itype(i+1,1)
13144 xi=mod(xi,boxxsize)
13145 if (xi.lt.0) xi=xi+boxxsize
13146 yi=mod(yi,boxysize)
13147 if (yi.lt.0) yi=yi+boxysize
13148 zi=mod(zi,boxzsize)
13149 if (zi.lt.0) zi=zi+boxzsize
13150 if ((zi.gt.bordlipbot) &
13151 .and.(zi.lt.bordliptop)) then
13152 !C the energy transfer exist
13153 if (zi.lt.buflipbot) then
13154 !C what fraction I am in
13156 ((zi-bordlipbot)/lipbufthick)
13157 !C lipbufthick is thickenes of lipid buffore
13158 sslipi=sscalelip(fracinbuf)
13159 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
13160 elseif (zi.gt.bufliptop) then
13161 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
13162 sslipi=sscalelip(fracinbuf)
13163 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
13173 dxi=dc_norm(1,nres+i)
13174 dyi=dc_norm(2,nres+i)
13175 dzi=dc_norm(3,nres+i)
13176 ! dsci_inv=dsc_inv(itypi)
13177 dsci_inv=vbld_inv(i+nres)
13178 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
13179 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
13181 ! Calculate SC interaction energy.
13183 do iint=1,nint_gr(i)
13184 do j=istart(i,iint),iend(i,iint)
13185 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
13186 ! call dyn_ssbond_ene(i,j,evdwij)
13188 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13189 ! 'evdw',i,j,evdwij,' ss'
13190 ! if (energy_dec) write (iout,*) &
13191 ! 'evdw',i,j,evdwij,' ss'
13192 ! do k=j+1,iend(i,iint)
13193 !C search over all next residues
13194 ! if (dyn_ss_mask(k)) then
13195 !C check if they are cysteins
13196 !C write(iout,*) 'k=',k
13198 !c write(iout,*) "PRZED TRI", evdwij
13199 ! evdwij_przed_tri=evdwij
13200 ! call triple_ssbond_ene(i,j,k,evdwij)
13201 !c if(evdwij_przed_tri.ne.evdwij) then
13202 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
13205 !c write(iout,*) "PO TRI", evdwij
13206 !C call the energy function that removes the artifical triple disulfide
13207 !C bond the soubroutine is located in ssMD.F
13209 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13210 'evdw',i,j,evdwij,'tss'
13211 ! endif!dyn_ss_mask(k)
13217 if (itypj.eq.ntyp1) cycle
13218 ! dscj_inv=dsc_inv(itypj)
13219 dscj_inv=vbld_inv(j+nres)
13220 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
13221 ! & 1.0d0/vbld(j+nres)
13222 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
13223 sig0ij=sigma(itypi,itypj)
13224 chi1=chi(itypi,itypj)
13225 chi2=chi(itypj,itypi)
13232 alf12=0.5D0*(alf1+alf2)
13236 ! Searching for nearest neighbour
13237 xj=mod(xj,boxxsize)
13238 if (xj.lt.0) xj=xj+boxxsize
13239 yj=mod(yj,boxysize)
13240 if (yj.lt.0) yj=yj+boxysize
13241 zj=mod(zj,boxzsize)
13242 if (zj.lt.0) zj=zj+boxzsize
13243 if ((zj.gt.bordlipbot) &
13244 .and.(zj.lt.bordliptop)) then
13245 !C the energy transfer exist
13246 if (zj.lt.buflipbot) then
13247 !C what fraction I am in
13249 ((zj-bordlipbot)/lipbufthick)
13250 !C lipbufthick is thickenes of lipid buffore
13251 sslipj=sscalelip(fracinbuf)
13252 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
13253 elseif (zj.gt.bufliptop) then
13254 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
13255 sslipj=sscalelip(fracinbuf)
13256 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13265 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13266 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13267 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13268 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13270 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13278 xj=xj_safe+xshift*boxxsize
13279 yj=yj_safe+yshift*boxysize
13280 zj=zj_safe+zshift*boxzsize
13281 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13282 if(dist_temp.lt.dist_init) then
13283 dist_init=dist_temp
13292 if (subchap.eq.1) then
13302 dxj=dc_norm(1,nres+j)
13303 dyj=dc_norm(2,nres+j)
13304 dzj=dc_norm(3,nres+j)
13305 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13307 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13308 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
13309 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
13310 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13311 if (sss_ele_cut.le.0.0) cycle
13312 if (sss.lt.1.0d0) then
13314 ! Calculate angle-dependent terms of energy and contributions to their
13318 sig=sig0ij*dsqrt(sigsq)
13319 rij_shift=1.0D0/rij-sig+sig0ij
13320 ! for diagnostics; uncomment
13321 ! rij_shift=1.2*sig0ij
13322 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13323 if (rij_shift.le.0.0D0) then
13325 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13326 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13327 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13331 !---------------------------------------------------------------
13332 rij_shift=1.0D0/rij_shift
13333 fac=rij_shift**expon
13336 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13337 eps2der=evdwij*eps3rt
13338 eps3der=evdwij*eps2rt
13339 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13340 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13341 evdwij=evdwij*eps2rt*eps3rt
13342 evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
13344 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13345 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13346 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13347 restyp(itypi,1),i,restyp(itypj,1),j,&
13348 epsi,sigm,chi1,chi2,chip1,chip2,&
13349 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13350 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13354 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13356 ! if (energy_dec) write (iout,*) &
13357 ! 'evdw',i,j,evdwij,"egb_long"
13359 ! Calculate gradient components.
13360 e1=e1*eps1*eps2rt**2*eps3rt**2
13361 fac=-expon*(e1+evdwij)*rij_shift
13364 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13365 /sigma(itypi,itypj)*rij-sss_grad/(1.0-sss)*rij &
13366 /sigmaii(itypi,itypj))
13368 ! Calculate the radial part of the gradient
13372 ! Calculate angular part of the gradient.
13373 call sc_grad_scale(1.0d0-sss)
13379 ! write (iout,*) "Number of loop steps in EGB:",ind
13380 !ccc energy_dec=.false.
13382 end subroutine egb_long
13383 !-----------------------------------------------------------------------------
13384 subroutine egb_short(evdw)
13386 ! This subroutine calculates the interaction energy of nonbonded side chains
13387 ! assuming the Gay-Berne potential of interaction.
13390 ! implicit real*8 (a-h,o-z)
13391 ! include 'DIMENSIONS'
13392 ! include 'COMMON.GEO'
13393 ! include 'COMMON.VAR'
13394 ! include 'COMMON.LOCAL'
13395 ! include 'COMMON.CHAIN'
13396 ! include 'COMMON.DERIV'
13397 ! include 'COMMON.NAMES'
13398 ! include 'COMMON.INTERACT'
13399 ! include 'COMMON.IOUNITS'
13400 ! include 'COMMON.CALC'
13401 ! include 'COMMON.CONTROL'
13403 !el local variables
13404 integer :: iint,itypi,itypi1,itypj,subchap
13405 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
13406 real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad
13407 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13408 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13409 ssgradlipi,ssgradlipj
13411 !cccc energy_dec=.false.
13412 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13415 ! if (icall.eq.0) lprn=.false.
13417 do i=iatsc_s,iatsc_e
13419 if (itypi.eq.ntyp1) cycle
13420 itypi1=itype(i+1,1)
13424 xi=mod(xi,boxxsize)
13425 if (xi.lt.0) xi=xi+boxxsize
13426 yi=mod(yi,boxysize)
13427 if (yi.lt.0) yi=yi+boxysize
13428 zi=mod(zi,boxzsize)
13429 if (zi.lt.0) zi=zi+boxzsize
13430 if ((zi.gt.bordlipbot) &
13431 .and.(zi.lt.bordliptop)) then
13432 !C the energy transfer exist
13433 if (zi.lt.buflipbot) then
13434 !C what fraction I am in
13436 ((zi-bordlipbot)/lipbufthick)
13437 !C lipbufthick is thickenes of lipid buffore
13438 sslipi=sscalelip(fracinbuf)
13439 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
13440 elseif (zi.gt.bufliptop) then
13441 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
13442 sslipi=sscalelip(fracinbuf)
13443 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
13453 dxi=dc_norm(1,nres+i)
13454 dyi=dc_norm(2,nres+i)
13455 dzi=dc_norm(3,nres+i)
13456 ! dsci_inv=dsc_inv(itypi)
13457 dsci_inv=vbld_inv(i+nres)
13459 dxi=dc_norm(1,nres+i)
13460 dyi=dc_norm(2,nres+i)
13461 dzi=dc_norm(3,nres+i)
13462 ! dsci_inv=dsc_inv(itypi)
13463 dsci_inv=vbld_inv(i+nres)
13464 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
13465 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
13467 ! Calculate SC interaction energy.
13469 do iint=1,nint_gr(i)
13470 do j=istart(i,iint),iend(i,iint)
13471 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
13472 call dyn_ssbond_ene(i,j,evdwij)
13474 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13475 'evdw',i,j,evdwij,' ss'
13476 do k=j+1,iend(i,iint)
13477 !C search over all next residues
13478 if (dyn_ss_mask(k)) then
13479 !C check if they are cysteins
13480 !C write(iout,*) 'k=',k
13482 !c write(iout,*) "PRZED TRI", evdwij
13483 ! evdwij_przed_tri=evdwij
13484 call triple_ssbond_ene(i,j,k,evdwij)
13485 !c if(evdwij_przed_tri.ne.evdwij) then
13486 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
13489 !c write(iout,*) "PO TRI", evdwij
13490 !C call the energy function that removes the artifical triple disulfide
13491 !C bond the soubroutine is located in ssMD.F
13493 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13494 'evdw',i,j,evdwij,'tss'
13495 endif!dyn_ss_mask(k)
13498 ! if (energy_dec) write (iout,*) &
13499 ! 'evdw',i,j,evdwij,' ss'
13503 if (itypj.eq.ntyp1) cycle
13504 ! dscj_inv=dsc_inv(itypj)
13505 dscj_inv=vbld_inv(j+nres)
13506 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
13507 ! & 1.0d0/vbld(j+nres)
13508 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
13509 sig0ij=sigma(itypi,itypj)
13510 chi1=chi(itypi,itypj)
13511 chi2=chi(itypj,itypi)
13518 alf12=0.5D0*(alf1+alf2)
13519 ! xj=c(1,nres+j)-xi
13520 ! yj=c(2,nres+j)-yi
13521 ! zj=c(3,nres+j)-zi
13525 ! Searching for nearest neighbour
13526 xj=mod(xj,boxxsize)
13527 if (xj.lt.0) xj=xj+boxxsize
13528 yj=mod(yj,boxysize)
13529 if (yj.lt.0) yj=yj+boxysize
13530 zj=mod(zj,boxzsize)
13531 if (zj.lt.0) zj=zj+boxzsize
13532 if ((zj.gt.bordlipbot) &
13533 .and.(zj.lt.bordliptop)) then
13534 !C the energy transfer exist
13535 if (zj.lt.buflipbot) then
13536 !C what fraction I am in
13538 ((zj-bordlipbot)/lipbufthick)
13539 !C lipbufthick is thickenes of lipid buffore
13540 sslipj=sscalelip(fracinbuf)
13541 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
13542 elseif (zj.gt.bufliptop) then
13543 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
13544 sslipj=sscalelip(fracinbuf)
13545 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13554 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13555 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13556 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13557 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13559 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13568 xj=xj_safe+xshift*boxxsize
13569 yj=yj_safe+yshift*boxysize
13570 zj=zj_safe+zshift*boxzsize
13571 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13572 if(dist_temp.lt.dist_init) then
13573 dist_init=dist_temp
13582 if (subchap.eq.1) then
13592 dxj=dc_norm(1,nres+j)
13593 dyj=dc_norm(2,nres+j)
13594 dzj=dc_norm(3,nres+j)
13595 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13597 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13598 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13599 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
13600 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
13601 if (sss_ele_cut.le.0.0) cycle
13603 if (sss.gt.0.0d0) then
13605 ! Calculate angle-dependent terms of energy and contributions to their
13609 sig=sig0ij*dsqrt(sigsq)
13610 rij_shift=1.0D0/rij-sig+sig0ij
13611 ! for diagnostics; uncomment
13612 ! rij_shift=1.2*sig0ij
13613 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13614 if (rij_shift.le.0.0D0) then
13616 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13617 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13618 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13622 !---------------------------------------------------------------
13623 rij_shift=1.0D0/rij_shift
13624 fac=rij_shift**expon
13627 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13628 eps2der=evdwij*eps3rt
13629 eps3der=evdwij*eps2rt
13630 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13631 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13632 evdwij=evdwij*eps2rt*eps3rt
13633 evdw=evdw+evdwij*sss*sss_ele_cut
13635 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13636 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13637 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13638 restyp(itypi,1),i,restyp(itypj,1),j,&
13639 epsi,sigm,chi1,chi2,chip1,chip2,&
13640 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13641 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13645 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13647 ! if (energy_dec) write (iout,*) &
13648 ! 'evdw',i,j,evdwij,"egb_short"
13650 ! Calculate gradient components.
13651 e1=e1*eps1*eps2rt**2*eps3rt**2
13652 fac=-expon*(e1+evdwij)*rij_shift
13655 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13656 /sigma(itypi,itypj)*rij+sss_grad/sss*rij &
13657 /sigmaii(itypi,itypj))
13660 ! Calculate the radial part of the gradient
13664 ! Calculate angular part of the gradient.
13665 call sc_grad_scale(sss)
13671 ! write (iout,*) "Number of loop steps in EGB:",ind
13672 !ccc energy_dec=.false.
13674 end subroutine egb_short
13675 !-----------------------------------------------------------------------------
13676 subroutine egbv_long(evdw)
13678 ! This subroutine calculates the interaction energy of nonbonded side chains
13679 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13682 ! implicit real*8 (a-h,o-z)
13683 ! include 'DIMENSIONS'
13684 ! include 'COMMON.GEO'
13685 ! include 'COMMON.VAR'
13686 ! include 'COMMON.LOCAL'
13687 ! include 'COMMON.CHAIN'
13688 ! include 'COMMON.DERIV'
13689 ! include 'COMMON.NAMES'
13690 ! include 'COMMON.INTERACT'
13691 ! include 'COMMON.IOUNITS'
13692 ! include 'COMMON.CALC'
13694 !el integer :: icall
13695 !el common /srutu/ icall
13697 !el local variables
13698 integer :: iint,itypi,itypi1,itypj
13699 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
13700 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
13702 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13705 ! if (icall.eq.0) lprn=.true.
13707 do i=iatsc_s,iatsc_e
13709 if (itypi.eq.ntyp1) cycle
13710 itypi1=itype(i+1,1)
13714 dxi=dc_norm(1,nres+i)
13715 dyi=dc_norm(2,nres+i)
13716 dzi=dc_norm(3,nres+i)
13717 ! dsci_inv=dsc_inv(itypi)
13718 dsci_inv=vbld_inv(i+nres)
13720 ! Calculate SC interaction energy.
13722 do iint=1,nint_gr(i)
13723 do j=istart(i,iint),iend(i,iint)
13726 if (itypj.eq.ntyp1) cycle
13727 ! dscj_inv=dsc_inv(itypj)
13728 dscj_inv=vbld_inv(j+nres)
13729 sig0ij=sigma(itypi,itypj)
13730 r0ij=r0(itypi,itypj)
13731 chi1=chi(itypi,itypj)
13732 chi2=chi(itypj,itypi)
13739 alf12=0.5D0*(alf1+alf2)
13743 dxj=dc_norm(1,nres+j)
13744 dyj=dc_norm(2,nres+j)
13745 dzj=dc_norm(3,nres+j)
13746 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13749 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13751 if (sss.lt.1.0d0) then
13753 ! Calculate angle-dependent terms of energy and contributions to their
13757 sig=sig0ij*dsqrt(sigsq)
13758 rij_shift=1.0D0/rij-sig+r0ij
13759 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13760 if (rij_shift.le.0.0D0) then
13765 !---------------------------------------------------------------
13766 rij_shift=1.0D0/rij_shift
13767 fac=rij_shift**expon
13768 e1=fac*fac*aa_aq(itypi,itypj)
13769 e2=fac*bb_aq(itypi,itypj)
13770 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13771 eps2der=evdwij*eps3rt
13772 eps3der=evdwij*eps2rt
13773 fac_augm=rrij**expon
13774 e_augm=augm(itypi,itypj)*fac_augm
13775 evdwij=evdwij*eps2rt*eps3rt
13776 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
13778 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13779 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13780 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13781 restyp(itypi,1),i,restyp(itypj,1),j,&
13782 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13783 chi1,chi2,chip1,chip2,&
13784 eps1,eps2rt**2,eps3rt**2,&
13785 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13788 ! Calculate gradient components.
13789 e1=e1*eps1*eps2rt**2*eps3rt**2
13790 fac=-expon*(e1+evdwij)*rij_shift
13792 fac=rij*fac-2*expon*rrij*e_augm
13793 ! Calculate the radial part of the gradient
13797 ! Calculate angular part of the gradient.
13798 call sc_grad_scale(1.0d0-sss)
13803 end subroutine egbv_long
13804 !-----------------------------------------------------------------------------
13805 subroutine egbv_short(evdw)
13807 ! This subroutine calculates the interaction energy of nonbonded side chains
13808 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13811 ! implicit real*8 (a-h,o-z)
13812 ! include 'DIMENSIONS'
13813 ! include 'COMMON.GEO'
13814 ! include 'COMMON.VAR'
13815 ! include 'COMMON.LOCAL'
13816 ! include 'COMMON.CHAIN'
13817 ! include 'COMMON.DERIV'
13818 ! include 'COMMON.NAMES'
13819 ! include 'COMMON.INTERACT'
13820 ! include 'COMMON.IOUNITS'
13821 ! include 'COMMON.CALC'
13823 !el integer :: icall
13824 !el common /srutu/ icall
13826 !el local variables
13827 integer :: iint,itypi,itypi1,itypj
13828 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
13829 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
13831 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13834 ! if (icall.eq.0) lprn=.true.
13836 do i=iatsc_s,iatsc_e
13838 if (itypi.eq.ntyp1) cycle
13839 itypi1=itype(i+1,1)
13843 dxi=dc_norm(1,nres+i)
13844 dyi=dc_norm(2,nres+i)
13845 dzi=dc_norm(3,nres+i)
13846 ! dsci_inv=dsc_inv(itypi)
13847 dsci_inv=vbld_inv(i+nres)
13849 ! Calculate SC interaction energy.
13851 do iint=1,nint_gr(i)
13852 do j=istart(i,iint),iend(i,iint)
13855 if (itypj.eq.ntyp1) cycle
13856 ! dscj_inv=dsc_inv(itypj)
13857 dscj_inv=vbld_inv(j+nres)
13858 sig0ij=sigma(itypi,itypj)
13859 r0ij=r0(itypi,itypj)
13860 chi1=chi(itypi,itypj)
13861 chi2=chi(itypj,itypi)
13868 alf12=0.5D0*(alf1+alf2)
13872 dxj=dc_norm(1,nres+j)
13873 dyj=dc_norm(2,nres+j)
13874 dzj=dc_norm(3,nres+j)
13875 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13878 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13880 if (sss.gt.0.0d0) then
13882 ! Calculate angle-dependent terms of energy and contributions to their
13886 sig=sig0ij*dsqrt(sigsq)
13887 rij_shift=1.0D0/rij-sig+r0ij
13888 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13889 if (rij_shift.le.0.0D0) then
13894 !---------------------------------------------------------------
13895 rij_shift=1.0D0/rij_shift
13896 fac=rij_shift**expon
13897 e1=fac*fac*aa_aq(itypi,itypj)
13898 e2=fac*bb_aq(itypi,itypj)
13899 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13900 eps2der=evdwij*eps3rt
13901 eps3der=evdwij*eps2rt
13902 fac_augm=rrij**expon
13903 e_augm=augm(itypi,itypj)*fac_augm
13904 evdwij=evdwij*eps2rt*eps3rt
13905 evdw=evdw+(evdwij+e_augm)*sss
13907 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13908 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13909 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13910 restyp(itypi,1),i,restyp(itypj,1),j,&
13911 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13912 chi1,chi2,chip1,chip2,&
13913 eps1,eps2rt**2,eps3rt**2,&
13914 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13917 ! Calculate gradient components.
13918 e1=e1*eps1*eps2rt**2*eps3rt**2
13919 fac=-expon*(e1+evdwij)*rij_shift
13921 fac=rij*fac-2*expon*rrij*e_augm
13922 ! Calculate the radial part of the gradient
13926 ! Calculate angular part of the gradient.
13927 call sc_grad_scale(sss)
13932 end subroutine egbv_short
13933 !-----------------------------------------------------------------------------
13934 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
13936 ! This subroutine calculates the average interaction energy and its gradient
13937 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
13938 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
13939 ! The potential depends both on the distance of peptide-group centers and on
13940 ! the orientation of the CA-CA virtual bonds.
13942 ! implicit real*8 (a-h,o-z)
13948 ! include 'DIMENSIONS'
13949 ! include 'COMMON.CONTROL'
13950 ! include 'COMMON.SETUP'
13951 ! include 'COMMON.IOUNITS'
13952 ! include 'COMMON.GEO'
13953 ! include 'COMMON.VAR'
13954 ! include 'COMMON.LOCAL'
13955 ! include 'COMMON.CHAIN'
13956 ! include 'COMMON.DERIV'
13957 ! include 'COMMON.INTERACT'
13958 ! include 'COMMON.CONTACTS'
13959 ! include 'COMMON.TORSION'
13960 ! include 'COMMON.VECTORS'
13961 ! include 'COMMON.FFIELD'
13962 ! include 'COMMON.TIME1'
13963 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
13964 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
13965 real(kind=8),dimension(2,2) :: acipa !el,a_temp
13966 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
13967 real(kind=8),dimension(4) :: muij
13968 !el integer :: num_conti,j1,j2
13969 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
13970 !el dz_normi,xmedi,ymedi,zmedi
13971 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
13972 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
13973 !el num_conti,j1,j2
13974 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
13976 real(kind=8) :: scal_el=1.0d0
13978 real(kind=8) :: scal_el=0.5d0
13981 ! 13-go grudnia roku pamietnego...
13982 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
13983 0.0d0,1.0d0,0.0d0,&
13984 0.0d0,0.0d0,1.0d0/),shape(unmat))
13985 !el local variables
13987 real(kind=8) :: fac
13988 real(kind=8) :: dxj,dyj,dzj
13989 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
13991 ! allocate(num_cont_hb(nres)) !(maxres)
13992 !d write(iout,*) 'In EELEC'
13994 !d write(iout,*) 'Type',i
13995 !d write(iout,*) 'B1',B1(:,i)
13996 !d write(iout,*) 'B2',B2(:,i)
13997 !d write(iout,*) 'CC',CC(:,:,i)
13998 !d write(iout,*) 'DD',DD(:,:,i)
13999 !d write(iout,*) 'EE',EE(:,:,i)
14001 !d call check_vecgrad
14003 if (icheckgrad.eq.1) then
14005 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
14007 dc_norm(k,i)=dc(k,i)*fac
14009 ! write (iout,*) 'i',i,' fac',fac
14012 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
14013 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
14014 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
14015 ! call vec_and_deriv
14019 ! print *, "before set matrices"
14021 ! print *,"after set martices"
14023 time_mat=time_mat+MPI_Wtime()-time01
14027 !d write (iout,*) 'i=',i
14029 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
14032 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
14033 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
14046 !d print '(a)','Enter EELEC'
14047 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
14048 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
14049 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
14051 gel_loc_loc(i)=0.0d0
14056 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
14058 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
14060 do i=iturn3_start,iturn3_end
14061 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1 &
14062 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
14066 dx_normi=dc_norm(1,i)
14067 dy_normi=dc_norm(2,i)
14068 dz_normi=dc_norm(3,i)
14069 xmedi=c(1,i)+0.5d0*dxi
14070 ymedi=c(2,i)+0.5d0*dyi
14071 zmedi=c(3,i)+0.5d0*dzi
14072 xmedi=dmod(xmedi,boxxsize)
14073 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14074 ymedi=dmod(ymedi,boxysize)
14075 if (ymedi.lt.0) ymedi=ymedi+boxysize
14076 zmedi=dmod(zmedi,boxzsize)
14077 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14079 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
14080 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
14081 num_cont_hb(i)=num_conti
14083 do i=iturn4_start,iturn4_end
14084 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
14085 .or. itype(i+3,1).eq.ntyp1 &
14086 .or. itype(i+4,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 num_conti=num_cont_hb(i)
14103 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
14104 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
14105 call eturn4(i,eello_turn4)
14106 num_cont_hb(i)=num_conti
14109 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
14111 do i=iatel_s,iatel_e
14112 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
14116 dx_normi=dc_norm(1,i)
14117 dy_normi=dc_norm(2,i)
14118 dz_normi=dc_norm(3,i)
14119 xmedi=c(1,i)+0.5d0*dxi
14120 ymedi=c(2,i)+0.5d0*dyi
14121 zmedi=c(3,i)+0.5d0*dzi
14122 xmedi=dmod(xmedi,boxxsize)
14123 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14124 ymedi=dmod(ymedi,boxysize)
14125 if (ymedi.lt.0) ymedi=ymedi+boxysize
14126 zmedi=dmod(zmedi,boxzsize)
14127 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14128 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
14129 num_conti=num_cont_hb(i)
14130 do j=ielstart(i),ielend(i)
14131 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
14132 call eelecij_scale(i,j,ees,evdw1,eel_loc)
14134 num_cont_hb(i)=num_conti
14136 ! write (iout,*) "Number of loop steps in EELEC:",ind
14138 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
14139 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
14141 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
14142 !cc eel_loc=eel_loc+eello_turn3
14143 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
14145 end subroutine eelec_scale
14146 !-----------------------------------------------------------------------------
14147 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
14148 ! implicit real*8 (a-h,o-z)
14151 ! include 'DIMENSIONS'
14155 ! include 'COMMON.CONTROL'
14156 ! include 'COMMON.IOUNITS'
14157 ! include 'COMMON.GEO'
14158 ! include 'COMMON.VAR'
14159 ! include 'COMMON.LOCAL'
14160 ! include 'COMMON.CHAIN'
14161 ! include 'COMMON.DERIV'
14162 ! include 'COMMON.INTERACT'
14163 ! include 'COMMON.CONTACTS'
14164 ! include 'COMMON.TORSION'
14165 ! include 'COMMON.VECTORS'
14166 ! include 'COMMON.FFIELD'
14167 ! include 'COMMON.TIME1'
14168 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
14169 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
14170 real(kind=8),dimension(2,2) :: acipa !el,a_temp
14171 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
14172 real(kind=8),dimension(4) :: muij
14173 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14174 dist_temp, dist_init,sss_grad
14175 integer xshift,yshift,zshift
14177 !el integer :: num_conti,j1,j2
14178 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
14179 !el dz_normi,xmedi,ymedi,zmedi
14180 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
14181 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14182 !el num_conti,j1,j2
14183 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14185 real(kind=8) :: scal_el=1.0d0
14187 real(kind=8) :: scal_el=0.5d0
14190 ! 13-go grudnia roku pamietnego...
14191 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
14192 0.0d0,1.0d0,0.0d0,&
14193 0.0d0,0.0d0,1.0d0/),shape(unmat))
14194 !el local variables
14195 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m,isubchap
14196 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
14197 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
14198 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
14199 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
14200 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
14201 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
14202 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
14203 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
14204 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
14205 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
14206 ecosam,ecosbm,ecosgm,ghalf,time00
14207 ! integer :: maxconts
14208 ! maxconts = nres/4
14209 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14210 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14211 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14212 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14213 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14214 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14215 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14216 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14217 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
14218 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
14219 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
14220 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
14221 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
14223 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
14224 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
14229 !d write (iout,*) "eelecij",i,j
14233 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
14234 aaa=app(iteli,itelj)
14235 bbb=bpp(iteli,itelj)
14236 ael6i=ael6(iteli,itelj)
14237 ael3i=ael3(iteli,itelj)
14241 dx_normj=dc_norm(1,j)
14242 dy_normj=dc_norm(2,j)
14243 dz_normj=dc_norm(3,j)
14244 ! xj=c(1,j)+0.5D0*dxj-xmedi
14245 ! yj=c(2,j)+0.5D0*dyj-ymedi
14246 ! zj=c(3,j)+0.5D0*dzj-zmedi
14247 xj=c(1,j)+0.5D0*dxj
14248 yj=c(2,j)+0.5D0*dyj
14249 zj=c(3,j)+0.5D0*dzj
14250 xj=mod(xj,boxxsize)
14251 if (xj.lt.0) xj=xj+boxxsize
14252 yj=mod(yj,boxysize)
14253 if (yj.lt.0) yj=yj+boxysize
14254 zj=mod(zj,boxzsize)
14255 if (zj.lt.0) zj=zj+boxzsize
14257 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14264 xj=xj_safe+xshift*boxxsize
14265 yj=yj_safe+yshift*boxysize
14266 zj=zj_safe+zshift*boxzsize
14267 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14268 if(dist_temp.lt.dist_init) then
14269 dist_init=dist_temp
14278 if (isubchap.eq.1) then
14289 rij=xj*xj+yj*yj+zj*zj
14293 ! For extracting the short-range part of Evdwpp
14294 sss=sscale(rij/rpp(iteli,itelj))
14295 sss_ele_cut=sscale_ele(rij)
14296 sss_ele_grad=sscagrad_ele(rij)
14297 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
14298 ! sss_ele_cut=1.0d0
14299 ! sss_ele_grad=0.0d0
14300 if (sss_ele_cut.le.0.0) go to 128
14304 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
14305 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
14306 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
14307 fac=cosa-3.0D0*cosb*cosg
14309 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
14310 if (j.eq.i+2) ev1=scal_el*ev1
14315 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
14318 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
14319 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
14320 ees=ees+eesij*sss_ele_cut
14321 evdw1=evdw1+evdwij*(1.0d0-sss)*sss_ele_cut
14322 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
14323 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
14324 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
14325 !d & xmedi,ymedi,zmedi,xj,yj,zj
14327 if (energy_dec) then
14328 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
14329 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
14333 ! Calculate contributions to the Cartesian gradient.
14336 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
14337 facel=-3*rrmij*(el1+eesij)*sss_ele_cut
14343 ! Radial derivatives. First process both termini of the fragment (i,j)
14345 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj
14346 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj
14347 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj
14349 ! ghalf=0.5D0*ggg(k)
14350 ! gelc(k,i)=gelc(k,i)+ghalf
14351 ! gelc(k,j)=gelc(k,j)+ghalf
14353 ! 9/28/08 AL Gradient compotents will be summed only at the end
14355 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14356 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14359 ! Loop over residues i+1 thru j-1.
14363 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14366 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*(1.0d0-sss) &
14367 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
14368 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*(1.0d0-sss) &
14369 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
14370 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*(1.0d0-sss) &
14371 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
14373 ! ghalf=0.5D0*ggg(k)
14374 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
14375 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
14377 ! 9/28/08 AL Gradient compotents will be summed only at the end
14379 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14380 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14383 ! Loop over residues i+1 thru j-1.
14387 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
14391 facvdw=(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
14392 facel=(el1+eesij)*sss_ele_cut
14394 fac=-3*rrmij*(facvdw+facvdw+facel)
14399 ! Radial derivatives. First process both termini of the fragment (i,j)
14405 ! ghalf=0.5D0*ggg(k)
14406 ! gelc(k,i)=gelc(k,i)+ghalf
14407 ! gelc(k,j)=gelc(k,j)+ghalf
14409 ! 9/28/08 AL Gradient compotents will be summed only at the end
14411 gelc_long(k,j)=gelc(k,j)+ggg(k)
14412 gelc_long(k,i)=gelc(k,i)-ggg(k)
14415 ! Loop over residues i+1 thru j-1.
14419 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14422 ! 9/28/08 AL Gradient compotents will be summed only at the end
14427 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14428 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14434 ecosa=2.0D0*fac3*fac1+fac4
14437 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
14438 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
14440 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14441 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14443 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
14444 !d & (dcosg(k),k=1,3)
14446 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k) )*sss_ele_cut
14449 ! ghalf=0.5D0*ggg(k)
14450 ! gelc(k,i)=gelc(k,i)+ghalf
14451 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
14452 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14453 ! gelc(k,j)=gelc(k,j)+ghalf
14454 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
14455 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14459 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14463 gelc(k,i)=gelc(k,i) &
14464 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14465 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
14467 gelc(k,j)=gelc(k,j) &
14468 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14469 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14471 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14472 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14474 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
14475 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
14476 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14478 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
14479 ! energy of a peptide unit is assumed in the form of a second-order
14480 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
14481 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
14482 ! are computed for EVERY pair of non-contiguous peptide groups.
14484 if (j.lt.nres-1) then
14495 muij(kkk)=mu(k,i)*mu(l,j)
14498 !d write (iout,*) 'EELEC: i',i,' j',j
14499 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
14500 !d write(iout,*) 'muij',muij
14501 ury=scalar(uy(1,i),erij)
14502 urz=scalar(uz(1,i),erij)
14503 vry=scalar(uy(1,j),erij)
14504 vrz=scalar(uz(1,j),erij)
14505 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
14506 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
14507 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
14508 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
14509 fac=dsqrt(-ael6i)*r3ij
14514 !d write (iout,'(4i5,4f10.5)')
14515 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
14516 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
14517 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
14518 !d & uy(:,j),uz(:,j)
14519 !d write (iout,'(4f10.5)')
14520 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
14521 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
14522 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
14523 !d write (iout,'(9f10.5/)')
14524 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
14525 ! Derivatives of the elements of A in virtual-bond vectors
14526 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
14528 uryg(k,1)=scalar(erder(1,k),uy(1,i))
14529 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
14530 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
14531 urzg(k,1)=scalar(erder(1,k),uz(1,i))
14532 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
14533 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
14534 vryg(k,1)=scalar(erder(1,k),uy(1,j))
14535 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
14536 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
14537 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
14538 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
14539 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
14541 ! Compute radial contributions to the gradient
14559 ! Add the contributions coming from er
14562 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
14563 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
14564 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
14565 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
14568 ! Derivatives in DC(i)
14569 !grad ghalf1=0.5d0*agg(k,1)
14570 !grad ghalf2=0.5d0*agg(k,2)
14571 !grad ghalf3=0.5d0*agg(k,3)
14572 !grad ghalf4=0.5d0*agg(k,4)
14573 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
14574 -3.0d0*uryg(k,2)*vry)!+ghalf1
14575 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
14576 -3.0d0*uryg(k,2)*vrz)!+ghalf2
14577 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
14578 -3.0d0*urzg(k,2)*vry)!+ghalf3
14579 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
14580 -3.0d0*urzg(k,2)*vrz)!+ghalf4
14581 ! Derivatives in DC(i+1)
14582 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
14583 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
14584 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
14585 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
14586 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
14587 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
14588 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
14589 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
14590 ! Derivatives in DC(j)
14591 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
14592 -3.0d0*vryg(k,2)*ury)!+ghalf1
14593 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
14594 -3.0d0*vrzg(k,2)*ury)!+ghalf2
14595 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
14596 -3.0d0*vryg(k,2)*urz)!+ghalf3
14597 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
14598 -3.0d0*vrzg(k,2)*urz)!+ghalf4
14599 ! Derivatives in DC(j+1) or DC(nres-1)
14600 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
14601 -3.0d0*vryg(k,3)*ury)
14602 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
14603 -3.0d0*vrzg(k,3)*ury)
14604 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
14605 -3.0d0*vryg(k,3)*urz)
14606 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
14607 -3.0d0*vrzg(k,3)*urz)
14608 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
14610 !grad aggj1(k,l)=aggj1(k,l)+agg(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)
14629 if (j.lt.nres-1) then
14635 aggi(k,l)=-aggi(k,l)
14636 aggi1(k,l)=-aggi1(k,l)
14637 aggj(k,l)=-aggj(k,l)
14638 aggj1(k,l)=-aggj1(k,l)
14649 aggi(k,l)=-aggi(k,l)
14650 aggi1(k,l)=-aggi1(k,l)
14651 aggj(k,l)=-aggj(k,l)
14652 aggj1(k,l)=-aggj1(k,l)
14657 IF (wel_loc.gt.0.0d0) THEN
14658 ! Contribution to the local-electrostatic energy coming from the i-j pair
14659 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
14661 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
14663 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
14664 'eelloc',i,j,eel_loc_ij
14665 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
14667 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
14668 ! Partial derivatives in virtual-bond dihedral angles gamma
14670 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
14671 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
14672 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
14674 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
14675 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
14676 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
14682 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
14684 ggg(l)=(agg(l,1)*muij(1)+ &
14685 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
14687 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
14689 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
14690 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
14691 !grad ghalf=0.5d0*ggg(l)
14692 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
14693 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
14697 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
14700 ! Remaining derivatives of eello
14702 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
14703 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
14706 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
14707 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))&
14710 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
14711 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
14714 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
14715 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))&
14720 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
14721 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
14722 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
14723 .and. num_conti.le.maxconts) then
14724 ! write (iout,*) i,j," entered corr"
14726 ! Calculate the contact function. The ith column of the array JCONT will
14727 ! contain the numbers of atoms that make contacts with the atom I (of numbers
14728 ! greater than I). The arrays FACONT and GACONT will contain the values of
14729 ! the contact function and its derivative.
14730 ! r0ij=1.02D0*rpp(iteli,itelj)
14731 ! r0ij=1.11D0*rpp(iteli,itelj)
14732 r0ij=2.20D0*rpp(iteli,itelj)
14733 ! r0ij=1.55D0*rpp(iteli,itelj)
14734 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
14735 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14736 if (fcont.gt.0.0D0) then
14737 num_conti=num_conti+1
14738 if (num_conti.gt.maxconts) then
14739 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14740 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
14741 ' will skip next contacts for this conf.',num_conti
14743 jcont_hb(num_conti,i)=j
14744 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
14745 !d & " jcont_hb",jcont_hb(num_conti,i)
14746 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
14747 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14748 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
14750 d_cont(num_conti,i)=rij
14751 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
14752 ! --- Electrostatic-interaction matrix ---
14753 a_chuj(1,1,num_conti,i)=a22
14754 a_chuj(1,2,num_conti,i)=a23
14755 a_chuj(2,1,num_conti,i)=a32
14756 a_chuj(2,2,num_conti,i)=a33
14757 ! --- Gradient of rij
14759 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
14766 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
14767 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
14768 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
14769 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
14770 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
14775 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
14776 ! Calculate contact energies
14778 wij=cosa-3.0D0*cosb*cosg
14781 ! fac3=dsqrt(-ael6i)/r0ij**3
14782 fac3=dsqrt(-ael6i)*r3ij
14783 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
14784 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
14785 if (ees0tmp.gt.0) then
14786 ees0pij=dsqrt(ees0tmp)
14790 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
14791 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
14792 if (ees0tmp.gt.0) then
14793 ees0mij=dsqrt(ees0tmp)
14798 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
14801 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
14804 ! Diagnostics. Comment out or remove after debugging!
14805 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
14806 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
14807 ! ees0m(num_conti,i)=0.0D0
14809 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
14810 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
14811 ! Angular derivatives of the contact function
14812 ees0pij1=fac3/ees0pij
14813 ees0mij1=fac3/ees0mij
14814 fac3p=-3.0D0*fac3*rrmij
14815 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
14816 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
14818 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
14819 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
14820 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
14821 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
14822 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
14823 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
14824 ecosap=ecosa1+ecosa2
14825 ecosbp=ecosb1+ecosb2
14826 ecosgp=ecosg1+ecosg2
14827 ecosam=ecosa1-ecosa2
14828 ecosbm=ecosb1-ecosb2
14829 ecosgm=ecosg1-ecosg2
14838 facont_hb(num_conti,i)=fcont
14839 fprimcont=fprimcont/rij
14840 !d facont_hb(num_conti,i)=1.0D0
14841 ! Following line is for diagnostics.
14844 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14845 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14848 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
14849 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
14851 ! gggp(1)=gggp(1)+ees0pijp*xj
14852 ! gggp(2)=gggp(2)+ees0pijp*yj
14853 ! gggp(3)=gggp(3)+ees0pijp*zj
14854 ! gggm(1)=gggm(1)+ees0mijp*xj
14855 ! gggm(2)=gggm(2)+ees0mijp*yj
14856 ! gggm(3)=gggm(3)+ees0mijp*zj
14857 gggp(1)=gggp(1)+ees0pijp*xj &
14858 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14859 gggp(2)=gggp(2)+ees0pijp*yj &
14860 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14861 gggp(3)=gggp(3)+ees0pijp*zj &
14862 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14864 gggm(1)=gggm(1)+ees0mijp*xj &
14865 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14867 gggm(2)=gggm(2)+ees0mijp*yj &
14868 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14870 gggm(3)=gggm(3)+ees0mijp*zj &
14871 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14873 ! Derivatives due to the contact function
14874 gacont_hbr(1,num_conti,i)=fprimcont*xj
14875 gacont_hbr(2,num_conti,i)=fprimcont*yj
14876 gacont_hbr(3,num_conti,i)=fprimcont*zj
14879 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
14880 ! following the change of gradient-summation algorithm.
14882 !grad ghalfp=0.5D0*gggp(k)
14883 !grad ghalfm=0.5D0*gggm(k)
14884 ! gacontp_hb1(k,num_conti,i)= & !ghalfp
14885 ! +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14886 ! + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14887 ! gacontp_hb2(k,num_conti,i)= & !ghalfp
14888 ! +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14889 ! + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14890 ! gacontp_hb3(k,num_conti,i)=gggp(k)
14891 ! gacontm_hb1(k,num_conti,i)= &!ghalfm
14892 ! +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14893 ! + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14894 ! gacontm_hb2(k,num_conti,i)= & !ghalfm
14895 ! +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14896 ! + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14897 ! gacontm_hb3(k,num_conti,i)=gggm(k)
14898 gacontp_hb1(k,num_conti,i)= & !ghalfp+
14899 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14900 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14903 gacontp_hb2(k,num_conti,i)= & !ghalfp+
14904 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14905 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14908 gacontp_hb3(k,num_conti,i)=gggp(k) &
14911 gacontm_hb1(k,num_conti,i)= & !ghalfm+
14912 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14913 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14916 gacontm_hb2(k,num_conti,i)= & !ghalfm+
14917 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14918 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
14921 gacontm_hb3(k,num_conti,i)=gggm(k) &
14926 endif ! num_conti.le.maxconts
14929 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
14932 ghalf=0.5d0*agg(l,k)
14933 aggi(l,k)=aggi(l,k)+ghalf
14934 aggi1(l,k)=aggi1(l,k)+agg(l,k)
14935 aggj(l,k)=aggj(l,k)+ghalf
14938 if (j.eq.nres-1 .and. i.lt.j-2) then
14941 aggj1(l,k)=aggj1(l,k)+agg(l,k)
14947 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
14949 end subroutine eelecij_scale
14950 !-----------------------------------------------------------------------------
14951 subroutine evdwpp_short(evdw1)
14955 ! implicit real*8 (a-h,o-z)
14956 ! include 'DIMENSIONS'
14957 ! include 'COMMON.CONTROL'
14958 ! include 'COMMON.IOUNITS'
14959 ! include 'COMMON.GEO'
14960 ! include 'COMMON.VAR'
14961 ! include 'COMMON.LOCAL'
14962 ! include 'COMMON.CHAIN'
14963 ! include 'COMMON.DERIV'
14964 ! include 'COMMON.INTERACT'
14965 ! include 'COMMON.CONTACTS'
14966 ! include 'COMMON.TORSION'
14967 ! include 'COMMON.VECTORS'
14968 ! include 'COMMON.FFIELD'
14969 real(kind=8),dimension(3) :: ggg
14970 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14972 real(kind=8) :: scal_el=1.0d0
14974 real(kind=8) :: scal_el=0.5d0
14976 !el local variables
14977 integer :: i,j,k,iteli,itelj,num_conti,isubchap
14978 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
14979 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
14980 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14981 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
14982 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14983 dist_temp, dist_init,sss_grad
14984 integer xshift,yshift,zshift
14988 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
14989 ! & " iatel_e_vdw",iatel_e_vdw
14991 do i=iatel_s_vdw,iatel_e_vdw
14992 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1) cycle
14996 dx_normi=dc_norm(1,i)
14997 dy_normi=dc_norm(2,i)
14998 dz_normi=dc_norm(3,i)
14999 xmedi=c(1,i)+0.5d0*dxi
15000 ymedi=c(2,i)+0.5d0*dyi
15001 zmedi=c(3,i)+0.5d0*dzi
15002 xmedi=dmod(xmedi,boxxsize)
15003 if (xmedi.lt.0) xmedi=xmedi+boxxsize
15004 ymedi=dmod(ymedi,boxysize)
15005 if (ymedi.lt.0) ymedi=ymedi+boxysize
15006 zmedi=dmod(zmedi,boxzsize)
15007 if (zmedi.lt.0) zmedi=zmedi+boxzsize
15009 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
15010 ! & ' ielend',ielend_vdw(i)
15012 do j=ielstart_vdw(i),ielend_vdw(i)
15013 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
15017 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
15018 aaa=app(iteli,itelj)
15019 bbb=bpp(iteli,itelj)
15023 dx_normj=dc_norm(1,j)
15024 dy_normj=dc_norm(2,j)
15025 dz_normj=dc_norm(3,j)
15026 ! xj=c(1,j)+0.5D0*dxj-xmedi
15027 ! yj=c(2,j)+0.5D0*dyj-ymedi
15028 ! zj=c(3,j)+0.5D0*dzj-zmedi
15029 xj=c(1,j)+0.5D0*dxj
15030 yj=c(2,j)+0.5D0*dyj
15031 zj=c(3,j)+0.5D0*dzj
15032 xj=mod(xj,boxxsize)
15033 if (xj.lt.0) xj=xj+boxxsize
15034 yj=mod(yj,boxysize)
15035 if (yj.lt.0) yj=yj+boxysize
15036 zj=mod(zj,boxzsize)
15037 if (zj.lt.0) zj=zj+boxzsize
15039 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15046 xj=xj_safe+xshift*boxxsize
15047 yj=yj_safe+yshift*boxysize
15048 zj=zj_safe+zshift*boxzsize
15049 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15050 if(dist_temp.lt.dist_init) then
15051 dist_init=dist_temp
15060 if (isubchap.eq.1) then
15071 rij=xj*xj+yj*yj+zj*zj
15074 sss=sscale(rij/rpp(iteli,itelj))
15075 sss_ele_cut=sscale_ele(rij)
15076 sss_ele_grad=sscagrad_ele(rij)
15077 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
15078 if (sss_ele_cut.le.0.0) cycle
15079 if (sss.gt.0.0d0) then
15084 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
15085 if (j.eq.i+2) ev1=scal_el*ev1
15088 if (energy_dec) then
15089 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
15091 evdw1=evdw1+evdwij*sss*sss_ele_cut
15093 ! Calculate contributions to the Cartesian gradient.
15095 facvdw=-6*rrmij*(ev1+evdwij)*sss*sss_ele_cut
15099 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*sss &
15100 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
15101 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*sss &
15102 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
15103 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*sss &
15104 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
15107 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
15108 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
15114 end subroutine evdwpp_short
15115 !-----------------------------------------------------------------------------
15116 subroutine escp_long(evdw2,evdw2_14)
15118 ! This subroutine calculates the excluded-volume interaction energy between
15119 ! peptide-group centers and side chains and its gradient in virtual-bond and
15120 ! side-chain vectors.
15122 ! implicit real*8 (a-h,o-z)
15123 ! include 'DIMENSIONS'
15124 ! include 'COMMON.GEO'
15125 ! include 'COMMON.VAR'
15126 ! include 'COMMON.LOCAL'
15127 ! include 'COMMON.CHAIN'
15128 ! include 'COMMON.DERIV'
15129 ! include 'COMMON.INTERACT'
15130 ! include 'COMMON.FFIELD'
15131 ! include 'COMMON.IOUNITS'
15132 ! include 'COMMON.CONTROL'
15133 real(kind=8),dimension(3) :: ggg
15134 !el local variables
15135 integer :: i,iint,j,k,iteli,itypj,subchap
15136 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
15137 real(kind=8) :: evdw2,evdw2_14,evdwij
15138 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15139 dist_temp, dist_init
15143 !d print '(a)','Enter ESCP'
15144 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
15145 do i=iatscp_s,iatscp_e
15146 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
15148 xi=0.5D0*(c(1,i)+c(1,i+1))
15149 yi=0.5D0*(c(2,i)+c(2,i+1))
15150 zi=0.5D0*(c(3,i)+c(3,i+1))
15151 xi=mod(xi,boxxsize)
15152 if (xi.lt.0) xi=xi+boxxsize
15153 yi=mod(yi,boxysize)
15154 if (yi.lt.0) yi=yi+boxysize
15155 zi=mod(zi,boxzsize)
15156 if (zi.lt.0) zi=zi+boxzsize
15158 do iint=1,nscp_gr(i)
15160 do j=iscpstart(i,iint),iscpend(i,iint)
15162 if (itypj.eq.ntyp1) cycle
15163 ! Uncomment following three lines for SC-p interactions
15164 ! xj=c(1,nres+j)-xi
15165 ! yj=c(2,nres+j)-yi
15166 ! zj=c(3,nres+j)-zi
15167 ! Uncomment following three lines for Ca-p interactions
15171 xj=mod(xj,boxxsize)
15172 if (xj.lt.0) xj=xj+boxxsize
15173 yj=mod(yj,boxysize)
15174 if (yj.lt.0) yj=yj+boxysize
15175 zj=mod(zj,boxzsize)
15176 if (zj.lt.0) zj=zj+boxzsize
15177 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15185 xj=xj_safe+xshift*boxxsize
15186 yj=yj_safe+yshift*boxysize
15187 zj=zj_safe+zshift*boxzsize
15188 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15189 if(dist_temp.lt.dist_init) then
15190 dist_init=dist_temp
15199 if (subchap.eq.1) then
15208 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15210 rij=dsqrt(1.0d0/rrij)
15211 sss_ele_cut=sscale_ele(rij)
15212 sss_ele_grad=sscagrad_ele(rij)
15213 ! print *,sss_ele_cut,sss_ele_grad,&
15214 ! (rij),r_cut_ele,rlamb_ele
15215 if (sss_ele_cut.le.0.0) cycle
15216 sss=sscale((rij/rscp(itypj,iteli)))
15217 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
15218 if (sss.lt.1.0d0) then
15221 e1=fac*fac*aad(itypj,iteli)
15222 e2=fac*bad(itypj,iteli)
15223 if (iabs(j-i) .le. 2) then
15226 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)*sss_ele_cut
15229 evdw2=evdw2+evdwij*(1.0d0-sss)*sss_ele_cut
15230 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15231 'evdw2',i,j,sss,evdwij
15233 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15235 fac=-(evdwij+e1)*rrij*(1.0d0-sss)*sss_ele_cut
15236 fac=fac+evdwij*sss_ele_grad/rij/expon*(1.0d0-sss)&
15237 -evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15241 ! Uncomment following three lines for SC-p interactions
15243 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15245 ! Uncomment following line for SC-p interactions
15246 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15248 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15249 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15258 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15259 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15260 gradx_scp(j,i)=expon*gradx_scp(j,i)
15263 !******************************************************************************
15267 ! To save time the factor EXPON has been extracted from ALL components
15268 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15271 !******************************************************************************
15273 end subroutine escp_long
15274 !-----------------------------------------------------------------------------
15275 subroutine escp_short(evdw2,evdw2_14)
15277 ! This subroutine calculates the excluded-volume interaction energy between
15278 ! peptide-group centers and side chains and its gradient in virtual-bond and
15279 ! side-chain vectors.
15281 ! implicit real*8 (a-h,o-z)
15282 ! include 'DIMENSIONS'
15283 ! include 'COMMON.GEO'
15284 ! include 'COMMON.VAR'
15285 ! include 'COMMON.LOCAL'
15286 ! include 'COMMON.CHAIN'
15287 ! include 'COMMON.DERIV'
15288 ! include 'COMMON.INTERACT'
15289 ! include 'COMMON.FFIELD'
15290 ! include 'COMMON.IOUNITS'
15291 ! include 'COMMON.CONTROL'
15292 real(kind=8),dimension(3) :: ggg
15293 !el local variables
15294 integer :: i,iint,j,k,iteli,itypj,subchap
15295 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
15296 real(kind=8) :: evdw2,evdw2_14,evdwij
15297 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15298 dist_temp, dist_init
15302 !d print '(a)','Enter ESCP'
15303 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
15304 do i=iatscp_s,iatscp_e
15305 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
15307 xi=0.5D0*(c(1,i)+c(1,i+1))
15308 yi=0.5D0*(c(2,i)+c(2,i+1))
15309 zi=0.5D0*(c(3,i)+c(3,i+1))
15310 xi=mod(xi,boxxsize)
15311 if (xi.lt.0) xi=xi+boxxsize
15312 yi=mod(yi,boxysize)
15313 if (yi.lt.0) yi=yi+boxysize
15314 zi=mod(zi,boxzsize)
15315 if (zi.lt.0) zi=zi+boxzsize
15317 do iint=1,nscp_gr(i)
15319 do j=iscpstart(i,iint),iscpend(i,iint)
15321 if (itypj.eq.ntyp1) cycle
15322 ! Uncomment following three lines for SC-p interactions
15323 ! xj=c(1,nres+j)-xi
15324 ! yj=c(2,nres+j)-yi
15325 ! zj=c(3,nres+j)-zi
15326 ! Uncomment following three lines for Ca-p interactions
15333 xj=mod(xj,boxxsize)
15334 if (xj.lt.0) xj=xj+boxxsize
15335 yj=mod(yj,boxysize)
15336 if (yj.lt.0) yj=yj+boxysize
15337 zj=mod(zj,boxzsize)
15338 if (zj.lt.0) zj=zj+boxzsize
15339 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15347 xj=xj_safe+xshift*boxxsize
15348 yj=yj_safe+yshift*boxysize
15349 zj=zj_safe+zshift*boxzsize
15350 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15351 if(dist_temp.lt.dist_init) then
15352 dist_init=dist_temp
15361 if (subchap.eq.1) then
15371 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15372 rij=dsqrt(1.0d0/rrij)
15373 sss_ele_cut=sscale_ele(rij)
15374 sss_ele_grad=sscagrad_ele(rij)
15375 ! print *,sss_ele_cut,sss_ele_grad,&
15376 ! (rij),r_cut_ele,rlamb_ele
15377 if (sss_ele_cut.le.0.0) cycle
15378 sss=sscale(rij/rscp(itypj,iteli))
15379 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
15380 if (sss.gt.0.0d0) then
15383 e1=fac*fac*aad(itypj,iteli)
15384 e2=fac*bad(itypj,iteli)
15385 if (iabs(j-i) .le. 2) then
15388 evdw2_14=evdw2_14+(e1+e2)*sss*sss_ele_cut
15391 evdw2=evdw2+evdwij*sss*sss_ele_cut
15392 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15393 'evdw2',i,j,sss,evdwij
15395 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15397 fac=-(evdwij+e1)*rrij*sss*sss_ele_cut
15398 fac=fac+evdwij*sss_ele_grad/rij/expon*sss &
15399 +evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15404 ! Uncomment following three lines for SC-p interactions
15406 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15408 ! Uncomment following line for SC-p interactions
15409 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15411 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15412 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15421 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15422 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15423 gradx_scp(j,i)=expon*gradx_scp(j,i)
15426 !******************************************************************************
15430 ! To save time the factor EXPON has been extracted from ALL components
15431 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15434 !******************************************************************************
15436 end subroutine escp_short
15437 !-----------------------------------------------------------------------------
15438 ! energy_p_new-sep_barrier.F
15439 !-----------------------------------------------------------------------------
15440 subroutine sc_grad_scale(scalfac)
15441 ! implicit real*8 (a-h,o-z)
15443 ! include 'DIMENSIONS'
15444 ! include 'COMMON.CHAIN'
15445 ! include 'COMMON.DERIV'
15446 ! include 'COMMON.CALC'
15447 ! include 'COMMON.IOUNITS'
15448 real(kind=8),dimension(3) :: dcosom1,dcosom2
15449 real(kind=8) :: scalfac
15450 !el local variables
15451 ! integer :: i,j,k,l
15453 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
15454 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
15455 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
15456 -2.0D0*alf12*eps3der+sigder*sigsq_om12
15460 ! eom12=evdwij*eps1_om12
15462 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
15463 ! & " sigder",sigder
15464 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
15465 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
15467 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
15468 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
15471 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac&
15474 ! write (iout,*) "gg",(gg(k),k=1,3)
15476 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
15477 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
15478 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
15480 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
15481 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
15482 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac&
15484 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
15485 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
15486 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
15487 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
15490 ! Calculate the components of the gradient in DC and X
15493 gvdwc(l,i)=gvdwc(l,i)-gg(l)
15494 gvdwc(l,j)=gvdwc(l,j)+gg(l)
15497 end subroutine sc_grad_scale
15498 !-----------------------------------------------------------------------------
15499 ! energy_split-sep.F
15500 !-----------------------------------------------------------------------------
15501 subroutine etotal_long(energia)
15503 ! Compute the long-range slow-varying contributions to the energy
15505 ! implicit real*8 (a-h,o-z)
15506 ! include 'DIMENSIONS'
15507 use MD_data, only: totT,usampl,eq_time
15511 !MS$ATTRIBUTES C :: proc_proc
15516 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
15518 ! include 'COMMON.SETUP'
15519 ! include 'COMMON.IOUNITS'
15520 ! include 'COMMON.FFIELD'
15521 ! include 'COMMON.DERIV'
15522 ! include 'COMMON.INTERACT'
15523 ! include 'COMMON.SBRIDGE'
15524 ! include 'COMMON.CHAIN'
15525 ! include 'COMMON.VAR'
15526 ! include 'COMMON.LOCAL'
15527 ! include 'COMMON.MD'
15528 real(kind=8),dimension(0:n_ene) :: energia
15529 !el local variables
15530 integer :: i,n_corr,n_corr1,ierror,ierr
15531 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
15532 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
15533 ecorr,ecorr5,ecorr6,eturn6,time00
15534 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
15535 !elwrite(iout,*)"in etotal long"
15537 if (modecalc.eq.12.or.modecalc.eq.14) then
15539 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
15541 call int_from_cart1(.false.)
15544 !elwrite(iout,*)"in etotal long"
15547 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
15548 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15550 if (nfgtasks.gt.1) then
15552 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15553 if (fg_rank.eq.0) then
15554 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
15555 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15557 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15558 ! FG slaves as WEIGHTS array.
15565 weights_(7)=wel_loc
15568 weights_(10)=wturn6
15570 weights_(12)=wscloc
15572 weights_(14)=wtor_d
15573 weights_(15)=wstrain
15574 weights_(16)=wvdwpp
15576 weights_(18)=scal14
15577 weights_(21)=wsccor
15578 ! FG Master broadcasts the WEIGHTS_ array
15579 call MPI_Bcast(weights_(1),n_ene,&
15580 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15582 ! FG slaves receive the WEIGHTS array
15583 call MPI_Bcast(weights(1),n_ene,&
15584 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15599 wstrain=weights(15)
15605 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
15607 time_Bcast=time_Bcast+MPI_Wtime()-time00
15608 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
15609 ! call chainbuild_cart
15610 ! call int_from_cart1(.false.)
15612 ! write (iout,*) 'Processor',myrank,
15613 ! & ' calling etotal_short ipot=',ipot
15615 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15617 !d print *,'nnt=',nnt,' nct=',nct
15619 !elwrite(iout,*)"in etotal long"
15620 ! Compute the side-chain and electrostatic interaction energy
15622 goto (101,102,103,104,105,106) ipot
15623 ! Lennard-Jones potential.
15624 101 call elj_long(evdw)
15625 !d print '(a)','Exit ELJ'
15627 ! Lennard-Jones-Kihara potential (shifted).
15628 102 call eljk_long(evdw)
15630 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15631 103 call ebp_long(evdw)
15633 ! Gay-Berne potential (shifted LJ, angular dependence).
15634 104 call egb_long(evdw)
15636 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15637 105 call egbv_long(evdw)
15639 ! Soft-sphere potential
15640 106 call e_softsphere(evdw)
15642 ! Calculate electrostatic (H-bonding) energy of the main chain.
15646 if (ipot.lt.6) then
15648 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
15649 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15650 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15651 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15653 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
15654 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15655 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15656 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15658 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
15667 ! write (iout,*) "Soft-spheer ELEC potential"
15668 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
15672 ! Calculate excluded-volume interaction energy between peptide groups
15675 if (ipot.lt.6) then
15676 if(wscp.gt.0d0) then
15677 call escp_long(evdw2,evdw2_14)
15683 call escp_soft_sphere(evdw2,evdw2_14)
15686 ! 12/1/95 Multi-body terms
15690 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
15691 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
15692 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
15693 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
15694 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
15701 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
15702 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
15705 ! If performing constraint dynamics, call the constraint energy
15706 ! after the equilibration time
15707 if(usampl.and.totT.gt.eq_time) then
15722 energia(2)=evdw2-evdw2_14
15723 energia(18)=evdw2_14
15732 energia(3)=ees+evdw1
15739 energia(8)=eello_turn3
15740 energia(9)=eello_turn4
15742 energia(20)=Uconst+Uconst_back
15743 call sum_energy(energia,.true.)
15744 ! write (iout,*) "Exit ETOTAL_LONG"
15747 end subroutine etotal_long
15748 !-----------------------------------------------------------------------------
15749 subroutine etotal_short(energia)
15751 ! Compute the short-range fast-varying contributions to the energy
15753 ! implicit real*8 (a-h,o-z)
15754 ! include 'DIMENSIONS'
15758 !MS$ATTRIBUTES C :: proc_proc
15763 integer :: ierror,ierr
15764 real(kind=8),dimension(n_ene) :: weights_
15765 real(kind=8) :: time00
15767 ! include 'COMMON.SETUP'
15768 ! include 'COMMON.IOUNITS'
15769 ! include 'COMMON.FFIELD'
15770 ! include 'COMMON.DERIV'
15771 ! include 'COMMON.INTERACT'
15772 ! include 'COMMON.SBRIDGE'
15773 ! include 'COMMON.CHAIN'
15774 ! include 'COMMON.VAR'
15775 ! include 'COMMON.LOCAL'
15776 real(kind=8),dimension(0:n_ene) :: energia
15777 !el local variables
15779 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
15780 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr
15783 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
15785 if (modecalc.eq.12.or.modecalc.eq.14) then
15787 if (fg_rank.eq.0) call int_from_cart1(.false.)
15789 call int_from_cart1(.false.)
15793 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
15794 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15796 if (nfgtasks.gt.1) then
15798 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15799 if (fg_rank.eq.0) then
15800 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
15801 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15803 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15804 ! FG slaves as WEIGHTS array.
15811 weights_(7)=wel_loc
15814 weights_(10)=wturn6
15816 weights_(12)=wscloc
15818 weights_(14)=wtor_d
15819 weights_(15)=wstrain
15820 weights_(16)=wvdwpp
15822 weights_(18)=scal14
15823 weights_(21)=wsccor
15824 ! FG Master broadcasts the WEIGHTS_ array
15825 call MPI_Bcast(weights_(1),n_ene,&
15826 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15828 ! FG slaves receive the WEIGHTS array
15829 call MPI_Bcast(weights(1),n_ene,&
15830 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15845 wstrain=weights(15)
15851 ! write (iout,*),"Processor",myrank," BROADCAST weights"
15852 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
15854 ! write (iout,*) "Processor",myrank," BROADCAST c"
15855 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
15857 ! write (iout,*) "Processor",myrank," BROADCAST dc"
15858 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
15860 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
15861 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
15863 ! write (iout,*) "Processor",myrank," BROADCAST theta"
15864 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
15866 ! write (iout,*) "Processor",myrank," BROADCAST phi"
15867 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
15869 ! write (iout,*) "Processor",myrank," BROADCAST alph"
15870 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
15872 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
15873 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
15875 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
15876 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
15878 time_Bcast=time_Bcast+MPI_Wtime()-time00
15879 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
15881 ! write (iout,*) 'Processor',myrank,
15882 ! & ' calling etotal_short ipot=',ipot
15884 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15886 ! call int_from_cart1(.false.)
15888 ! Compute the side-chain and electrostatic interaction energy
15890 goto (101,102,103,104,105,106) ipot
15891 ! Lennard-Jones potential.
15892 101 call elj_short(evdw)
15893 !d print '(a)','Exit ELJ'
15895 ! Lennard-Jones-Kihara potential (shifted).
15896 102 call eljk_short(evdw)
15898 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15899 103 call ebp_short(evdw)
15901 ! Gay-Berne potential (shifted LJ, angular dependence).
15902 104 call egb_short(evdw)
15904 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15905 105 call egbv_short(evdw)
15907 ! Soft-sphere potential - already dealt with in the long-range part
15909 ! 106 call e_softsphere_short(evdw)
15911 ! Calculate electrostatic (H-bonding) energy of the main chain.
15915 ! Calculate the short-range part of Evdwpp
15917 call evdwpp_short(evdw1)
15919 ! Calculate the short-range part of ESCp
15921 if (ipot.lt.6) then
15922 call escp_short(evdw2,evdw2_14)
15925 ! Calculate the bond-stretching energy
15929 ! Calculate the disulfide-bridge and other energy and the contributions
15930 ! from other distance constraints.
15933 ! Calculate the virtual-bond-angle energy.
15935 call ebend(ebe,ethetacnstr)
15937 ! Calculate the SC local energy.
15942 ! Calculate the virtual-bond torsional energy.
15944 call etor(etors,edihcnstr)
15946 ! 6/23/01 Calculate double-torsional energy
15948 call etor_d(etors_d)
15950 ! 21/5/07 Calculate local sicdechain correlation energy
15952 if (wsccor.gt.0.0d0) then
15953 call eback_sc_corr(esccor)
15958 ! Put energy components into an array
15965 energia(2)=evdw2-evdw2_14
15966 energia(18)=evdw2_14
15979 energia(14)=etors_d
15982 energia(19)=edihcnstr
15984 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
15986 call sum_energy(energia,.true.)
15987 ! write (iout,*) "Exit ETOTAL_SHORT"
15990 end subroutine etotal_short
15991 !-----------------------------------------------------------------------------
15993 !-----------------------------------------------------------------------------
15994 real(kind=8) function gnmr1(y,ymin,ymax)
15996 real(kind=8) :: y,ymin,ymax
15997 real(kind=8) :: wykl=4.0d0
15998 if (y.lt.ymin) then
15999 gnmr1=(ymin-y)**wykl/wykl
16000 else if (y.gt.ymax) then
16001 gnmr1=(y-ymax)**wykl/wykl
16007 !-----------------------------------------------------------------------------
16008 real(kind=8) function gnmr1prim(y,ymin,ymax)
16010 real(kind=8) :: y,ymin,ymax
16011 real(kind=8) :: wykl=4.0d0
16012 if (y.lt.ymin) then
16013 gnmr1prim=-(ymin-y)**(wykl-1)
16014 else if (y.gt.ymax) then
16015 gnmr1prim=(y-ymax)**(wykl-1)
16020 end function gnmr1prim
16021 !----------------------------------------------------------------------------
16022 real(kind=8) function rlornmr1(y,ymin,ymax,sigma)
16023 real(kind=8) y,ymin,ymax,sigma
16024 real(kind=8) wykl /4.0d0/
16025 if (y.lt.ymin) then
16026 rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl)
16027 else if (y.gt.ymax) then
16028 rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
16033 end function rlornmr1
16034 !------------------------------------------------------------------------------
16035 real(kind=8) function rlornmr1prim(y,ymin,ymax,sigma)
16036 real(kind=8) y,ymin,ymax,sigma
16037 real(kind=8) wykl /4.0d0/
16038 if (y.lt.ymin) then
16039 rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ &
16040 ((ymin-y)**wykl+sigma**wykl)**2
16041 else if (y.gt.ymax) then
16042 rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ &
16043 ((y-ymax)**wykl+sigma**wykl)**2
16048 end function rlornmr1prim
16050 real(kind=8) function harmonic(y,ymax)
16052 real(kind=8) :: y,ymax
16053 real(kind=8) :: wykl=2.0d0
16054 harmonic=(y-ymax)**wykl
16056 end function harmonic
16057 !-----------------------------------------------------------------------------
16058 real(kind=8) function harmonicprim(y,ymax)
16059 real(kind=8) :: y,ymin,ymax
16060 real(kind=8) :: wykl=2.0d0
16061 harmonicprim=(y-ymax)*wykl
16063 end function harmonicprim
16064 !-----------------------------------------------------------------------------
16066 !-----------------------------------------------------------------------------
16067 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
16069 use io_base, only:intout,briefout
16070 ! implicit real*8 (a-h,o-z)
16071 ! include 'DIMENSIONS'
16072 ! include 'COMMON.CHAIN'
16073 ! include 'COMMON.DERIV'
16074 ! include 'COMMON.VAR'
16075 ! include 'COMMON.INTERACT'
16076 ! include 'COMMON.FFIELD'
16077 ! include 'COMMON.MD'
16078 ! include 'COMMON.IOUNITS'
16079 real(kind=8),external :: ufparm
16080 integer :: uiparm(1)
16081 real(kind=8) :: urparm(1)
16082 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
16083 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
16084 integer :: n,nf,ind,ind1,i,k,j
16086 ! This subroutine calculates total internal coordinate gradient.
16087 ! Depending on the number of function evaluations, either whole energy
16088 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
16089 ! internal coordinates are reevaluated or only the cartesian-in-internal
16090 ! coordinate derivatives are evaluated. The subroutine was designed to work
16096 !d print *,'grad',nf,icg
16097 if (nf-nfl+1) 20,30,40
16098 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
16099 ! write (iout,*) 'grad 20'
16100 if (nf.eq.0) return
16102 30 call var_to_geom(n,x)
16104 ! write (iout,*) 'grad 30'
16106 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
16109 ! write (iout,*) 'grad 40'
16110 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
16112 ! Convert the Cartesian gradient into internal-coordinate gradient.
16122 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
16124 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
16127 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
16133 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
16135 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
16136 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
16139 if (i.gt.1) g(i-1)=gphii
16140 if (n.gt.nphi) g(nphi+i)=gthetai
16142 if (n.le.nphi+ntheta) goto 10
16144 if (itype(i,1).ne.10) then
16148 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
16151 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
16153 g(ialph(i,1))=galphai
16154 g(ialph(i,1)+nside)=gomegai
16158 ! Add the components corresponding to local energy terms.
16162 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
16163 g(i)=g(i)+gloc(i,icg)
16165 ! Uncomment following three lines for diagnostics.
16167 !elwrite(iout,*) "in gradient after calling intout"
16168 !d call briefout(0,0.0d0)
16169 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
16171 end subroutine gradient
16172 !-----------------------------------------------------------------------------
16173 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
16176 ! implicit real*8 (a-h,o-z)
16177 ! include 'DIMENSIONS'
16178 ! include 'COMMON.DERIV'
16179 ! include 'COMMON.IOUNITS'
16180 ! include 'COMMON.GEO'
16183 !el common /chuju/ jjj
16184 real(kind=8) :: energia(0:n_ene)
16185 integer :: uiparm(1)
16186 real(kind=8) :: urparm(1)
16188 real(kind=8),external :: ufparm
16189 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
16190 ! if (jjj.gt.0) then
16191 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
16195 !d print *,'func',nf,nfl,icg
16196 call var_to_geom(n,x)
16199 !d write (iout,*) 'ETOTAL called from FUNC'
16200 call etotal(energia)
16203 ! if (jjj.gt.0) then
16204 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
16205 ! write (iout,*) 'f=',etot
16209 end subroutine func
16210 !-----------------------------------------------------------------------------
16211 subroutine cartgrad
16212 ! implicit real*8 (a-h,o-z)
16213 ! include 'DIMENSIONS'
16215 use MD_data, only: totT,usampl,eq_time
16219 ! include 'COMMON.CHAIN'
16220 ! include 'COMMON.DERIV'
16221 ! include 'COMMON.VAR'
16222 ! include 'COMMON.INTERACT'
16223 ! include 'COMMON.FFIELD'
16224 ! include 'COMMON.MD'
16225 ! include 'COMMON.IOUNITS'
16226 ! include 'COMMON.TIME1'
16230 ! This subrouting calculates total Cartesian coordinate gradient.
16231 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
16241 !el write (iout,*) "After sum_gradient"
16243 !el write (iout,*) "After sum_gradient"
16245 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
16246 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
16249 ! If performing constraint dynamics, add the gradients of the constraint energy
16250 if(usampl.and.totT.gt.eq_time) then
16253 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
16254 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
16258 gloc(i,icg)=gloc(i,icg)+dugamma(i)
16261 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
16264 !elwrite (iout,*) "After sum_gradient"
16269 !elwrite (iout,*) "After sum_gradient"
16271 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
16273 ! call checkintcartgrad
16274 ! write(iout,*) 'calling int_to_cart'
16276 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
16280 gcart(j,i)=gradc(j,i,icg)
16281 gxcart(j,i)=gradx(j,i,icg)
16282 ! if (i.le.2) print *,"gcart_one",gcart(j,i),gradc(j,i,icg)
16285 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
16286 (gxcart(j,i),j=1,3),gloc(i,icg)
16292 ! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
16294 ! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
16297 time_inttocart=time_inttocart+MPI_Wtime()-time01
16300 write (iout,*) "gcart and gxcart after int_to_cart"
16302 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
16303 (gxcart(j,i),j=1,3)
16308 write (iout,*) "CARGRAD"
16312 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
16313 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
16315 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
16316 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
16318 ! Correction: dummy residues
16321 ! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
16322 gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
16325 if (nct.lt.nres) then
16327 ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
16328 gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
16333 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
16337 end subroutine cartgrad
16338 !-----------------------------------------------------------------------------
16339 subroutine zerograd
16340 ! implicit real*8 (a-h,o-z)
16341 ! include 'DIMENSIONS'
16342 ! include 'COMMON.DERIV'
16343 ! include 'COMMON.CHAIN'
16344 ! include 'COMMON.VAR'
16345 ! include 'COMMON.MD'
16346 ! include 'COMMON.SCCOR'
16348 !el local variables
16349 integer :: i,j,intertyp,k
16350 ! Initialize Cartesian-coordinate gradient
16352 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
16353 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
16355 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
16356 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
16357 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
16358 ! allocate(gradcorr_long(3,nres))
16359 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
16360 ! allocate(gcorr6_turn_long(3,nres))
16361 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
16363 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
16365 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
16366 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
16368 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
16369 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
16371 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
16372 ! allocate(gscloc(3,nres)) !(3,maxres)
16373 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
16377 ! common /deriv_scloc/
16378 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
16379 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
16380 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
16382 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
16386 ! gradc(j,i,icg)=0.0d0
16387 ! gradx(j,i,icg)=0.0d0
16389 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
16390 !elwrite(iout,*) "icg",icg
16394 gradx_scp(j,i)=0.0D0
16396 gvdwc_scp(j,i)=0.0D0
16397 gvdwc_scpp(j,i)=0.0d0
16399 gelc_long(j,i)=0.0D0
16404 gel_loc_long(j,i)=0.0d0
16407 gcorr3_turn(j,i)=0.0d0
16408 gcorr4_turn(j,i)=0.0d0
16409 gradcorr(j,i)=0.0d0
16410 gradcorr_long(j,i)=0.0d0
16411 gradcorr5_long(j,i)=0.0d0
16412 gradcorr6_long(j,i)=0.0d0
16413 gcorr6_turn_long(j,i)=0.0d0
16414 gradcorr5(j,i)=0.0d0
16415 gradcorr6(j,i)=0.0d0
16416 gcorr6_turn(j,i)=0.0d0
16419 gradc(j,i,icg)=0.0d0
16420 gradx(j,i,icg)=0.0d0
16423 gliptran(j,i)=0.0d0
16424 gliptranx(j,i)=0.0d0
16425 gliptranc(j,i)=0.0d0
16426 gshieldx(j,i)=0.0d0
16427 gshieldc(j,i)=0.0d0
16428 gshieldc_loc(j,i)=0.0d0
16429 gshieldx_ec(j,i)=0.0d0
16430 gshieldc_ec(j,i)=0.0d0
16431 gshieldc_loc_ec(j,i)=0.0d0
16432 gshieldx_t3(j,i)=0.0d0
16433 gshieldc_t3(j,i)=0.0d0
16434 gshieldc_loc_t3(j,i)=0.0d0
16435 gshieldx_t4(j,i)=0.0d0
16436 gshieldc_t4(j,i)=0.0d0
16437 gshieldc_loc_t4(j,i)=0.0d0
16438 gshieldx_ll(j,i)=0.0d0
16439 gshieldc_ll(j,i)=0.0d0
16440 gshieldc_loc_ll(j,i)=0.0d0
16442 gg_tube_sc(j,i)=0.0d0
16444 gradb_nucl(j,i)=0.0d0
16445 gradbx_nucl(j,i)=0.0d0
16446 gvdwpp_nucl(j,i)=0.0d0
16450 gvdwpsb1(j,i)=0.0d0
16454 gradcorr_nucl(j,i)=0.0d0
16455 gradcorr3_nucl(j,i)=0.0d0
16456 gradxorr_nucl(j,i)=0.0d0
16457 gradxorr3_nucl(j,i)=0.0d0
16461 gradpepcat(j,i)=0.0d0
16462 gradpepcatx(j,i)=0.0d0
16463 gradcatcat(j,i)=0.0d0
16464 gvdwx_scbase(j,i)=0.0d0
16465 gvdwc_scbase(j,i)=0.0d0
16466 gvdwx_pepbase(j,i)=0.0d0
16467 gvdwc_pepbase(j,i)=0.0d0
16468 gvdwx_scpho(j,i)=0.0d0
16469 gvdwc_scpho(j,i)=0.0d0
16470 gvdwc_peppho(j,i)=0.0d0
16476 gloc_sc(intertyp,i,icg)=0.0d0
16485 grad_shield_side(k,j,i)=0.0d0
16486 grad_shield_loc(k,j,i)=0.0d0
16493 ! Initialize the gradient of local energy terms.
16495 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
16496 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
16497 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
16498 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
16499 ! allocate(gel_loc_turn3(nres))
16500 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
16501 ! allocate(gsccor_loc(nres)) !(maxres)
16507 gel_loc_loc(i)=0.0d0
16509 g_corr5_loc(i)=0.0d0
16510 g_corr6_loc(i)=0.0d0
16511 gel_loc_turn3(i)=0.0d0
16512 gel_loc_turn4(i)=0.0d0
16513 gel_loc_turn6(i)=0.0d0
16514 gsccor_loc(i)=0.0d0
16516 ! initialize gcart and gxcart
16517 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
16525 end subroutine zerograd
16526 !-----------------------------------------------------------------------------
16527 real(kind=8) function fdum()
16531 !-----------------------------------------------------------------------------
16533 !-----------------------------------------------------------------------------
16534 subroutine intcartderiv
16535 ! implicit real*8 (a-h,o-z)
16536 ! include 'DIMENSIONS'
16540 ! include 'COMMON.SETUP'
16541 ! include 'COMMON.CHAIN'
16542 ! include 'COMMON.VAR'
16543 ! include 'COMMON.GEO'
16544 ! include 'COMMON.INTERACT'
16545 ! include 'COMMON.DERIV'
16546 ! include 'COMMON.IOUNITS'
16547 ! include 'COMMON.LOCAL'
16548 ! include 'COMMON.SCCOR'
16549 real(kind=8) :: pi4,pi34
16550 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
16551 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
16552 dcosomega,dsinomega !(3,3,maxres)
16553 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
16556 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
16557 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
16558 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
16559 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
16563 !el from module energy-------------
16564 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
16565 !el allocate(dsintau(3,3,3,itau_start:itau_end))
16566 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
16568 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
16569 !el allocate(dsintau(3,3,3,0:nres2))
16570 !el allocate(dtauangle(3,3,3,0:nres2))
16571 !el allocate(domicron(3,2,2,0:nres2))
16572 !el allocate(dcosomicron(3,2,2,0:nres2))
16576 #if defined(MPI) && defined(PARINTDER)
16577 if (nfgtasks.gt.1 .and. me.eq.king) &
16578 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
16583 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
16584 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
16586 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
16589 dtheta(j,1,i)=0.0d0
16590 dtheta(j,2,i)=0.0d0
16596 ! Derivatives of theta's
16597 #if defined(MPI) && defined(PARINTDER)
16598 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16599 do i=max0(ithet_start-1,3),ithet_end
16603 cost=dcos(theta(i))
16604 sint=sqrt(1-cost*cost)
16606 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
16608 if (itype(i-1,1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
16609 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
16611 if (itype(i-1,1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
16614 #if defined(MPI) && defined(PARINTDER)
16615 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16616 do i=max0(ithet_start-1,3),ithet_end
16620 if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1)) then
16621 cost1=dcos(omicron(1,i))
16622 sint1=sqrt(1-cost1*cost1)
16623 cost2=dcos(omicron(2,i))
16624 sint2=sqrt(1-cost2*cost2)
16626 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
16627 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
16628 cost1*dc_norm(j,i-2))/ &
16630 domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i)
16631 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
16632 +cost1*(dc_norm(j,i-1+nres)))/ &
16634 domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i)
16635 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
16636 !C Looks messy but better than if in loop
16637 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
16638 +cost2*dc_norm(j,i-1))/ &
16640 domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i)
16641 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
16642 +cost2*(-dc_norm(j,i-1+nres)))/ &
16644 ! write(iout,*) "vbld", i,itype(i,1),vbld(i-1+nres)
16645 domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i)
16649 !elwrite(iout,*) "after vbld write"
16650 ! Derivatives of phi:
16651 ! If phi is 0 or 180 degrees, then the formulas
16652 ! have to be derived by power series expansion of the
16653 ! conventional formulas around 0 and 180.
16655 do i=iphi1_start,iphi1_end
16659 ! if (itype(i-1,1).eq.21 .or. itype(i-2,1).eq.21 ) cycle
16660 ! the conventional case
16661 sint=dsin(theta(i))
16662 sint1=dsin(theta(i-1))
16664 cost=dcos(theta(i))
16665 cost1=dcos(theta(i-1))
16667 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
16668 fac0=1.0d0/(sint1*sint)
16671 fac3=cosg*cost1/(sint1*sint1)
16672 fac4=cosg*cost/(sint*sint)
16673 ! Obtaining the gamma derivatives from sine derivative
16674 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
16675 phi(i).gt.pi34.and.phi(i).le.pi.or. &
16676 phi(i).ge.-pi.and.phi(i).le.-pi34) then
16677 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16678 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
16679 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16683 cosg_inv=1.0d0/cosg
16684 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
16685 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16686 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
16687 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
16689 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
16690 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16691 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
16692 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
16693 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16694 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16695 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
16697 ! Bug fixed 3/24/05 (AL)
16699 ! Obtaining the gamma derivatives from cosine derivative
16702 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
16703 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16704 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16705 dc_norm(j,i-3))/vbld(i-2)
16706 dphi(j,1,i)=-1/sing*dcosphi(j,1,i)
16707 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16708 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16710 dphi(j,2,i)=-1/sing*dcosphi(j,2,i)
16711 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16712 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16713 dc_norm(j,i-1))/vbld(i)
16714 dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
16719 !alculate derivative of Tauangle
16721 do i=itau_start,itau_end
16724 !elwrite(iout,*) " vecpr",i,nres
16726 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
16727 ! if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10).or.
16728 ! & (itype(i-1,1).eq.ntyp1).or.(itype(i,1).eq.ntyp1)) cycle
16729 !c dtauangle(j,intertyp,dervityp,residue number)
16730 !c INTERTYP=1 SC...Ca...Ca..Ca
16731 ! the conventional case
16732 sint=dsin(theta(i))
16733 sint1=dsin(omicron(2,i-1))
16734 sing=dsin(tauangle(1,i))
16735 cost=dcos(theta(i))
16736 cost1=dcos(omicron(2,i-1))
16737 cosg=dcos(tauangle(1,i))
16738 !elwrite(iout,*) " vecpr5",i,nres
16740 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
16741 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
16742 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16743 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
16745 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
16746 fac0=1.0d0/(sint1*sint)
16749 fac3=cosg*cost1/(sint1*sint1)
16750 fac4=cosg*cost/(sint*sint)
16751 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
16752 ! Obtaining the gamma derivatives from sine derivative
16753 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
16754 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
16755 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
16756 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16757 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
16758 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16762 cosg_inv=1.0d0/cosg
16763 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16764 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
16765 *vbld_inv(i-2+nres)
16766 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
16767 dsintau(j,1,2,i)= &
16768 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
16769 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16770 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
16771 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
16772 ! Bug fixed 3/24/05 (AL)
16773 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
16774 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16775 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16776 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
16778 ! Obtaining the gamma derivatives from cosine derivative
16781 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16782 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16783 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
16784 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
16785 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16786 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16788 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
16789 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16790 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
16791 dc_norm(j,i-1))/vbld(i)
16792 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
16793 ! write (iout,*) "else",i
16797 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
16800 !C Second case Ca...Ca...Ca...SC
16802 do i=itau_start,itau_end
16806 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
16807 (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle
16808 ! the conventional case
16809 sint=dsin(omicron(1,i))
16810 sint1=dsin(theta(i-1))
16811 sing=dsin(tauangle(2,i))
16812 cost=dcos(omicron(1,i))
16813 cost1=dcos(theta(i-1))
16814 cosg=dcos(tauangle(2,i))
16816 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16818 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
16819 fac0=1.0d0/(sint1*sint)
16822 fac3=cosg*cost1/(sint1*sint1)
16823 fac4=cosg*cost/(sint*sint)
16824 ! Obtaining the gamma derivatives from sine derivative
16825 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
16826 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
16827 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
16828 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
16829 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
16830 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16834 cosg_inv=1.0d0/cosg
16835 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16836 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
16837 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
16838 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
16839 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
16840 dsintau(j,2,2,i)= &
16841 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
16842 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16843 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
16844 ! & sing*ctgt*domicron(j,1,2,i),
16845 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16846 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
16847 ! Bug fixed 3/24/05 (AL)
16848 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16849 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
16850 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16851 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
16853 ! Obtaining the gamma derivatives from cosine derivative
16856 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16857 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16858 dc_norm(j,i-3))/vbld(i-2)
16859 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
16860 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16861 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16862 dcosomicron(j,1,1,i)
16863 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
16864 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16865 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16866 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16867 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
16868 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
16873 !CC third case SC...Ca...Ca...SC
16876 do i=itau_start,itau_end
16880 ! the conventional case
16881 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
16882 (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
16883 sint=dsin(omicron(1,i))
16884 sint1=dsin(omicron(2,i-1))
16885 sing=dsin(tauangle(3,i))
16886 cost=dcos(omicron(1,i))
16887 cost1=dcos(omicron(2,i-1))
16888 cosg=dcos(tauangle(3,i))
16890 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16891 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16893 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
16894 fac0=1.0d0/(sint1*sint)
16897 fac3=cosg*cost1/(sint1*sint1)
16898 fac4=cosg*cost/(sint*sint)
16899 ! Obtaining the gamma derivatives from sine derivative
16900 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
16901 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
16902 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
16903 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
16904 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
16905 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16909 cosg_inv=1.0d0/cosg
16910 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16911 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
16912 *vbld_inv(i-2+nres)
16913 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
16914 dsintau(j,3,2,i)= &
16915 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
16916 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16917 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
16918 ! Bug fixed 3/24/05 (AL)
16919 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16920 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
16921 *vbld_inv(i-1+nres)
16922 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16923 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
16925 ! Obtaining the gamma derivatives from cosine derivative
16928 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16929 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16930 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
16931 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
16932 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16933 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16934 dcosomicron(j,1,1,i)
16935 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
16936 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16937 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
16938 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16939 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
16940 ! write(iout,*) "else",i
16946 ! Derivatives of side-chain angles alpha and omega
16947 #if defined(MPI) && defined(PARINTDER)
16948 do i=ibond_start,ibond_end
16952 if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
16953 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
16956 fac8=fac5/vbld(i+1)
16957 fac9=fac5/vbld(i+nres)
16958 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
16959 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
16960 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
16961 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
16962 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
16963 sina=sqrt(1-cosa*cosa)
16965 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
16967 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
16968 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
16969 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
16970 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
16971 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
16972 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
16973 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
16974 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
16976 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
16978 ! obtaining the derivatives of omega from sines
16979 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
16980 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
16981 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
16982 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
16984 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
16985 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
16986 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
16987 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
16988 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
16989 coso_inv=1.0d0/dcos(omeg(i))
16991 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
16992 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
16993 (sino*dc_norm(j,i-1))/vbld(i)
16994 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
16995 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
16996 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
16997 -sino*dc_norm(j,i)/vbld(i+1)
16998 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
16999 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
17000 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
17002 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
17005 ! obtaining the derivatives of omega from cosines
17006 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
17007 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
17012 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
17013 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
17014 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
17015 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
17016 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
17017 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
17018 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
17019 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
17020 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
17021 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
17022 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
17023 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
17024 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
17025 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
17026 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
17032 dalpha(k,j,i)=0.0d0
17033 domega(k,j,i)=0.0d0
17039 #if defined(MPI) && defined(PARINTDER)
17040 if (nfgtasks.gt.1) then
17042 !d write (iout,*) "Gather dtheta"
17043 !d call flush(iout)
17044 write (iout,*) "dtheta before gather"
17046 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
17049 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
17050 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
17051 king,FG_COMM,IERROR)
17053 !d write (iout,*) "Gather dphi"
17054 !d call flush(iout)
17055 write (iout,*) "dphi before gather"
17057 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
17060 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
17061 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
17062 king,FG_COMM,IERROR)
17063 !d write (iout,*) "Gather dalpha"
17064 !d call flush(iout)
17066 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
17067 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
17068 king,FG_COMM,IERROR)
17069 !d write (iout,*) "Gather domega"
17070 !d call flush(iout)
17071 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
17072 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
17073 king,FG_COMM,IERROR)
17078 write (iout,*) "dtheta after gather"
17080 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
17082 write (iout,*) "dphi after gather"
17084 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
17086 write (iout,*) "dalpha after gather"
17088 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
17090 write (iout,*) "domega after gather"
17092 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
17096 end subroutine intcartderiv
17097 !-----------------------------------------------------------------------------
17098 subroutine checkintcartgrad
17099 ! implicit real*8 (a-h,o-z)
17100 ! include 'DIMENSIONS'
17104 ! include 'COMMON.CHAIN'
17105 ! include 'COMMON.VAR'
17106 ! include 'COMMON.GEO'
17107 ! include 'COMMON.INTERACT'
17108 ! include 'COMMON.DERIV'
17109 ! include 'COMMON.IOUNITS'
17110 ! include 'COMMON.SETUP'
17111 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
17112 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
17113 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
17114 real(kind=8),dimension(3) :: dc_norm_s
17115 real(kind=8) :: aincr=1.0d-5
17117 real(kind=8) :: dcji
17120 theta_s(i)=theta(i)
17124 ! Check theta gradient
17126 "Analytical (upper) and numerical (lower) gradient of theta"
17131 dc(j,i-2)=dcji+aincr
17132 call chainbuild_cart
17133 call int_from_cart1(.false.)
17134 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
17137 dc(j,i-1)=dc(j,i-1)+aincr
17138 call chainbuild_cart
17139 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
17142 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
17143 !el (dtheta(j,2,i),j=1,3)
17144 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
17145 !el (dthetanum(j,2,i),j=1,3)
17146 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
17147 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
17148 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
17151 ! Check gamma gradient
17153 "Analytical (upper) and numerical (lower) gradient of gamma"
17157 dc(j,i-3)=dcji+aincr
17158 call chainbuild_cart
17159 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
17162 dc(j,i-2)=dcji+aincr
17163 call chainbuild_cart
17164 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
17167 dc(j,i-1)=dc(j,i-1)+aincr
17168 call chainbuild_cart
17169 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
17172 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
17173 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
17174 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
17175 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
17176 !el write (iout,'(5x,3(3f10.5,5x))') &
17177 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
17178 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
17179 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
17182 ! Check alpha gradient
17184 "Analytical (upper) and numerical (lower) gradient of alpha"
17186 if(itype(i,1).ne.10) then
17189 dc(j,i-1)=dcji+aincr
17190 call chainbuild_cart
17191 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
17196 call chainbuild_cart
17197 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
17201 dc(j,i+nres)=dc(j,i+nres)+aincr
17202 call chainbuild_cart
17203 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
17208 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
17209 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
17210 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
17211 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
17212 !el write (iout,'(5x,3(3f10.5,5x))') &
17213 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
17214 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
17215 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
17218 ! Check omega gradient
17220 "Analytical (upper) and numerical (lower) gradient of omega"
17222 if(itype(i,1).ne.10) then
17225 dc(j,i-1)=dcji+aincr
17226 call chainbuild_cart
17227 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
17232 call chainbuild_cart
17233 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
17237 dc(j,i+nres)=dc(j,i+nres)+aincr
17238 call chainbuild_cart
17239 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
17244 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
17245 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
17246 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
17247 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
17248 !el write (iout,'(5x,3(3f10.5,5x))') &
17249 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
17250 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
17251 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
17255 end subroutine checkintcartgrad
17256 !-----------------------------------------------------------------------------
17258 !-----------------------------------------------------------------------------
17259 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
17260 ! implicit real*8 (a-h,o-z)
17261 ! include 'DIMENSIONS'
17262 ! include 'COMMON.IOUNITS'
17263 ! include 'COMMON.CHAIN'
17264 ! include 'COMMON.INTERACT'
17265 ! include 'COMMON.VAR'
17266 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
17267 integer :: kkk,nsep=3
17268 real(kind=8) :: qm !dist,
17269 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
17270 logical :: lprn=.false.
17272 ! real(kind=8) :: sigm,x
17274 !el sigm(x)=0.25d0*x ! local function
17280 do il=seg1+nsep,seg2
17283 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
17284 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
17285 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17287 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
17288 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17291 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17292 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17293 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17294 dijCM=dist(il+nres,jl+nres)
17295 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
17297 qq = qq+qqij+qqijCM
17303 if((seg3-il).lt.3) then
17310 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17311 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17312 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17314 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
17315 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17318 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17319 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17320 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17321 dijCM=dist(il+nres,jl+nres)
17322 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
17324 qq = qq+qqij+qqijCM
17329 if (qqmax.le.qq) qqmax=qq
17331 qwolynes=1.0d0-qqmax
17333 end function qwolynes
17334 !-----------------------------------------------------------------------------
17335 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
17336 ! implicit real*8 (a-h,o-z)
17337 ! include 'DIMENSIONS'
17338 ! include 'COMMON.IOUNITS'
17339 ! include 'COMMON.CHAIN'
17340 ! include 'COMMON.INTERACT'
17341 ! include 'COMMON.VAR'
17342 ! include 'COMMON.MD'
17343 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
17344 integer :: nsep=3, kkk
17345 !el real(kind=8) :: dist
17346 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
17347 logical :: lprn=.false.
17349 real(kind=8) :: sim,dd0,fac,ddqij
17350 !el sigm(x)=0.25d0*x ! local function
17360 do il=seg1+nsep,seg2
17363 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17364 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17365 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17367 sim = 1.0d0/sigm(d0ij)
17370 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
17372 ddqij = (c(k,il)-c(k,jl))*fac
17373 dqwol(k,il)=dqwol(k,il)+ddqij
17374 dqwol(k,jl)=dqwol(k,jl)-ddqij
17377 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17380 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17381 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17382 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17383 dijCM=dist(il+nres,jl+nres)
17384 sim = 1.0d0/sigm(d0ijCM)
17387 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17389 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17390 dxqwol(k,il)=dxqwol(k,il)+ddqij
17391 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17398 if((seg3-il).lt.3) then
17405 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17406 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17407 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17409 sim = 1.0d0/sigm(d0ij)
17412 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
17414 ddqij = (c(k,il)-c(k,jl))*fac
17415 dqwol(k,il)=dqwol(k,il)+ddqij
17416 dqwol(k,jl)=dqwol(k,jl)-ddqij
17418 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17421 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17422 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17423 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17424 dijCM=dist(il+nres,jl+nres)
17425 sim = 1.0d0/sigm(d0ijCM)
17428 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17430 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17431 dxqwol(k,il)=dxqwol(k,il)+ddqij
17432 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17441 dqwol(j,i)=dqwol(j,i)/nl
17442 dxqwol(j,i)=dxqwol(j,i)/nl
17446 end subroutine qwolynes_prim
17447 !-----------------------------------------------------------------------------
17448 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
17449 ! implicit real*8 (a-h,o-z)
17450 ! include 'DIMENSIONS'
17451 ! include 'COMMON.IOUNITS'
17452 ! include 'COMMON.CHAIN'
17453 ! include 'COMMON.INTERACT'
17454 ! include 'COMMON.VAR'
17455 integer :: seg1,seg2,seg3,seg4
17457 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
17458 real(kind=8),dimension(3,0:2*nres) :: cdummy
17459 real(kind=8) :: q1,q2
17460 real(kind=8) :: delta=1.0d-10
17465 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
17467 c(j,i)=c(j,i)+delta
17468 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
17469 qwolan(j,i)=(q2-q1)/delta
17475 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
17476 cdummy(j,i+nres)=c(j,i+nres)
17477 c(j,i+nres)=c(j,i+nres)+delta
17478 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
17479 qwolxan(j,i)=(q2-q1)/delta
17480 c(j,i+nres)=cdummy(j,i+nres)
17483 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
17485 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
17487 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
17489 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
17492 end subroutine qwol_num
17493 !-----------------------------------------------------------------------------
17494 subroutine EconstrQ
17495 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
17496 ! implicit real*8 (a-h,o-z)
17497 ! include 'DIMENSIONS'
17498 ! include 'COMMON.CONTROL'
17499 ! include 'COMMON.VAR'
17500 ! include 'COMMON.MD'
17503 ! include 'COMMON.LANGEVIN'
17505 ! include 'COMMON.LANGEVIN.lang0'
17507 ! include 'COMMON.CHAIN'
17508 ! include 'COMMON.DERIV'
17509 ! include 'COMMON.GEO'
17510 ! include 'COMMON.LOCAL'
17511 ! include 'COMMON.INTERACT'
17512 ! include 'COMMON.IOUNITS'
17513 ! include 'COMMON.NAMES'
17514 ! include 'COMMON.TIME1'
17515 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
17516 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
17518 integer :: kstart,kend,lstart,lend,idummy
17519 real(kind=8) :: delta=1.0d-7
17520 integer :: i,j,k,ii
17524 dudconst(j,i)=0.0d0
17525 duxconst(j,i)=0.0d0
17526 dudxconst(j,i)=0.0d0
17531 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
17533 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
17534 ! Calculating the derivatives of Constraint energy with respect to Q
17535 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
17537 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
17538 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
17539 ! hmnum=(hm2-hm1)/delta
17540 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
17541 ! & qinfrag(i,iset))
17542 ! write(iout,*) "harmonicnum frag", hmnum
17543 ! Calculating the derivatives of Q with respect to cartesian coordinates
17544 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
17546 ! write(iout,*) "dqwol "
17548 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17550 ! write(iout,*) "dxqwol "
17552 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17554 ! Calculating numerical gradients of dU/dQi and dQi/dxi
17555 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
17556 ! & ,idummy,idummy)
17557 ! The gradients of Uconst in Cs
17560 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
17561 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
17566 kstart=ifrag(1,ipair(1,i,iset),iset)
17567 kend=ifrag(2,ipair(1,i,iset),iset)
17568 lstart=ifrag(1,ipair(2,i,iset),iset)
17569 lend=ifrag(2,ipair(2,i,iset),iset)
17570 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
17571 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
17572 ! Calculating dU/dQ
17573 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
17574 ! hm1=harmonic(qpair(i),qinpair(i,iset))
17575 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
17576 ! hmnum=(hm2-hm1)/delta
17577 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
17578 ! & qinpair(i,iset))
17579 ! write(iout,*) "harmonicnum pair ", hmnum
17580 ! Calculating dQ/dXi
17581 call qwolynes_prim(kstart,kend,.false.,&
17583 ! write(iout,*) "dqwol "
17585 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17587 ! write(iout,*) "dxqwol "
17589 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17591 ! Calculating numerical gradients
17592 ! call qwol_num(kstart,kend,.false.
17594 ! The gradients of Uconst in Cs
17597 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
17598 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
17602 ! write(iout,*) "Uconst inside subroutine ", Uconst
17603 ! Transforming the gradients from Cs to dCs for the backbone
17607 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
17611 ! Transforming the gradients from Cs to dCs for the side chains
17614 dudxconst(j,i)=duxconst(j,i)
17617 ! write(iout,*) "dU/ddc backbone "
17619 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
17621 ! write(iout,*) "dU/ddX side chain "
17623 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
17625 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
17626 ! call dEconstrQ_num
17628 end subroutine EconstrQ
17629 !-----------------------------------------------------------------------------
17630 subroutine dEconstrQ_num
17631 ! Calculating numerical dUconst/ddc and dUconst/ddx
17632 ! implicit real*8 (a-h,o-z)
17633 ! include 'DIMENSIONS'
17634 ! include 'COMMON.CONTROL'
17635 ! include 'COMMON.VAR'
17636 ! include 'COMMON.MD'
17639 ! include 'COMMON.LANGEVIN'
17641 ! include 'COMMON.LANGEVIN.lang0'
17643 ! include 'COMMON.CHAIN'
17644 ! include 'COMMON.DERIV'
17645 ! include 'COMMON.GEO'
17646 ! include 'COMMON.LOCAL'
17647 ! include 'COMMON.INTERACT'
17648 ! include 'COMMON.IOUNITS'
17649 ! include 'COMMON.NAMES'
17650 ! include 'COMMON.TIME1'
17651 real(kind=8) :: uzap1,uzap2
17652 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
17653 integer :: kstart,kend,lstart,lend,idummy
17654 real(kind=8) :: delta=1.0d-7
17655 !el local variables
17661 dUcartan(j,i)=0.0d0
17662 cdummy(j,i)=dc(j,i)
17663 dc(j,i)=dc(j,i)+delta
17664 call chainbuild_cart
17667 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17669 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17673 kstart=ifrag(1,ipair(1,ii,iset),iset)
17674 kend=ifrag(2,ipair(1,ii,iset),iset)
17675 lstart=ifrag(1,ipair(2,ii,iset),iset)
17676 lend=ifrag(2,ipair(2,ii,iset),iset)
17677 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17678 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17681 dc(j,i)=cdummy(j,i)
17682 call chainbuild_cart
17685 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17687 uzap1=uzap1+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 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17699 ducartan(j,i)=(uzap2-uzap1)/(delta)
17702 ! Calculating numerical gradients for dU/ddx
17704 duxcartan(j,i)=0.0d0
17706 cdummy(j,i)=dc(j,i+nres)
17707 dc(j,i+nres)=dc(j,i+nres)+delta
17708 call chainbuild_cart
17711 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17713 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17717 kstart=ifrag(1,ipair(1,ii,iset),iset)
17718 kend=ifrag(2,ipair(1,ii,iset),iset)
17719 lstart=ifrag(1,ipair(2,ii,iset),iset)
17720 lend=ifrag(2,ipair(2,ii,iset),iset)
17721 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17722 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17725 dc(j,i+nres)=cdummy(j,i)
17726 call chainbuild_cart
17729 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
17730 ifrag(2,ii,iset),.true.,idummy,idummy)
17731 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17735 kstart=ifrag(1,ipair(1,ii,iset),iset)
17736 kend=ifrag(2,ipair(1,ii,iset),iset)
17737 lstart=ifrag(1,ipair(2,ii,iset),iset)
17738 lend=ifrag(2,ipair(2,ii,iset),iset)
17739 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17740 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17743 duxcartan(j,i)=(uzap2-uzap1)/(delta)
17746 write(iout,*) "Numerical dUconst/ddc backbone "
17748 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
17750 ! write(iout,*) "Numerical dUconst/ddx side-chain "
17752 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
17755 end subroutine dEconstrQ_num
17756 !-----------------------------------------------------------------------------
17758 !-----------------------------------------------------------------------------
17759 subroutine check_energies
17761 ! use random, only: ran_number
17765 ! include 'DIMENSIONS'
17766 ! include 'COMMON.CHAIN'
17767 ! include 'COMMON.VAR'
17768 ! include 'COMMON.IOUNITS'
17769 ! include 'COMMON.SBRIDGE'
17770 ! include 'COMMON.LOCAL'
17771 ! include 'COMMON.GEO'
17773 ! External functions
17774 !EL double precision ran_number
17775 !EL external ran_number
17778 integer :: i,j,k,l,lmax,p,pmax
17779 real(kind=8) :: rmin,rmax
17780 real(kind=8) :: eij
17783 real(kind=8) :: wi,rij,tj,pj
17805 !t wi=ran_number(0.0D0,pi)
17806 ! wi=ran_number(0.0D0,pi/6.0D0)
17808 !t tj=ran_number(0.0D0,pi)
17809 !t pj=ran_number(0.0D0,pi)
17810 ! pj=ran_number(0.0D0,pi/6.0D0)
17814 !t rij=ran_number(rmin,rmax)
17816 c(1,j)=d*sin(pj)*cos(tj)
17817 c(2,j)=d*sin(pj)*sin(tj)
17823 c(3,i)=-rij-d*cos(wi)
17826 dc(k,nres+i)=c(k,nres+i)-c(k,i)
17827 dc_norm(k,nres+i)=dc(k,nres+i)/d
17828 dc(k,nres+j)=c(k,nres+j)-c(k,j)
17829 dc_norm(k,nres+j)=dc(k,nres+j)/d
17832 call dyn_ssbond_ene(i,j,eij)
17837 end subroutine check_energies
17838 !-----------------------------------------------------------------------------
17839 subroutine dyn_ssbond_ene(resi,resj,eij)
17844 ! include 'DIMENSIONS'
17845 ! include 'COMMON.SBRIDGE'
17846 ! include 'COMMON.CHAIN'
17847 ! include 'COMMON.DERIV'
17848 ! include 'COMMON.LOCAL'
17849 ! include 'COMMON.INTERACT'
17850 ! include 'COMMON.VAR'
17851 ! include 'COMMON.IOUNITS'
17852 ! include 'COMMON.CALC'
17856 ! include 'COMMON.MD'
17857 ! use MD, only: totT,t_bath
17860 ! External functions
17861 !EL double precision h_base
17862 !EL external h_base
17865 integer :: resi,resj
17868 real(kind=8) :: eij
17871 logical :: havebond
17872 integer itypi,itypj
17873 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
17874 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
17875 real(kind=8),dimension(3) :: dcosom1,dcosom2
17877 real(kind=8) :: pom1,pom2
17878 real(kind=8) :: ljA,ljB,ljXs
17879 real(kind=8),dimension(1:3) :: d_ljB
17880 real(kind=8) :: ssA,ssB,ssC,ssXs
17881 real(kind=8) :: ssxm,ljxm,ssm,ljm
17882 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
17883 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
17884 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
17885 !-------FIRST METHOD
17887 real(kind=8),dimension(1:3) :: d_xm
17888 !-------END FIRST METHOD
17889 !-------SECOND METHOD
17890 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
17891 !-------END SECOND METHOD
17893 !-------TESTING CODE
17894 !el logical :: checkstop,transgrad
17895 !el common /sschecks/ checkstop,transgrad
17897 integer :: icheck,nicheck,jcheck,njcheck
17898 real(kind=8),dimension(-1:1) :: echeck
17899 real(kind=8) :: deps,ssx0,ljx0
17900 !-------END TESTING CODE
17906 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
17907 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
17910 dxi=dc_norm(1,nres+i)
17911 dyi=dc_norm(2,nres+i)
17912 dzi=dc_norm(3,nres+i)
17913 dsci_inv=vbld_inv(i+nres)
17916 xj=c(1,nres+j)-c(1,nres+i)
17917 yj=c(2,nres+j)-c(2,nres+i)
17918 zj=c(3,nres+j)-c(3,nres+i)
17919 dxj=dc_norm(1,nres+j)
17920 dyj=dc_norm(2,nres+j)
17921 dzj=dc_norm(3,nres+j)
17922 dscj_inv=vbld_inv(j+nres)
17924 chi1=chi(itypi,itypj)
17925 chi2=chi(itypj,itypi)
17932 alf12=0.5D0*(alf1+alf2)
17934 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
17935 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
17936 ! The following are set in sc_angular
17940 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
17941 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
17942 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
17944 rij=1.0D0/rij ! Reset this so it makes sense
17946 sig0ij=sigma(itypi,itypj)
17947 sig=sig0ij*dsqrt(1.0D0/sigsq)
17950 ljA=eps1*eps2rt**2*eps3rt**2
17951 ljB=ljA*bb_aq(itypi,itypj)
17952 ljA=ljA*aa_aq(itypi,itypj)
17953 ljxm=ljXs+(-2.0D0*aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
17958 deltat12=om2-om1+2.0d0
17959 cosphi=om12-om1*om2
17963 +akth*(deltat1*deltat1+deltat2*deltat2) &
17964 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
17965 ssxm=ssXs-0.5D0*ssB/ssA
17967 !-------TESTING CODE
17968 !$$$c Some extra output
17969 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
17970 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
17971 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
17972 !$$$ if (ssx0.gt.0.0d0) then
17973 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
17977 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
17978 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
17979 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
17981 !-------END TESTING CODE
17983 !-------TESTING CODE
17984 ! Stop and plot energy and derivative as a function of distance
17985 if (checkstop) then
17986 ssm=ssC-0.25D0*ssB*ssB/ssA
17987 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
17988 if (ssm.lt.ljm .and. &
17989 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
17997 if (.not.checkstop) then
18002 do icheck=0,nicheck
18003 do jcheck=-1,njcheck
18004 if (checkstop) rij=(ssxm-1.0d0)+ &
18005 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
18006 !-------END TESTING CODE
18008 if (rij.gt.ljxm) then
18011 fac=(1.0D0/ljd)**expon
18012 e1=fac*fac*aa_aq(itypi,itypj)
18013 e2=fac*bb_aq(itypi,itypj)
18014 eij=eps1*eps2rt*eps3rt*(e1+e2)
18017 eij=eij*eps2rt*eps3rt
18020 e1=e1*eps1*eps2rt**2*eps3rt**2
18021 ed=-expon*(e1+eij)/ljd
18023 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
18024 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
18025 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
18026 -2.0D0*alf12*eps3der+sigder*sigsq_om12
18027 else if (rij.lt.ssxm) then
18030 eij=ssA*ssd*ssd+ssB*ssd+ssC
18032 ed=2*akcm*ssd+akct*deltat12
18034 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
18035 eom1=-2*akth*deltat1-pom1-om2*pom2
18036 eom2= 2*akth*deltat2+pom1-om1*pom2
18039 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
18041 d_ssxm(1)=0.5D0*akct/ssA
18042 d_ssxm(2)=-d_ssxm(1)
18045 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
18046 d_ljxm(2)=d_ljxm(1)*sigsq_om2
18047 d_ljxm(3)=d_ljxm(1)*sigsq_om12
18048 d_ljxm(1)=d_ljxm(1)*sigsq_om1
18050 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
18051 xm=0.5d0*(ssxm+ljxm)
18053 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
18055 if (rij.lt.xm) then
18057 ssm=ssC-0.25D0*ssB*ssB/ssA
18058 d_ssm(1)=0.5D0*akct*ssB/ssA
18059 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
18060 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
18062 f1=(rij-xm)/(ssxm-xm)
18063 f2=(rij-ssxm)/(xm-ssxm)
18067 delta_inv=1.0d0/(xm-ssxm)
18068 deltasq_inv=delta_inv*delta_inv
18070 fac1=deltasq_inv*fac*(xm-rij)
18071 fac2=deltasq_inv*fac*(rij-ssxm)
18072 ed=delta_inv*(Ht*hd2-ssm*hd1)
18073 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
18074 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
18075 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
18078 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
18079 d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
18080 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
18081 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
18083 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
18084 f1=(rij-ljxm)/(xm-ljxm)
18085 f2=(rij-xm)/(ljxm-xm)
18089 delta_inv=1.0d0/(ljxm-xm)
18090 deltasq_inv=delta_inv*delta_inv
18092 fac1=deltasq_inv*fac*(ljxm-rij)
18093 fac2=deltasq_inv*fac*(rij-xm)
18094 ed=delta_inv*(ljm*hd2-Ht*hd1)
18095 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
18096 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
18097 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
18099 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
18101 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
18107 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
18108 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
18109 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
18111 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
18112 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
18113 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
18114 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
18115 !$$$ d_ssm(3)=omega
18117 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
18119 !$$$ d_ljm(k)=ljm*d_ljB(k)
18123 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
18124 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
18125 !$$$ d_ss(2)=akct*ssd
18126 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
18127 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
18130 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
18131 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
18132 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
18134 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
18135 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
18137 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
18139 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
18140 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
18141 !$$$ h1=h_base(f1,hd1)
18142 !$$$ h2=h_base(f2,hd2)
18143 !$$$ eij=ss*h1+ljf*h2
18144 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
18145 !$$$ deltasq_inv=delta_inv*delta_inv
18146 !$$$ fac=ljf*hd2-ss*hd1
18147 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
18148 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
18149 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
18150 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
18151 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
18152 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
18153 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
18155 !$$$ havebond=.false.
18156 !$$$ if (ed.gt.0.0d0) havebond=.true.
18157 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
18164 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
18165 ! write(iout,'(a15,f12.2,f8.1,2i5)')
18166 ! & "SSBOND_E_FORM",totT,t_bath,i,j
18170 dyn_ssbond_ij(i,j)=eij
18171 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
18172 dyn_ssbond_ij(i,j)=1.0d300
18175 ! write(iout,'(a15,f12.2,f8.1,2i5)')
18176 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
18181 !-------TESTING CODE
18182 !el if (checkstop) then
18183 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
18184 "CHECKSTOP",rij,eij,ed
18188 if (checkstop) then
18189 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
18192 if (checkstop) then
18196 !-------END TESTING CODE
18199 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
18200 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
18203 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
18206 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
18207 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
18208 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
18209 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
18210 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
18211 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
18215 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
18220 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18221 gvdwc(l,j)=gvdwc(l,j)+gg(l)
18225 end subroutine dyn_ssbond_ene
18226 !--------------------------------------------------------------------------
18227 subroutine triple_ssbond_ene(resi,resj,resk,eij)
18232 ! include 'DIMENSIONS'
18233 ! include 'COMMON.SBRIDGE'
18234 ! include 'COMMON.CHAIN'
18235 ! include 'COMMON.DERIV'
18236 ! include 'COMMON.LOCAL'
18237 ! include 'COMMON.INTERACT'
18238 ! include 'COMMON.VAR'
18239 ! include 'COMMON.IOUNITS'
18240 ! include 'COMMON.CALC'
18244 ! include 'COMMON.MD'
18245 ! use MD, only: totT,t_bath
18248 double precision h_base
18252 integer resi,resj,resk,m,itypi,itypj,itypk
18254 !c Output arguments
18255 double precision eij,eij1,eij2,eij3
18259 !c integer itypi,itypj,k,l
18260 double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi
18261 double precision rrik,rrjk,rik,rjk,xi,xk,yi,yk,zi,zk,xij,yij,zij
18262 double precision xik,yik,zik,xjk,yjk,zjk,dxk,dyk,dzk
18263 double precision sig0ij,ljd,sig,fac,e1,e2
18264 double precision dcosom1(3),dcosom2(3),ed
18265 double precision pom1,pom2
18266 double precision ljA,ljB,ljXs
18267 double precision d_ljB(1:3)
18268 double precision ssA,ssB,ssC,ssXs
18269 double precision ssxm,ljxm,ssm,ljm
18270 double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3)
18272 if (dtriss.eq.0) return
18276 !C write(iout,*) resi,resj,resk
18278 dxi=dc_norm(1,nres+i)
18279 dyi=dc_norm(2,nres+i)
18280 dzi=dc_norm(3,nres+i)
18281 dsci_inv=vbld_inv(i+nres)
18290 dxj=dc_norm(1,nres+j)
18291 dyj=dc_norm(2,nres+j)
18292 dzj=dc_norm(3,nres+j)
18293 dscj_inv=vbld_inv(j+nres)
18299 dxk=dc_norm(1,nres+k)
18300 dyk=dc_norm(2,nres+k)
18301 dzk=dc_norm(3,nres+k)
18302 dscj_inv=vbld_inv(k+nres)
18312 rrij=(xij*xij+yij*yij+zij*zij)
18313 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
18314 rrik=(xik*xik+yik*yik+zik*zik)
18316 rrjk=(xjk*xjk+yjk*yjk+zjk*zjk)
18318 !C there are three combination of distances for each trisulfide bonds
18319 !C The first case the ith atom is the center
18320 !C Energy function is E=d/(a*(x-y)**2+b*(x+y)**2+c) where x is first
18321 !C distance y is second distance the a,b,c,d are parameters derived for
18322 !C this problem d parameter was set as a penalty currenlty set to 1.
18323 if ((iabs(j-i).le.2).or.(iabs(i-k).le.2)) then
18326 eij1=dtriss/(atriss*(rij-rik)**2+btriss*(rij+rik)**6+ctriss)
18328 !C second case jth atom is center
18329 if ((iabs(j-i).le.2).or.(iabs(j-k).le.2)) then
18332 eij2=dtriss/(atriss*(rij-rjk)**2+btriss*(rij+rjk)**6+ctriss)
18334 !C the third case kth atom is the center
18335 if ((iabs(i-k).le.2).or.(iabs(j-k).le.2)) then
18338 eij3=dtriss/(atriss*(rik-rjk)**2+btriss*(rik+rjk)**6+ctriss)
18344 !C write(iout,*)i,j,k,eij
18345 !C The energy penalty calculated now time for the gradient part
18346 !C derivative over rij
18347 fac=-eij1**2/dtriss*(2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
18348 -eij2**2/dtriss*(2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)
18353 gvdwx(m,i)=gvdwx(m,i)-gg(m)
18354 gvdwx(m,j)=gvdwx(m,j)+gg(m)
18358 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18359 gvdwc(l,j)=gvdwc(l,j)+gg(l)
18361 !C now derivative over rik
18362 fac=-eij1**2/dtriss* &
18363 (-2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
18364 -eij3**2/dtriss*(2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
18369 gvdwx(m,i)=gvdwx(m,i)-gg(m)
18370 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18373 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18374 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18376 !C now derivative over rjk
18377 fac=-eij2**2/dtriss* &
18378 (-2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)- &
18379 eij3**2/dtriss*(-2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
18384 gvdwx(m,j)=gvdwx(m,j)-gg(m)
18385 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18388 gvdwc(l,j)=gvdwc(l,j)-gg(l)
18389 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18392 end subroutine triple_ssbond_ene
18396 !-----------------------------------------------------------------------------
18397 real(kind=8) function h_base(x,deriv)
18398 ! A smooth function going 0->1 in range [0,1]
18399 ! It should NOT be called outside range [0,1], it will not work there.
18406 real(kind=8) :: deriv
18409 real(kind=8) :: xsq
18412 ! Two parabolas put together. First derivative zero at extrema
18413 !$$$ if (x.lt.0.5D0) then
18414 !$$$ h_base=2.0D0*x*x
18418 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
18419 !$$$ deriv=4.0D0*deriv
18422 ! Third degree polynomial. First derivative zero at extrema
18423 h_base=x*x*(3.0d0-2.0d0*x)
18424 deriv=6.0d0*x*(1.0d0-x)
18426 ! Fifth degree polynomial. First and second derivatives zero at extrema
18428 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
18430 !$$$ deriv=deriv*deriv
18431 !$$$ deriv=30.0d0*xsq*deriv
18434 end function h_base
18435 !-----------------------------------------------------------------------------
18436 subroutine dyn_set_nss
18437 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
18439 use MD_data, only: totT,t_bath
18441 ! include 'DIMENSIONS'
18445 ! include 'COMMON.SBRIDGE'
18446 ! include 'COMMON.CHAIN'
18447 ! include 'COMMON.IOUNITS'
18448 ! include 'COMMON.SETUP'
18449 ! include 'COMMON.MD'
18451 real(kind=8) :: emin
18452 integer :: i,j,imin,ierr
18453 integer :: diff,allnss,newnss
18454 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
18457 integer,dimension(0:nfgtasks) :: i_newnss
18458 integer,dimension(0:nfgtasks) :: displ
18459 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
18460 integer :: g_newnss
18465 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
18474 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
18478 if (allflag(i).eq.0 .and. &
18479 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
18480 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
18484 if (emin.lt.1.0d300) then
18487 if (allflag(i).eq.0 .and. &
18488 (allihpb(i).eq.allihpb(imin) .or. &
18489 alljhpb(i).eq.allihpb(imin) .or. &
18490 allihpb(i).eq.alljhpb(imin) .or. &
18491 alljhpb(i).eq.alljhpb(imin))) then
18498 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
18502 if (allflag(i).eq.1) then
18504 newihpb(newnss)=allihpb(i)
18505 newjhpb(newnss)=alljhpb(i)
18510 if (nfgtasks.gt.1)then
18512 call MPI_Reduce(newnss,g_newnss,1,&
18513 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
18514 call MPI_Gather(newnss,1,MPI_INTEGER,&
18515 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
18517 do i=1,nfgtasks-1,1
18518 displ(i)=i_newnss(i-1)+displ(i-1)
18520 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
18521 g_newihpb,i_newnss,displ,MPI_INTEGER,&
18523 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
18524 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
18526 if(fg_rank.eq.0) then
18527 ! print *,'g_newnss',g_newnss
18528 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
18529 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
18532 newihpb(i)=g_newihpb(i)
18533 newjhpb(i)=g_newjhpb(i)
18541 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
18542 ! print *,newnss,nss,maxdim
18548 if (idssb(i).eq.newihpb(j) .and. &
18549 jdssb(i).eq.newjhpb(j)) found=.true.
18553 ! write(iout,*) "found",found,i,j
18554 if (.not.found.and.fg_rank.eq.0) &
18555 write(iout,'(a15,f12.2,f8.1,2i5)') &
18556 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
18565 if (newihpb(i).eq.idssb(j) .and. &
18566 newjhpb(i).eq.jdssb(j)) found=.true.
18570 ! write(iout,*) "found",found,i,j
18571 if (.not.found.and.fg_rank.eq.0) &
18572 write(iout,'(a15,f12.2,f8.1,2i5)') &
18573 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
18580 idssb(i)=newihpb(i)
18581 jdssb(i)=newjhpb(i)
18585 end subroutine dyn_set_nss
18586 ! Lipid transfer energy function
18587 subroutine Eliptransfer(eliptran)
18588 !C this is done by Adasko
18589 !C print *,"wchodze"
18590 !C structure of box:
18592 !C--bordliptop-- buffore starts
18593 !C--bufliptop--- here true lipid starts
18595 !C--buflipbot--- lipid ends buffore starts
18596 !C--bordlipbot--buffore ends
18597 real(kind=8) :: fracinbuf,eliptran,sslip,positi,ssgradlip
18600 ! print *, "I am in eliptran"
18601 do i=ilip_start,ilip_end
18603 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))&
18606 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
18607 if (positi.le.0.0) positi=positi+boxzsize
18609 !C first for peptide groups
18610 !c for each residue check if it is in lipid or lipid water border area
18611 if ((positi.gt.bordlipbot) &
18612 .and.(positi.lt.bordliptop)) then
18613 !C the energy transfer exist
18614 if (positi.lt.buflipbot) then
18615 !C what fraction I am in
18617 ((positi-bordlipbot)/lipbufthick)
18618 !C lipbufthick is thickenes of lipid buffore
18619 sslip=sscalelip(fracinbuf)
18620 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
18621 eliptran=eliptran+sslip*pepliptran
18622 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
18623 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
18624 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
18626 !C print *,"doing sccale for lower part"
18627 !C print *,i,sslip,fracinbuf,ssgradlip
18628 elseif (positi.gt.bufliptop) then
18629 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
18630 sslip=sscalelip(fracinbuf)
18631 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
18632 eliptran=eliptran+sslip*pepliptran
18633 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
18634 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
18635 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
18636 !C print *, "doing sscalefor top part"
18637 !C print *,i,sslip,fracinbuf,ssgradlip
18639 eliptran=eliptran+pepliptran
18640 !C print *,"I am in true lipid"
18643 !C eliptran=elpitran+0.0 ! I am in water
18645 if (energy_dec) write(iout,*) i,"eliptran=",eliptran,positi,sslip
18647 ! here starts the side chain transfer
18648 do i=ilip_start,ilip_end
18649 if (itype(i,1).eq.ntyp1) cycle
18650 positi=(mod(c(3,i+nres),boxzsize))
18651 if (positi.le.0) positi=positi+boxzsize
18652 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18653 !c for each residue check if it is in lipid or lipid water border area
18654 !C respos=mod(c(3,i+nres),boxzsize)
18655 !C print *,positi,bordlipbot,buflipbot
18656 if ((positi.gt.bordlipbot) &
18657 .and.(positi.lt.bordliptop)) then
18658 !C the energy transfer exist
18659 if (positi.lt.buflipbot) then
18661 ((positi-bordlipbot)/lipbufthick)
18662 !C lipbufthick is thickenes of lipid buffore
18663 sslip=sscalelip(fracinbuf)
18664 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
18665 eliptran=eliptran+sslip*liptranene(itype(i,1))
18666 gliptranx(3,i)=gliptranx(3,i) &
18667 +ssgradlip*liptranene(itype(i,1))
18668 gliptranc(3,i-1)= gliptranc(3,i-1) &
18669 +ssgradlip*liptranene(itype(i,1))
18670 !C print *,"doing sccale for lower part"
18671 elseif (positi.gt.bufliptop) then
18673 ((bordliptop-positi)/lipbufthick)
18674 sslip=sscalelip(fracinbuf)
18675 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
18676 eliptran=eliptran+sslip*liptranene(itype(i,1))
18677 gliptranx(3,i)=gliptranx(3,i) &
18678 +ssgradlip*liptranene(itype(i,1))
18679 gliptranc(3,i-1)= gliptranc(3,i-1) &
18680 +ssgradlip*liptranene(itype(i,1))
18681 !C print *, "doing sscalefor top part",sslip,fracinbuf
18683 eliptran=eliptran+liptranene(itype(i,1))
18684 !C print *,"I am in true lipid"
18686 endif ! if in lipid or buffor
18688 !C eliptran=elpitran+0.0 ! I am in water
18689 if (energy_dec) write(iout,*) i,"eliptran=",eliptran
18692 end subroutine Eliptransfer
18693 !----------------------------------NANO FUNCTIONS
18694 !C-----------------------------------------------------------------------
18695 !C-----------------------------------------------------------
18696 !C This subroutine is to mimic the histone like structure but as well can be
18697 !C utilizet to nanostructures (infinit) small modification has to be used to
18698 !C make it finite (z gradient at the ends has to be changes as well as the x,y
18699 !C gradient has to be modified at the ends
18700 !C The energy function is Kihara potential
18701 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
18702 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
18703 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
18704 !C simple Kihara potential
18705 subroutine calctube(Etube)
18706 real(kind=8),dimension(3) :: vectube
18707 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18708 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi, &
18709 sc_aa_tube,sc_bb_tube
18712 do i=itube_start,itube_end
18714 enetube(i+nres)=0.0d0
18716 !C first we calculate the distance from tube center
18718 do i=itube_start,itube_end
18719 !C lets ommit dummy atoms for now
18720 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18721 !C now calculate distance from center of tube and direction vectors
18724 ! Find minimum distance in periodic box
18726 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18727 vectube(1)=vectube(1)+boxxsize*j
18728 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18729 vectube(2)=vectube(2)+boxysize*j
18730 xminact=abs(vectube(1)-tubecenter(1))
18731 yminact=abs(vectube(2)-tubecenter(2))
18732 if (xmin.gt.xminact) then
18736 if (ymin.gt.yminact) then
18743 vectube(1)=vectube(1)-tubecenter(1)
18744 vectube(2)=vectube(2)-tubecenter(2)
18746 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18747 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18749 !C as the tube is infinity we do not calculate the Z-vector use of Z
18752 !C now calculte the distance
18753 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18754 !C now normalize vector
18755 vectube(1)=vectube(1)/tub_r
18756 vectube(2)=vectube(2)/tub_r
18757 !C calculte rdiffrence between r and r0
18760 rdiff6=rdiff**6.0d0
18761 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18762 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
18763 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18764 !C print *,rdiff,rdiff6,pep_aa_tube
18765 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18766 !C now we calculate gradient
18767 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18768 6.0d0*pep_bb_tube)/rdiff6/rdiff
18769 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18771 !C now direction of gg_tube vector
18773 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18774 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18777 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18778 !C print *,gg_tube(1,0),"TU"
18781 do i=itube_start,itube_end
18782 !C Lets not jump over memory as we use many times iti
18784 !C lets ommit dummy atoms for now
18785 if ((iti.eq.ntyp1) &
18786 !C in UNRES uncomment the line below as GLY has no side-chain...
18792 vectube(1)=mod((c(1,i+nres)),boxxsize)
18793 vectube(1)=vectube(1)+boxxsize*j
18794 vectube(2)=mod((c(2,i+nres)),boxysize)
18795 vectube(2)=vectube(2)+boxysize*j
18797 xminact=abs(vectube(1)-tubecenter(1))
18798 yminact=abs(vectube(2)-tubecenter(2))
18799 if (xmin.gt.xminact) then
18803 if (ymin.gt.yminact) then
18810 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
18812 vectube(1)=vectube(1)-tubecenter(1)
18813 vectube(2)=vectube(2)-tubecenter(2)
18815 !C as the tube is infinity we do not calculate the Z-vector use of Z
18818 !C now calculte the distance
18819 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18820 !C now normalize vector
18821 vectube(1)=vectube(1)/tub_r
18822 vectube(2)=vectube(2)/tub_r
18824 !C calculte rdiffrence between r and r0
18827 rdiff6=rdiff**6.0d0
18828 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18829 sc_aa_tube=sc_aa_tube_par(iti)
18830 sc_bb_tube=sc_bb_tube_par(iti)
18831 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
18832 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
18833 6.0d0*sc_bb_tube/rdiff6/rdiff
18834 !C now direction of gg_tube vector
18836 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
18837 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
18840 do i=itube_start,itube_end
18841 Etube=Etube+enetube(i)+enetube(i+nres)
18843 !C print *,"ETUBE", etube
18845 end subroutine calctube
18846 !C TO DO 1) add to total energy
18847 !C 2) add to gradient summation
18848 !C 3) add reading parameters (AND of course oppening of PARAM file)
18849 !C 4) add reading the center of tube
18851 !C 6) add to zerograd
18852 !C 7) allocate matrices
18855 !C-----------------------------------------------------------------------
18856 !C-----------------------------------------------------------
18857 !C This subroutine is to mimic the histone like structure but as well can be
18858 !C utilizet to nanostructures (infinit) small modification has to be used to
18859 !C make it finite (z gradient at the ends has to be changes as well as the x,y
18860 !C gradient has to be modified at the ends
18861 !C The energy function is Kihara potential
18862 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
18863 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
18864 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
18865 !C simple Kihara potential
18866 subroutine calctube2(Etube)
18867 real(kind=8),dimension(3) :: vectube
18868 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18869 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi,fracinbuf,&
18870 sstube,ssgradtube,sc_aa_tube,sc_bb_tube
18873 do i=itube_start,itube_end
18875 enetube(i+nres)=0.0d0
18877 !C first we calculate the distance from tube center
18878 !C first sugare-phosphate group for NARES this would be peptide group
18880 do i=itube_start,itube_end
18881 !C lets ommit dummy atoms for now
18883 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18884 !C now calculate distance from center of tube and direction vectors
18885 !C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18886 !C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
18887 !C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18888 !C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
18892 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18893 vectube(1)=vectube(1)+boxxsize*j
18894 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18895 vectube(2)=vectube(2)+boxysize*j
18897 xminact=abs(vectube(1)-tubecenter(1))
18898 yminact=abs(vectube(2)-tubecenter(2))
18899 if (xmin.gt.xminact) then
18903 if (ymin.gt.yminact) then
18910 vectube(1)=vectube(1)-tubecenter(1)
18911 vectube(2)=vectube(2)-tubecenter(2)
18913 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18914 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18916 !C as the tube is infinity we do not calculate the Z-vector use of Z
18919 !C now calculte the distance
18920 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18921 !C now normalize vector
18922 vectube(1)=vectube(1)/tub_r
18923 vectube(2)=vectube(2)/tub_r
18924 !C calculte rdiffrence between r and r0
18927 rdiff6=rdiff**6.0d0
18928 !C THIS FRAGMENT MAKES TUBE FINITE
18929 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
18930 if (positi.le.0) positi=positi+boxzsize
18931 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18932 !c for each residue check if it is in lipid or lipid water border area
18933 !C respos=mod(c(3,i+nres),boxzsize)
18934 !C print *,positi,bordtubebot,buftubebot,bordtubetop
18935 if ((positi.gt.bordtubebot) &
18936 .and.(positi.lt.bordtubetop)) then
18937 !C the energy transfer exist
18938 if (positi.lt.buftubebot) then
18940 ((positi-bordtubebot)/tubebufthick)
18941 !C lipbufthick is thickenes of lipid buffore
18942 sstube=sscalelip(fracinbuf)
18943 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
18944 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
18945 enetube(i)=enetube(i)+sstube*tubetranenepep
18946 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18947 !C &+ssgradtube*tubetranene(itype(i,1))
18948 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18949 !C &+ssgradtube*tubetranene(itype(i,1))
18950 !C print *,"doing sccale for lower part"
18951 elseif (positi.gt.buftubetop) then
18953 ((bordtubetop-positi)/tubebufthick)
18954 sstube=sscalelip(fracinbuf)
18955 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
18956 enetube(i)=enetube(i)+sstube*tubetranenepep
18957 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18958 !C &+ssgradtube*tubetranene(itype(i,1))
18959 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18960 !C &+ssgradtube*tubetranene(itype(i,1))
18961 !C print *, "doing sscalefor top part",sslip,fracinbuf
18965 enetube(i)=enetube(i)+sstube*tubetranenepep
18966 !C print *,"I am in true lipid"
18970 !C ssgradtube=0.0d0
18972 endif ! if in lipid or buffor
18974 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18975 enetube(i)=enetube(i)+sstube* &
18976 (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
18977 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18978 !C print *,rdiff,rdiff6,pep_aa_tube
18979 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18980 !C now we calculate gradient
18981 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18982 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
18983 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18986 !C now direction of gg_tube vector
18988 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18989 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18991 gg_tube(3,i)=gg_tube(3,i) &
18992 +ssgradtube*enetube(i)/sstube/2.0d0
18993 gg_tube(3,i-1)= gg_tube(3,i-1) &
18994 +ssgradtube*enetube(i)/sstube/2.0d0
18997 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18998 !C print *,gg_tube(1,0),"TU"
18999 do i=itube_start,itube_end
19000 !C Lets not jump over memory as we use many times iti
19002 !C lets ommit dummy atoms for now
19003 if ((iti.eq.ntyp1) &
19004 !!C in UNRES uncomment the line below as GLY has no side-chain...
19007 vectube(1)=c(1,i+nres)
19008 vectube(1)=mod(vectube(1),boxxsize)
19009 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
19010 vectube(2)=c(2,i+nres)
19011 vectube(2)=mod(vectube(2),boxysize)
19012 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
19014 vectube(1)=vectube(1)-tubecenter(1)
19015 vectube(2)=vectube(2)-tubecenter(2)
19016 !C THIS FRAGMENT MAKES TUBE FINITE
19017 positi=(mod(c(3,i+nres),boxzsize))
19018 if (positi.le.0) positi=positi+boxzsize
19019 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
19020 !c for each residue check if it is in lipid or lipid water border area
19021 !C respos=mod(c(3,i+nres),boxzsize)
19022 !C print *,positi,bordtubebot,buftubebot,bordtubetop
19024 if ((positi.gt.bordtubebot) &
19025 .and.(positi.lt.bordtubetop)) then
19026 !C the energy transfer exist
19027 if (positi.lt.buftubebot) then
19029 ((positi-bordtubebot)/tubebufthick)
19030 !C lipbufthick is thickenes of lipid buffore
19031 sstube=sscalelip(fracinbuf)
19032 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
19033 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
19034 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19035 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19036 !C &+ssgradtube*tubetranene(itype(i,1))
19037 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19038 !C &+ssgradtube*tubetranene(itype(i,1))
19039 !C print *,"doing sccale for lower part"
19040 elseif (positi.gt.buftubetop) then
19042 ((bordtubetop-positi)/tubebufthick)
19044 sstube=sscalelip(fracinbuf)
19045 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
19046 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19047 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19048 !C &+ssgradtube*tubetranene(itype(i,1))
19049 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19050 !C &+ssgradtube*tubetranene(itype(i,1))
19051 !C print *, "doing sscalefor top part",sslip,fracinbuf
19055 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19056 !C print *,"I am in true lipid"
19060 !C ssgradtube=0.0d0
19062 endif ! if in lipid or buffor
19063 !CEND OF FINITE FRAGMENT
19064 !C as the tube is infinity we do not calculate the Z-vector use of Z
19067 !C now calculte the distance
19068 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19069 !C now normalize vector
19070 vectube(1)=vectube(1)/tub_r
19071 vectube(2)=vectube(2)/tub_r
19072 !C calculte rdiffrence between r and r0
19075 rdiff6=rdiff**6.0d0
19076 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19077 sc_aa_tube=sc_aa_tube_par(iti)
19078 sc_bb_tube=sc_bb_tube_par(iti)
19079 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)&
19080 *sstube+enetube(i+nres)
19081 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19082 !C now we calculate gradient
19083 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-&
19084 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
19085 !C now direction of gg_tube vector
19087 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19088 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19090 gg_tube_SC(3,i)=gg_tube_SC(3,i) &
19091 +ssgradtube*enetube(i+nres)/sstube
19092 gg_tube(3,i-1)= gg_tube(3,i-1) &
19093 +ssgradtube*enetube(i+nres)/sstube
19096 do i=itube_start,itube_end
19097 Etube=Etube+enetube(i)+enetube(i+nres)
19099 !C print *,"ETUBE", etube
19101 end subroutine calctube2
19102 !=====================================================================================================================================
19103 subroutine calcnano(Etube)
19104 real(kind=8),dimension(3) :: vectube
19106 real(kind=8) :: Etube,xtemp,xminact,yminact,&
19107 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,denominator,faccav,&
19108 sc_aa_tube,sc_bb_tube,zmin,ztemp,zminact
19109 integer:: i,j,iti,r
19112 ! print *,itube_start,itube_end,"poczatek"
19113 do i=itube_start,itube_end
19115 enetube(i+nres)=0.0d0
19117 !C first we calculate the distance from tube center
19118 !C first sugare-phosphate group for NARES this would be peptide group
19120 do i=itube_start,itube_end
19121 !C lets ommit dummy atoms for now
19122 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
19123 !C now calculate distance from center of tube and direction vectors
19129 vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19130 vectube(1)=vectube(1)+boxxsize*j
19131 vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19132 vectube(2)=vectube(2)+boxysize*j
19133 vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
19134 vectube(3)=vectube(3)+boxzsize*j
19137 xminact=dabs(vectube(1)-tubecenter(1))
19138 yminact=dabs(vectube(2)-tubecenter(2))
19139 zminact=dabs(vectube(3)-tubecenter(3))
19141 if (xmin.gt.xminact) then
19145 if (ymin.gt.yminact) then
19149 if (zmin.gt.zminact) then
19158 vectube(1)=vectube(1)-tubecenter(1)
19159 vectube(2)=vectube(2)-tubecenter(2)
19160 vectube(3)=vectube(3)-tubecenter(3)
19162 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
19163 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
19164 !C as the tube is infinity we do not calculate the Z-vector use of Z
19166 !C vectube(3)=0.0d0
19167 !C now calculte the distance
19168 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19169 !C now normalize vector
19170 vectube(1)=vectube(1)/tub_r
19171 vectube(2)=vectube(2)/tub_r
19172 vectube(3)=vectube(3)/tub_r
19173 !C calculte rdiffrence between r and r0
19176 rdiff6=rdiff**6.0d0
19177 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19178 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
19179 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
19180 !C print *,rdiff,rdiff6,pep_aa_tube
19181 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19182 !C now we calculate gradient
19183 fac=(-12.0d0*pep_aa_tube/rdiff6- &
19184 6.0d0*pep_bb_tube)/rdiff6/rdiff
19185 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
19187 if (acavtubpep.eq.0.0d0) then
19192 denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
19194 (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
19197 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
19198 *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
19199 +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
19200 /denominator**2.0d0
19205 if (energy_dec) write(iout,*),i,rdiff,enetube(i),enecavtube(i)
19207 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
19208 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
19212 do i=itube_start,itube_end
19213 enecavtube(i)=0.0d0
19214 !C Lets not jump over memory as we use many times iti
19216 !C lets ommit dummy atoms for now
19217 if ((iti.eq.ntyp1) &
19218 !C in UNRES uncomment the line below as GLY has no side-chain...
19225 vectube(1)=dmod((c(1,i+nres)),boxxsize)
19226 vectube(1)=vectube(1)+boxxsize*j
19227 vectube(2)=dmod((c(2,i+nres)),boxysize)
19228 vectube(2)=vectube(2)+boxysize*j
19229 vectube(3)=dmod((c(3,i+nres)),boxzsize)
19230 vectube(3)=vectube(3)+boxzsize*j
19233 xminact=dabs(vectube(1)-tubecenter(1))
19234 yminact=dabs(vectube(2)-tubecenter(2))
19235 zminact=dabs(vectube(3)-tubecenter(3))
19237 if (xmin.gt.xminact) then
19241 if (ymin.gt.yminact) then
19245 if (zmin.gt.zminact) then
19254 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
19256 vectube(1)=vectube(1)-tubecenter(1)
19257 vectube(2)=vectube(2)-tubecenter(2)
19258 vectube(3)=vectube(3)-tubecenter(3)
19259 !C now calculte the distance
19260 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19261 !C now normalize vector
19262 vectube(1)=vectube(1)/tub_r
19263 vectube(2)=vectube(2)/tub_r
19264 vectube(3)=vectube(3)/tub_r
19266 !C calculte rdiffrence between r and r0
19269 rdiff6=rdiff**6.0d0
19270 sc_aa_tube=sc_aa_tube_par(iti)
19271 sc_bb_tube=sc_bb_tube_par(iti)
19272 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19273 !C enetube(i+nres)=0.0d0
19274 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19275 !C now we calculate gradient
19276 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
19277 6.0d0*sc_bb_tube/rdiff6/rdiff
19279 !C now direction of gg_tube vector
19280 !C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
19281 if (acavtub(iti).eq.0.0d0) then
19283 enecavtube(i+nres)=0.0d0
19286 denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
19287 enecavtube(i+nres)= &
19288 (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
19290 !C enecavtube(i)=0.0
19291 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
19292 *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
19293 +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
19294 /denominator**2.0d0
19299 !C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
19300 !C & enecavtube(i),faccav
19301 !C print *,"licz=",
19302 !C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
19303 !C print *,"finene=",enetube(i+nres)+enecavtube(i)
19305 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19306 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19308 if (energy_dec) write(iout,*),i,rdiff,enetube(i+nres),enecavtube(i+nres)
19313 do i=itube_start,itube_end
19314 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) &
19315 +enecavtube(i+nres)
19318 ! print *,"begin", i,"a"
19321 ! rdiff6=rdiff**6.0d0
19322 ! sc_aa_tube=sc_aa_tube_par(i)
19323 ! sc_bb_tube=sc_bb_tube_par(i)
19324 ! enetube(i)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19325 ! denominator=(1.0d0+dcavtub(i)*rdiff6*rdiff6)
19327 ! (bcavtub(i)*rdiff+acavtub(i)*dsqrt(rdiff)+ccavtub(i)) &
19330 ! print '(5(f10.3,1x))',rdiff,enetube(i),enecavtube(i),enecavtube(i)+enetube(i)
19332 ! print *,"end",i,"a"
19334 !C print *,"ETUBE", etube
19336 end subroutine calcnano
19338 !===============================================
19339 !--------------------------------------------------------------------------------
19340 !C first for shielding is setting of function of side-chains
19342 subroutine set_shield_fac2
19343 real(kind=8) :: div77_81=0.974996043d0, &
19344 div4_81=0.2222222222d0
19345 real (kind=8) :: dist_pep_side,dist_side_calf,dist_pept_group, &
19346 scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
19347 short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
19348 sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
19349 !C the vector between center of side_chain and peptide group
19350 real(kind=8),dimension(3) :: pep_side_long,side_calf, &
19351 pept_group,costhet_grad,cosphi_grad_long, &
19352 cosphi_grad_loc,pep_side_norm,side_calf_norm, &
19353 sh_frac_dist_grad,pep_side
19355 !C write(2,*) "ivec",ivec_start,ivec_end
19357 fac_shield(i)=0.0d0
19359 grad_shield(j,i)=0.0d0
19362 do i=ivec_start,ivec_end
19364 !C if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
19366 if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
19367 !Cif there two consequtive dummy atoms there is no peptide group between them
19368 !C the line below has to be changed for FGPROC>1
19371 if ((itype(k,1).eq.ntyp1).or.(itype(k,1).eq.10)) cycle
19375 !C first lets set vector conecting the ithe side-chain with kth side-chain
19376 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
19377 !C pep_side(j)=2.0d0
19378 !C and vector conecting the side-chain with its proper calfa
19379 side_calf(j)=c(j,k+nres)-c(j,k)
19380 !C side_calf(j)=2.0d0
19381 pept_group(j)=c(j,i)-c(j,i+1)
19382 !C lets have their lenght
19383 dist_pep_side=pep_side(j)**2+dist_pep_side
19384 dist_side_calf=dist_side_calf+side_calf(j)**2
19385 dist_pept_group=dist_pept_group+pept_group(j)**2
19387 dist_pep_side=sqrt(dist_pep_side)
19388 dist_pept_group=sqrt(dist_pept_group)
19389 dist_side_calf=sqrt(dist_side_calf)
19391 pep_side_norm(j)=pep_side(j)/dist_pep_side
19392 side_calf_norm(j)=dist_side_calf
19394 !C now sscale fraction
19395 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
19396 !C print *,buff_shield,"buff"
19398 if (sh_frac_dist.le.0.0) cycle
19399 !C print *,ishield_list(i),i
19400 !C If we reach here it means that this side chain reaches the shielding sphere
19401 !C Lets add him to the list for gradient
19402 ishield_list(i)=ishield_list(i)+1
19403 !C ishield_list is a list of non 0 side-chain that contribute to factor gradient
19404 !C this list is essential otherwise problem would be O3
19405 shield_list(ishield_list(i),i)=k
19406 !C Lets have the sscale value
19407 if (sh_frac_dist.gt.1.0) then
19408 scale_fac_dist=1.0d0
19410 sh_frac_dist_grad(j)=0.0d0
19413 scale_fac_dist=-sh_frac_dist*sh_frac_dist &
19414 *(2.0d0*sh_frac_dist-3.0d0)
19415 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
19416 /dist_pep_side/buff_shield*0.5d0
19418 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
19419 !C sh_frac_dist_grad(j)=0.0d0
19420 !C scale_fac_dist=1.0d0
19421 !C print *,"jestem",scale_fac_dist,fac_help_scale,
19422 !C & sh_frac_dist_grad(j)
19425 !C this is what is now we have the distance scaling now volume...
19426 short=short_r_sidechain(itype(k,1))
19427 long=long_r_sidechain(itype(k,1))
19428 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
19429 sinthet=short/dist_pep_side*costhet
19430 !C now costhet_grad
19433 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
19434 !C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
19435 !C & -short/dist_pep_side**2/costhet)
19436 !C costhet_fac=0.0d0
19438 costhet_grad(j)=costhet_fac*pep_side(j)
19440 !C remember for the final gradient multiply costhet_grad(j)
19441 !C for side_chain by factor -2 !
19442 !C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
19443 !C pep_side0pept_group is vector multiplication
19444 pep_side0pept_group=0.0d0
19446 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
19448 cosalfa=(pep_side0pept_group/ &
19449 (dist_pep_side*dist_side_calf))
19450 fac_alfa_sin=1.0d0-cosalfa**2
19451 fac_alfa_sin=dsqrt(fac_alfa_sin)
19452 rkprim=fac_alfa_sin*(long-short)+short
19455 !C now costhet_grad
19456 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
19458 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
19459 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ &
19463 cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
19464 +cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
19465 *(long-short)/fac_alfa_sin*cosalfa/ &
19466 ((dist_pep_side*dist_side_calf))* &
19467 ((side_calf(j))-cosalfa* &
19468 ((pep_side(j)/dist_pep_side)*dist_side_calf))
19469 !C cosphi_grad_long(j)=0.0d0
19470 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
19471 *(long-short)/fac_alfa_sin*cosalfa &
19472 /((dist_pep_side*dist_side_calf))* &
19474 cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
19475 !C cosphi_grad_loc(j)=0.0d0
19477 !C print *,sinphi,sinthet
19478 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) &
19481 !C now the gradient...
19483 grad_shield(j,i)=grad_shield(j,i) &
19484 !C gradient po skalowaniu
19485 +(sh_frac_dist_grad(j)*VofOverlap &
19486 !C gradient po costhet
19487 +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
19488 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
19489 sinphi/sinthet*costhet*costhet_grad(j) &
19490 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
19492 !C grad_shield_side is Cbeta sidechain gradient
19493 grad_shield_side(j,ishield_list(i),i)=&
19494 (sh_frac_dist_grad(j)*-2.0d0&
19496 -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
19497 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(&
19498 sinphi/sinthet*costhet*costhet_grad(j)&
19499 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
19502 grad_shield_loc(j,ishield_list(i),i)= &
19503 scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
19504 (1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(&
19505 sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
19509 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
19511 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
19513 !C write(2,*) "TOTAL VOLUME",i,itype(i,1),fac_shield(i)
19516 end subroutine set_shield_fac2
19517 !----------------------------------------------------------------------------
19518 ! SOUBROUTINE FOR AFM
19519 subroutine AFMvel(Eafmforce)
19520 use MD_data, only:totTafm
19521 real(kind=8),dimension(3) :: diffafm
19522 real(kind=8) :: afmdist,Eafmforce
19524 !C Only for check grad COMMENT if not used for checkgrad
19526 !C--------------------------------------------------------
19527 !C print *,"wchodze"
19531 diffafm(i)=c(i,afmend)-c(i,afmbeg)
19532 afmdist=afmdist+diffafm(i)**2
19534 afmdist=dsqrt(afmdist)
19536 Eafmforce=0.5d0*forceAFMconst &
19537 *(distafminit+totTafm*velAFMconst-afmdist)**2
19538 !C Eafmforce=-forceAFMconst*(dist-distafminit)
19540 gradafm(i,afmend-1)=-forceAFMconst* &
19541 (distafminit+totTafm*velAFMconst-afmdist) &
19542 *diffafm(i)/afmdist
19543 gradafm(i,afmbeg-1)=forceAFMconst* &
19544 (distafminit+totTafm*velAFMconst-afmdist) &
19545 *diffafm(i)/afmdist
19547 ! print *,'AFM',Eafmforce,totTafm*velAFMconst,afmdist
19549 end subroutine AFMvel
19550 !---------------------------------------------------------
19551 subroutine AFMforce(Eafmforce)
19553 real(kind=8),dimension(3) :: diffafm
19554 ! real(kind=8) ::afmdist
19555 real(kind=8) :: afmdist,Eafmforce
19560 diffafm(i)=c(i,afmend)-c(i,afmbeg)
19561 afmdist=afmdist+diffafm(i)**2
19563 afmdist=dsqrt(afmdist)
19564 ! print *,afmdist,distafminit
19565 Eafmforce=-forceAFMconst*(afmdist-distafminit)
19567 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/afmdist
19568 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/afmdist
19570 !C print *,'AFM',Eafmforce
19572 end subroutine AFMforce
19574 !-----------------------------------------------------------------------------
19576 subroutine read_ssHist
19579 ! include 'DIMENSIONS'
19580 ! include "DIMENSIONS.FREE"
19581 ! include 'COMMON.FREE'
19584 character(len=80) :: controlcard
19587 call card_concat(controlcard,.true.)
19588 read(controlcard,*) &
19589 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
19593 end subroutine read_ssHist
19595 !-----------------------------------------------------------------------------
19596 integer function indmat(i,j)
19598 ! get the position of the jth ijth fragment of the chain coordinate system
19599 ! in the fromto array.
19602 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
19604 end function indmat
19605 !-----------------------------------------------------------------------------
19606 real(kind=8) function sigm(x)
19612 !-----------------------------------------------------------------------------
19613 !-----------------------------------------------------------------------------
19614 subroutine alloc_ener_arrays
19615 !EL Allocation of arrays used by module energy
19616 use MD_data, only: mset
19617 !el local variables
19620 if(nres.lt.100) then
19622 elseif(nres.lt.200) then
19623 maxconts=0.8*nres ! Max. number of contacts per residue
19625 maxconts=0.6*nres ! (maxconts=maxres/4)
19627 maxcont=12*nres ! Max. number of SC contacts
19628 maxvar=6*nres ! Max. number of variables
19629 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
19630 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
19631 !----------------------
19632 ! arrays in subroutine init_int_table
19634 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
19635 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
19637 allocate(nint_gr(nres))
19638 allocate(nscp_gr(nres))
19639 allocate(ielstart(nres))
19640 allocate(ielend(nres))
19642 allocate(istart(nres,maxint_gr))
19643 allocate(iend(nres,maxint_gr))
19644 !(maxres,maxint_gr)
19645 allocate(iscpstart(nres,maxint_gr))
19646 allocate(iscpend(nres,maxint_gr))
19647 !(maxres,maxint_gr)
19648 allocate(ielstart_vdw(nres))
19649 allocate(ielend_vdw(nres))
19651 allocate(nint_gr_nucl(nres))
19652 allocate(nscp_gr_nucl(nres))
19653 allocate(ielstart_nucl(nres))
19654 allocate(ielend_nucl(nres))
19656 allocate(istart_nucl(nres,maxint_gr))
19657 allocate(iend_nucl(nres,maxint_gr))
19658 !(maxres,maxint_gr)
19659 allocate(iscpstart_nucl(nres,maxint_gr))
19660 allocate(iscpend_nucl(nres,maxint_gr))
19661 !(maxres,maxint_gr)
19662 allocate(ielstart_vdw_nucl(nres))
19663 allocate(ielend_vdw_nucl(nres))
19665 allocate(lentyp(0:nfgtasks-1))
19667 !----------------------
19669 ! common /contacts/
19670 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
19671 allocate(icont(2,maxcont))
19673 ! common /contacts1/
19674 allocate(num_cont(0:nres+4))
19676 allocate(jcont(maxconts,nres))
19678 allocate(facont(maxconts,nres))
19680 allocate(gacont(3,maxconts,nres))
19681 !(3,maxconts,maxres)
19682 ! common /contacts_hb/
19683 allocate(gacontp_hb1(3,maxconts,nres))
19684 allocate(gacontp_hb2(3,maxconts,nres))
19685 allocate(gacontp_hb3(3,maxconts,nres))
19686 allocate(gacontm_hb1(3,maxconts,nres))
19687 allocate(gacontm_hb2(3,maxconts,nres))
19688 allocate(gacontm_hb3(3,maxconts,nres))
19689 allocate(gacont_hbr(3,maxconts,nres))
19690 allocate(grij_hb_cont(3,maxconts,nres))
19691 !(3,maxconts,maxres)
19692 allocate(facont_hb(maxconts,nres))
19694 allocate(ees0p(maxconts,nres))
19695 allocate(ees0m(maxconts,nres))
19696 allocate(d_cont(maxconts,nres))
19697 allocate(ees0plist(maxconts,nres))
19700 allocate(num_cont_hb(nres))
19702 allocate(jcont_hb(maxconts,nres))
19705 allocate(Ug(2,2,nres))
19706 allocate(Ugder(2,2,nres))
19707 allocate(Ug2(2,2,nres))
19708 allocate(Ug2der(2,2,nres))
19710 allocate(obrot(2,nres))
19711 allocate(obrot2(2,nres))
19712 allocate(obrot_der(2,nres))
19713 allocate(obrot2_der(2,nres))
19715 ! common /precomp1/
19716 allocate(mu(2,nres))
19717 allocate(muder(2,nres))
19718 allocate(Ub2(2,nres))
19721 allocate(Ub2der(2,nres))
19722 allocate(Ctobr(2,nres))
19723 allocate(Ctobrder(2,nres))
19724 allocate(Dtobr2(2,nres))
19725 allocate(Dtobr2der(2,nres))
19727 allocate(EUg(2,2,nres))
19728 allocate(EUgder(2,2,nres))
19729 allocate(CUg(2,2,nres))
19730 allocate(CUgder(2,2,nres))
19731 allocate(DUg(2,2,nres))
19732 allocate(Dugder(2,2,nres))
19733 allocate(DtUg2(2,2,nres))
19734 allocate(DtUg2der(2,2,nres))
19736 ! common /precomp2/
19737 allocate(Ug2Db1t(2,nres))
19738 allocate(Ug2Db1tder(2,nres))
19739 allocate(CUgb2(2,nres))
19740 allocate(CUgb2der(2,nres))
19742 allocate(EUgC(2,2,nres))
19743 allocate(EUgCder(2,2,nres))
19744 allocate(EUgD(2,2,nres))
19745 allocate(EUgDder(2,2,nres))
19746 allocate(DtUg2EUg(2,2,nres))
19747 allocate(Ug2DtEUg(2,2,nres))
19749 allocate(Ug2DtEUgder(2,2,2,nres))
19750 allocate(DtUg2EUgder(2,2,2,nres))
19752 ! common /rotat_old/
19753 allocate(costab(nres))
19754 allocate(sintab(nres))
19755 allocate(costab2(nres))
19756 allocate(sintab2(nres))
19759 allocate(a_chuj(2,2,maxconts,nres))
19760 !(2,2,maxconts,maxres)(maxconts=maxres/4)
19761 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
19762 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
19763 ! common /contdistrib/
19764 allocate(ncont_sent(nres))
19765 allocate(ncont_recv(nres))
19767 allocate(iat_sent(nres))
19769 allocate(iint_sent(4,nres,nres))
19770 allocate(iint_sent_local(4,nres,nres))
19772 allocate(iturn3_sent(4,0:nres+4))
19773 allocate(iturn4_sent(4,0:nres+4))
19774 allocate(iturn3_sent_local(4,nres))
19775 allocate(iturn4_sent_local(4,nres))
19777 allocate(itask_cont_from(0:nfgtasks-1))
19778 allocate(itask_cont_to(0:nfgtasks-1))
19779 !(0:max_fg_procs-1)
19783 !----------------------
19786 allocate(dcdv(6,maxdim))
19787 allocate(dxdv(6,maxdim))
19789 allocate(dxds(6,nres))
19791 allocate(gradx(3,-1:nres,0:2))
19792 allocate(gradc(3,-1:nres,0:2))
19794 allocate(gvdwx(3,-1:nres))
19795 allocate(gvdwc(3,-1:nres))
19796 allocate(gelc(3,-1:nres))
19797 allocate(gelc_long(3,-1:nres))
19798 allocate(gvdwpp(3,-1:nres))
19799 allocate(gvdwc_scpp(3,-1:nres))
19800 allocate(gradx_scp(3,-1:nres))
19801 allocate(gvdwc_scp(3,-1:nres))
19802 allocate(ghpbx(3,-1:nres))
19803 allocate(ghpbc(3,-1:nres))
19804 allocate(gradcorr(3,-1:nres))
19805 allocate(gradcorr_long(3,-1:nres))
19806 allocate(gradcorr5_long(3,-1:nres))
19807 allocate(gradcorr6_long(3,-1:nres))
19808 allocate(gcorr6_turn_long(3,-1:nres))
19809 allocate(gradxorr(3,-1:nres))
19810 allocate(gradcorr5(3,-1:nres))
19811 allocate(gradcorr6(3,-1:nres))
19812 allocate(gliptran(3,-1:nres))
19813 allocate(gliptranc(3,-1:nres))
19814 allocate(gliptranx(3,-1:nres))
19815 allocate(gshieldx(3,-1:nres))
19816 allocate(gshieldc(3,-1:nres))
19817 allocate(gshieldc_loc(3,-1:nres))
19818 allocate(gshieldx_ec(3,-1:nres))
19819 allocate(gshieldc_ec(3,-1:nres))
19820 allocate(gshieldc_loc_ec(3,-1:nres))
19821 allocate(gshieldx_t3(3,-1:nres))
19822 allocate(gshieldc_t3(3,-1:nres))
19823 allocate(gshieldc_loc_t3(3,-1:nres))
19824 allocate(gshieldx_t4(3,-1:nres))
19825 allocate(gshieldc_t4(3,-1:nres))
19826 allocate(gshieldc_loc_t4(3,-1:nres))
19827 allocate(gshieldx_ll(3,-1:nres))
19828 allocate(gshieldc_ll(3,-1:nres))
19829 allocate(gshieldc_loc_ll(3,-1:nres))
19830 allocate(grad_shield(3,-1:nres))
19831 allocate(gg_tube_sc(3,-1:nres))
19832 allocate(gg_tube(3,-1:nres))
19833 allocate(gradafm(3,-1:nres))
19834 allocate(gradb_nucl(3,-1:nres))
19835 allocate(gradbx_nucl(3,-1:nres))
19836 allocate(gvdwpsb1(3,-1:nres))
19837 allocate(gelpp(3,-1:nres))
19838 allocate(gvdwpsb(3,-1:nres))
19839 allocate(gelsbc(3,-1:nres))
19840 allocate(gelsbx(3,-1:nres))
19841 allocate(gvdwsbx(3,-1:nres))
19842 allocate(gvdwsbc(3,-1:nres))
19843 allocate(gsbloc(3,-1:nres))
19844 allocate(gsblocx(3,-1:nres))
19845 allocate(gradcorr_nucl(3,-1:nres))
19846 allocate(gradxorr_nucl(3,-1:nres))
19847 allocate(gradcorr3_nucl(3,-1:nres))
19848 allocate(gradxorr3_nucl(3,-1:nres))
19849 allocate(gvdwpp_nucl(3,-1:nres))
19850 allocate(gradpepcat(3,-1:nres))
19851 allocate(gradpepcatx(3,-1:nres))
19852 allocate(gradcatcat(3,-1:nres))
19854 allocate(grad_shield_side(3,50,nres))
19855 allocate(grad_shield_loc(3,50,nres))
19856 ! grad for shielding surroing
19857 allocate(gloc(0:maxvar,0:2))
19858 allocate(gloc_x(0:maxvar,2))
19860 allocate(gel_loc(3,-1:nres))
19861 allocate(gel_loc_long(3,-1:nres))
19862 allocate(gcorr3_turn(3,-1:nres))
19863 allocate(gcorr4_turn(3,-1:nres))
19864 allocate(gcorr6_turn(3,-1:nres))
19865 allocate(gradb(3,-1:nres))
19866 allocate(gradbx(3,-1:nres))
19868 allocate(gel_loc_loc(maxvar))
19869 allocate(gel_loc_turn3(maxvar))
19870 allocate(gel_loc_turn4(maxvar))
19871 allocate(gel_loc_turn6(maxvar))
19872 allocate(gcorr_loc(maxvar))
19873 allocate(g_corr5_loc(maxvar))
19874 allocate(g_corr6_loc(maxvar))
19876 allocate(gsccorc(3,-1:nres))
19877 allocate(gsccorx(3,-1:nres))
19879 allocate(gsccor_loc(-1:nres))
19881 allocate(gvdwx_scbase(3,-1:nres))
19882 allocate(gvdwc_scbase(3,-1:nres))
19883 allocate(gvdwx_pepbase(3,-1:nres))
19884 allocate(gvdwc_pepbase(3,-1:nres))
19885 allocate(gvdwx_scpho(3,-1:nres))
19886 allocate(gvdwc_scpho(3,-1:nres))
19887 allocate(gvdwc_peppho(3,-1:nres))
19889 allocate(dtheta(3,2,-1:nres))
19891 allocate(gscloc(3,-1:nres))
19892 allocate(gsclocx(3,-1:nres))
19894 allocate(dphi(3,3,-1:nres))
19895 allocate(dalpha(3,3,-1:nres))
19896 allocate(domega(3,3,-1:nres))
19898 ! common /deriv_scloc/
19899 allocate(dXX_C1tab(3,nres))
19900 allocate(dYY_C1tab(3,nres))
19901 allocate(dZZ_C1tab(3,nres))
19902 allocate(dXX_Ctab(3,nres))
19903 allocate(dYY_Ctab(3,nres))
19904 allocate(dZZ_Ctab(3,nres))
19905 allocate(dXX_XYZtab(3,nres))
19906 allocate(dYY_XYZtab(3,nres))
19907 allocate(dZZ_XYZtab(3,nres))
19910 allocate(jgrad_start(nres))
19911 allocate(jgrad_end(nres))
19913 !----------------------
19916 allocate(ibond_displ(0:nfgtasks-1))
19917 allocate(ibond_count(0:nfgtasks-1))
19918 allocate(ithet_displ(0:nfgtasks-1))
19919 allocate(ithet_count(0:nfgtasks-1))
19920 allocate(iphi_displ(0:nfgtasks-1))
19921 allocate(iphi_count(0:nfgtasks-1))
19922 allocate(iphi1_displ(0:nfgtasks-1))
19923 allocate(iphi1_count(0:nfgtasks-1))
19924 allocate(ivec_displ(0:nfgtasks-1))
19925 allocate(ivec_count(0:nfgtasks-1))
19926 allocate(iset_displ(0:nfgtasks-1))
19927 allocate(iset_count(0:nfgtasks-1))
19928 allocate(iint_count(0:nfgtasks-1))
19929 allocate(iint_displ(0:nfgtasks-1))
19930 !(0:max_fg_procs-1)
19931 !----------------------
19934 allocate(gcart(3,-1:nres))
19935 allocate(gxcart(3,-1:nres))
19937 allocate(gradcag(3,-1:nres))
19938 allocate(gradxag(3,-1:nres))
19940 ! common /back_constr/
19941 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
19942 allocate(dutheta(nres))
19943 allocate(dugamma(nres))
19945 allocate(duscdiff(3,nres))
19946 allocate(duscdiffx(3,nres))
19948 !el i io:read_fragments
19949 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
19950 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
19952 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
19953 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
19954 allocate(mset(0:nprocs)) !(maxprocs/20)
19956 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
19957 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
19958 allocate(dUdconst(3,0:nres))
19959 allocate(dUdxconst(3,0:nres))
19960 allocate(dqwol(3,0:nres))
19961 allocate(dxqwol(3,0:nres))
19963 !----------------------
19965 ! common /sbridge/ in io_common: read_bridge
19966 !el allocate((:),allocatable :: iss !(maxss)
19967 ! common /links/ in io_common: read_bridge
19968 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
19969 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
19970 ! common /dyn_ssbond/
19971 ! and side-chain vectors in theta or phi.
19972 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
19976 dyn_ssbond_ij(:,:)=1.0d300
19980 ! if (nss.gt.0) then
19981 allocate(idssb(maxdim),jdssb(maxdim))
19982 ! allocate(newihpb(nss),newjhpb(nss))
19985 allocate(ishield_list(nres))
19986 allocate(shield_list(50,nres))
19987 allocate(dyn_ss_mask(nres))
19988 allocate(fac_shield(nres))
19989 allocate(enetube(nres*2))
19990 allocate(enecavtube(nres*2))
19993 dyn_ss_mask(:)=.false.
19994 !----------------------
19996 ! Parameters of the SCCOR term
19998 !el in io_conf: parmread
19999 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
20000 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
20001 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
20002 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
20003 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
20004 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
20005 ! allocate(vlor1sccor(maxterm_sccor,20,20))
20006 ! allocate(vlor2sccor(maxterm_sccor,20,20))
20007 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
20009 allocate(gloc_sc(3,0:2*nres,0:10))
20010 !(3,0:maxres2,10)maxres2=2*maxres
20011 allocate(dcostau(3,3,3,2*nres))
20012 allocate(dsintau(3,3,3,2*nres))
20013 allocate(dtauangle(3,3,3,2*nres))
20014 allocate(dcosomicron(3,3,3,2*nres))
20015 allocate(domicron(3,3,3,2*nres))
20016 !(3,3,3,maxres2)maxres2=2*maxres
20017 !----------------------
20020 allocate(varall(maxvar))
20021 !(maxvar)(maxvar=6*maxres)
20022 allocate(mask_theta(nres))
20023 allocate(mask_phi(nres))
20024 allocate(mask_side(nres))
20026 !----------------------
20029 allocate(uy(3,nres))
20030 allocate(uz(3,nres))
20032 allocate(uygrad(3,3,2,nres))
20033 allocate(uzgrad(3,3,2,nres))
20037 end subroutine alloc_ener_arrays
20038 !-----------------------------------------------------------------
20039 subroutine ebond_nucl(estr_nucl)
20041 !c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
20044 real(kind=8),dimension(3) :: u,ud
20045 real(kind=8) :: usum,uprod,uprod1,uprod2,usumsqder
20046 real(kind=8) :: estr_nucl,diff
20047 integer :: iti,i,j,k,nbi
20049 !C print *,"I enter ebond"
20051 write (iout,*) "ibondp_start,ibondp_end",&
20052 ibondp_nucl_start,ibondp_nucl_end
20053 do i=ibondp_nucl_start,ibondp_nucl_end
20054 if (itype(i-1,2).eq.ntyp1_molec(2) .or. &
20055 itype(i,2).eq.ntyp1_molec(2)) cycle
20056 ! estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
20058 ! gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
20059 ! & *dc(j,i-1)/vbld(i)
20061 ! if (energy_dec) write(iout,*)
20062 ! & "estr1",i,vbld(i),distchainmax,
20063 ! & gnmr1(vbld(i),-1.0d0,distchainmax)
20065 diff = vbld(i)-vbldp0_nucl
20066 if(energy_dec)write(iout,*) "estr_nucl_bb" , i,vbld(i),&
20067 vbldp0_nucl,diff,AKP_nucl*diff*diff
20068 estr_nucl=estr_nucl+diff*diff
20069 ! print *,estr_nucl
20071 gradb_nucl(j,i-1)=AKP_nucl*diff*dc(j,i-1)/vbld(i)
20073 !c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
20075 estr_nucl=0.5d0*AKP_nucl*estr_nucl
20076 ! print *,"partial sum", estr_nucl,AKP_nucl
20079 write (iout,*) "ibondp_start,ibondp_end",&
20080 ibond_nucl_start,ibond_nucl_end
20082 do i=ibond_nucl_start,ibond_nucl_end
20083 !C print *, "I am stuck",i
20085 if (iti.eq.ntyp1_molec(2)) cycle
20086 nbi=nbondterm_nucl(iti)
20089 diff=vbld(i+nres)-vbldsc0_nucl(1,iti)
20092 write (iout,*) "estr_nucl_sc", i,iti,vbld(i+nres),vbldsc0_nucl(1,iti),diff, &
20093 AKSC_nucl(1,iti),AKSC_nucl(1,iti)*diff*diff
20094 estr_nucl=estr_nucl+0.5d0*AKSC_nucl(1,iti)*diff*diff
20095 ! print *,estr_nucl
20097 gradbx_nucl(j,i)=AKSC_nucl(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
20101 diff=vbld(i+nres)-vbldsc0_nucl(j,iti)
20102 ud(j)=aksc_nucl(j,iti)*diff
20103 u(j)=abond0_nucl(j,iti)+0.5d0*ud(j)*diff
20117 uprod2=uprod2*u(k)*u(k)
20121 usumsqder=usumsqder+ud(j)*uprod2
20123 estr_nucl=estr_nucl+uprod/usum
20125 gradbx_nucl(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
20129 !C print *,"I am about to leave ebond"
20131 end subroutine ebond_nucl
20133 !-----------------------------------------------------------------------------
20134 subroutine ebend_nucl(etheta_nucl)
20135 real(kind=8),dimension(nntheterm_nucl+1) :: coskt,sinkt !mmaxtheterm
20136 real(kind=8),dimension(nsingle_nucl+1) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
20137 real(kind=8),dimension(ndouble_nucl+1,ndouble_nucl+1) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
20138 logical :: lprn=.false., lprn1=.false.
20139 !el local variables
20140 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
20141 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
20142 real(kind=8) :: aux,etheta_nucl,ccl,ssl,scl,csl,ethetacnstr
20143 ! local variables for constrains
20144 real(kind=8) :: difi,thetiii
20147 ! print *,"ithet_start",ithet_nucl_start," ithet_end",ithet_nucl_end,nres
20148 do i=ithet_nucl_start,ithet_nucl_end
20149 if ((itype(i-1,2).eq.ntyp1_molec(2)).or.&
20150 (itype(i-2,2).eq.ntyp1_molec(2)).or. &
20151 (itype(i,2).eq.ntyp1_molec(2))) cycle
20155 theti2=0.5d0*theta(i)
20156 ityp2=ithetyp_nucl(itype(i-1,2))
20157 do k=1,nntheterm_nucl
20158 coskt(k)=dcos(k*theti2)
20159 sinkt(k)=dsin(k*theti2)
20161 if (i.gt.3 .and. itype(i-2,2).ne.ntyp1_molec(2)) then
20164 if (phii.ne.phii) phii=150.0
20168 ityp1=ithetyp_nucl(itype(i-2,2))
20169 do k=1,nsingle_nucl
20170 cosph1(k)=dcos(k*phii)
20171 sinph1(k)=dsin(k*phii)
20175 ityp1=nthetyp_nucl+1
20176 do k=1,nsingle_nucl
20182 if (i.lt.nres .and. itype(i,2).ne.ntyp1_molec(2)) then
20185 if (phii1.ne.phii1) phii1=150.0
20186 phii1=pinorm(phii1)
20190 ityp3=ithetyp_nucl(itype(i,2))
20191 do k=1,nsingle_nucl
20192 cosph2(k)=dcos(k*phii1)
20193 sinph2(k)=dsin(k*phii1)
20197 ityp3=nthetyp_nucl+1
20198 do k=1,nsingle_nucl
20203 ethetai=aa0thet_nucl(ityp1,ityp2,ityp3)
20204 do k=1,ndouble_nucl
20206 ccl=cosph1(l)*cosph2(k-l)
20207 ssl=sinph1(l)*sinph2(k-l)
20208 scl=sinph1(l)*cosph2(k-l)
20209 csl=cosph1(l)*sinph2(k-l)
20210 cosph1ph2(l,k)=ccl-ssl
20211 cosph1ph2(k,l)=ccl+ssl
20212 sinph1ph2(l,k)=scl+csl
20213 sinph1ph2(k,l)=scl-csl
20217 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
20218 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
20219 write (iout,*) "coskt and sinkt",nntheterm_nucl
20220 do k=1,nntheterm_nucl
20221 write (iout,*) k,coskt(k),sinkt(k)
20224 do k=1,ntheterm_nucl
20225 ethetai=ethetai+aathet_nucl(k,ityp1,ityp2,ityp3)*sinkt(k)
20226 dethetai=dethetai+0.5d0*k*aathet_nucl(k,ityp1,ityp2,ityp3)&
20229 write (iout,*) "k",k," aathet",aathet_nucl(k,ityp1,ityp2,ityp3),&
20233 write (iout,*) "cosph and sinph"
20234 do k=1,nsingle_nucl
20235 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
20237 write (iout,*) "cosph1ph2 and sinph2ph2"
20238 do k=2,ndouble_nucl
20240 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
20241 sinph1ph2(l,k),sinph1ph2(k,l)
20244 write(iout,*) "ethetai",ethetai
20246 do m=1,ntheterm2_nucl
20247 do k=1,nsingle_nucl
20248 aux=bbthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)&
20249 +ccthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k)&
20250 +ddthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)&
20251 +eethet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k)
20252 ethetai=ethetai+sinkt(m)*aux
20253 dethetai=dethetai+0.5d0*m*aux*coskt(m)
20254 dephii=dephii+k*sinkt(m)*(&
20255 ccthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)-&
20256 bbthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k))
20257 dephii1=dephii1+k*sinkt(m)*(&
20258 eethet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)-&
20259 ddthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k))
20261 write (iout,*) "m",m," k",k," bbthet",&
20262 bbthet_nucl(k,m,ityp1,ityp2,ityp3)," ccthet",&
20263 ccthet_nucl(k,m,ityp1,ityp2,ityp3)," ddthet",&
20264 ddthet_nucl(k,m,ityp1,ityp2,ityp3)," eethet",&
20265 eethet_nucl(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
20269 write(iout,*) "ethetai",ethetai
20270 do m=1,ntheterm3_nucl
20271 do k=2,ndouble_nucl
20273 aux=ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
20274 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+&
20275 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
20276 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
20277 ethetai=ethetai+sinkt(m)*aux
20278 dethetai=dethetai+0.5d0*m*coskt(m)*aux
20279 dephii=dephii+l*sinkt(m)*(&
20280 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-&
20281 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
20282 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
20283 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
20284 dephii1=dephii1+(k-l)*sinkt(m)*( &
20285 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
20286 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
20287 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-&
20288 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
20290 write (iout,*) "m",m," k",k," l",l," ffthet", &
20291 ffthet_nucl(l,k,m,ityp1,ityp2,ityp3), &
20292 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ggthet",&
20293 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3),&
20294 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
20295 write (iout,*) cosph1ph2(l,k)*sinkt(m), &
20296 cosph1ph2(k,l)*sinkt(m),&
20297 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
20303 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
20304 i,theta(i)*rad2deg,phii*rad2deg, &
20305 phii1*rad2deg,ethetai
20306 etheta_nucl=etheta_nucl+ethetai
20307 ! print *,i,"partial sum",etheta_nucl
20308 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang_nucl*dephii
20309 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang_nucl*dephii1
20310 gloc(nphi+i-2,icg)=wang_nucl*dethetai
20313 end subroutine ebend_nucl
20314 !----------------------------------------------------
20315 subroutine etor_nucl(etors_nucl)
20316 ! implicit real*8 (a-h,o-z)
20317 ! include 'DIMENSIONS'
20318 ! include 'COMMON.VAR'
20319 ! include 'COMMON.GEO'
20320 ! include 'COMMON.LOCAL'
20321 ! include 'COMMON.TORSION'
20322 ! include 'COMMON.INTERACT'
20323 ! include 'COMMON.DERIV'
20324 ! include 'COMMON.CHAIN'
20325 ! include 'COMMON.NAMES'
20326 ! include 'COMMON.IOUNITS'
20327 ! include 'COMMON.FFIELD'
20328 ! include 'COMMON.TORCNSTR'
20329 ! include 'COMMON.CONTROL'
20330 real(kind=8) :: etors_nucl,edihcnstr
20332 !el local variables
20333 integer :: i,j,iblock,itori,itori1
20334 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
20335 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
20336 ! Set lprn=.true. for debugging
20340 ! print *,"iphi_nucl_start/end", iphi_nucl_start,iphi_nucl_end
20341 do i=iphi_nucl_start,iphi_nucl_end
20342 if (itype(i-2,2).eq.ntyp1_molec(2) .or. itype(i-1,2).eq.ntyp1_molec(2) &
20343 .or. itype(i-3,2).eq.ntyp1_molec(2) &
20344 .or. itype(i,2).eq.ntyp1_molec(2)) cycle
20346 itori=itortyp_nucl(itype(i-2,2))
20347 itori1=itortyp_nucl(itype(i-1,2))
20349 ! print *,i,itori,itori1
20351 !C Regular cosine and sine terms
20352 do j=1,nterm_nucl(itori,itori1)
20353 v1ij=v1_nucl(j,itori,itori1)
20354 v2ij=v2_nucl(j,itori,itori1)
20355 cosphi=dcos(j*phii)
20356 sinphi=dsin(j*phii)
20357 etors_nucl=etors_nucl+v1ij*cosphi+v2ij*sinphi
20358 if (energy_dec) etors_ii=etors_ii+&
20359 v1ij*cosphi+v2ij*sinphi
20360 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
20364 !C E = SUM ----------------------------------- - v1
20365 !C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
20367 cosphi=dcos(0.5d0*phii)
20368 sinphi=dsin(0.5d0*phii)
20369 do j=1,nlor_nucl(itori,itori1)
20370 vl1ij=vlor1_nucl(j,itori,itori1)
20371 vl2ij=vlor2_nucl(j,itori,itori1)
20372 vl3ij=vlor3_nucl(j,itori,itori1)
20373 pom=vl2ij*cosphi+vl3ij*sinphi
20374 pom1=1.0d0/(pom*pom+1.0d0)
20375 etors_nucl=etors_nucl+vl1ij*pom1
20376 if (energy_dec) etors_ii=etors_ii+ &
20379 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
20381 !C Subtract the constant term
20382 etors_nucl=etors_nucl-v0_nucl(itori,itori1)
20383 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
20384 'etor',i,etors_ii-v0_nucl(itori,itori1)
20386 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
20387 restyp(itype(i-2,2),2),i-2,restyp(itype(i-1,2),2),i-1,itori,itori1, &
20388 (v1_nucl(j,itori,itori1),j=1,6),(v2_nucl(j,itori,itori1),j=1,6)
20389 gloc(i-3,icg)=gloc(i-3,icg)+wtor_nucl*gloci
20390 !c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
20393 end subroutine etor_nucl
20394 !------------------------------------------------------------
20395 subroutine epp_nucl_sub(evdw1,ees)
20397 !C This subroutine calculates the average interaction energy and its gradient
20398 !C in the virtual-bond vectors between non-adjacent peptide groups, based on
20399 !C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
20400 !C The potential depends both on the distance of peptide-group centers and on
20401 !C the orientation of the CA-CA virtual bonds.
20403 integer :: i,j,k,iteli,itelj,num_conti,isubchap,ind
20404 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
20405 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
20406 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
20407 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
20408 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20409 dist_temp, dist_init,sss_grad,fac,evdw1ij
20410 integer xshift,yshift,zshift
20411 real(kind=8),dimension(3):: ggg,gggp,gggm,erij
20412 real(kind=8) :: ees,eesij
20413 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
20414 real(kind=8) scal_el /0.5d0/
20420 !c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
20422 print *,"iatel_s_nucl,iatel_e_nucl",iatel_s_nucl,iatel_e_nucl
20423 do i=iatel_s_nucl,iatel_e_nucl
20424 if (itype(i,2).eq.ntyp1_molec(2) .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
20428 dx_normi=dc_norm(1,i)
20429 dy_normi=dc_norm(2,i)
20430 dz_normi=dc_norm(3,i)
20431 xmedi=c(1,i)+0.5d0*dxi
20432 ymedi=c(2,i)+0.5d0*dyi
20433 zmedi=c(3,i)+0.5d0*dzi
20434 xmedi=dmod(xmedi,boxxsize)
20435 if (xmedi.lt.0) xmedi=xmedi+boxxsize
20436 ymedi=dmod(ymedi,boxysize)
20437 if (ymedi.lt.0) ymedi=ymedi+boxysize
20438 zmedi=dmod(zmedi,boxzsize)
20439 if (zmedi.lt.0) zmedi=zmedi+boxzsize
20441 do j=ielstart_nucl(i),ielend_nucl(i)
20442 if (itype(j,2).eq.ntyp1_molec(2) .or. itype(j+1,2).eq.ntyp1_molec(2)) cycle
20447 ! xj=c(1,j)+0.5D0*dxj-xmedi
20448 ! yj=c(2,j)+0.5D0*dyj-ymedi
20449 ! zj=c(3,j)+0.5D0*dzj-zmedi
20450 xj=c(1,j)+0.5D0*dxj
20451 yj=c(2,j)+0.5D0*dyj
20452 zj=c(3,j)+0.5D0*dzj
20453 xj=mod(xj,boxxsize)
20454 if (xj.lt.0) xj=xj+boxxsize
20455 yj=mod(yj,boxysize)
20456 if (yj.lt.0) yj=yj+boxysize
20457 zj=mod(zj,boxzsize)
20458 if (zj.lt.0) zj=zj+boxzsize
20460 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
20467 xj=xj_safe+xshift*boxxsize
20468 yj=yj_safe+yshift*boxysize
20469 zj=zj_safe+zshift*boxzsize
20470 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
20471 if(dist_temp.lt.dist_init) then
20472 dist_init=dist_temp
20481 if (isubchap.eq.1) then
20492 rij=xj*xj+yj*yj+zj*zj
20493 !c write (2,*)"ij",i,j," r0pp",r0pp," rij",rij," epspp",epspp
20494 fac=(r0pp**2/rij)**3
20498 fac=(-ev1-evdw1ij)/rij
20499 ! write (2,*)"fac",fac," ev1",ev1," ev2",ev2," evdw1ij",evdw1ij
20500 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"evdw1ij",evdw1ij
20501 evdw1=evdw1+evdw1ij
20503 !C Calculate contributions to the Cartesian gradient.
20509 gvdwpp_nucl(k,i)=gvdwpp_nucl(k,i)-ggg(k)
20510 gvdwpp_nucl(k,j)=gvdwpp_nucl(k,j)+ggg(k)
20512 !c phoshate-phosphate electrostatic interactions
20515 eesij=dexp(-BEES*rij)*fac
20516 ! write (2,*)"fac",fac," eesijpp",eesij
20517 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"eesijpp",eesij
20520 fac=-(fac+BEES)*eesij*fac
20524 !c write(2,*) "ggg",i,j,ggg(1),ggg(2),ggg(3)
20525 !c write(2,*) "gelpp",i,(gelpp(k,i),k=1,3)
20526 !c write(2,*) "gelpp",j,(gelpp(k,j),k=1,3)
20528 gelpp(k,i)=gelpp(k,i)-ggg(k)
20529 gelpp(k,j)=gelpp(k,j)+ggg(k)
20536 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
20538 gvdwpp_nucl(k,i)=6*gvdwpp_nucl(k,i)
20539 !c gelpp(k,i)=332.0d0*gelpp(k,i)
20540 gelpp(k,i)=AEES*gelpp(k,i)
20542 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
20544 !c write (2,*) "total EES",ees
20546 end subroutine epp_nucl_sub
20547 !---------------------------------------------------------------------
20548 subroutine epsb(evdwpsb,eelpsb)
20551 !C This subroutine calculates the excluded-volume interaction energy between
20552 !C peptide-group centers and side chains and its gradient in virtual-bond and
20553 !C side-chain vectors.
20555 real(kind=8),dimension(3):: ggg
20556 integer :: i,iint,j,k,iteli,itypj,subchap
20557 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
20558 e1,e2,evdwij,rij,evdwpsb,eelpsb
20559 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20560 dist_temp, dist_init
20561 integer xshift,yshift,zshift
20563 !cd print '(a)','Enter ESCP'
20564 !cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
20567 ! print *,"iatscp_s_nucl,iatscp_e_nucl",iatscp_s_nucl,iatscp_e_nucl
20568 do i=iatscp_s_nucl,iatscp_e_nucl
20569 if (itype(i,2).eq.ntyp1_molec(2) &
20570 .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
20571 xi=0.5D0*(c(1,i)+c(1,i+1))
20572 yi=0.5D0*(c(2,i)+c(2,i+1))
20573 zi=0.5D0*(c(3,i)+c(3,i+1))
20574 xi=mod(xi,boxxsize)
20575 if (xi.lt.0) xi=xi+boxxsize
20576 yi=mod(yi,boxysize)
20577 if (yi.lt.0) yi=yi+boxysize
20578 zi=mod(zi,boxzsize)
20579 if (zi.lt.0) zi=zi+boxzsize
20581 do iint=1,nscp_gr_nucl(i)
20583 do j=iscpstart_nucl(i,iint),iscpend_nucl(i,iint)
20585 if (itypj.eq.ntyp1_molec(2)) cycle
20586 !C Uncomment following three lines for SC-p interactions
20587 !c xj=c(1,nres+j)-xi
20588 !c yj=c(2,nres+j)-yi
20589 !c zj=c(3,nres+j)-zi
20590 !C Uncomment following three lines for Ca-p interactions
20597 xj=mod(xj,boxxsize)
20598 if (xj.lt.0) xj=xj+boxxsize
20599 yj=mod(yj,boxysize)
20600 if (yj.lt.0) yj=yj+boxysize
20601 zj=mod(zj,boxzsize)
20602 if (zj.lt.0) zj=zj+boxzsize
20603 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20611 xj=xj_safe+xshift*boxxsize
20612 yj=yj_safe+yshift*boxysize
20613 zj=zj_safe+zshift*boxzsize
20614 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20615 if(dist_temp.lt.dist_init) then
20616 dist_init=dist_temp
20625 if (subchap.eq.1) then
20635 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
20637 e1=fac*fac*aad_nucl(itypj)
20638 e2=fac*bad_nucl(itypj)
20639 if (iabs(j-i) .le. 2) then
20644 evdwpsb=evdwpsb+evdwij
20645 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a4)') &
20646 'evdw2',i,j,evdwij,"tu4"
20648 !C Calculate contributions to the gradient in the virtual-bond and SC vectors.
20650 fac=-(evdwij+e1)*rrij
20655 gvdwpsb1(k,i)=gvdwpsb1(k,i)-ggg(k)
20656 gvdwpsb(k,j)=gvdwpsb(k,j)+ggg(k)
20664 gvdwpsb(j,i)=expon*gvdwpsb(j,i)
20665 gvdwpsb1(j,i)=expon*gvdwpsb1(j,i)
20669 end subroutine epsb
20671 !------------------------------------------------------
20672 subroutine esb_gb(evdwsb,eelsb)
20675 integer :: iint,itypi,itypi1,itypj,subchap,num_conti2
20676 real(kind=8) :: xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
20677 real(kind=8) :: evdw,sig0iji,evdwsb,eelsb,ecorr,eelij
20678 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20679 dist_temp, dist_init,aa,bb,faclip,sig0ij
20688 ! print *,"iastsc_nucl",iatsc_s_nucl,iatsc_e_nucl
20689 do i=iatsc_s_nucl,iatsc_e_nucl
20693 ! PRINT *,"I=",i,itypi
20694 if (itypi.eq.ntyp1_molec(2)) cycle
20695 itypi1=itype(i+1,2)
20699 xi=dmod(xi,boxxsize)
20700 if (xi.lt.0) xi=xi+boxxsize
20701 yi=dmod(yi,boxysize)
20702 if (yi.lt.0) yi=yi+boxysize
20703 zi=dmod(zi,boxzsize)
20704 if (zi.lt.0) zi=zi+boxzsize
20706 dxi=dc_norm(1,nres+i)
20707 dyi=dc_norm(2,nres+i)
20708 dzi=dc_norm(3,nres+i)
20709 dsci_inv=vbld_inv(i+nres)
20711 !C Calculate SC interaction energy.
20713 do iint=1,nint_gr_nucl(i)
20714 ! print *,"tu?",i,istart_nucl(i,iint),iend_nucl(i,iint)
20715 do j=istart_nucl(i,iint),iend_nucl(i,iint)
20719 if (itypj.eq.ntyp1_molec(2)) cycle
20720 dscj_inv=vbld_inv(j+nres)
20721 sig0ij=sigma_nucl(itypi,itypj)
20722 chi1=chi_nucl(itypi,itypj)
20723 chi2=chi_nucl(itypj,itypi)
20725 chip1=chip_nucl(itypi,itypj)
20726 chip2=chip_nucl(itypj,itypi)
20728 ! xj=c(1,nres+j)-xi
20729 ! yj=c(2,nres+j)-yi
20730 ! zj=c(3,nres+j)-zi
20734 xj=dmod(xj,boxxsize)
20735 if (xj.lt.0) xj=xj+boxxsize
20736 yj=dmod(yj,boxysize)
20737 if (yj.lt.0) yj=yj+boxysize
20738 zj=dmod(zj,boxzsize)
20739 if (zj.lt.0) zj=zj+boxzsize
20740 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20748 xj=xj_safe+xshift*boxxsize
20749 yj=yj_safe+yshift*boxysize
20750 zj=zj_safe+zshift*boxzsize
20751 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20752 if(dist_temp.lt.dist_init) then
20753 dist_init=dist_temp
20762 if (subchap.eq.1) then
20772 dxj=dc_norm(1,nres+j)
20773 dyj=dc_norm(2,nres+j)
20774 dzj=dc_norm(3,nres+j)
20775 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
20777 !C Calculate angle-dependent terms of energy and contributions to their
20782 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
20783 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
20784 om12=dxi*dxj+dyi*dyj+dzi*dzj
20785 call sc_angular_nucl
20787 sig=sig0ij*dsqrt(sigsq)
20788 rij_shift=1.0D0/rij-sig+sig0ij
20789 ! print *,rij_shift,"rij_shift"
20790 !c write (2,*) " rij",1.0D0/rij," sig",sig," sig0ij",sig0ij,
20791 !c & " rij_shift",rij_shift
20792 if (rij_shift.le.0.0D0) then
20797 !c---------------------------------------------------------------
20798 rij_shift=1.0D0/rij_shift
20799 fac=rij_shift**expon
20800 e1=fac*fac*aa_nucl(itypi,itypj)
20801 e2=fac*bb_nucl(itypi,itypj)
20802 evdwij=eps1*eps2rt*(e1+e2)
20803 !c write (2,*) "eps1",eps1," eps2rt",eps2rt,
20804 !c & " e1",e1," e2",e2," evdwij",evdwij
20806 evdwij=evdwij*eps2rt
20807 evdwsb=evdwsb+evdwij
20809 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
20810 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
20811 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
20812 restyp(itypi,2),i,restyp(itypj,2),j, &
20813 epsi,sigm,chi1,chi2,chip1,chip2, &
20814 eps1,eps2rt**2,sig,sig0ij, &
20815 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
20817 write (iout,*) "aa",aa_nucl(itypi,itypj)," bb",bb_nucl(itypi,itypj)
20820 if (energy_dec) write (iout,'(a6,2i5,e15.3,a4)') &
20821 'evdw',i,j,evdwij,"tu3"
20824 !C Calculate gradient components.
20825 e1=e1*eps1*eps2rt**2
20826 fac=-expon*(e1+evdwij)*rij_shift
20830 !C Calculate the radial part of the gradient
20834 !C Calculate angular part of the gradient.
20836 call eelsbij(eelij,num_conti2)
20837 if (energy_dec .and. &
20838 (j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2)) &
20839 write (istat,'(e14.5)') evdwij
20843 num_cont_hb(i)=num_conti2
20845 !c write (iout,*) "Number of loop steps in EGB:",ind
20846 !cccc energy_dec=.false.
20848 end subroutine esb_gb
20849 !-------------------------------------------------------------------------------
20850 subroutine eelsbij(eesij,num_conti2)
20853 real(kind=8),dimension(3) :: ggg,gggp,gggm,dcosb,dcosg
20854 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
20855 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20856 dist_temp, dist_init,rlocshield,fracinbuf
20857 integer xshift,yshift,zshift,ilist,iresshield,num_conti2
20859 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
20860 real(kind=8) scal_el /0.5d0/
20861 integer :: iteli,itelj,kkk,kkll,m,isubchap
20862 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp,facfac
20863 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i,ael63i,ael32i
20864 real(kind=8) :: dx_normj,dy_normj,dz_normj,&
20865 r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,fac5,fac6,&
20866 el1,el2,el3,el4,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
20867 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
20868 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
20869 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
20870 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
20871 ecosgp,ecosam,ecosbm,ecosgm,ghalf,itypi,itypj
20875 ! print *,i,j,itypi,itypj,istype(i),istype(j),"????"
20876 ael6i=ael6_nucl(itypi,itypj)
20877 ael3i=ael3_nucl(itypi,itypj)
20878 ael63i=ael63_nucl(itypi,itypj)
20879 ael32i=ael32_nucl(itypi,itypj)
20880 !c write (iout,*) "eelecij",i,j,itype(i),itype(j),
20881 !c & ael6i,ael3i,ael63i,al32i,rij,rrij
20885 dx_normi=dc_norm(1,i+nres)
20886 dy_normi=dc_norm(2,i+nres)
20887 dz_normi=dc_norm(3,i+nres)
20888 dx_normj=dc_norm(1,j+nres)
20889 dy_normj=dc_norm(2,j+nres)
20890 dz_normj=dc_norm(3,j+nres)
20891 !c xj=c(1,j)+0.5D0*dxj-xmedi
20892 !c yj=c(2,j)+0.5D0*dyj-ymedi
20893 !c zj=c(3,j)+0.5D0*dzj-zmedi
20894 if (ipot_nucl.ne.2) then
20895 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
20896 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
20897 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
20905 fac=cosa-3.0D0*cosb*cosg
20907 fac1=3.0d0*(cosb*cosb+cosg*cosg)
20912 !c write (iout,*) "r3ij",r3ij," r6ij",r6ij," fac",fac," fac1",fac1,
20913 !c & " fac2",fac2," fac3",fac3," fac4",fac4," fac5",fac5," fac6",fac6
20914 el1=fac3*(4.0D0+facfac-fac1)
20916 el3=fac5*(2.0d0-2.0d0*facfac+fac1)
20918 eesij=el1+el2+el3+el4
20919 !C 12/26/95 - for the evaluation of multi-body H-bonding interactions
20920 ees0ij=4.0D0+facfac-fac1
20922 if (energy_dec) then
20923 if(j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2) &
20924 write (istat,'(2a1,i4,1x,2a1,i4,4f10.5,3e12.5,$)') &
20925 sugartyp(istype(i)),restyp(itypi,2),i,sugartyp(istype(j)),&
20926 restyp(itypj,2),j,1.0d0/rij,cosa,cosb,cosg,fac*r3ij, &
20927 (4.0D0+facfac-fac1)*r6ij,(2.0d0-2.0d0*facfac+fac1)*r6ij
20928 write (iout,'(a6,2i5,e15.3)') 'ees',i,j,eesij
20932 !C Calculate contributions to the Cartesian gradient.
20934 facel=-3.0d0*rrij*(eesij+el1+el3+el4)
20940 !* Radial derivatives. First process both termini of the fragment (i,j)
20946 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
20947 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
20948 gelsbx(k,j)=gelsbx(k,j)+ggg(k)
20949 gelsbx(k,i)=gelsbx(k,i)-ggg(k)
20954 ecosa=2.0D0*fac3*fac1+fac4+(-4.0d0*fac5+2.0d0*fac6)*fac1
20959 ecosb=fac3*(fac1*cosg+cosb)+cosg*fac4+(cosb+2*fac1*cosg)*fac5+&
20961 ecosg=fac3*(fac1*cosb+cosg)+cosb*fac4+(cosg+2*fac1*cosb)*fac5+&
20964 dcosb(k)=rij*(dc_norm(k,i+nres)-erij(k)*cosb)
20965 dcosg(k)=rij*(dc_norm(k,j+nres)-erij(k)*cosg)
20968 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
20971 gelsbx(k,i)=gelsbx(k,i)-ggg(k) &
20972 +(ecosa*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres))&
20973 + ecosb*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
20974 gelsbx(k,j)=gelsbx(k,j)+ggg(k) &
20975 +(ecosa*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
20976 + ecosg*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
20977 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
20978 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
20980 ! IF ( (wcorr_nucl.gt.0.0d0.or.wcorr3_nucl.gt.0.0d0) .and.
20981 IF ( j.gt.i+1 .and.&
20982 num_conti.le.maxconts) THEN
20984 !C Calculate the contact function. The ith column of the array JCONT will
20985 !C contain the numbers of atoms that make contacts with the atom I (of numbers
20986 !C greater than I). The arrays FACONT and GACONT will contain the values of
20987 !C the contact function and its derivative.
20988 r0ij=2.20D0*sigma(itypi,itypj)
20989 !c write (2,*) "ij",i,j," rij",1.0d0/rij," r0ij",r0ij
20990 call gcont(rij,r0ij,1.0D0,0.2d0/r0ij,fcont,fprimcont)
20991 !c write (2,*) "fcont",fcont
20992 if (fcont.gt.0.0D0) then
20993 num_conti=num_conti+1
20994 num_conti2=num_conti2+1
20996 if (num_conti.gt.maxconts) then
20997 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
20998 ' will skip next contacts for this conf.'
21000 jcont_hb(num_conti,i)=j
21001 !c write (iout,*) "num_conti",num_conti,
21002 !c & " jcont_hb",jcont_hb(num_conti,i)
21003 !C Calculate contact energies
21005 wij=cosa-3.0D0*cosb*cosg
21008 fac3=dsqrt(-ael6i)*r3ij
21009 !c write (2,*) "ael6i",ael6i," r3ij",r3ij," fac3",fac3
21010 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
21011 if (ees0tmp.gt.0) then
21012 ees0pij=dsqrt(ees0tmp)
21016 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
21017 if (ees0tmp.gt.0) then
21018 ees0mij=dsqrt(ees0tmp)
21022 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
21023 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
21024 !c write (iout,*) "i",i," j",j,
21025 !c & " ees0m",ees0m(num_conti,i)," ees0p",ees0p(num_conti,i)
21026 ees0pij1=fac3/ees0pij
21027 ees0mij1=fac3/ees0mij
21028 fac3p=-3.0D0*fac3*rrij
21029 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
21030 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
21031 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
21032 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
21033 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
21034 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
21035 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
21036 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
21037 ecosap=ecosa1+ecosa2
21038 ecosbp=ecosb1+ecosb2
21039 ecosgp=ecosg1+ecosg2
21040 ecosam=ecosa1-ecosa2
21041 ecosbm=ecosb1-ecosb2
21042 ecosgm=ecosg1-ecosg2
21044 facont_hb(num_conti,i)=fcont
21045 fprimcont=fprimcont/rij
21047 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
21048 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
21050 gggp(1)=gggp(1)+ees0pijp*xj
21051 gggp(2)=gggp(2)+ees0pijp*yj
21052 gggp(3)=gggp(3)+ees0pijp*zj
21053 gggm(1)=gggm(1)+ees0mijp*xj
21054 gggm(2)=gggm(2)+ees0mijp*yj
21055 gggm(3)=gggm(3)+ees0mijp*zj
21056 !C Derivatives due to the contact function
21057 gacont_hbr(1,num_conti,i)=fprimcont*xj
21058 gacont_hbr(2,num_conti,i)=fprimcont*yj
21059 gacont_hbr(3,num_conti,i)=fprimcont*zj
21062 !c Gradient of the correlation terms
21064 gacontp_hb1(k,num_conti,i)= &
21065 (ecosap*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
21066 + ecosbp*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21067 gacontp_hb2(k,num_conti,i)= &
21068 (ecosap*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres)) &
21069 + ecosgp*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21070 gacontp_hb3(k,num_conti,i)=gggp(k)
21071 gacontm_hb1(k,num_conti,i)= &
21072 (ecosam*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
21073 + ecosbm*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21074 gacontm_hb2(k,num_conti,i)= &
21075 (ecosam*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
21076 + ecosgm*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21077 gacontm_hb3(k,num_conti,i)=gggm(k)
21083 end subroutine eelsbij
21084 !------------------------------------------------------------------
21085 subroutine sc_grad_nucl
21088 real(kind=8),dimension(3) :: dcosom1,dcosom2
21089 eom1=eps2der*eps2rt_om1+sigder*sigsq_om1
21090 eom2=eps2der*eps2rt_om2+sigder*sigsq_om2
21091 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12+sigder*sigsq_om12
21093 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
21094 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
21097 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
21100 gvdwsbx(k,i)=gvdwsbx(k,i)-gg(k) &
21101 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
21102 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
21103 gvdwsbx(k,j)=gvdwsbx(k,j)+gg(k) &
21104 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
21105 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
21108 !C Calculate the components of the gradient in DC and X
21111 gvdwsbc(l,i)=gvdwsbc(l,i)-gg(l)
21112 gvdwsbc(l,j)=gvdwsbc(l,j)+gg(l)
21115 end subroutine sc_grad_nucl
21116 !-----------------------------------------------------------------------
21117 subroutine esb(esbloc)
21118 !C Calculate the local energy of a side chain and its derivatives in the
21119 !C corresponding virtual-bond valence angles THETA and the spherical angles
21120 !C ALPHA and OMEGA derived from AM1 all-atom calculations.
21121 !C added by Urszula Kozlowska. 07/11/2007
21123 real(kind=8),dimension(3):: x_prime,y_prime,z_prime
21124 real(kind=8),dimension(9):: x
21125 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1, &
21126 sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,&
21127 de_dxx,de_dyy,de_dzz,de_dt,s1_t,s1_6_t,s2_t,s2_6_t
21128 real(kind=8),dimension(3):: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,&
21129 dYY_Ci,dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
21130 real(kind=8) :: esbloc,delta,cosfac2,cosfac,sinfac2,sinfac,de_dtt,&
21131 cossc,cossc1,cosfac2xx,sinfac2yy,pom1,pom
21132 integer::it,nlobit,i,j,k
21133 ! common /sccalc/ time11,time12,time112,theti,it,nlobit
21136 do i=loc_start_nucl,loc_end_nucl
21137 if (itype(i,2).eq.ntyp1_molec(2)) cycle
21138 costtab(i+1) =dcos(theta(i+1))
21139 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
21140 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
21141 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
21142 cosfac2=0.5d0/(1.0d0+costtab(i+1))
21143 cosfac=dsqrt(cosfac2)
21144 sinfac2=0.5d0/(1.0d0-costtab(i+1))
21145 sinfac=dsqrt(sinfac2)
21147 if (it.eq.10) goto 1
21150 !C Compute the axes of tghe local cartesian coordinates system; store in
21151 !c x_prime, y_prime and z_prime
21158 !C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
21159 !C & dc_norm(3,i+nres)
21161 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
21162 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
21165 z_prime(j) = -uz(j,i-1)
21173 xx = xx + x_prime(j)*dc_norm(j,i+nres)
21174 yy = yy + y_prime(j)*dc_norm(j,i+nres)
21175 zz = zz + z_prime(j)*dc_norm(j,i+nres)
21183 x(j) = sc_parmin_nucl(j,it)
21186 !Cc diagnostics - remove later
21187 xx1 = dcos(alph(2))
21188 yy1 = dsin(alph(2))*dcos(omeg(2))
21189 zz1 = -dsin(alph(2))*dsin(omeg(2))
21190 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
21191 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
21193 !C," --- ", xx_w,yy_w,zz_w
21196 sumene = enesc_nucl(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21197 esbloc = esbloc + sumene
21198 sumene2= enesc_nucl(x,xx,yy,0.0d0,cost2tab(i+1),sint2tab(i+1))
21199 ! print *,"enecomp",sumene,sumene2
21200 ! if (energy_dec) write(iout,*) "i",i," esbloc",sumene,esbloc,xx,yy,zz
21201 ! if (energy_dec) write(iout,*) "x",(x(k),k=1,9)
21203 write (2,*) "x",(x(k),k=1,9)
21205 !C This section to check the numerical derivatives of the energy of ith side
21206 !C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
21207 !C #define DEBUG in the code to turn it on.
21209 write (2,*) "sumene =",sumene
21213 write (2,*) xx,yy,zz
21214 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21215 de_dxx_num=(sumenep-sumene)/aincr
21217 write (2,*) "xx+ sumene from enesc=",sumenep,sumene
21220 write (2,*) xx,yy,zz
21221 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21222 de_dyy_num=(sumenep-sumene)/aincr
21224 write (2,*) "yy+ sumene from enesc=",sumenep,sumene
21227 write (2,*) xx,yy,zz
21228 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21229 de_dzz_num=(sumenep-sumene)/aincr
21231 write (2,*) "zz+ sumene from enesc=",sumenep,sumene
21232 costsave=cost2tab(i+1)
21233 sintsave=sint2tab(i+1)
21234 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
21235 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
21236 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21237 de_dt_num=(sumenep-sumene)/aincr
21238 write (2,*) " t+ sumene from enesc=",sumenep,sumene
21239 cost2tab(i+1)=costsave
21240 sint2tab(i+1)=sintsave
21241 !C End of diagnostics section.
21244 !C Compute the gradient of esc
21246 de_dxx=x(1)+2*x(4)*xx+x(7)*zz+x(8)*yy
21247 de_dyy=x(2)+2*x(5)*yy+x(8)*xx+x(9)*zz
21248 de_dzz=x(3)+2*x(6)*zz+x(7)*xx+x(9)*yy
21251 write (2,*) "x",(x(k),k=1,9)
21252 write (2,*) "xx",xx," yy",yy," zz",zz
21253 write (2,*) "de_xx ",de_xx," de_yy ",de_yy,&
21254 " de_zz ",de_zz," de_tt ",de_tt
21255 write (2,*) "de_xx_num",de_dxx_num," de_yy_num",de_dyy_num,&
21256 " de_zz_num",de_dzz_num," de_dt_num",de_dt_num
21259 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
21260 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
21261 cosfac2xx=cosfac2*xx
21262 sinfac2yy=sinfac2*yy
21264 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*&
21266 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*&
21268 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
21269 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
21270 !c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
21271 !c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
21272 !c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
21273 !c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
21274 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
21275 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
21276 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
21277 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
21281 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
21282 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
21285 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
21286 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
21287 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
21289 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
21290 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
21294 dXX_Ctab(k,i)=dXX_Ci(k)
21295 dXX_C1tab(k,i)=dXX_Ci1(k)
21296 dYY_Ctab(k,i)=dYY_Ci(k)
21297 dYY_C1tab(k,i)=dYY_Ci1(k)
21298 dZZ_Ctab(k,i)=dZZ_Ci(k)
21299 dZZ_C1tab(k,i)=dZZ_Ci1(k)
21300 dXX_XYZtab(k,i)=dXX_XYZ(k)
21301 dYY_XYZtab(k,i)=dYY_XYZ(k)
21302 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
21305 !c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
21306 !c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
21307 !c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
21308 !c & dyy_ci(k)," dzz_ci",dzz_ci(k)
21309 !c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
21311 !c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
21312 !c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
21313 gsbloc(k,i-1)=gsbloc(k,i-1)+(de_dxx*dxx_ci1(k) &
21314 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k))
21315 gsbloc(k,i)=gsbloc(k,i)+(de_dxx*dxx_Ci(k) &
21316 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k))
21317 gsblocx(k,i)= de_dxx*dxx_XYZ(k)&
21318 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
21319 ! print *,i,de_dxx*dxx_ci1(k)+de_dyy*dyy_ci1(k),de_dzz*dzz_ci1(k)*2
21321 !c write(iout,*) "ENERGY GRAD = ", (gsbloc(k,i-1),k=1,3),
21322 !c & (gsbloc(k,i),k=1,3),(gsblocx(k,i),k=1,3)
21324 !C to check gradient call subroutine check_grad
21330 !=-------------------------------------------------------
21331 real(kind=8) function enesc_nucl(x,xx,yy,zz,cost2,sint2)
21333 real(kind=8),dimension(9):: x(9)
21334 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2, &
21335 sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
21337 !c write (2,*) "enesc"
21338 !c write (2,*) "x",(x(i),i=1,9)
21339 !c write(2,*)"xx",xx," yy",yy," zz",zz," cost2",cost2," sint2",sint2
21340 sumene=x(1)*xx+x(2)*yy+x(3)*zz+x(4)*xx**2 &
21341 + x(5)*yy**2+x(6)*zz**2+x(7)*xx*zz+x(8)*xx*yy &
21345 end function enesc_nucl
21346 !-----------------------------------------------------------------------------
21347 subroutine multibody_hb_nucl(ecorr,ecorr3,n_corr,n_corr1)
21350 integer,parameter :: max_cont=2000
21351 integer,parameter:: max_dim=2*(8*3+6)
21352 integer, parameter :: msglen1=max_cont*max_dim
21353 integer,parameter :: msglen2=2*msglen1
21354 integer source,CorrelType,CorrelID,Error
21355 real(kind=8) :: buffer(max_cont,max_dim)
21356 integer status(MPI_STATUS_SIZE)
21357 integer :: ierror,nbytes
21359 real(kind=8),dimension(3):: gx(3),gx1(3)
21360 real(kind=8) :: time00
21362 integer i,j,i1,j1,jj,kk,num_conti,num_conti1,nn
21363 real(kind=8) ecorr,ecorr3
21364 integer :: n_corr,n_corr1,mm,msglen
21365 !C Set lprn=.true. for debugging
21370 if(.not.allocated(zapas2)) allocate(zapas2(3,maxconts,nres,8))
21372 if (nfgtasks.le.1) goto 30
21374 write (iout,'(a)') 'Contact function values:'
21376 write (iout,'(2i3,50(1x,i2,f5.2))') &
21377 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
21378 j=1,num_cont_hb(i))
21381 !C Caution! Following code assumes that electrostatic interactions concerning
21382 !C a given atom are split among at most two processors!
21392 !c write (*,*) 'MyRank',MyRank,' mm',mm
21395 !c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
21396 if (fg_rank.gt.0) then
21397 !C Send correlation contributions to the preceding processor
21399 nn=num_cont_hb(iatel_s_nucl)
21400 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
21401 !c write (*,*) 'The BUFFER array:'
21403 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
21405 if (ielstart_nucl(iatel_s_nucl).gt.iatel_s_nucl+ispp) then
21407 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
21408 !C Clear the contacts of the atom passed to the neighboring processor
21409 nn=num_cont_hb(iatel_s_nucl+1)
21411 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
21413 num_cont_hb(iatel_s_nucl)=0
21415 !cd write (iout,*) 'Processor ',fg_rank,MyRank,
21416 !cd & ' is sending correlation contribution to processor',fg_rank-1,
21417 !cd & ' msglen=',msglen
21418 !c write (*,*) 'Processor ',fg_rank,MyRank,
21419 !c & ' is sending correlation contribution to processor',fg_rank-1,
21420 !c & ' msglen=',msglen,' CorrelType=',CorrelType
21422 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, &
21423 CorrelType,FG_COMM,IERROR)
21424 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
21425 !cd write (iout,*) 'Processor ',fg_rank,
21426 !cd & ' has sent correlation contribution to processor',fg_rank-1,
21427 !cd & ' msglen=',msglen,' CorrelID=',CorrelID
21428 !c write (*,*) 'Processor ',fg_rank,
21429 !c & ' has sent correlation contribution to processor',fg_rank-1,
21430 !c & ' msglen=',msglen,' CorrelID=',CorrelID
21432 endif ! (fg_rank.gt.0)
21436 !c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
21437 if (fg_rank.lt.nfgtasks-1) then
21438 !C Receive correlation contributions from the next processor
21440 if (ielend_nucl(iatel_e_nucl).lt.nct_molec(2)-1) msglen=msglen2
21441 !cd write (iout,*) 'Processor',fg_rank,
21442 !cd & ' is receiving correlation contribution from processor',fg_rank+1,
21443 !cd & ' msglen=',msglen,' CorrelType=',CorrelType
21444 !c write (*,*) 'Processor',fg_rank,
21445 !c &' is receiving correlation contribution from processor',fg_rank+1,
21446 !c & ' msglen=',msglen,' CorrelType=',CorrelType
21449 do while (nbytes.le.0)
21450 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
21451 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
21453 !c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
21454 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, &
21455 fg_rank+1,CorrelType,FG_COMM,status,IERROR)
21456 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
21457 !c write (*,*) 'Processor',fg_rank,
21458 !c &' has received correlation contribution from processor',fg_rank+1,
21459 !c & ' msglen=',msglen,' nbytes=',nbytes
21460 !c write (*,*) 'The received BUFFER array:'
21462 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
21464 if (msglen.eq.msglen1) then
21465 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,0,buffer)
21466 else if (msglen.eq.msglen2) then
21467 call unpack_buffer(max_cont,max_dim,iatel_e_nucl,0,buffer)
21468 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,30,buffer)
21471 'ERROR!!!! message length changed while processing correlations.'
21473 'ERROR!!!! message length changed while processing correlations.'
21474 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
21475 endif ! msglen.eq.msglen1
21476 endif ! fg_rank.lt.nfgtasks-1
21483 write (iout,'(a)') 'Contact function values:'
21484 do i=nnt_molec(2),nct_molec(2)-1
21485 write (iout,'(2i3,50(1x,i2,f5.2))') &
21486 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
21487 j=1,num_cont_hb(i))
21492 !C Remove the loop below after debugging !!!
21493 ! do i=nnt_molec(2),nct_molec(2)
21495 ! gradcorr_nucl(j,i)=0.0D0
21496 ! gradxorr_nucl(j,i)=0.0D0
21497 ! gradcorr3_nucl(j,i)=0.0D0
21498 ! gradxorr3_nucl(j,i)=0.0D0
21501 ! print *,"iatsc_s_nucl,iatsc_e_nucl",iatsc_s_nucl,iatsc_e_nucl
21502 !C Calculate the local-electrostatic correlation terms
21503 do i=iatsc_s_nucl,iatsc_e_nucl
21505 num_conti=num_cont_hb(i)
21506 num_conti1=num_cont_hb(i+1)
21507 ! print *,i,num_conti,num_conti1
21512 !c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
21513 !c & ' jj=',jj,' kk=',kk
21514 if (j1.eq.j+1 .or. j1.eq.j-1) then
21516 !C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
21517 !C The system gains extra energy.
21518 !C Tentative expression & coefficients; assumed d(stacking)=4.5 A,
21519 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
21520 !C Need to implement full formulas 34 and 35 from Liwo et al., 1998.
21522 ecorr=ecorr+ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
21523 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
21524 'ecorrh',i,j,ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
21526 else if (j1.eq.j) then
21528 !C Contacts I-J and I-(J+1) occur simultaneously.
21529 !C The system loses extra energy.
21530 !C Tentative expression & c?oefficients; assumed d(stacking)=4.5 A,
21531 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
21532 !C Need to implement full formulas 32 from Liwo et al., 1998.
21534 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
21535 !c & ' jj=',jj,' kk=',kk
21536 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i+1,j,jj,kk,0.310D0,-0.155D0)
21541 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
21542 !c & ' jj=',jj,' kk=',kk
21543 if (j1.eq.j+1) then
21544 !C Contacts I-J and (I+1)-J occur simultaneously.
21545 !C The system loses extra energy.
21546 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i,j+1,jj,kk,0.310D0,-0.155D0)
21552 end subroutine multibody_hb_nucl
21553 !-----------------------------------------------------------
21554 real(kind=8) function ehbcorr_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
21555 ! implicit real*8 (a-h,o-z)
21556 ! include 'DIMENSIONS'
21557 ! include 'COMMON.IOUNITS'
21558 ! include 'COMMON.DERIV'
21559 ! include 'COMMON.INTERACT'
21560 ! include 'COMMON.CONTACTS'
21561 real(kind=8),dimension(3) :: gx,gx1
21563 !el local variables
21564 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
21565 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
21566 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
21567 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
21571 eij=facont_hb(jj,i)
21572 ekl=facont_hb(kk,k)
21573 ees0pij=ees0p(jj,i)
21574 ees0pkl=ees0p(kk,k)
21575 ees0mij=ees0m(jj,i)
21576 ees0mkl=ees0m(kk,k)
21578 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
21579 ! print *,"ehbcorr_nucl",ekont,ees
21580 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
21581 !C Following 4 lines for diagnostics.
21586 !cd write (iout,*)'Contacts have occurred for nucleic bases',
21587 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
21588 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
21589 !C Calculate the multi-body contribution to energy.
21590 ! ecorr_nucl=ecorr_nucl+ekont*ees
21591 !C Calculate multi-body contributions to the gradient.
21592 coeffpees0pij=coeffp*ees0pij
21593 coeffmees0mij=coeffm*ees0mij
21594 coeffpees0pkl=coeffp*ees0pkl
21595 coeffmees0mkl=coeffm*ees0mkl
21597 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i) &
21598 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
21599 coeffmees0mkl*gacontm_hb1(ll,jj,i))
21600 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j) &
21601 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+&
21602 coeffmees0mkl*gacontm_hb2(ll,jj,i))
21603 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k) &
21604 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
21605 coeffmees0mij*gacontm_hb1(ll,kk,k))
21606 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l) &
21607 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
21608 coeffmees0mij*gacontm_hb2(ll,kk,k))
21609 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
21610 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
21611 coeffmees0mkl*gacontm_hb3(ll,jj,i))
21612 gradcorr_nucl(ll,j)=gradcorr_nucl(ll,j)+gradlongij
21613 gradcorr_nucl(ll,i)=gradcorr_nucl(ll,i)-gradlongij
21614 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
21615 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
21616 coeffmees0mij*gacontm_hb3(ll,kk,k))
21617 gradcorr_nucl(ll,l)=gradcorr_nucl(ll,l)+gradlongkl
21618 gradcorr_nucl(ll,k)=gradcorr_nucl(ll,k)-gradlongkl
21619 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i)-gradlongij
21620 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j)+gradlongij
21621 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k)-gradlongkl
21622 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l)+gradlongkl
21624 ehbcorr_nucl=ekont*ees
21626 end function ehbcorr_nucl
21627 !-------------------------------------------------------------------------
21629 real(kind=8) function ehbcorr3_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
21630 ! implicit real*8 (a-h,o-z)
21631 ! include 'DIMENSIONS'
21632 ! include 'COMMON.IOUNITS'
21633 ! include 'COMMON.DERIV'
21634 ! include 'COMMON.INTERACT'
21635 ! include 'COMMON.CONTACTS'
21636 real(kind=8),dimension(3) :: gx,gx1
21638 !el local variables
21639 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
21640 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
21641 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
21642 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
21646 eij=facont_hb(jj,i)
21647 ekl=facont_hb(kk,k)
21648 ees0pij=ees0p(jj,i)
21649 ees0pkl=ees0p(kk,k)
21650 ees0mij=ees0m(jj,i)
21651 ees0mkl=ees0m(kk,k)
21653 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
21654 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
21655 !C Following 4 lines for diagnostics.
21660 !cd write (iout,*)'Contacts have occurred for nucleic bases',
21661 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
21662 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
21663 !C Calculate the multi-body contribution to energy.
21664 ! ecorr=ecorr+ekont*ees
21665 !C Calculate multi-body contributions to the gradient.
21666 coeffpees0pij=coeffp*ees0pij
21667 coeffmees0mij=coeffm*ees0mij
21668 coeffpees0pkl=coeffp*ees0pkl
21669 coeffmees0mkl=coeffm*ees0mkl
21671 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i) &
21672 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
21673 coeffmees0mkl*gacontm_hb1(ll,jj,i))
21674 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j) &
21675 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
21676 coeffmees0mkl*gacontm_hb2(ll,jj,i))
21677 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k) &
21678 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ &
21679 coeffmees0mij*gacontm_hb1(ll,kk,k))
21680 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l) &
21681 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
21682 coeffmees0mij*gacontm_hb2(ll,kk,k))
21683 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
21684 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
21685 coeffmees0mkl*gacontm_hb3(ll,jj,i))
21686 gradcorr3_nucl(ll,j)=gradcorr3_nucl(ll,j)+gradlongij
21687 gradcorr3_nucl(ll,i)=gradcorr3_nucl(ll,i)-gradlongij
21688 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
21689 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
21690 coeffmees0mij*gacontm_hb3(ll,kk,k))
21691 gradcorr3_nucl(ll,l)=gradcorr3_nucl(ll,l)+gradlongkl
21692 gradcorr3_nucl(ll,k)=gradcorr3_nucl(ll,k)-gradlongkl
21693 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i)-gradlongij
21694 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j)+gradlongij
21695 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k)-gradlongkl
21696 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l)+gradlongkl
21698 ehbcorr3_nucl=ekont*ees
21700 end function ehbcorr3_nucl
21702 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
21703 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
21704 real(kind=8):: buffer(dimen1,dimen2)
21705 num_kont=num_cont_hb(atom)
21709 buffer(i,indx+(k-1)*3+j)=zapas2(j,i,atom,k)
21712 buffer(i,indx+25)=facont_hb(i,atom)
21713 buffer(i,indx+26)=ees0p(i,atom)
21714 buffer(i,indx+27)=ees0m(i,atom)
21715 buffer(i,indx+28)=d_cont(i,atom)
21716 buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
21718 buffer(1,indx+30)=dfloat(num_kont)
21720 end subroutine pack_buffer
21721 !c------------------------------------------------------------------------------
21722 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
21723 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
21724 real(kind=8):: buffer(dimen1,dimen2)
21725 ! double precision zapas
21726 ! common /contacts_hb/ zapas(3,maxconts,maxres,8),
21727 ! & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
21728 ! & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
21729 ! & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
21730 num_kont=buffer(1,indx+30)
21731 num_kont_old=num_cont_hb(atom)
21732 num_cont_hb(atom)=num_kont+num_kont_old
21737 zapas2(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
21740 facont_hb(ii,atom)=buffer(i,indx+25)
21741 ees0p(ii,atom)=buffer(i,indx+26)
21742 ees0m(ii,atom)=buffer(i,indx+27)
21743 d_cont(i,atom)=buffer(i,indx+28)
21744 jcont_hb(ii,atom)=buffer(i,indx+29)
21747 end subroutine unpack_buffer
21748 !c------------------------------------------------------------------------------
21750 subroutine ecatcat(ecationcation)
21751 integer :: i,j,itmp,xshift,yshift,zshift,subchap,k
21752 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
21753 r7,r4,ecationcation,k0,rcal
21754 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
21755 dist_init,dist_temp,Evan1cat,Evan2cat,Eeleccat
21756 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
21759 ecationcation=0.0d0
21760 if (nres_molec(5).eq.0) return
21765 k0 = 332.0*(2.0*2.0)/80.0
21768 itmp=itmp+nres_molec(i)
21770 do i=itmp+1,itmp+nres_molec(5)-1
21775 xi=mod(xi,boxxsize)
21776 if (xi.lt.0) xi=xi+boxxsize
21777 yi=mod(yi,boxysize)
21778 if (yi.lt.0) yi=yi+boxysize
21779 zi=mod(zi,boxzsize)
21780 if (zi.lt.0) zi=zi+boxzsize
21782 do j=i+1,itmp+nres_molec(5)
21783 ! print *,i,j,'catcat'
21787 xj=dmod(xj,boxxsize)
21788 if (xj.lt.0) xj=xj+boxxsize
21789 yj=dmod(yj,boxysize)
21790 if (yj.lt.0) yj=yj+boxysize
21791 zj=dmod(zj,boxzsize)
21792 if (zj.lt.0) zj=zj+boxzsize
21793 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21801 xj=xj_safe+xshift*boxxsize
21802 yj=yj_safe+yshift*boxysize
21803 zj=zj_safe+zshift*boxzsize
21804 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21805 if(dist_temp.lt.dist_init) then
21806 dist_init=dist_temp
21815 if (subchap.eq.1) then
21824 rcal =xj**2+yj**2+zj**2
21830 ! k0 = 332*(2*2)/80
21831 Evan1cat=epscalc*(r012/rcal**6)
21832 Evan2cat=epscalc*2*(r06/rcal**3)
21840 dEvan1Cmcat(k)=-12*r(k)*epscalc*r012/r7
21841 dEvan2Cmcat(k)=-12*r(k)*epscalc*r06/r4
21842 dEeleccat(k)=-k0*r(k)/ract**3
21845 gg(k) = dEvan1Cmcat(k)+dEvan2Cmcat(k)+dEeleccat(k)
21846 gradcatcat(k,i)=gradcatcat(k,i)-gg(k)
21847 gradcatcat(k,j)=gradcatcat(k,j)+gg(k)
21850 ecationcation=ecationcation+Evan1cat+Evan2cat+Eeleccat
21854 end subroutine ecatcat
21855 !---------------------------------------------------------------------------
21856 subroutine ecat_prot(ecation_prot)
21857 integer i,j,k,subchap,itmp,inum
21858 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
21859 r7,r4,ecationcation
21860 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
21861 dist_init,dist_temp,ecation_prot,rcal,rocal, &
21862 Evan1,Evan2,EC,cm1mag,DASGL,delta,r0p,Epepcat, &
21863 catl,cml,calpl, Etotal_p, Etotal_m,rtab,wdip,wmodquad,wquad1, &
21864 wquad2,wvan1,E1,E2,wconst,wvan2,rcpm,dcmag,sin2thet,sinthet, &
21865 costhet,v1m,v2m,wh2o,wc,rsecp,Ir,Irsecp,Irthrp,Irfourp,Irfiftp,&
21866 Irsistp,Irseven,Irtwelv,Irthir,dE1dr,dE2dr,dEdcos,wquad2p,opt, &
21867 rs,rthrp,rfourp,rsixp,reight,Irsixp,Ireight,Irtw,Irfourt, &
21868 opt1,opt2,opt3,opt4,opt5,opt6,opt7,opt8,opt9,opt10,opt11,opt12,&
21869 opt13,opt14,opt15,opt16,opt17,opt18,opt19, &
21870 Equad1,Equad2,dscmag,v1dpv2,dscmag3,constA,constB,Edip
21871 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
21872 gg,r,EtotalCat,dEtotalCm,dEtotalCalp,dEvan1Cm,dEvan2Cm, &
21873 dEtotalpep,dEtotalcat_num,dEddci,dEtotalcm_num,dEtotalcalp_num, &
21874 tab1,tab2,tab3,diff,cm1,sc,p,tcat,talp,cm,drcp,drcp_norm,vcat, &
21875 v1,v2,v3,myd_norm,dx,vcm,valpha,drdpep,dcosdpep,dcosddci,dEdpep,&
21876 dEcCat,dEdipCm,dEdipCalp,dEquad1Cat,dEquad1Cm,dEquad1Calp, &
21877 dEquad2Cat,dEquad2Cm,dEquad2Calpd,Evan1Cat,dEvan1Calp,dEvan2Cat,&
21878 dEvan2Calp,dEtotalCat,dscvec,dEcCm,dEcCalp,dEdipCat,dEquad2Calp,&
21880 real(kind=8),dimension(6) :: vcatprm
21882 ! first lets calculate interaction with peptide groups
21883 if (nres_molec(5).eq.0) return
21885 wdip =1.092777950857032D2
21887 wmodquad=-2.174122713004870D4
21888 wmodquad=wmodquad/wconst
21889 wquad1 = 3.901232068562804D1
21890 wquad1=wquad1/wconst
21892 wquad2=wquad2/wconst
21897 itmp=itmp+nres_molec(i)
21899 ! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
21900 do i=ibond_start,ibond_end
21902 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle ! leave dummy atoms
21903 xi=0.5d0*(c(1,i)+c(1,i+1))
21904 yi=0.5d0*(c(2,i)+c(2,i+1))
21905 zi=0.5d0*(c(3,i)+c(3,i+1))
21906 xi=mod(xi,boxxsize)
21907 if (xi.lt.0) xi=xi+boxxsize
21908 yi=mod(yi,boxysize)
21909 if (yi.lt.0) yi=yi+boxysize
21910 zi=mod(zi,boxzsize)
21911 if (zi.lt.0) zi=zi+boxzsize
21913 do j=itmp+1,itmp+nres_molec(5)
21917 xj=dmod(xj,boxxsize)
21918 if (xj.lt.0) xj=xj+boxxsize
21919 yj=dmod(yj,boxysize)
21920 if (yj.lt.0) yj=yj+boxysize
21921 zj=dmod(zj,boxzsize)
21922 if (zj.lt.0) zj=zj+boxzsize
21923 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21931 xj=xj_safe+xshift*boxxsize
21932 yj=yj_safe+yshift*boxysize
21933 zj=zj_safe+zshift*boxzsize
21934 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21935 if(dist_temp.lt.dist_init) then
21936 dist_init=dist_temp
21945 if (subchap.eq.1) then
21956 rcpm = sqrt(xj**2+yj**2+zj**2)
21957 drcp_norm(1)=xj/rcpm
21958 drcp_norm(2)=yj/rcpm
21959 drcp_norm(3)=zj/rcpm
21962 dcmag=dcmag+dc(k,i)**2
21966 myd_norm(k)=dc(k,i)/dcmag
21968 costhet=drcp_norm(1)*myd_norm(1)+drcp_norm(2)*myd_norm(2)+&
21969 drcp_norm(3)*myd_norm(3)
21972 Irsecp = 1.0d0/rsecp
21973 Irthrp = Irsecp/rcpm
21974 Irfourp = Irthrp/rcpm
21975 Irfiftp = Irfourp/rcpm
21976 Irsistp=Irfiftp/rcpm
21977 Irseven=Irsistp/rcpm
21978 Irtwelv=Irsistp*Irsistp
21979 Irthir=Irtwelv/rcpm
21980 sin2thet = (1-costhet*costhet)
21981 sinthet=sqrt(sin2thet)
21982 E1 = wdip*Irsecp*costhet+(wmodquad*Irfourp+wquad1*Irthrp)&
21984 E2 = -wquad1*Irthrp*wquad2+wvan1*(wvan2**12*Irtwelv-&
21985 2*wvan2**6*Irsistp)
21986 ecation_prot = ecation_prot+E1+E2
21987 dE1dr = -2*costhet*wdip*Irthrp-&
21988 (4*wmodquad*Irfiftp+3*wquad1*Irfourp)*sin2thet
21989 dE2dr = 3*wquad1*wquad2*Irfourp- &
21990 12*wvan1*wvan2**6*(wvan2**6*Irthir-Irseven)
21991 dEdcos = wdip*Irsecp-2*(wmodquad*Irfourp+wquad1*Irthrp)*costhet
21993 drdpep(k) = -drcp_norm(k)
21994 dcosdpep(k) = Ir*(costhet*drcp_norm(k)-myd_norm(k))
21995 dcosddci(k) = drcp_norm(k)/dcmag-costhet*myd_norm(k)/dcmag
21996 dEdpep(k) = (dE1dr+dE2dr)*drdpep(k)+dEdcos*dcosdpep(k)
21997 dEddci(k) = dEdcos*dcosddci(k)
22000 gradpepcat(k,i)=gradpepcat(k,i)+0.5D0*dEdpep(k)-dEddci(k)
22001 gradpepcat(k,i+1)=gradpepcat(k,i+1)+0.5D0*dEdpep(k)+dEddci(k)
22002 gradpepcat(k,j)=gradpepcat(k,j)-dEdpep(k)
22006 !------------------------------------------sidechains
22007 ! do i=1,nres_molec(1)
22008 do i=ibond_start,ibond_end
22009 if ((itype(i,1).eq.ntyp1)) cycle ! leave dummy atoms
22011 ! print *,i,ecation_prot
22015 xi=mod(xi,boxxsize)
22016 if (xi.lt.0) xi=xi+boxxsize
22017 yi=mod(yi,boxysize)
22018 if (yi.lt.0) yi=yi+boxysize
22019 zi=mod(zi,boxzsize)
22020 if (zi.lt.0) zi=zi+boxzsize
22022 cm1(k)=dc(k,i+nres)
22024 cm1mag=sqrt(cm1(1)**2+cm1(2)**2+cm1(3)**2)
22025 do j=itmp+1,itmp+nres_molec(5)
22029 xj=dmod(xj,boxxsize)
22030 if (xj.lt.0) xj=xj+boxxsize
22031 yj=dmod(yj,boxysize)
22032 if (yj.lt.0) yj=yj+boxysize
22033 zj=dmod(zj,boxzsize)
22034 if (zj.lt.0) zj=zj+boxzsize
22035 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22043 xj=xj_safe+xshift*boxxsize
22044 yj=yj_safe+yshift*boxysize
22045 zj=zj_safe+zshift*boxzsize
22046 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22047 if(dist_temp.lt.dist_init) then
22048 dist_init=dist_temp
22057 if (subchap.eq.1) then
22068 if(itype(i,1).eq.15.or.itype(i,1).eq.16) then
22069 if(itype(i,1).eq.16) then
22075 vcatprm(k)=catprm(k,inum)
22077 dASGL=catprm(7,inum)
22079 vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
22084 dx(k) = vcat(k)-vcm(k)
22087 v1(k)=(vcm(k)-valpha(k))
22088 v2(k)=(vcat(k)-valpha(k))
22090 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
22091 v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
22092 v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
22094 ! The weights of the energy function calculated from
22095 !The quantum mechanical GAMESS simulations of calcium with ASP/GLU
22103 wquad2 = vcatprm(4)
22108 opt = dx(1)**2+dx(2)**2
22109 rsecp = opt+dx(3)**2
22113 rsixp = rfourp*rsecp
22118 Irfourp = Irthrp/rs
22124 opt1 = (4*rs*dx(3)*wdip)
22125 opt2 = 6*rsecp*wquad1*opt
22126 opt3 = wquad1*wquad2p*Irsixp
22127 opt4 = (wvan1*wvan2**12)
22128 opt5 = opt4*12*Irfourt
22129 opt6 = 2*wvan1*wvan2**6
22130 opt7 = 6*opt6*Ireight
22133 opt11 = (rsecp*v2m)**2
22134 opt12 = (rsecp*v1m)**2
22135 opt14 = (v1m*v2m*rsecp)**2
22136 opt15 = -wquad1/v2m**2
22137 opt16 = (rthrp*(v1m*v2m)**2)**2
22138 opt17 = (v1m**2*rthrp)**2
22139 opt18 = -wquad1/rthrp
22140 opt19 = (v1m**2*v2m**2)**2
22143 dEcCat(k) = -(dx(k)*wc)*Irthrp
22144 dEcCm(k)=(dx(k)*wc)*Irthrp
22147 Edip=opt8*(v1dpv2)/(rsecp*v2m)
22149 dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m &
22150 *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
22151 dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m &
22152 *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
22153 dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m &
22154 *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp) &
22157 Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
22159 dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp* &
22160 (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2* &
22161 v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
22162 dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp* &
22163 (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2* &
22164 v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
22165 dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
22166 v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)* &
22169 Equad2=wquad1*wquad2p*Irthrp
22171 dEquad2Cat(k)=-3*dx(k)*rs*opt3
22172 dEquad2Cm(k)=3*dx(k)*rs*opt3
22173 dEquad2Calp(k)=0.0d0
22177 dEvan1Cat(k)=-dx(k)*opt5
22178 dEvan1Cm(k)=dx(k)*opt5
22179 dEvan1Calp(k)=0.0d0
22183 dEvan2Cat(k)=dx(k)*opt7
22184 dEvan2Cm(k)=-dx(k)*opt7
22185 dEvan2Calp(k)=0.0d0
22187 ecation_prot=ecation_prot+Ec+Edip+Equad1+Equad2+Evan1+Evan2
22188 ! print *,ecation_prot,Ec+Edip+Equad1+Equad2+Evan1+Evan2
22191 dEtotalCat(k)=dEcCat(k)+dEdipCat(k)+dEquad1Cat(k)+ &
22192 dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
22193 !c write(*,*) 'dEtotalCat inside', (dEtotalCat(l),l=1,3)
22194 dEtotalCm(k)=dEcCm(k)+dEdipCm(k)+dEquad1Cm(k)+ &
22195 dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
22196 dEtotalCalp(k)=dEcCalp(k)+dEdipCalp(k)+dEquad1Calp(k) &
22197 +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
22201 dscvec(k) = dc(k,i+nres)
22202 dscmag = dscmag+dscvec(k)*dscvec(k)
22205 dscmag = sqrt(dscmag)
22206 dscmag3 = dscmag3*dscmag
22207 constA = 1.0d0+dASGL/dscmag
22210 constB = constB+dscvec(k)*dEtotalCm(k)
22212 constB = constB*dASGL/dscmag3
22214 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
22215 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
22216 constA*dEtotalCm(k)-constB*dscvec(k)
22217 ! print *,j,constA,dEtotalCm(k),constB,dscvec(k)
22218 gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
22219 gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
22221 else if (itype(i,1).eq.13.or.itype(i,1).eq.14) then
22222 if(itype(i,1).eq.14) then
22228 vcatprm(k)=catprm(k,inum)
22230 dASGL=catprm(7,inum)
22232 vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
22238 dx(k) = vcat(k)-vcm(k)
22241 v1(k)=(vcm(k)-valpha(k))
22242 v2(k)=(vcat(k)-valpha(k))
22244 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
22245 v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
22246 v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
22247 ! The weights of the energy function calculated from
22248 !The quantum mechanical GAMESS simulations of ASN/GLN with calcium
22254 wquad2 = vcatprm(4)
22259 opt = dx(1)**2+dx(2)**2
22260 rsecp = opt+dx(3)**2
22264 rsixp = rfourp*rsecp
22269 Irfourp = Irthrp/rs
22275 opt1 = (4*rs*dx(3)*wdip)
22276 opt2 = 6*rsecp*wquad1*opt
22277 opt3 = wquad1*wquad2p*Irsixp
22278 opt4 = (wvan1*wvan2**12)
22279 opt5 = opt4*12*Irfourt
22280 opt6 = 2*wvan1*wvan2**6
22281 opt7 = 6*opt6*Ireight
22284 opt11 = (rsecp*v2m)**2
22285 opt12 = (rsecp*v1m)**2
22286 opt14 = (v1m*v2m*rsecp)**2
22287 opt15 = -wquad1/v2m**2
22288 opt16 = (rthrp*(v1m*v2m)**2)**2
22289 opt17 = (v1m**2*rthrp)**2
22290 opt18 = -wquad1/rthrp
22291 opt19 = (v1m**2*v2m**2)**2
22292 Edip=opt8*(v1dpv2)/(rsecp*v2m)
22294 dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m&
22295 *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
22296 dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m&
22297 *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
22298 dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m&
22299 *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp)&
22302 Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
22304 dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp*&
22305 (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2*&
22306 v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
22307 dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp*&
22308 (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2*&
22309 v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
22310 dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
22311 v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)*&
22314 Equad2=wquad1*wquad2p*Irthrp
22316 dEquad2Cat(k)=-3*dx(k)*rs*opt3
22317 dEquad2Cm(k)=3*dx(k)*rs*opt3
22318 dEquad2Calp(k)=0.0d0
22322 dEvan1Cat(k)=-dx(k)*opt5
22323 dEvan1Cm(k)=dx(k)*opt5
22324 dEvan1Calp(k)=0.0d0
22328 dEvan2Cat(k)=dx(k)*opt7
22329 dEvan2Cm(k)=-dx(k)*opt7
22330 dEvan2Calp(k)=0.0d0
22332 ecation_prot = ecation_prot+Edip+Equad1+Equad2+Evan1+Evan2
22334 dEtotalCat(k)=dEdipCat(k)+dEquad1Cat(k)+ &
22335 dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
22336 dEtotalCm(k)=dEdipCm(k)+dEquad1Cm(k)+ &
22337 dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
22338 dEtotalCalp(k)=dEdipCalp(k)+dEquad1Calp(k) &
22339 +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
22343 dscvec(k) = c(k,i+nres)-c(k,i)
22344 dscmag = dscmag+dscvec(k)*dscvec(k)
22347 dscmag = sqrt(dscmag)
22348 dscmag3 = dscmag3*dscmag
22349 constA = 1+dASGL/dscmag
22352 constB = constB+dscvec(k)*dEtotalCm(k)
22354 constB = constB*dASGL/dscmag3
22356 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
22357 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
22358 constA*dEtotalCm(k)-constB*dscvec(k)
22359 gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
22360 gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
22365 r(k) = c(k,j)-c(k,i+nres)
22366 rcal = rcal+r(k)*r(k)
22371 r0p=0.5*(rocal+sig0(itype(i,1)))
22374 Evan1=epscalc*(r012/rcal**6)
22375 Evan2=epscalc*2*(r06/rcal**3)
22379 dEvan1Cm(k) = 12*r(k)*epscalc*r012/r7
22380 dEvan2Cm(k) = 12*r(k)*epscalc*r06/r4
22383 dEtotalCm(k)=dEvan1Cm(k)+dEvan2Cm(k)
22385 ecation_prot = ecation_prot+ Evan1+Evan2
22387 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
22389 gradpepcat(k,i)=gradpepcat(k,i)+dEtotalCm(k)
22390 gradpepcat(k,j)=gradpepcat(k,j)-dEtotalCm(k)
22392 endif ! 13-16 residues
22396 end subroutine ecat_prot
22398 !----------------------------------------------------------------------------
22399 !-----------------------------------------------------------------------------
22400 !-----------------------------------------------------------------------------
22401 subroutine eprot_sc_base(escbase)
22403 ! implicit real*8 (a-h,o-z)
22404 ! include 'DIMENSIONS'
22405 ! include 'COMMON.GEO'
22406 ! include 'COMMON.VAR'
22407 ! include 'COMMON.LOCAL'
22408 ! include 'COMMON.CHAIN'
22409 ! include 'COMMON.DERIV'
22410 ! include 'COMMON.NAMES'
22411 ! include 'COMMON.INTERACT'
22412 ! include 'COMMON.IOUNITS'
22413 ! include 'COMMON.CALC'
22414 ! include 'COMMON.CONTROL'
22415 ! include 'COMMON.SBRIDGE'
22417 !el local variables
22418 integer :: iint,itypi,itypi1,itypj,subchap
22419 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
22420 real(kind=8) :: evdw,sig0ij
22421 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
22422 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
22423 sslipi,sslipj,faclip
22425 real(kind=8) :: fracinbuf
22426 real (kind=8) :: escbase
22427 real (kind=8),dimension(4):: ener
22428 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
22429 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
22430 sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
22431 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
22432 dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
22433 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
22434 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
22435 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
22436 real(kind=8),dimension(3,2)::chead,erhead_tail
22437 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
22441 ! do i=1,nres_molec(1)
22442 do i=ibond_start,ibond_end
22443 if (itype(i,1).eq.ntyp1_molec(1)) cycle
22445 dxi = dc_norm(1,nres+i)
22446 dyi = dc_norm(2,nres+i)
22447 dzi = dc_norm(3,nres+i)
22448 dsci_inv = vbld_inv(i+nres)
22452 xi=mod(xi,boxxsize)
22453 if (xi.lt.0) xi=xi+boxxsize
22454 yi=mod(yi,boxysize)
22455 if (yi.lt.0) yi=yi+boxysize
22456 zi=mod(zi,boxzsize)
22457 if (zi.lt.0) zi=zi+boxzsize
22458 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
22460 if (itype(j,2).eq.ntyp1_molec(2))cycle
22464 xj=dmod(xj,boxxsize)
22465 if (xj.lt.0) xj=xj+boxxsize
22466 yj=dmod(yj,boxysize)
22467 if (yj.lt.0) yj=yj+boxysize
22468 zj=dmod(zj,boxzsize)
22469 if (zj.lt.0) zj=zj+boxzsize
22470 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22479 xj=xj_safe+xshift*boxxsize
22480 yj=yj_safe+yshift*boxysize
22481 zj=zj_safe+zshift*boxzsize
22482 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22483 if(dist_temp.lt.dist_init) then
22484 dist_init=dist_temp
22493 if (subchap.eq.1) then
22502 dxj = dc_norm( 1, nres+j )
22503 dyj = dc_norm( 2, nres+j )
22504 dzj = dc_norm( 3, nres+j )
22505 ! print *,i,j,itypi,itypj
22506 d1i = dhead_scbasei(itypi,itypj) !this is shift of dipole/charge
22507 d1j = dhead_scbasej(itypi,itypj) !this is shift of dipole/charge
22510 ! BetaT = 1.0d0 / (298.0d0 * Rb)
22512 sig0ij = sigma_scbase( itypi,itypj )
22513 chi1 = chi_scbase( itypi, itypj,1 )
22514 chi2 = chi_scbase( itypi, itypj,2 )
22517 chi12 = chi1 * chi2
22518 chip1 = chipp_scbase( itypi, itypj,1 )
22519 chip2 = chipp_scbase( itypi, itypj,2 )
22522 chip12 = chip1 * chip2
22523 ! not used by momo potential, but needed by sc_angular which is shared
22524 ! by all energy_potential subroutines
22528 a12sq = rborn_scbasei(itypi,itypj) * rborn_scbasej(itypi,itypj)
22529 ! a12sq = a12sq * a12sq
22530 ! charge of amino acid itypi is...
22531 chis1 = chis_scbase(itypi,itypj,1)
22532 chis2 = chis_scbase(itypi,itypj,2)
22533 chis12 = chis1 * chis2
22534 sig1 = sigmap1_scbase(itypi,itypj)
22535 sig2 = sigmap2_scbase(itypi,itypj)
22536 ! write (*,*) "sig1 = ", sig1
22537 ! write (*,*) "sig2 = ", sig2
22538 ! alpha factors from Fcav/Gcav
22539 b1 = alphasur_scbase(1,itypi,itypj)
22541 b2 = alphasur_scbase(2,itypi,itypj)
22542 b3 = alphasur_scbase(3,itypi,itypj)
22543 b4 = alphasur_scbase(4,itypi,itypj)
22544 ! used to determine whether we want to do quadrupole calculations
22546 eps_in = epsintab_scbase(itypi,itypj)
22547 if (eps_in.eq.0.0) eps_in=1.0
22548 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
22549 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
22550 !-------------------------------------------------------------------
22551 ! tail location and distance calculations
22553 ! location of polar head is computed by taking hydrophobic centre
22554 ! and moving by a d1 * dc_norm vector
22555 ! see unres publications for very informative images
22556 chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
22557 chead(k,2) = c(k, j+nres) + d1j * dc_norm(k, j+nres)
22559 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
22560 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
22561 Rhead_distance(k) = chead(k,2) - chead(k,1)
22563 ! pitagoras (root of sum of squares)
22565 (Rhead_distance(1)*Rhead_distance(1)) &
22566 + (Rhead_distance(2)*Rhead_distance(2)) &
22567 + (Rhead_distance(3)*Rhead_distance(3)))
22568 !-------------------------------------------------------------------
22569 ! zero everything that should be zero'ed
22587 dscj_inv = vbld_inv(j+nres)
22588 ! print *,i,j,dscj_inv,dsci_inv
22589 ! rij holds 1/(distance of Calpha atoms)
22590 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
22592 !----------------------------
22594 ! this should be in elgrad_init but om's are calculated by sc_angular
22595 ! which in turn is used by older potentials
22596 ! om = omega, sqom = om^2
22599 sqom12 = om12 * om12
22601 ! now we calculate EGB - Gey-Berne
22602 ! It will be summed up in evdwij and saved in evdw
22603 sigsq = 1.0D0 / sigsq
22604 sig = sig0ij * dsqrt(sigsq)
22605 ! rij_shift = 1.0D0 / rij - sig + sig0ij
22606 rij_shift = 1.0/rij - sig + sig0ij
22607 IF (rij_shift.le.0.0D0) THEN
22611 sigder = -sig * sigsq
22612 rij_shift = 1.0D0 / rij_shift
22613 fac = rij_shift**expon
22614 c1 = fac * fac * aa_scbase(itypi,itypj)
22616 c2 = fac * bb_scbase(itypi,itypj)
22618 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
22619 eps2der = eps3rt * evdwij
22620 eps3der = eps2rt * evdwij
22621 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
22622 evdwij = eps2rt * eps3rt * evdwij
22623 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
22624 fac = -expon * (c1 + evdwij) * rij_shift
22625 sigder = fac * sigder
22627 ! Calculate distance derivative
22631 ! if (b2.gt.0.0) then
22632 fac = chis1 * sqom1 + chis2 * sqom2 &
22633 - 2.0d0 * chis12 * om1 * om2 * om12
22634 ! we will use pom later in Gcav, so dont mess with it!
22635 pom = 1.0d0 - chis1 * chis2 * sqom12
22636 Lambf = (1.0d0 - (fac / pom))
22637 Lambf = dsqrt(Lambf)
22638 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
22639 ! write (*,*) "sparrow = ", sparrow
22640 Chif = 1.0d0/rij * sparrow
22641 ChiLambf = Chif * Lambf
22642 eagle = dsqrt(ChiLambf)
22643 bat = ChiLambf ** 11.0d0
22644 top = b1 * ( eagle + b2 * ChiLambf - b3 )
22645 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
22649 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
22650 dbot = 12.0d0 * b4 * bat * Lambf
22651 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
22653 ! write (*,*) "dFcav/dR = ", dFdR
22654 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
22655 dbot = 12.0d0 * b4 * bat * Chif
22656 eagle = Lambf * pom
22657 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
22658 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
22659 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
22660 * (chis2 * om2 * om12 - om1) / (eagle * pom)
22662 dFdL = ((dtop * bot - top * dbot) / botsq)
22664 dCAVdOM1 = dFdL * ( dFdOM1 )
22665 dCAVdOM2 = dFdL * ( dFdOM2 )
22666 dCAVdOM12 = dFdL * ( dFdOM12 )
22671 ! eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
22672 ! eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
22673 ! eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
22674 ! -2.0D0*alf12*eps3der+sigder*sigsq_om12
22675 ! print *,"EOMY",eom1,eom2,eom12
22676 ! erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
22677 ! erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
22679 ! facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
22680 ! facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
22682 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
22683 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
22685 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
22686 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
22687 - (( dFdR + gg(k) ) * pom)
22688 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
22689 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
22690 ! & - ( dFdR * pom )
22692 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
22693 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
22694 + (( dFdR + gg(k) ) * pom)
22695 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
22696 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
22697 !c! & + ( dFdR * pom )
22699 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
22700 - (( dFdR + gg(k) ) * ertail(k))
22701 !c! & - ( dFdR * ertail(k))
22703 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
22704 + (( dFdR + gg(k) ) * ertail(k))
22705 !c! & + ( dFdR * ertail(k))
22708 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
22709 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
22716 if (wdipdip_scbase(2,itypi,itypj).gt.0.0d0) then
22717 w1 = wdipdip_scbase(1,itypi,itypj)
22718 w2 = -wdipdip_scbase(3,itypi,itypj)/2.0
22719 w3 = wdipdip_scbase(2,itypi,itypj)
22720 !c!-------------------------------------------------------------------
22722 fac = (om12 - 3.0d0 * om1 * om2)
22723 c1 = (w1 / (Rhead**3.0d0)) * fac
22724 c2 = (w2 / Rhead ** 6.0d0) &
22725 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
22726 c3= (w3/ Rhead ** 6.0d0) &
22727 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
22729 !c! write (*,*) "w1 = ", w1
22730 !c! write (*,*) "w2 = ", w2
22731 !c! write (*,*) "om1 = ", om1
22732 !c! write (*,*) "om2 = ", om2
22733 !c! write (*,*) "om12 = ", om12
22734 !c! write (*,*) "fac = ", fac
22735 !c! write (*,*) "c1 = ", c1
22736 !c! write (*,*) "c2 = ", c2
22737 !c! write (*,*) "Ecl = ", Ecl
22738 !c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
22739 !c! write (*,*) "c2_2 = ",
22740 !c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
22741 !c!-------------------------------------------------------------------
22742 !c! dervative of ECL is GCL...
22744 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
22745 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
22746 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
22747 c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
22748 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
22749 dGCLdR = c1 - c2 + c3
22751 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
22752 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
22753 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
22754 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
22755 dGCLdOM1 = c1 - c2 + c3
22757 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
22758 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
22759 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
22760 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
22761 dGCLdOM2 = c1 - c2 + c3
22763 c1 = w1 / (Rhead ** 3.0d0)
22764 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
22765 c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
22766 dGCLdOM12 = c1 - c2 + c3
22768 erhead(k) = Rhead_distance(k)/Rhead
22770 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
22771 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
22772 facd1 = d1i * vbld_inv(i+nres)
22773 facd2 = d1j * vbld_inv(j+nres)
22776 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
22777 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
22779 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
22780 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
22783 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
22784 - dGCLdR * erhead(k)
22785 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
22786 + dGCLdR * erhead(k)
22789 !now charge with dipole eg. ARG-dG
22790 if (wqdip_scbase(2,itypi,itypj).gt.0.0d0) then
22791 alphapol1 = alphapol_scbase(itypi,itypj)
22792 w1 = wqdip_scbase(1,itypi,itypj)
22793 w2 = wqdip_scbase(2,itypi,itypj)
22796 ! pis = sig0head_scbase(itypi,itypj)
22797 ! eps_head = epshead_scbase(itypi,itypj)
22798 !c!-------------------------------------------------------------------
22799 !c! R1 - distance between head of ith side chain and tail of jth sidechain
22802 !c! Calculate head-to-tail distances tail is center of side-chain
22803 R1=R1+(c(k,j+nres)-chead(k,1))**2
22808 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
22809 !c! & +dhead(1,1,itypi,itypj))**2))
22810 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
22811 !c! & +dhead(2,1,itypi,itypj))**2))
22813 !c!-------------------------------------------------------------------
22816 hawk = w2 * (1.0d0 - sqom2)
22817 Ecl = sparrow / Rhead**2.0d0 &
22818 - hawk / Rhead**4.0d0
22819 !c!-------------------------------------------------------------------
22820 !c! derivative of ecl is Gcl
22822 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
22823 + 4.0d0 * hawk / Rhead**5.0d0
22825 dGCLdOM1 = (w1) / (Rhead**2.0d0)
22827 dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
22828 !c--------------------------------------------------------------------
22829 !c Polarization energy
22831 MomoFac1 = (1.0d0 - chi1 * sqom2)
22832 RR1 = R1 * R1 / MomoFac1
22833 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
22834 fgb1 = sqrt( RR1 + a12sq * ee1)
22835 ! eps_inout_fac=0.0d0
22836 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
22837 ! derivative of Epol is Gpol...
22838 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
22840 dFGBdR1 = ( (R1 / MomoFac1) &
22841 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
22843 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
22844 * (2.0d0 - 0.5d0 * ee1) ) &
22846 dPOLdR1 = dPOLdFGB1 * dFGBdR1
22849 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
22851 erhead(k) = Rhead_distance(k)/Rhead
22852 erhead_tail(k,1) = ((c(k,j+nres)-chead(k,1))/R1)
22855 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
22856 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
22857 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
22859 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
22860 facd1 = d1i * vbld_inv(i+nres)
22861 facd2 = d1j * vbld_inv(j+nres)
22862 ! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
22865 hawk = (erhead_tail(k,1) + &
22866 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
22869 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
22870 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
22872 - dPOLdR1 * (erhead_tail(k,1))
22875 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
22876 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
22878 + dPOLdR1 * (erhead_tail(k,1))
22882 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
22883 - dGCLdR * erhead(k) &
22884 - dPOLdR1 * erhead_tail(k,1)
22885 ! & - dGLJdR * erhead(k)
22887 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
22888 + dGCLdR * erhead(k) &
22889 + dPOLdR1 * erhead_tail(k,1)
22890 ! & + dGLJdR * erhead(k)
22894 ! print *,i,j,evdwij,epol,Fcav,ECL
22895 escbase=escbase+evdwij+epol+Fcav+ECL
22896 call sc_grad_scbase
22901 end subroutine eprot_sc_base
22902 SUBROUTINE sc_grad_scbase
22905 real (kind=8) :: dcosom1(3),dcosom2(3)
22907 eps2der * eps2rt_om1 &
22908 - 2.0D0 * alf1 * eps3der &
22909 + sigder * sigsq_om1 &
22915 eps2der * eps2rt_om2 &
22916 + 2.0D0 * alf2 * eps3der &
22917 + sigder * sigsq_om2 &
22923 evdwij * eps1_om12 &
22924 + eps2der * eps2rt_om12 &
22925 - 2.0D0 * alf12 * eps3der &
22926 + sigder *sigsq_om12 &
22930 ! print *,eom1,eom2,eom12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
22931 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
22932 ! gg(1),gg(2),"rozne"
22934 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
22935 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
22936 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
22937 gvdwx_scbase(k,i)= gvdwx_scbase(k,i) - gg(k) &
22938 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
22939 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
22940 gvdwx_scbase(k,j)= gvdwx_scbase(k,j) + gg(k) &
22941 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
22942 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
22943 gvdwc_scbase(k,i)=gvdwc_scbase(k,i)-gg(k)
22944 gvdwc_scbase(k,j)=gvdwc_scbase(k,j)+gg(k)
22947 END SUBROUTINE sc_grad_scbase
22950 subroutine epep_sc_base(epepbase)
22953 !el local variables
22954 integer :: iint,itypi,itypi1,itypj,subchap
22955 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
22956 real(kind=8) :: evdw,sig0ij
22957 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
22958 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
22959 sslipi,sslipj,faclip
22961 real(kind=8) :: fracinbuf
22962 real (kind=8) :: epepbase
22963 real (kind=8),dimension(4):: ener
22964 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
22965 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
22966 sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
22967 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
22968 dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
22969 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
22970 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
22971 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
22972 real(kind=8),dimension(3,2)::chead,erhead_tail
22973 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
22977 ! do i=1,nres_molec(1)-1
22978 do i=ibond_start,ibond_end
22979 if (itype(i,1).eq.ntyp1_molec(1).or.itype(i+1,1).eq.ntyp1_molec(1)) cycle
22980 !C itypi = itype(i,1)
22984 ! print *,dxi,(-c(1,i)+c(1,i+1))*vbld_inv(i+1)
22985 dsci_inv = vbld_inv(i+1)/2.0
22986 xi=(c(1,i)+c(1,i+1))/2.0
22987 yi=(c(2,i)+c(2,i+1))/2.0
22988 zi=(c(3,i)+c(3,i+1))/2.0
22989 xi=mod(xi,boxxsize)
22990 if (xi.lt.0) xi=xi+boxxsize
22991 yi=mod(yi,boxysize)
22992 if (yi.lt.0) yi=yi+boxysize
22993 zi=mod(zi,boxzsize)
22994 if (zi.lt.0) zi=zi+boxzsize
22995 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
22997 if (itype(j,2).eq.ntyp1_molec(2))cycle
23001 xj=dmod(xj,boxxsize)
23002 if (xj.lt.0) xj=xj+boxxsize
23003 yj=dmod(yj,boxysize)
23004 if (yj.lt.0) yj=yj+boxysize
23005 zj=dmod(zj,boxzsize)
23006 if (zj.lt.0) zj=zj+boxzsize
23007 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23016 xj=xj_safe+xshift*boxxsize
23017 yj=yj_safe+yshift*boxysize
23018 zj=zj_safe+zshift*boxzsize
23019 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23020 if(dist_temp.lt.dist_init) then
23021 dist_init=dist_temp
23030 if (subchap.eq.1) then
23039 dxj = dc_norm( 1, nres+j )
23040 dyj = dc_norm( 2, nres+j )
23041 dzj = dc_norm( 3, nres+j )
23042 ! d1i = dhead_scbasei(itypi) !this is shift of dipole/charge
23043 ! d1j = dhead_scbasej(itypi) !this is shift of dipole/charge
23046 sig0ij = sigma_pepbase(itypj )
23047 chi1 = chi_pepbase(itypj,1 )
23048 chi2 = chi_pepbase(itypj,2 )
23051 chi12 = chi1 * chi2
23052 chip1 = chipp_pepbase(itypj,1 )
23053 chip2 = chipp_pepbase(itypj,2 )
23056 chip12 = chip1 * chip2
23057 chis1 = chis_pepbase(itypj,1)
23058 chis2 = chis_pepbase(itypj,2)
23059 chis12 = chis1 * chis2
23060 sig1 = sigmap1_pepbase(itypj)
23061 sig2 = sigmap2_pepbase(itypj)
23062 ! write (*,*) "sig1 = ", sig1
23063 ! write (*,*) "sig2 = ", sig2
23065 ! location of polar head is computed by taking hydrophobic centre
23066 ! and moving by a d1 * dc_norm vector
23067 ! see unres publications for very informative images
23068 chead(k,1) = (c(k,i)+c(k,i+1))/2.0
23069 ! + d1i * dc_norm(k, i+nres)
23070 chead(k,2) = c(k, j+nres)
23071 ! + d1j * dc_norm(k, j+nres)
23073 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
23074 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
23075 Rhead_distance(k) = chead(k,2) - chead(k,1)
23076 ! print *,gvdwc_pepbase(k,i)
23080 (Rhead_distance(1)*Rhead_distance(1)) &
23081 + (Rhead_distance(2)*Rhead_distance(2)) &
23082 + (Rhead_distance(3)*Rhead_distance(3)))
23084 ! alpha factors from Fcav/Gcav
23085 b1 = alphasur_pepbase(1,itypj)
23087 b2 = alphasur_pepbase(2,itypj)
23088 b3 = alphasur_pepbase(3,itypj)
23089 b4 = alphasur_pepbase(4,itypj)
23093 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23096 !----------------------------
23114 dscj_inv = vbld_inv(j+nres)
23116 ! this should be in elgrad_init but om's are calculated by sc_angular
23117 ! which in turn is used by older potentials
23118 ! om = omega, sqom = om^2
23121 sqom12 = om12 * om12
23123 ! now we calculate EGB - Gey-Berne
23124 ! It will be summed up in evdwij and saved in evdw
23125 sigsq = 1.0D0 / sigsq
23126 sig = sig0ij * dsqrt(sigsq)
23127 rij_shift = 1.0/rij - sig + sig0ij
23128 IF (rij_shift.le.0.0D0) THEN
23132 sigder = -sig * sigsq
23133 rij_shift = 1.0D0 / rij_shift
23134 fac = rij_shift**expon
23135 c1 = fac * fac * aa_pepbase(itypj)
23137 c2 = fac * bb_pepbase(itypj)
23139 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
23140 eps2der = eps3rt * evdwij
23141 eps3der = eps2rt * evdwij
23142 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
23143 evdwij = eps2rt * eps3rt * evdwij
23144 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
23145 fac = -expon * (c1 + evdwij) * rij_shift
23146 sigder = fac * sigder
23148 ! Calculate distance derivative
23152 fac = chis1 * sqom1 + chis2 * sqom2 &
23153 - 2.0d0 * chis12 * om1 * om2 * om12
23154 ! we will use pom later in Gcav, so dont mess with it!
23155 pom = 1.0d0 - chis1 * chis2 * sqom12
23156 Lambf = (1.0d0 - (fac / pom))
23157 Lambf = dsqrt(Lambf)
23158 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
23159 ! write (*,*) "sparrow = ", sparrow
23160 Chif = 1.0d0/rij * sparrow
23161 ChiLambf = Chif * Lambf
23162 eagle = dsqrt(ChiLambf)
23163 bat = ChiLambf ** 11.0d0
23164 top = b1 * ( eagle + b2 * ChiLambf - b3 )
23165 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
23169 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
23170 dbot = 12.0d0 * b4 * bat * Lambf
23171 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
23173 ! write (*,*) "dFcav/dR = ", dFdR
23174 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
23175 dbot = 12.0d0 * b4 * bat * Chif
23176 eagle = Lambf * pom
23177 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
23178 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
23179 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
23180 * (chis2 * om2 * om12 - om1) / (eagle * pom)
23182 dFdL = ((dtop * bot - top * dbot) / botsq)
23184 dCAVdOM1 = dFdL * ( dFdOM1 )
23185 dCAVdOM2 = dFdL * ( dFdOM2 )
23186 dCAVdOM12 = dFdL * ( dFdOM12 )
23192 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23193 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23195 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
23196 gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
23197 - (( dFdR + gg(k) ) * pom)/2.0
23198 ! print *,gvdwc_pepbase(k,i),i,(( dFdR + gg(k) ) * pom)/2.0
23199 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
23200 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
23201 ! & - ( dFdR * pom )
23203 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
23204 gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
23205 + (( dFdR + gg(k) ) * pom)
23206 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
23207 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23208 !c! & + ( dFdR * pom )
23210 gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
23211 - (( dFdR + gg(k) ) * ertail(k))/2.0
23212 ! print *,gvdwc_pepbase(k,i+1),i+1,(( dFdR + gg(k) ) * pom)/2.0
23214 !c! & - ( dFdR * ertail(k))
23216 gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
23217 + (( dFdR + gg(k) ) * ertail(k))
23218 !c! & + ( dFdR * ertail(k))
23221 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23222 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23226 w1 = wdipdip_pepbase(1,itypj)
23227 w2 = -wdipdip_pepbase(3,itypj)/2.0
23228 w3 = wdipdip_pepbase(2,itypj)
23231 !c!-------------------------------------------------------------------
23234 fac = (om12 - 3.0d0 * om1 * om2)
23235 c1 = (w1 / (Rhead**3.0d0)) * fac
23236 c2 = (w2 / Rhead ** 6.0d0) &
23237 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
23238 c3= (w3/ Rhead ** 6.0d0) &
23239 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
23243 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
23244 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
23245 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
23246 c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
23247 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
23249 dGCLdR = c1 - c2 + c3
23251 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
23252 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
23253 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
23254 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
23255 dGCLdOM1 = c1 - c2 + c3
23257 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
23258 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
23259 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
23260 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
23262 dGCLdOM2 = c1 - c2 + c3
23264 c1 = w1 / (Rhead ** 3.0d0)
23265 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
23266 c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
23267 dGCLdOM12 = c1 - c2 + c3
23269 erhead(k) = Rhead_distance(k)/Rhead
23271 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
23272 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
23273 ! facd1 = d1 * vbld_inv(i+nres)
23274 ! facd2 = d2 * vbld_inv(j+nres)
23278 !+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
23279 ! gvdwx_pepbase(k,i) = gvdwx_scbase(k,i) &
23282 !+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
23283 gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
23286 gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
23287 - dGCLdR * erhead(k)/2.0d0
23288 ! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
23289 gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
23290 - dGCLdR * erhead(k)/2.0d0
23291 ! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
23292 gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
23293 + dGCLdR * erhead(k)
23295 ! print *,i,j,evdwij,Fcav,ECL,"vdw,cav,ecl"
23296 epepbase=epepbase+evdwij+Fcav+ECL
23297 call sc_grad_pepbase
23300 END SUBROUTINE epep_sc_base
23301 SUBROUTINE sc_grad_pepbase
23304 real (kind=8) :: dcosom1(3),dcosom2(3)
23306 eps2der * eps2rt_om1 &
23307 - 2.0D0 * alf1 * eps3der &
23308 + sigder * sigsq_om1 &
23314 eps2der * eps2rt_om2 &
23315 + 2.0D0 * alf2 * eps3der &
23316 + sigder * sigsq_om2 &
23322 evdwij * eps1_om12 &
23323 + eps2der * eps2rt_om12 &
23324 - 2.0D0 * alf12 * eps3der &
23325 + sigder *sigsq_om12 &
23330 ! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
23331 ! if (i.eq.30) print *,gvdwc_pepbase(k,i),- gg(k),&
23332 ! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
23334 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
23335 ! gg(1),gg(2),"rozne"
23337 dcosom1(k) = rij * (dc_norm(k,i) - om1 * erij(k))
23338 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
23339 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
23340 gvdwc_pepbase(k,i)= gvdwc_pepbase(k,i) +0.5*(- gg(k)) &
23341 + (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
23343 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
23344 gvdwc_pepbase(k,i+1)= gvdwc_pepbase(k,i+1) +0.5*(- gg(k)) &
23345 - (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i))) &
23347 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
23348 ! print *,eom12,eom2,om12,om2
23349 !eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
23350 ! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
23351 gvdwx_pepbase(k,j)= gvdwx_pepbase(k,j) + gg(k) &
23352 + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
23353 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23354 gvdwc_pepbase(k,j)=gvdwc_pepbase(k,j)+gg(k)
23357 END SUBROUTINE sc_grad_pepbase
23358 subroutine eprot_sc_phosphate(escpho)
23360 ! implicit real*8 (a-h,o-z)
23361 ! include 'DIMENSIONS'
23362 ! include 'COMMON.GEO'
23363 ! include 'COMMON.VAR'
23364 ! include 'COMMON.LOCAL'
23365 ! include 'COMMON.CHAIN'
23366 ! include 'COMMON.DERIV'
23367 ! include 'COMMON.NAMES'
23368 ! include 'COMMON.INTERACT'
23369 ! include 'COMMON.IOUNITS'
23370 ! include 'COMMON.CALC'
23371 ! include 'COMMON.CONTROL'
23372 ! include 'COMMON.SBRIDGE'
23374 !el local variables
23375 integer :: iint,itypi,itypi1,itypj,subchap
23376 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
23377 real(kind=8) :: evdw,sig0ij
23378 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
23379 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
23380 sslipi,sslipj,faclip
23382 real(kind=8) :: fracinbuf
23383 real (kind=8) :: escpho
23384 real (kind=8),dimension(4):: ener
23385 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
23386 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
23387 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
23388 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
23389 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
23390 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
23391 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
23392 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
23393 real(kind=8),dimension(3,2)::chead,erhead_tail
23394 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
23398 ! do i=1,nres_molec(1)
23399 do i=ibond_start,ibond_end
23400 if (itype(i,1).eq.ntyp1_molec(1)) cycle
23402 dxi = dc_norm(1,nres+i)
23403 dyi = dc_norm(2,nres+i)
23404 dzi = dc_norm(3,nres+i)
23405 dsci_inv = vbld_inv(i+nres)
23409 xi=mod(xi,boxxsize)
23410 if (xi.lt.0) xi=xi+boxxsize
23411 yi=mod(yi,boxysize)
23412 if (yi.lt.0) yi=yi+boxysize
23413 zi=mod(zi,boxzsize)
23414 if (zi.lt.0) zi=zi+boxzsize
23415 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
23417 if ((itype(j,2).eq.ntyp1_molec(2)).or.&
23418 (itype(j+1,2).eq.ntyp1_molec(2))) cycle
23419 xj=(c(1,j)+c(1,j+1))/2.0
23420 yj=(c(2,j)+c(2,j+1))/2.0
23421 zj=(c(3,j)+c(3,j+1))/2.0
23422 xj=dmod(xj,boxxsize)
23423 if (xj.lt.0) xj=xj+boxxsize
23424 yj=dmod(yj,boxysize)
23425 if (yj.lt.0) yj=yj+boxysize
23426 zj=dmod(zj,boxzsize)
23427 if (zj.lt.0) zj=zj+boxzsize
23428 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23436 yj=yj_safe+yshift*boxysize
23437 zj=zj_safe+zshift*boxzsize
23438 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23439 if(dist_temp.lt.dist_init) then
23440 dist_init=dist_temp
23449 if (subchap.eq.1) then
23458 dxj = dc_norm( 1,j )
23459 dyj = dc_norm( 2,j )
23460 dzj = dc_norm( 3,j )
23461 dscj_inv = vbld_inv(j+1)
23464 sig0ij = sigma_scpho(itypi )
23465 chi1 = chi_scpho(itypi,1 )
23466 chi2 = chi_scpho(itypi,2 )
23469 chi12 = chi1 * chi2
23470 chip1 = chipp_scpho(itypi,1 )
23471 chip2 = chipp_scpho(itypi,2 )
23474 chip12 = chip1 * chip2
23475 chis1 = chis_scpho(itypi,1)
23476 chis2 = chis_scpho(itypi,2)
23477 chis12 = chis1 * chis2
23478 sig1 = sigmap1_scpho(itypi)
23479 sig2 = sigmap2_scpho(itypi)
23480 ! write (*,*) "sig1 = ", sig1
23481 ! write (*,*) "sig1 = ", sig1
23482 ! write (*,*) "sig2 = ", sig2
23483 ! alpha factors from Fcav/Gcav
23487 a12sq = rborn_scphoi(itypi) * rborn_scphoj(itypi)
23489 b1 = alphasur_scpho(1,itypi)
23491 b2 = alphasur_scpho(2,itypi)
23492 b3 = alphasur_scpho(3,itypi)
23493 b4 = alphasur_scpho(4,itypi)
23494 ! used to determine whether we want to do quadrupole calculations
23496 eps_in = epsintab_scpho(itypi)
23497 if (eps_in.eq.0.0) eps_in=1.0
23498 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
23499 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
23500 !-------------------------------------------------------------------
23501 ! tail location and distance calculations
23502 d1i = dhead_scphoi(itypi) !this is shift of dipole/charge
23505 ! location of polar head is computed by taking hydrophobic centre
23506 ! and moving by a d1 * dc_norm vector
23507 ! see unres publications for very informative images
23508 chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
23509 chead(k,2) = (c(k, j) + c(k, j+1))/2.0
23511 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
23512 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
23513 Rhead_distance(k) = chead(k,2) - chead(k,1)
23515 ! pitagoras (root of sum of squares)
23517 (Rhead_distance(1)*Rhead_distance(1)) &
23518 + (Rhead_distance(2)*Rhead_distance(2)) &
23519 + (Rhead_distance(3)*Rhead_distance(3)))
23520 Rhead_sq=Rhead**2.0
23521 !-------------------------------------------------------------------
23522 ! zero everything that should be zero'ed
23541 dscj_inv = vbld_inv(j+1)/2.0
23542 !dhead_scbasej(itypi,itypj)
23543 ! print *,i,j,dscj_inv,dsci_inv
23544 ! rij holds 1/(distance of Calpha atoms)
23545 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23547 !----------------------------
23549 ! this should be in elgrad_init but om's are calculated by sc_angular
23550 ! which in turn is used by older potentials
23551 ! om = omega, sqom = om^2
23554 sqom12 = om12 * om12
23556 ! now we calculate EGB - Gey-Berne
23557 ! It will be summed up in evdwij and saved in evdw
23558 sigsq = 1.0D0 / sigsq
23559 sig = sig0ij * dsqrt(sigsq)
23560 ! rij_shift = 1.0D0 / rij - sig + sig0ij
23561 rij_shift = 1.0/rij - sig + sig0ij
23562 IF (rij_shift.le.0.0D0) THEN
23566 sigder = -sig * sigsq
23567 rij_shift = 1.0D0 / rij_shift
23568 fac = rij_shift**expon
23569 c1 = fac * fac * aa_scpho(itypi)
23571 c2 = fac * bb_scpho(itypi)
23573 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
23574 eps2der = eps3rt * evdwij
23575 eps3der = eps2rt * evdwij
23576 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
23577 evdwij = eps2rt * eps3rt * evdwij
23578 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
23579 fac = -expon * (c1 + evdwij) * rij_shift
23580 sigder = fac * sigder
23582 ! Calculate distance derivative
23586 fac = chis1 * sqom1 + chis2 * sqom2 &
23587 - 2.0d0 * chis12 * om1 * om2 * om12
23588 ! we will use pom later in Gcav, so dont mess with it!
23589 pom = 1.0d0 - chis1 * chis2 * sqom12
23590 Lambf = (1.0d0 - (fac / pom))
23591 Lambf = dsqrt(Lambf)
23592 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
23593 ! write (*,*) "sparrow = ", sparrow
23594 Chif = 1.0d0/rij * sparrow
23595 ChiLambf = Chif * Lambf
23596 eagle = dsqrt(ChiLambf)
23597 bat = ChiLambf ** 11.0d0
23598 top = b1 * ( eagle + b2 * ChiLambf - b3 )
23599 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
23602 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
23603 dbot = 12.0d0 * b4 * bat * Lambf
23604 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
23606 ! write (*,*) "dFcav/dR = ", dFdR
23607 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
23608 dbot = 12.0d0 * b4 * bat * Chif
23609 eagle = Lambf * pom
23610 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
23611 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
23612 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
23613 * (chis2 * om2 * om12 - om1) / (eagle * pom)
23615 dFdL = ((dtop * bot - top * dbot) / botsq)
23617 dCAVdOM1 = dFdL * ( dFdOM1 )
23618 dCAVdOM2 = dFdL * ( dFdOM2 )
23619 dCAVdOM12 = dFdL * ( dFdOM12 )
23625 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23626 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23627 ! if (i.eq.3) print *,'decl0',gvdwx_scpho(k,i),i
23630 ! print *,pom,gg(k),dFdR
23631 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
23632 gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
23633 - (( dFdR + gg(k) ) * pom)
23634 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
23635 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
23636 ! & - ( dFdR * pom )
23638 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
23639 ! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
23640 ! + (( dFdR + gg(k) ) * pom)
23641 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
23642 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23643 !c! & + ( dFdR * pom )
23645 gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
23646 - (( dFdR + gg(k) ) * ertail(k))
23647 !c! & - ( dFdR * ertail(k))
23649 gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
23650 + (( dFdR + gg(k) ) * ertail(k))/2.0
23652 gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
23653 + (( dFdR + gg(k) ) * ertail(k))/2.0
23655 !c! & + ( dFdR * ertail(k))
23659 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23660 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23661 ! alphapol1 = alphapol_scpho(itypi)
23662 if (wqq_scpho(itypi).gt.0.0) then
23663 Qij=wqq_scpho(itypi)/eps_in
23665 Ecl = (332.0d0 * Qij) / Rhead
23666 !c! derivative of Ecl is Gcl...
23667 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
23668 else if (wqdip_scpho(2,itypi).gt.0.0d0) then
23669 w1 = wqdip_scpho(1,itypi)
23670 w2 = wqdip_scpho(2,itypi)
23673 ! pis = sig0head_scbase(itypi,itypj)
23674 ! eps_head = epshead_scbase(itypi,itypj)
23675 !c!-------------------------------------------------------------------
23677 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
23678 !c! & +dhead(1,1,itypi,itypj))**2))
23679 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
23680 !c! & +dhead(2,1,itypi,itypj))**2))
23682 !c!-------------------------------------------------------------------
23685 hawk = w2 * (1.0d0 - sqom2)
23686 Ecl = sparrow / Rhead**2.0d0 &
23687 - hawk / Rhead**4.0d0
23688 !c!-------------------------------------------------------------------
23689 !c! derivative of ecl is Gcl
23691 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
23692 + 4.0d0 * hawk / Rhead**5.0d0
23694 dGCLdOM1 = (w1) / (Rhead**2.0d0)
23696 dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
23699 !c--------------------------------------------------------------------
23700 !c Polarization energy
23704 !c! Calculate head-to-tail distances tail is center of side-chain
23705 R1=R1+((c(k,j)+c(k,j+1))/2.0-chead(k,1))**2
23710 alphapol1 = alphapol_scpho(itypi)
23712 MomoFac1 = (1.0d0 - chi2 * sqom1)
23713 RR1 = R1 * R1 / MomoFac1
23714 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
23715 ! print *,"ee1",ee1,a12sq,alphapol1,eps_inout_fac
23716 fgb1 = sqrt( RR1 + a12sq * ee1)
23717 ! eps_inout_fac=0.0d0
23718 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
23719 ! derivative of Epol is Gpol...
23720 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
23722 dFGBdR1 = ( (R1 / MomoFac1) &
23723 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
23725 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
23726 * (2.0d0 - 0.5d0 * ee1) ) &
23728 dPOLdR1 = dPOLdFGB1 * dFGBdR1
23731 dFGBdOM1 = (((R1 * R1 * chi2 * om1) / (MomoFac1 * MomoFac1)) &
23732 * (2.0d0 - 0.5d0 * ee1) ) &
23735 dPOLdOM1 = dPOLdFGB1 * dFGBdOM1
23738 erhead(k) = Rhead_distance(k)/Rhead
23739 erhead_tail(k,1) = (((c(k,j)+c(k,j+1))/2.0-chead(k,1))/R1)
23742 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
23743 erdxj = scalar( erhead(1), dC_norm(1,j) )
23744 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
23746 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j))
23747 facd1 = d1i * vbld_inv(i+nres)
23748 facd2 = d1j * vbld_inv(j)
23749 ! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
23752 hawk = (erhead_tail(k,1) + &
23753 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
23756 ! if (i.eq.3) print *,'decl1',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i,&
23757 ! pom,(erhead_tail(k,1))
23759 ! print *,'decl',dGCLdR,dPOLdR1,gvdwc_scpho(k,i)
23760 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
23761 gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
23763 - dPOLdR1 * (erhead_tail(k,1))
23766 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
23767 ! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
23769 ! + dPOLdR1 * (erhead_tail(k,1))
23773 gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
23774 - dGCLdR * erhead(k) &
23775 - dPOLdR1 * erhead_tail(k,1)
23776 ! & - dGLJdR * erhead(k)
23778 gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
23779 + (dGCLdR * erhead(k) &
23780 + dPOLdR1 * erhead_tail(k,1))/2.0
23781 gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
23782 + (dGCLdR * erhead(k) &
23783 + dPOLdR1 * erhead_tail(k,1))/2.0
23785 ! & + dGLJdR * erhead(k)
23786 ! if (i.eq.3) print *,'decl2',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i
23789 ! if (i.eq.3) print *,i,j,evdwij,epol,Fcav,ECL
23790 escpho=escpho+evdwij+epol+Fcav+ECL
23797 end subroutine eprot_sc_phosphate
23798 SUBROUTINE sc_grad_scpho
23801 real (kind=8) :: dcosom1(3),dcosom2(3)
23803 eps2der * eps2rt_om1 &
23804 - 2.0D0 * alf1 * eps3der &
23805 + sigder * sigsq_om1 &
23811 eps2der * eps2rt_om2 &
23812 + 2.0D0 * alf2 * eps3der &
23813 + sigder * sigsq_om2 &
23819 evdwij * eps1_om12 &
23820 + eps2der * eps2rt_om12 &
23821 - 2.0D0 * alf12 * eps3der &
23822 + sigder *sigsq_om12 &
23827 ! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
23828 ! if (i.eq.30) print *,gvdwc_scpho(k,i),- gg(k),&
23829 ! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
23831 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
23832 ! gg(1),gg(2),"rozne"
23834 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
23835 dcosom2(k) = rij * (dc_norm(k,j) - om2 * erij(k))
23836 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
23837 gvdwc_scpho(k,j)= gvdwc_scpho(k,j) +0.5*( gg(k)) &
23838 + (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)))&
23840 - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
23841 gvdwc_scpho(k,j+1)= gvdwc_scpho(k,j+1) +0.5*( gg(k)) &
23842 - (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j))) &
23844 + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
23845 gvdwx_scpho(k,i)= gvdwx_scpho(k,i) - gg(k) &
23846 + (eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
23847 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
23849 ! print *,eom12,eom2,om12,om2
23850 !eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
23851 ! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
23852 ! gvdwx_scpho(k,j)= gvdwx_scpho(k,j) + gg(k) &
23853 ! + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
23854 ! + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23855 gvdwc_scpho(k,i)=gvdwc_scpho(k,i)-gg(k)
23858 END SUBROUTINE sc_grad_scpho
23859 subroutine eprot_pep_phosphate(epeppho)
23861 ! implicit real*8 (a-h,o-z)
23862 ! include 'DIMENSIONS'
23863 ! include 'COMMON.GEO'
23864 ! include 'COMMON.VAR'
23865 ! include 'COMMON.LOCAL'
23866 ! include 'COMMON.CHAIN'
23867 ! include 'COMMON.DERIV'
23868 ! include 'COMMON.NAMES'
23869 ! include 'COMMON.INTERACT'
23870 ! include 'COMMON.IOUNITS'
23871 ! include 'COMMON.CALC'
23872 ! include 'COMMON.CONTROL'
23873 ! include 'COMMON.SBRIDGE'
23875 !el local variables
23876 integer :: iint,itypi,itypi1,itypj,subchap
23877 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
23878 real(kind=8) :: evdw,sig0ij
23879 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
23880 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
23881 sslipi,sslipj,faclip
23883 real(kind=8) :: fracinbuf
23884 real (kind=8) :: epeppho
23885 real (kind=8),dimension(4):: ener
23886 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
23887 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
23888 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
23889 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
23890 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
23891 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
23892 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
23893 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
23894 real(kind=8),dimension(3,2)::chead,erhead_tail
23895 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
23897 real (kind=8) :: dcosom1(3),dcosom2(3)
23899 ! do i=1,nres_molec(1)
23900 do i=ibond_start,ibond_end
23901 if (itype(i,1).eq.ntyp1_molec(1)) cycle
23903 dsci_inv = vbld_inv(i+1)/2.0
23907 xi=(c(1,i)+c(1,i+1))/2.0
23908 yi=(c(2,i)+c(2,i+1))/2.0
23909 zi=(c(3,i)+c(3,i+1))/2.0
23910 xi=mod(xi,boxxsize)
23911 if (xi.lt.0) xi=xi+boxxsize
23912 yi=mod(yi,boxysize)
23913 if (yi.lt.0) yi=yi+boxysize
23914 zi=mod(zi,boxzsize)
23915 if (zi.lt.0) zi=zi+boxzsize
23916 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
23918 if ((itype(j,2).eq.ntyp1_molec(2)).or.&
23919 (itype(j+1,2).eq.ntyp1_molec(2))) cycle
23920 xj=(c(1,j)+c(1,j+1))/2.0
23921 yj=(c(2,j)+c(2,j+1))/2.0
23922 zj=(c(3,j)+c(3,j+1))/2.0
23923 xj=dmod(xj,boxxsize)
23924 if (xj.lt.0) xj=xj+boxxsize
23925 yj=dmod(yj,boxysize)
23926 if (yj.lt.0) yj=yj+boxysize
23927 zj=dmod(zj,boxzsize)
23928 if (zj.lt.0) zj=zj+boxzsize
23929 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23937 yj=yj_safe+yshift*boxysize
23938 zj=zj_safe+zshift*boxzsize
23939 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23940 if(dist_temp.lt.dist_init) then
23941 dist_init=dist_temp
23950 if (subchap.eq.1) then
23959 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23961 dxj = dc_norm( 1,j )
23962 dyj = dc_norm( 2,j )
23963 dzj = dc_norm( 3,j )
23964 dscj_inv = vbld_inv(j+1)/2.0
23966 sig0ij = sigma_peppho
23969 chi12 = chi1 * chi2
23972 chip12 = chip1 * chip2
23975 chis12 = chis1 * chis2
23976 sig1 = sigmap1_peppho
23977 sig2 = sigmap2_peppho
23978 ! write (*,*) "sig1 = ", sig1
23979 ! write (*,*) "sig1 = ", sig1
23980 ! write (*,*) "sig2 = ", sig2
23981 ! alpha factors from Fcav/Gcav
23985 b1 = alphasur_peppho(1)
23987 b2 = alphasur_peppho(2)
23988 b3 = alphasur_peppho(3)
23989 b4 = alphasur_peppho(4)
24011 fac = rij_shift**expon
24012 c1 = fac * fac * aa_peppho
24014 c2 = fac * bb_peppho
24017 ! Now cavity....................
24018 eagle = dsqrt(1.0/rij_shift)
24019 top = b1 * ( eagle + b2 * 1.0/rij_shift - b3 )
24020 bot = 1.0d0 + b4 * (1.0/rij_shift ** 12.0d0)
24023 dtop = b1 * ((1.0/ (2.0d0 * eagle)) + (b2))
24024 dbot = 12.0d0 * b4 * (1.0/rij_shift) ** 11.0d0
24025 dFdR = ((dtop * bot - top * dbot) / botsq)
24026 w1 = wqdip_peppho(1)
24027 w2 = wqdip_peppho(2)
24030 ! pis = sig0head_scbase(itypi,itypj)
24031 ! eps_head = epshead_scbase(itypi,itypj)
24032 !c!-------------------------------------------------------------------
24034 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
24035 !c! & +dhead(1,1,itypi,itypj))**2))
24036 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
24037 !c! & +dhead(2,1,itypi,itypj))**2))
24039 !c!-------------------------------------------------------------------
24042 hawk = w2 * (1.0d0 - sqom1)
24043 Ecl = sparrow * rij_shift**2.0d0 &
24044 - hawk * rij_shift**4.0d0
24045 !c!-------------------------------------------------------------------
24046 !c! derivative of ecl is Gcl
24049 dGCLdR = - 2.0d0 * sparrow * rij_shift**3.0d0 &
24050 + 4.0d0 * hawk * rij_shift**5.0d0
24052 dGCLdOM1 = (w1) * (rij_shift**2.0d0)
24054 dGCLdOM2 = (2.0d0 * w2 * om1) * (rij_shift ** 4.0d0)
24055 eom1 = dGCLdOM1+dGCLdOM2
24058 fac = -expon * (c1 + evdwij) * rij_shift+dFdR+dGCLdR
24064 gvdwc_peppho(k,j) = gvdwc_peppho(k,j) +gg(k)/2.0
24065 gvdwc_peppho(k,j+1) = gvdwc_peppho(k,j+1) +gg(k)/2.0
24066 gvdwc_peppho(k,i) = gvdwc_peppho(k,i) -gg(k)/2.0
24067 gvdwc_peppho(k,i+1) = gvdwc_peppho(k,i+1) -gg(k)/2.0
24072 dcosom1(k) = rij* (dc_norm(k,i) - om1 * erij(k))
24073 dcosom2(k) = rij* (dc_norm(k,j) - om2 * erij(k))
24074 gg(k) = gg(k) + eom1 * dcosom1(k)! + eom2 * dcosom2(k)
24075 gvdwc_peppho(k,j)= gvdwc_peppho(k,j) +0.5*( gg(k)) !&
24076 ! - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
24077 gvdwc_peppho(k,j+1)= gvdwc_peppho(k,j+1) +0.5*( gg(k)) !&
24078 ! + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
24079 gvdwc_peppho(k,i)= gvdwc_peppho(k,i) -0.5*( gg(k)) &
24080 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
24081 gvdwc_peppho(k,i+1)= gvdwc_peppho(k,i+1) - 0.5*( gg(k)) &
24082 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
24084 epeppho=epeppho+evdwij+Fcav+ECL
24085 ! print *,i,j,evdwij,Fcav,ECL,rij_shift
24088 end subroutine eprot_pep_phosphate