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 ! print *,"before",ees,evdw1,ecorr
608 call ebond_nucl(estr_nucl)
609 call ebend_nucl(ebe_nucl)
610 call etor_nucl(etors_nucl)
611 call esb_gb(evdwsb,eelsb)
612 call epp_nucl_sub(evdwpp,eespp)
613 call epsb(evdwpsb,eelpsb)
615 call multibody_hb_nucl(ecorr_nucl,ecorr3_nucl,n_corr,n_corr1)
616 call ecatcat(ecationcation)
617 call ecat_prot(ecation_prot)
618 call eprot_sc_base(escbase)
619 call epep_sc_base(epepbase)
620 call eprot_sc_phosphate(escpho)
621 call eprot_pep_phosphate(epeppho)
622 ! call ecatcat(ecationcation)
623 ! print *,"after ebend", ebe_nucl
625 time_enecalc=time_enecalc+MPI_Wtime()-time00
627 ! print *,"Processor",myrank," computed Uconstr"
636 energia(2)=evdw2-evdw2_14
653 energia(8)=eello_turn3
654 energia(9)=eello_turn4
661 energia(19)=edihcnstr
663 energia(20)=Uconst+Uconst_back
666 energia(23)=Eafmforce
667 energia(24)=ethetacnstr
669 !---------------------------------------------------------------
676 energia(32)=estr_nucl
679 energia(35)=etors_nucl
680 energia(36)=etors_d_nucl
681 energia(37)=ecorr_nucl
682 energia(38)=ecorr3_nucl
683 !----------------------------------------------------------------------
684 ! Here are the energies showed per procesor if the are more processors
685 ! per molecule then we sum it up in sum_energy subroutine
686 ! print *," Processor",myrank," calls SUM_ENERGY"
687 energia(41)=ecation_prot
688 energia(42)=ecationcation
693 call sum_energy(energia,.true.)
694 if (dyn_ss) call dyn_set_nss
695 ! print *," Processor",myrank," left SUM_ENERGY"
697 time_sumene=time_sumene+MPI_Wtime()-time00
699 !el call enerprint(energia)
700 !elwrite(iout,*)"finish etotal"
702 end subroutine etotal
703 !-----------------------------------------------------------------------------
704 subroutine sum_energy(energia,reduce)
705 ! implicit real*8 (a-h,o-z)
706 ! include 'DIMENSIONS'
710 !MS$ATTRIBUTES C :: proc_proc
716 ! include 'COMMON.SETUP'
717 ! include 'COMMON.IOUNITS'
718 real(kind=8) :: energia(0:n_ene),enebuff(0:n_ene+1)
719 ! include 'COMMON.FFIELD'
720 ! include 'COMMON.DERIV'
721 ! include 'COMMON.INTERACT'
722 ! include 'COMMON.SBRIDGE'
723 ! include 'COMMON.CHAIN'
724 ! include 'COMMON.VAR'
725 ! include 'COMMON.CONTROL'
726 ! include 'COMMON.TIME1'
728 real(kind=8) :: evdw,evdw2,evdw2_14,ees,evdw1,ecorr,ecorr5,ecorr6
729 real(kind=8) :: eel_loc,eello_turn3,eello_turn4,eturn6,ebe,escloc
730 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,esccor,etot, &
731 eliptran,etube, Eafmforce,ethetacnstr
732 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
733 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
735 real(kind=8) :: ecation_prot,ecationcation
736 real(kind=8) :: escbase,epepbase,escpho,epeppho
740 real(kind=8) :: time00
741 if (nfgtasks.gt.1 .and. reduce) then
744 write (iout,*) "energies before REDUCE"
745 call enerprint(energia)
749 enebuff(i)=energia(i)
752 call MPI_Barrier(FG_COMM,IERR)
753 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
755 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,&
756 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
758 write (iout,*) "energies after REDUCE"
759 call enerprint(energia)
762 time_Reduce=time_Reduce+MPI_Wtime()-time00
764 if (fg_rank.eq.0) then
768 evdw2=energia(2)+energia(18)
784 eello_turn3=energia(8)
785 eello_turn4=energia(9)
792 edihcnstr=energia(19)
797 Eafmforce=energia(23)
798 ethetacnstr=energia(24)
806 estr_nucl=energia(32)
809 etors_nucl=energia(35)
810 etors_d_nucl=energia(36)
811 ecorr_nucl=energia(37)
812 ecorr3_nucl=energia(38)
813 ecation_prot=energia(41)
814 ecationcation=energia(42)
819 ! energia(41)=ecation_prot
820 ! energia(42)=ecationcation
824 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 &
825 +wang*ebe+wtor*etors+wscloc*escloc &
826 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
827 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
828 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
829 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
830 +Eafmforce+ethetacnstr &
831 +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
832 +wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
833 +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
834 +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
835 +wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
836 +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho
838 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) &
839 +wang*ebe+wtor*etors+wscloc*escloc &
840 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
841 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
842 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
843 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
844 +Eafmforce+ethetacnstr &
845 +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
846 +wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
847 +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
848 +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
849 +wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
850 +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho
856 if (isnan(etot).ne.0) energia(0)=1.0d+99
858 if (isnan(etot)) energia(0)=1.0d+99
863 idumm=proc_proc(etot,i)
865 call proc_proc(etot,i)
867 if(i.eq.1)energia(0)=1.0d+99
872 ! call enerprint(energia)
875 end subroutine sum_energy
876 !-----------------------------------------------------------------------------
877 subroutine rescale_weights(t_bath)
878 ! implicit real*8 (a-h,o-z)
882 ! include 'DIMENSIONS'
883 ! include 'COMMON.IOUNITS'
884 ! include 'COMMON.FFIELD'
885 ! include 'COMMON.SBRIDGE'
886 real(kind=8) :: kfac=2.4d0
887 real(kind=8) :: x,x2,x3,x4,x5,licznik=1.12692801104297249644
889 real(kind=8) :: t_bath,facT(6) !,facT2,facT3,facT4,facT5,facT6
890 real(kind=8) :: T0=3.0d2
893 ! facT=2*temp0/(t_bath+temp0)
894 if (rescale_mode.eq.0) then
901 else if (rescale_mode.eq.1) then
902 facT(1)=kfac/(kfac-1.0d0+t_bath/temp0)
903 facT(2)=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
904 facT(3)=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
905 facT(4)=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
906 facT(5)=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
908 !#if defined(WHAM_RUN) || defined(CLUSTER)
910 ! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
911 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
918 else if (rescale_mode.eq.2) then
924 facT(1)=licznik/dlog(dexp(x)+dexp(-x))
925 facT(2)=licznik/dlog(dexp(x2)+dexp(-x2))
926 facT(3)=licznik/dlog(dexp(x3)+dexp(-x3))
927 facT(4)=licznik/dlog(dexp(x4)+dexp(-x4))
928 facT(5)=licznik/dlog(dexp(x5)+dexp(-x5))
930 !#if defined(WHAM_RUN) || defined(CLUSTER)
932 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
940 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
941 write (*,*) "Wrong RESCALE_MODE",rescale_mode
943 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
947 welec=weights(3)*fact(1)
948 wcorr=weights(4)*fact(3)
949 wcorr5=weights(5)*fact(4)
950 wcorr6=weights(6)*fact(5)
951 wel_loc=weights(7)*fact(2)
952 wturn3=weights(8)*fact(2)
953 wturn4=weights(9)*fact(3)
954 wturn6=weights(10)*fact(5)
955 wtor=weights(13)*fact(1)
956 wtor_d=weights(14)*fact(2)
957 wsccor=weights(21)*fact(1)
960 end subroutine rescale_weights
961 !-----------------------------------------------------------------------------
962 subroutine enerprint(energia)
963 ! implicit real*8 (a-h,o-z)
964 ! include 'DIMENSIONS'
965 ! include 'COMMON.IOUNITS'
966 ! include 'COMMON.FFIELD'
967 ! include 'COMMON.SBRIDGE'
968 ! include 'COMMON.MD'
969 real(kind=8) :: energia(0:n_ene)
971 real(kind=8) :: etot,evdw,evdw2,ees,evdw1,ecorr,ecorr5,ecorr6,eel_loc
972 real(kind=8) :: eello_turn6,eello_turn3,eello_turn4,ebe,escloc
973 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,Uconst,esccor,eliptran,&
974 etube,ethetacnstr,Eafmforce
975 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
976 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
978 real(kind=8) :: ecation_prot,ecationcation
979 real(kind=8) :: escbase,epepbase,escpho,epeppho
985 evdw2=energia(2)+energia(18)
997 eello_turn3=energia(8)
998 eello_turn4=energia(9)
999 eello_turn6=energia(10)
1005 edihcnstr=energia(19)
1009 eliptran=energia(22)
1010 Eafmforce=energia(23)
1011 ethetacnstr=energia(24)
1019 estr_nucl=energia(32)
1020 ebe_nucl=energia(33)
1022 etors_nucl=energia(35)
1023 etors_d_nucl=energia(36)
1024 ecorr_nucl=energia(37)
1025 ecorr3_nucl=energia(38)
1026 ecation_prot=energia(41)
1027 ecationcation=energia(42)
1029 epepbase=energia(47)
1033 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,&
1034 estr,wbond,ebe,wang,&
1035 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
1037 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
1038 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,&
1039 edihcnstr,ethetacnstr,ebr*nss,&
1040 Uconst,eliptran,wliptran,Eafmforce,etube,wtube, & ! till now protein
1041 estr_nucl,wbond_nucl,ebe_nucl,wang_nucl, &
1042 evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb,&
1043 evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl,&
1044 etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
1045 ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, &
1046 escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
1048 10 format (/'Virtual-chain energies:'// &
1049 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
1050 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
1051 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
1052 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ &
1053 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
1054 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
1055 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
1056 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
1057 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
1058 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
1059 ' (SS bridges & dist. cnstr.)'/ &
1060 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1061 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1062 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1063 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
1064 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
1065 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
1066 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
1067 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
1068 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
1069 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
1070 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
1071 'UCONST= ',1pE16.6,' (Constraint energy)'/ &
1072 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/&
1073 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
1074 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
1075 'ESTR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
1076 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
1077 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
1078 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
1079 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
1080 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
1081 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
1082 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
1083 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
1084 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
1085 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
1086 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
1087 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
1088 'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ &
1089 'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ &
1090 'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ &
1091 'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
1092 'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
1093 'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
1094 'ETOT= ',1pE16.6,' (total)')
1096 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,&
1097 estr,wbond,ebe,wang,&
1098 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
1100 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
1101 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,&
1102 ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc, &
1104 estr_nucl,wbond_nucl, ebe_nucl,wang_nucl,&
1105 evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb&
1106 evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl&
1107 etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
1108 ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, &
1109 escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
1111 10 format (/'Virtual-chain energies:'// &
1112 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
1113 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
1114 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
1115 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
1116 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
1117 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
1118 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
1119 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
1120 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
1121 ' (SS bridges & dist. cnstr.)'/ &
1122 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1123 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1124 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1125 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
1126 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
1127 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
1128 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
1129 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
1130 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
1131 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
1132 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
1133 'UCONST=',1pE16.6,' (Constraint energy)'/ &
1134 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ &
1135 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
1136 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
1137 'ESTR_nucl= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
1138 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
1139 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
1140 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
1141 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
1142 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
1143 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
1144 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
1145 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
1146 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
1147 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
1148 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
1149 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
1150 'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ &
1151 'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ &
1152 'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ &
1153 'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
1154 'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
1155 'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
1156 'ETOT= ',1pE16.6,' (total)')
1159 end subroutine enerprint
1160 !-----------------------------------------------------------------------------
1161 subroutine elj(evdw)
1163 ! This subroutine calculates the interaction energy of nonbonded side chains
1164 ! assuming the LJ potential of interaction.
1166 ! implicit real*8 (a-h,o-z)
1167 ! include 'DIMENSIONS'
1168 real(kind=8),parameter :: accur=1.0d-10
1169 ! include 'COMMON.GEO'
1170 ! include 'COMMON.VAR'
1171 ! include 'COMMON.LOCAL'
1172 ! include 'COMMON.CHAIN'
1173 ! include 'COMMON.DERIV'
1174 ! include 'COMMON.INTERACT'
1175 ! include 'COMMON.TORSION'
1176 ! include 'COMMON.SBRIDGE'
1177 ! include 'COMMON.NAMES'
1178 ! include 'COMMON.IOUNITS'
1179 ! include 'COMMON.CONTACTS'
1180 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1181 integer :: num_conti
1183 integer :: i,itypi,iint,j,itypi1,itypj,k
1184 real(kind=8) :: rij,rcut,fcont,fprimcont,rrij
1185 real(kind=8) :: evdw,xi,yi,zi,xj,yj,zj
1186 real(kind=8) :: eps0ij,fac,e1,e2,evdwij,sigij,r0ij
1188 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1190 ! allocate(num_cont(iatsc_s:iatsc_e)) !(maxres) nnt,nct-2
1191 ! allocate(jcont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres) (maxconts=maxres/4)
1192 ! allocate(facont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres)
1193 ! allocate(gacont(3,nres/4,iatsc_s:iatsc_e)) !(3,maxconts,maxres)
1195 do i=iatsc_s,iatsc_e
1196 itypi=iabs(itype(i,1))
1197 if (itypi.eq.ntyp1) cycle
1198 itypi1=iabs(itype(i+1,1))
1205 ! Calculate SC interaction energy.
1207 do iint=1,nint_gr(i)
1208 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1209 !d & 'iend=',iend(i,iint)
1210 do j=istart(i,iint),iend(i,iint)
1211 itypj=iabs(itype(j,1))
1212 if (itypj.eq.ntyp1) cycle
1216 ! Change 12/1/95 to calculate four-body interactions
1217 rij=xj*xj+yj*yj+zj*zj
1219 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1220 eps0ij=eps(itypi,itypj)
1222 e1=fac*fac*aa_aq(itypi,itypj)
1223 e2=fac*bb_aq(itypi,itypj)
1225 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1226 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1227 !d write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1228 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1229 !d & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1230 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1233 ! Calculate the components of the gradient in DC and X
1235 fac=-rrij*(e1+evdwij)
1240 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1241 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1242 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1243 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1247 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1251 ! 12/1/95, revised on 5/20/97
1253 ! Calculate the contact function. The ith column of the array JCONT will
1254 ! contain the numbers of atoms that make contacts with the atom I (of numbers
1255 ! greater than I). The arrays FACONT and GACONT will contain the values of
1256 ! the contact function and its derivative.
1258 ! Uncomment next line, if the correlation interactions include EVDW explicitly.
1259 ! if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1260 ! Uncomment next line, if the correlation interactions are contact function only
1261 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1263 sigij=sigma(itypi,itypj)
1264 r0ij=rs0(itypi,itypj)
1266 ! Check whether the SC's are not too far to make a contact.
1269 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1270 ! Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1272 if (fcont.gt.0.0D0) then
1273 ! If the SC-SC distance if close to sigma, apply spline.
1274 !Adam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1275 !Adam & fcont1,fprimcont1)
1276 !Adam fcont1=1.0d0-fcont1
1277 !Adam if (fcont1.gt.0.0d0) then
1278 !Adam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1279 !Adam fcont=fcont*fcont1
1281 ! Uncomment following 4 lines to have the geometric average of the epsilon0's
1282 !ga eps0ij=1.0d0/dsqrt(eps0ij)
1284 !ga gg(k)=gg(k)*eps0ij
1286 !ga eps0ij=-evdwij*eps0ij
1287 ! Uncomment for AL's type of SC correlation interactions.
1288 !adam eps0ij=-evdwij
1289 num_conti=num_conti+1
1290 jcont(num_conti,i)=j
1291 facont(num_conti,i)=fcont*eps0ij
1292 fprimcont=eps0ij*fprimcont/rij
1294 !Adam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1295 !Adam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1296 !Adam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1297 ! Uncomment following 3 lines for Skolnick's type of SC correlation.
1298 gacont(1,num_conti,i)=-fprimcont*xj
1299 gacont(2,num_conti,i)=-fprimcont*yj
1300 gacont(3,num_conti,i)=-fprimcont*zj
1301 !d write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1302 !d write (iout,'(2i3,3f10.5)')
1303 !d & i,j,(gacont(kk,num_conti,i),kk=1,3)
1309 num_cont(i)=num_conti
1313 gvdwc(j,i)=expon*gvdwc(j,i)
1314 gvdwx(j,i)=expon*gvdwx(j,i)
1317 !******************************************************************************
1321 ! To save time, the factor of EXPON has been extracted from ALL components
1322 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
1325 !******************************************************************************
1328 !-----------------------------------------------------------------------------
1329 subroutine eljk(evdw)
1331 ! This subroutine calculates the interaction energy of nonbonded side chains
1332 ! assuming the LJK potential of interaction.
1334 ! implicit real*8 (a-h,o-z)
1335 ! include 'DIMENSIONS'
1336 ! include 'COMMON.GEO'
1337 ! include 'COMMON.VAR'
1338 ! include 'COMMON.LOCAL'
1339 ! include 'COMMON.CHAIN'
1340 ! include 'COMMON.DERIV'
1341 ! include 'COMMON.INTERACT'
1342 ! include 'COMMON.IOUNITS'
1343 ! include 'COMMON.NAMES'
1344 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1347 integer :: i,iint,j,itypi,itypi1,k,itypj
1348 real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij
1349 real(kind=8) :: evdw,rij,r_shift_inv,fac,e1,e2,evdwij
1351 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1353 do i=iatsc_s,iatsc_e
1354 itypi=iabs(itype(i,1))
1355 if (itypi.eq.ntyp1) cycle
1356 itypi1=iabs(itype(i+1,1))
1361 ! Calculate SC interaction energy.
1363 do iint=1,nint_gr(i)
1364 do j=istart(i,iint),iend(i,iint)
1365 itypj=iabs(itype(j,1))
1366 if (itypj.eq.ntyp1) cycle
1370 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1371 fac_augm=rrij**expon
1372 e_augm=augm(itypi,itypj)*fac_augm
1373 r_inv_ij=dsqrt(rrij)
1375 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1376 fac=r_shift_inv**expon
1377 e1=fac*fac*aa_aq(itypi,itypj)
1378 e2=fac*bb_aq(itypi,itypj)
1380 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1381 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1382 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1383 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1384 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1385 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1386 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1389 ! Calculate the components of the gradient in DC and X
1391 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1396 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1397 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1398 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1399 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1403 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1411 gvdwc(j,i)=expon*gvdwc(j,i)
1412 gvdwx(j,i)=expon*gvdwx(j,i)
1417 !-----------------------------------------------------------------------------
1418 subroutine ebp(evdw)
1420 ! This subroutine calculates the interaction energy of nonbonded side chains
1421 ! assuming the Berne-Pechukas potential of interaction.
1425 ! implicit real*8 (a-h,o-z)
1426 ! include 'DIMENSIONS'
1427 ! include 'COMMON.GEO'
1428 ! include 'COMMON.VAR'
1429 ! include 'COMMON.LOCAL'
1430 ! include 'COMMON.CHAIN'
1431 ! include 'COMMON.DERIV'
1432 ! include 'COMMON.NAMES'
1433 ! include 'COMMON.INTERACT'
1434 ! include 'COMMON.IOUNITS'
1435 ! include 'COMMON.CALC'
1437 !el integer :: icall
1438 !el common /srutu/ icall
1439 ! double precision rrsave(maxdim)
1442 integer :: iint,itypi,itypi1,itypj
1443 real(kind=8) :: rrij,xi,yi,zi
1444 real(kind=8) :: evdw,fac,e1,e2,sigm,epsi
1446 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1448 ! if (icall.eq.0) then
1454 do i=iatsc_s,iatsc_e
1455 itypi=iabs(itype(i,1))
1456 if (itypi.eq.ntyp1) cycle
1457 itypi1=iabs(itype(i+1,1))
1461 dxi=dc_norm(1,nres+i)
1462 dyi=dc_norm(2,nres+i)
1463 dzi=dc_norm(3,nres+i)
1464 ! dsci_inv=dsc_inv(itypi)
1465 dsci_inv=vbld_inv(i+nres)
1467 ! Calculate SC interaction energy.
1469 do iint=1,nint_gr(i)
1470 do j=istart(i,iint),iend(i,iint)
1472 itypj=iabs(itype(j,1))
1473 if (itypj.eq.ntyp1) cycle
1474 ! dscj_inv=dsc_inv(itypj)
1475 dscj_inv=vbld_inv(j+nres)
1476 chi1=chi(itypi,itypj)
1477 chi2=chi(itypj,itypi)
1484 alf12=0.5D0*(alf1+alf2)
1485 ! For diagnostics only!!!
1498 dxj=dc_norm(1,nres+j)
1499 dyj=dc_norm(2,nres+j)
1500 dzj=dc_norm(3,nres+j)
1501 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1502 !d if (icall.eq.0) then
1508 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
1510 ! Calculate whole angle-dependent part of epsilon and contributions
1511 ! to its derivatives
1512 fac=(rrij*sigsq)**expon2
1513 e1=fac*fac*aa_aq(itypi,itypj)
1514 e2=fac*bb_aq(itypi,itypj)
1515 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1516 eps2der=evdwij*eps3rt
1517 eps3der=evdwij*eps2rt
1518 evdwij=evdwij*eps2rt*eps3rt
1521 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1522 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1523 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1524 !d & restyp(itypi,1),i,restyp(itypj,1),j,
1525 !d & epsi,sigm,chi1,chi2,chip1,chip2,
1526 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1527 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
1530 ! Calculate gradient components.
1531 e1=e1*eps1*eps2rt**2*eps3rt**2
1532 fac=-expon*(e1+evdwij)
1535 ! Calculate radial part of the gradient
1539 ! Calculate the angular part of the gradient and sum add the contributions
1540 ! to the appropriate components of the Cartesian gradient.
1548 !-----------------------------------------------------------------------------
1549 subroutine egb(evdw)
1551 ! This subroutine calculates the interaction energy of nonbonded side chains
1552 ! assuming the Gay-Berne potential of interaction.
1555 ! implicit real*8 (a-h,o-z)
1556 ! include 'DIMENSIONS'
1557 ! include 'COMMON.GEO'
1558 ! include 'COMMON.VAR'
1559 ! include 'COMMON.LOCAL'
1560 ! include 'COMMON.CHAIN'
1561 ! include 'COMMON.DERIV'
1562 ! include 'COMMON.NAMES'
1563 ! include 'COMMON.INTERACT'
1564 ! include 'COMMON.IOUNITS'
1565 ! include 'COMMON.CALC'
1566 ! include 'COMMON.CONTROL'
1567 ! include 'COMMON.SBRIDGE'
1570 integer :: iint,itypi,itypi1,itypj,subchap
1571 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
1572 real(kind=8) :: evdw,sig0ij
1573 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
1574 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
1575 sslipi,sslipj,faclip
1577 real(kind=8) :: fracinbuf
1579 !cccc energy_dec=.false.
1580 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1583 ! if (icall.eq.0) lprn=.false.
1585 do i=iatsc_s,iatsc_e
1586 !C print *,"I am in EVDW",i
1587 itypi=iabs(itype(i,1))
1588 ! if (i.ne.47) cycle
1589 if (itypi.eq.ntyp1) cycle
1590 itypi1=iabs(itype(i+1,1))
1594 xi=dmod(xi,boxxsize)
1595 if (xi.lt.0) xi=xi+boxxsize
1596 yi=dmod(yi,boxysize)
1597 if (yi.lt.0) yi=yi+boxysize
1598 zi=dmod(zi,boxzsize)
1599 if (zi.lt.0) zi=zi+boxzsize
1601 if ((zi.gt.bordlipbot) &
1602 .and.(zi.lt.bordliptop)) then
1603 !C the energy transfer exist
1604 if (zi.lt.buflipbot) then
1605 !C what fraction I am in
1607 ((zi-bordlipbot)/lipbufthick)
1608 !C lipbufthick is thickenes of lipid buffore
1609 sslipi=sscalelip(fracinbuf)
1610 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1611 elseif (zi.gt.bufliptop) then
1612 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1613 sslipi=sscalelip(fracinbuf)
1614 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1623 ! print *, sslipi,ssgradlipi
1624 dxi=dc_norm(1,nres+i)
1625 dyi=dc_norm(2,nres+i)
1626 dzi=dc_norm(3,nres+i)
1627 ! dsci_inv=dsc_inv(itypi)
1628 dsci_inv=vbld_inv(i+nres)
1629 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1630 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1632 ! Calculate SC interaction energy.
1634 do iint=1,nint_gr(i)
1635 do j=istart(i,iint),iend(i,iint)
1636 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1637 call dyn_ssbond_ene(i,j,evdwij)
1639 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1640 'evdw',i,j,evdwij,' ss'
1641 ! if (energy_dec) write (iout,*) &
1642 ! 'evdw',i,j,evdwij,' ss'
1643 do k=j+1,iend(i,iint)
1644 !C search over all next residues
1645 if (dyn_ss_mask(k)) then
1646 !C check if they are cysteins
1647 !C write(iout,*) 'k=',k
1649 !c write(iout,*) "PRZED TRI", evdwij
1650 ! evdwij_przed_tri=evdwij
1651 call triple_ssbond_ene(i,j,k,evdwij)
1652 !c if(evdwij_przed_tri.ne.evdwij) then
1653 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1656 !c write(iout,*) "PO TRI", evdwij
1657 !C call the energy function that removes the artifical triple disulfide
1658 !C bond the soubroutine is located in ssMD.F
1660 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1661 'evdw',i,j,evdwij,'tss'
1662 endif!dyn_ss_mask(k)
1666 itypj=iabs(itype(j,1))
1667 if (itypj.eq.ntyp1) cycle
1668 ! if (j.ne.78) cycle
1669 ! dscj_inv=dsc_inv(itypj)
1670 dscj_inv=vbld_inv(j+nres)
1671 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,&
1672 ! 1.0d0/vbld(j+nres) !d
1673 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
1674 sig0ij=sigma(itypi,itypj)
1675 chi1=chi(itypi,itypj)
1676 chi2=chi(itypj,itypi)
1683 alf12=0.5D0*(alf1+alf2)
1684 ! For diagnostics only!!!
1697 xj=dmod(xj,boxxsize)
1698 if (xj.lt.0) xj=xj+boxxsize
1699 yj=dmod(yj,boxysize)
1700 if (yj.lt.0) yj=yj+boxysize
1701 zj=dmod(zj,boxzsize)
1702 if (zj.lt.0) zj=zj+boxzsize
1703 ! print *,"tu",xi,yi,zi,xj,yj,zj
1704 ! print *,"tu2",j,j+nres,c(1,j),c(1,j+nres)
1705 ! this fragment set correct epsilon for lipid phase
1706 if ((zj.gt.bordlipbot) &
1707 .and.(zj.lt.bordliptop)) then
1708 !C the energy transfer exist
1709 if (zj.lt.buflipbot) then
1710 !C what fraction I am in
1712 ((zj-bordlipbot)/lipbufthick)
1713 !C lipbufthick is thickenes of lipid buffore
1714 sslipj=sscalelip(fracinbuf)
1715 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1716 elseif (zj.gt.bufliptop) then
1717 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1718 sslipj=sscalelip(fracinbuf)
1719 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1728 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1729 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1730 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1731 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1732 !------------------------------------------------
1733 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1741 xj=xj_safe+xshift*boxxsize
1742 yj=yj_safe+yshift*boxysize
1743 zj=zj_safe+zshift*boxzsize
1744 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1745 if(dist_temp.lt.dist_init) then
1755 if (subchap.eq.1) then
1764 dxj=dc_norm(1,nres+j)
1765 dyj=dc_norm(2,nres+j)
1766 dzj=dc_norm(3,nres+j)
1767 ! write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1768 ! write (iout,*) "j",j," dc_norm",& !d
1769 ! dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1770 ! write(iout,*)"rrij ",rrij
1771 ! write(iout,*)"xj yj zj ", xj, yj, zj
1772 ! write(iout,*)"xi yi zi ", xi, yi, zi
1773 ! write(iout,*)"c ", c(1,:), c(2,:), c(3,:)
1774 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1776 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
1777 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
1778 ! print *,sss_ele_cut,sss_ele_grad,&
1779 ! 1.0d0/(rij),r_cut_ele,rlamb_ele
1780 if (sss_ele_cut.le.0.0) cycle
1781 ! Calculate angle-dependent terms of energy and contributions to their
1785 sig=sig0ij*dsqrt(sigsq)
1786 rij_shift=1.0D0/rij-sig+sig0ij
1787 ! write(iout,*)" rij_shift",rij_shift," rij",rij," sig",sig,&
1789 ! for diagnostics; uncomment
1790 ! rij_shift=1.2*sig0ij
1791 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1792 if (rij_shift.le.0.0D0) then
1794 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1795 !d & restyp(itypi,1),i,restyp(itypj,1),j,
1796 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1800 !---------------------------------------------------------------
1801 rij_shift=1.0D0/rij_shift
1802 fac=rij_shift**expon
1804 e1=fac*fac*aa!(itypi,itypj)
1805 e2=fac*bb!(itypi,itypj)
1806 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1807 eps2der=evdwij*eps3rt
1808 eps3der=evdwij*eps2rt
1809 ! write(iout,*)"aa, bb ",aa(:,:),bb(:,:)
1810 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,& !d
1811 ! " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2," fac",fac !d
1812 evdwij=evdwij*eps2rt*eps3rt
1813 evdw=evdw+evdwij*sss_ele_cut
1815 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1816 epsi=bb**2/aa!(itypi,itypj)
1817 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1818 restyp(itypi,1),i,restyp(itypj,1),j, &
1819 epsi,sigm,chi1,chi2,chip1,chip2, &
1820 eps1,eps2rt**2,eps3rt**2,sig,sig0ij, &
1821 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, &
1825 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2e10.2,e11.3)')&
1826 'evdw',i,j,evdwij,xi,xj,rij !,"egb"
1827 !C print *,i,j,c(1,i),c(1,j),c(2,i),c(2,j),c(3,i),c(3,j)
1828 ! if (energy_dec) write (iout,*) &
1830 ! print *,"ZALAMKA", evdw
1832 ! Calculate gradient components.
1833 e1=e1*eps1*eps2rt**2*eps3rt**2
1834 fac=-expon*(e1+evdwij)*rij_shift
1837 ! print *,'before fac',fac,rij,evdwij
1838 fac=fac+evdwij*sss_ele_grad/sss_ele_cut&
1839 /sigma(itypi,itypj)*rij
1840 ! print *,'grad part scale',fac, &
1841 ! evdwij*sss_ele_grad/sss_ele_cut &
1842 ! /sigma(itypi,itypj)*rij
1844 ! Calculate the radial part of the gradient
1848 !C Calculate the radial part of the gradient
1849 gg_lipi(3)=eps1*(eps2rt*eps2rt)&
1850 *(eps3rt*eps3rt)*sss_ele_cut/2.0d0*(faclip*faclip*&
1851 (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))&
1852 +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1853 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1854 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1856 ! print *,'before sc_grad', gg(1),gg(2),gg(3)
1857 ! Calculate angular part of the gradient.
1863 ! print *,"ZALAMKA", evdw
1864 ! write (iout,*) "Number of loop steps in EGB:",ind
1865 !ccc energy_dec=.false.
1868 !-----------------------------------------------------------------------------
1869 subroutine egbv(evdw)
1871 ! This subroutine calculates the interaction energy of nonbonded side chains
1872 ! assuming the Gay-Berne-Vorobjev potential of interaction.
1876 ! implicit real*8 (a-h,o-z)
1877 ! include 'DIMENSIONS'
1878 ! include 'COMMON.GEO'
1879 ! include 'COMMON.VAR'
1880 ! include 'COMMON.LOCAL'
1881 ! include 'COMMON.CHAIN'
1882 ! include 'COMMON.DERIV'
1883 ! include 'COMMON.NAMES'
1884 ! include 'COMMON.INTERACT'
1885 ! include 'COMMON.IOUNITS'
1886 ! include 'COMMON.CALC'
1888 !el integer :: icall
1889 !el common /srutu/ icall
1892 integer :: iint,itypi,itypi1,itypj
1893 real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2,sigm
1894 real(kind=8) :: evdw,sig0ij,sig,rij_shift,epsi
1896 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1899 ! if (icall.eq.0) lprn=.true.
1901 do i=iatsc_s,iatsc_e
1902 itypi=iabs(itype(i,1))
1903 if (itypi.eq.ntyp1) cycle
1904 itypi1=iabs(itype(i+1,1))
1908 dxi=dc_norm(1,nres+i)
1909 dyi=dc_norm(2,nres+i)
1910 dzi=dc_norm(3,nres+i)
1911 ! dsci_inv=dsc_inv(itypi)
1912 dsci_inv=vbld_inv(i+nres)
1914 ! Calculate SC interaction energy.
1916 do iint=1,nint_gr(i)
1917 do j=istart(i,iint),iend(i,iint)
1919 itypj=iabs(itype(j,1))
1920 if (itypj.eq.ntyp1) cycle
1921 ! dscj_inv=dsc_inv(itypj)
1922 dscj_inv=vbld_inv(j+nres)
1923 sig0ij=sigma(itypi,itypj)
1924 r0ij=r0(itypi,itypj)
1925 chi1=chi(itypi,itypj)
1926 chi2=chi(itypj,itypi)
1933 alf12=0.5D0*(alf1+alf2)
1934 ! For diagnostics only!!!
1947 dxj=dc_norm(1,nres+j)
1948 dyj=dc_norm(2,nres+j)
1949 dzj=dc_norm(3,nres+j)
1950 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1952 ! Calculate angle-dependent terms of energy and contributions to their
1956 sig=sig0ij*dsqrt(sigsq)
1957 rij_shift=1.0D0/rij-sig+r0ij
1958 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1959 if (rij_shift.le.0.0D0) then
1964 !---------------------------------------------------------------
1965 rij_shift=1.0D0/rij_shift
1966 fac=rij_shift**expon
1967 e1=fac*fac*aa_aq(itypi,itypj)
1968 e2=fac*bb_aq(itypi,itypj)
1969 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1970 eps2der=evdwij*eps3rt
1971 eps3der=evdwij*eps2rt
1972 fac_augm=rrij**expon
1973 e_augm=augm(itypi,itypj)*fac_augm
1974 evdwij=evdwij*eps2rt*eps3rt
1975 evdw=evdw+evdwij+e_augm
1977 sigm=dabs(aa_aq(itypi,itypj)/&
1978 bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1979 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1980 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1981 restyp(itypi,1),i,restyp(itypj,1),j,&
1982 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
1983 chi1,chi2,chip1,chip2,&
1984 eps1,eps2rt**2,eps3rt**2,&
1985 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
1988 ! Calculate gradient components.
1989 e1=e1*eps1*eps2rt**2*eps3rt**2
1990 fac=-expon*(e1+evdwij)*rij_shift
1992 fac=rij*fac-2*expon*rrij*e_augm
1993 ! Calculate the radial part of the gradient
1997 ! Calculate angular part of the gradient.
2003 !-----------------------------------------------------------------------------
2004 !el subroutine sc_angular in module geometry
2005 !-----------------------------------------------------------------------------
2006 subroutine e_softsphere(evdw)
2008 ! This subroutine calculates the interaction energy of nonbonded side chains
2009 ! assuming the LJ potential of interaction.
2011 ! implicit real*8 (a-h,o-z)
2012 ! include 'DIMENSIONS'
2013 real(kind=8),parameter :: accur=1.0d-10
2014 ! include 'COMMON.GEO'
2015 ! include 'COMMON.VAR'
2016 ! include 'COMMON.LOCAL'
2017 ! include 'COMMON.CHAIN'
2018 ! include 'COMMON.DERIV'
2019 ! include 'COMMON.INTERACT'
2020 ! include 'COMMON.TORSION'
2021 ! include 'COMMON.SBRIDGE'
2022 ! include 'COMMON.NAMES'
2023 ! include 'COMMON.IOUNITS'
2024 ! include 'COMMON.CONTACTS'
2025 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
2026 !d print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2028 integer :: i,iint,j,itypi,itypi1,itypj,k
2029 real(kind=8) :: evdw,xj,yj,zj,xi,yi,zi,rij,r0ij,r0ijsq,evdwij
2033 do i=iatsc_s,iatsc_e
2034 itypi=iabs(itype(i,1))
2035 if (itypi.eq.ntyp1) cycle
2036 itypi1=iabs(itype(i+1,1))
2041 ! Calculate SC interaction energy.
2043 do iint=1,nint_gr(i)
2044 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2045 !d & 'iend=',iend(i,iint)
2046 do j=istart(i,iint),iend(i,iint)
2047 itypj=iabs(itype(j,1))
2048 if (itypj.eq.ntyp1) cycle
2052 rij=xj*xj+yj*yj+zj*zj
2053 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2054 r0ij=r0(itypi,itypj)
2056 ! print *,i,j,r0ij,dsqrt(rij)
2057 if (rij.lt.r0ijsq) then
2058 evdwij=0.25d0*(rij-r0ijsq)**2
2066 ! Calculate the components of the gradient in DC and X
2072 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2073 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2074 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2075 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2079 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2086 end subroutine e_softsphere
2087 !-----------------------------------------------------------------------------
2088 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2090 ! Soft-sphere potential of p-p interaction
2092 ! implicit real*8 (a-h,o-z)
2093 ! include 'DIMENSIONS'
2094 ! include 'COMMON.CONTROL'
2095 ! include 'COMMON.IOUNITS'
2096 ! include 'COMMON.GEO'
2097 ! include 'COMMON.VAR'
2098 ! include 'COMMON.LOCAL'
2099 ! include 'COMMON.CHAIN'
2100 ! include 'COMMON.DERIV'
2101 ! include 'COMMON.INTERACT'
2102 ! include 'COMMON.CONTACTS'
2103 ! include 'COMMON.TORSION'
2104 ! include 'COMMON.VECTORS'
2105 ! include 'COMMON.FFIELD'
2106 real(kind=8),dimension(3) :: ggg
2107 !d write(iout,*) 'In EELEC_soft_sphere'
2109 integer :: i,j,k,num_conti,iteli,itelj
2110 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
2111 real(kind=8) :: dxi,dyi,dzi,xmedi,ymedi,zmedi,r0ij,r0ijsq
2112 real(kind=8) :: dxj,dyj,dzj,xj,yj,zj,rij,evdw1ij,fac
2120 do i=iatel_s,iatel_e
2121 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
2125 xmedi=c(1,i)+0.5d0*dxi
2126 ymedi=c(2,i)+0.5d0*dyi
2127 zmedi=c(3,i)+0.5d0*dzi
2129 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2130 do j=ielstart(i),ielend(i)
2131 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
2135 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2136 r0ij=rpp(iteli,itelj)
2141 xj=c(1,j)+0.5D0*dxj-xmedi
2142 yj=c(2,j)+0.5D0*dyj-ymedi
2143 zj=c(3,j)+0.5D0*dzj-zmedi
2144 rij=xj*xj+yj*yj+zj*zj
2145 if (rij.lt.r0ijsq) then
2146 evdw1ij=0.25d0*(rij-r0ijsq)**2
2154 ! Calculate contributions to the Cartesian gradient.
2160 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2161 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2164 ! Loop over residues i+1 thru j-1.
2168 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2173 !grad do i=nnt,nct-1
2175 !grad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2177 !grad do j=i+1,nct-1
2179 !grad gelc(k,i)=gelc(k,i)+gelc(k,j)
2184 end subroutine eelec_soft_sphere
2185 !-----------------------------------------------------------------------------
2186 subroutine vec_and_deriv
2187 ! implicit real*8 (a-h,o-z)
2188 ! include 'DIMENSIONS'
2192 ! include 'COMMON.IOUNITS'
2193 ! include 'COMMON.GEO'
2194 ! include 'COMMON.VAR'
2195 ! include 'COMMON.LOCAL'
2196 ! include 'COMMON.CHAIN'
2197 ! include 'COMMON.VECTORS'
2198 ! include 'COMMON.SETUP'
2199 ! include 'COMMON.TIME1'
2200 real(kind=8),dimension(3,3,2) :: uyder,uzder
2201 real(kind=8),dimension(2) :: vbld_inv_temp
2202 ! Compute the local reference systems. For reference system (i), the
2203 ! X-axis points from CA(i) to CA(i+1), the Y axis is in the
2204 ! CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2207 real(kind=8) :: facy,fac,costh
2210 do i=ivec_start,ivec_end
2214 if (i.eq.nres-1) then
2215 ! Case of the last full residue
2216 ! Compute the Z-axis
2217 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2218 costh=dcos(pi-theta(nres))
2219 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2223 ! Compute the derivatives of uz
2225 uzder(2,1,1)=-dc_norm(3,i-1)
2226 uzder(3,1,1)= dc_norm(2,i-1)
2227 uzder(1,2,1)= dc_norm(3,i-1)
2229 uzder(3,2,1)=-dc_norm(1,i-1)
2230 uzder(1,3,1)=-dc_norm(2,i-1)
2231 uzder(2,3,1)= dc_norm(1,i-1)
2234 uzder(2,1,2)= dc_norm(3,i)
2235 uzder(3,1,2)=-dc_norm(2,i)
2236 uzder(1,2,2)=-dc_norm(3,i)
2238 uzder(3,2,2)= dc_norm(1,i)
2239 uzder(1,3,2)= dc_norm(2,i)
2240 uzder(2,3,2)=-dc_norm(1,i)
2242 ! Compute the Y-axis
2245 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2247 ! Compute the derivatives of uy
2250 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) &
2251 -dc_norm(k,i)*dc_norm(j,i-1)
2252 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2254 uyder(j,j,1)=uyder(j,j,1)-costh
2255 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2260 uygrad(l,k,j,i)=uyder(l,k,j)
2261 uzgrad(l,k,j,i)=uzder(l,k,j)
2265 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2266 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2267 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2268 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2271 ! Compute the Z-axis
2272 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2273 costh=dcos(pi-theta(i+2))
2274 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2278 ! Compute the derivatives of uz
2280 uzder(2,1,1)=-dc_norm(3,i+1)
2281 uzder(3,1,1)= dc_norm(2,i+1)
2282 uzder(1,2,1)= dc_norm(3,i+1)
2284 uzder(3,2,1)=-dc_norm(1,i+1)
2285 uzder(1,3,1)=-dc_norm(2,i+1)
2286 uzder(2,3,1)= dc_norm(1,i+1)
2289 uzder(2,1,2)= dc_norm(3,i)
2290 uzder(3,1,2)=-dc_norm(2,i)
2291 uzder(1,2,2)=-dc_norm(3,i)
2293 uzder(3,2,2)= dc_norm(1,i)
2294 uzder(1,3,2)= dc_norm(2,i)
2295 uzder(2,3,2)=-dc_norm(1,i)
2297 ! Compute the Y-axis
2300 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2302 ! Compute the derivatives of uy
2305 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) &
2306 -dc_norm(k,i)*dc_norm(j,i+1)
2307 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2309 uyder(j,j,1)=uyder(j,j,1)-costh
2310 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2315 uygrad(l,k,j,i)=uyder(l,k,j)
2316 uzgrad(l,k,j,i)=uzder(l,k,j)
2320 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2321 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2322 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2323 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2327 vbld_inv_temp(1)=vbld_inv(i+1)
2328 if (i.lt.nres-1) then
2329 vbld_inv_temp(2)=vbld_inv(i+2)
2331 vbld_inv_temp(2)=vbld_inv(i)
2336 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2337 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2342 #if defined(PARVEC) && defined(MPI)
2343 if (nfgtasks1.gt.1) then
2345 ! print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2346 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2347 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2348 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),&
2349 MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2351 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),&
2352 MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2354 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),&
2355 ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),&
2356 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2357 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),&
2358 ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),&
2359 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2360 time_gather=time_gather+MPI_Wtime()-time00
2362 ! if (fg_rank.eq.0) then
2363 ! write (iout,*) "Arrays UY and UZ"
2365 ! write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2371 end subroutine vec_and_deriv
2372 !-----------------------------------------------------------------------------
2373 subroutine check_vecgrad
2374 ! implicit real*8 (a-h,o-z)
2375 ! include 'DIMENSIONS'
2376 ! include 'COMMON.IOUNITS'
2377 ! include 'COMMON.GEO'
2378 ! include 'COMMON.VAR'
2379 ! include 'COMMON.LOCAL'
2380 ! include 'COMMON.CHAIN'
2381 ! include 'COMMON.VECTORS'
2382 real(kind=8),dimension(3,3,2,nres) :: uygradt,uzgradt !(3,3,2,maxres)
2383 real(kind=8),dimension(3,nres) :: uyt,uzt !(3,maxres)
2384 real(kind=8),dimension(3,3,2) :: uygradn,uzgradn
2385 real(kind=8),dimension(3) :: erij
2386 real(kind=8) :: delta=1.0d-7
2392 !rc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2393 !rc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2394 !rc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2395 !d write(iout,'(2i5,2(3f10.5,5x))') i,1,
2396 !d & (dc_norm(if90,i),if90=1,3)
2397 !d write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2398 !d write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2399 !d write(iout,'(a)')
2405 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2406 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2419 !d write (iout,*) 'i=',i
2421 erij(k)=dc_norm(k,i)
2425 dc_norm(k,i)=erij(k)
2427 dc_norm(j,i)=dc_norm(j,i)+delta
2428 ! fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2430 ! dc_norm(k,i)=dc_norm(k,i)/fac
2432 ! write (iout,*) (dc_norm(k,i),k=1,3)
2433 ! write (iout,*) (erij(k),k=1,3)
2436 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2437 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2438 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2439 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2441 ! write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2442 ! & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2443 ! & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2446 dc_norm(k,i)=erij(k)
2449 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2450 !d & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2451 !d & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2452 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2453 !d & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2454 !d & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2455 !d write (iout,'(a)')
2459 end subroutine check_vecgrad
2460 !-----------------------------------------------------------------------------
2461 subroutine set_matrices
2462 ! implicit real*8 (a-h,o-z)
2463 ! include 'DIMENSIONS'
2466 ! include "COMMON.SETUP"
2468 integer :: status(MPI_STATUS_SIZE)
2470 ! include 'COMMON.IOUNITS'
2471 ! include 'COMMON.GEO'
2472 ! include 'COMMON.VAR'
2473 ! include 'COMMON.LOCAL'
2474 ! include 'COMMON.CHAIN'
2475 ! include 'COMMON.DERIV'
2476 ! include 'COMMON.INTERACT'
2477 ! include 'COMMON.CONTACTS'
2478 ! include 'COMMON.TORSION'
2479 ! include 'COMMON.VECTORS'
2480 ! include 'COMMON.FFIELD'
2481 real(kind=8) :: auxvec(2),auxmat(2,2)
2482 integer :: i,iti1,iti,k,l
2483 real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2
2484 ! print *,"in set matrices"
2486 ! Compute the virtual-bond-torsional-angle dependent quantities needed
2487 ! to calculate the el-loc multibody terms of various order.
2491 do i=ivec_start+2,ivec_end+2
2496 if (i .lt. nres+1) then
2533 if (i .gt. 3 .and. i .lt. nres+1) then
2534 obrot_der(1,i-2)=-sin1
2535 obrot_der(2,i-2)= cos1
2536 Ugder(1,1,i-2)= sin1
2537 Ugder(1,2,i-2)=-cos1
2538 Ugder(2,1,i-2)=-cos1
2539 Ugder(2,2,i-2)=-sin1
2542 obrot2_der(1,i-2)=-dwasin2
2543 obrot2_der(2,i-2)= dwacos2
2544 Ug2der(1,1,i-2)= dwasin2
2545 Ug2der(1,2,i-2)=-dwacos2
2546 Ug2der(2,1,i-2)=-dwacos2
2547 Ug2der(2,2,i-2)=-dwasin2
2549 obrot_der(1,i-2)=0.0d0
2550 obrot_der(2,i-2)=0.0d0
2551 Ugder(1,1,i-2)=0.0d0
2552 Ugder(1,2,i-2)=0.0d0
2553 Ugder(2,1,i-2)=0.0d0
2554 Ugder(2,2,i-2)=0.0d0
2555 obrot2_der(1,i-2)=0.0d0
2556 obrot2_der(2,i-2)=0.0d0
2557 Ug2der(1,1,i-2)=0.0d0
2558 Ug2der(1,2,i-2)=0.0d0
2559 Ug2der(2,1,i-2)=0.0d0
2560 Ug2der(2,2,i-2)=0.0d0
2562 ! if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2563 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2564 iti = itortyp(itype(i-2,1))
2568 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2569 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2570 iti1 = itortyp(itype(i-1,1))
2574 ! print *,iti,i,"iti",iti1,itype(i-1,1),itype(i-2,1)
2575 !d write (iout,*) '*******i',i,' iti1',iti
2576 !d write (iout,*) 'b1',b1(:,iti)
2577 !d write (iout,*) 'b2',b2(:,iti)
2578 !d write (iout,*) 'Ug',Ug(:,:,i-2)
2579 ! if (i .gt. iatel_s+2) then
2580 if (i .gt. nnt+2) then
2581 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2582 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2583 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2585 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2586 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2587 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2588 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2589 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2600 DtUg2(l,k,i-2)=0.0d0
2604 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2605 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2607 muder(k,i-2)=Ub2der(k,i-2)
2609 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2610 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2611 if (itype(i-1,1).le.ntyp) then
2612 iti1 = itortyp(itype(i-1,1))
2620 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2622 ! if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2)
2623 ! if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,iti1)
2624 ! if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2)
2625 !d write (iout,*) 'mu1',mu1(:,i-2)
2626 !d write (iout,*) 'mu2',mu2(:,i-2)
2627 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2629 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2630 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2631 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2632 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2633 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2634 ! Vectors and matrices dependent on a single virtual-bond dihedral.
2635 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2636 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2637 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2638 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2639 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2640 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2641 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2642 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2643 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2646 ! Matrices dependent on two consecutive virtual-bond dihedrals.
2647 ! The order of matrices is from left to right.
2648 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2650 ! do i=max0(ivec_start,2),ivec_end
2652 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2653 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2654 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2655 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2656 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2657 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2658 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2659 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2662 #if defined(MPI) && defined(PARMAT)
2664 ! if (fg_rank.eq.0) then
2665 write (iout,*) "Arrays UG and UGDER before GATHER"
2667 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2668 ((ug(l,k,i),l=1,2),k=1,2),&
2669 ((ugder(l,k,i),l=1,2),k=1,2)
2671 write (iout,*) "Arrays UG2 and UG2DER"
2673 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2674 ((ug2(l,k,i),l=1,2),k=1,2),&
2675 ((ug2der(l,k,i),l=1,2),k=1,2)
2677 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2679 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2680 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2681 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2683 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2685 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2686 costab(i),sintab(i),costab2(i),sintab2(i)
2688 write (iout,*) "Array MUDER"
2690 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2694 if (nfgtasks.gt.1) then
2696 ! write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2697 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2698 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2700 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),&
2701 MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2703 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),&
2704 MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2706 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),&
2707 MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2709 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),&
2710 MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2712 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),&
2713 MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2715 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),&
2716 MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2718 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),&
2719 MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),&
2720 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2721 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),&
2722 MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),&
2723 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2724 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),&
2725 MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),&
2726 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2727 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),&
2728 MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),&
2729 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2730 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2732 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),&
2733 MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2735 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),&
2736 MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2738 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),&
2739 MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2741 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),&
2742 MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2744 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),&
2745 MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2747 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),&
2748 ivec_count(fg_rank1),&
2749 MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2751 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),&
2752 MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2754 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),&
2755 MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2757 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),&
2758 MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2760 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),&
2761 MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2763 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),&
2764 MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2766 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),&
2767 MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2769 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),&
2770 MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2772 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),&
2773 ivec_count(fg_rank1),&
2774 MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2776 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),&
2777 MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2779 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),&
2780 MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2782 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),&
2783 MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2785 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),&
2786 MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2788 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),&
2789 ivec_count(fg_rank1),&
2790 MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2792 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),&
2793 ivec_count(fg_rank1),&
2794 MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2796 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),&
2797 ivec_count(fg_rank1),&
2798 MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2799 MPI_MAT2,FG_COMM1,IERR)
2800 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),&
2801 ivec_count(fg_rank1),&
2802 MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2803 MPI_MAT2,FG_COMM1,IERR)
2806 ! Passes matrix info through the ring
2809 if (irecv.lt.0) irecv=nfgtasks1-1
2812 if (inext.ge.nfgtasks1) inext=0
2814 ! write (iout,*) "isend",isend," irecv",irecv
2816 lensend=lentyp(isend)
2817 lenrecv=lentyp(irecv)
2818 ! write (iout,*) "lensend",lensend," lenrecv",lenrecv
2819 ! call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2820 ! & MPI_ROTAT1(lensend),inext,2200+isend,
2821 ! & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2822 ! & iprev,2200+irecv,FG_COMM,status,IERR)
2823 ! write (iout,*) "Gather ROTAT1"
2825 ! call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2826 ! & MPI_ROTAT2(lensend),inext,3300+isend,
2827 ! & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2828 ! & iprev,3300+irecv,FG_COMM,status,IERR)
2829 ! write (iout,*) "Gather ROTAT2"
2831 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,&
2832 MPI_ROTAT_OLD(lensend),inext,4400+isend,&
2833 costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),&
2834 iprev,4400+irecv,FG_COMM,status,IERR)
2835 ! write (iout,*) "Gather ROTAT_OLD"
2837 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,&
2838 MPI_PRECOMP11(lensend),inext,5500+isend,&
2839 mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),&
2840 iprev,5500+irecv,FG_COMM,status,IERR)
2841 ! write (iout,*) "Gather PRECOMP11"
2843 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,&
2844 MPI_PRECOMP12(lensend),inext,6600+isend,&
2845 Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),&
2846 iprev,6600+irecv,FG_COMM,status,IERR)
2847 ! write (iout,*) "Gather PRECOMP12"
2849 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2851 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,&
2852 MPI_ROTAT2(lensend),inext,7700+isend,&
2853 ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),&
2854 iprev,7700+irecv,FG_COMM,status,IERR)
2855 ! write (iout,*) "Gather PRECOMP21"
2857 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,&
2858 MPI_PRECOMP22(lensend),inext,8800+isend,&
2859 EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),&
2860 iprev,8800+irecv,FG_COMM,status,IERR)
2861 ! write (iout,*) "Gather PRECOMP22"
2863 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,&
2864 MPI_PRECOMP23(lensend),inext,9900+isend,&
2865 Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,&
2866 MPI_PRECOMP23(lenrecv),&
2867 iprev,9900+irecv,FG_COMM,status,IERR)
2868 ! write (iout,*) "Gather PRECOMP23"
2873 if (irecv.lt.0) irecv=nfgtasks1-1
2876 time_gather=time_gather+MPI_Wtime()-time00
2879 ! if (fg_rank.eq.0) then
2880 write (iout,*) "Arrays UG and UGDER"
2882 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2883 ((ug(l,k,i),l=1,2),k=1,2),&
2884 ((ugder(l,k,i),l=1,2),k=1,2)
2886 write (iout,*) "Arrays UG2 and UG2DER"
2888 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2889 ((ug2(l,k,i),l=1,2),k=1,2),&
2890 ((ug2der(l,k,i),l=1,2),k=1,2)
2892 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2894 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2895 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2896 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2898 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2900 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2901 costab(i),sintab(i),costab2(i),sintab2(i)
2903 write (iout,*) "Array MUDER"
2905 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2911 !d iti = itortyp(itype(i,1))
2914 !d write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2915 !d & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2919 end subroutine set_matrices
2920 !-----------------------------------------------------------------------------
2921 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2923 ! This subroutine calculates the average interaction energy and its gradient
2924 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
2925 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2926 ! The potential depends both on the distance of peptide-group centers and on
2927 ! the orientation of the CA-CA virtual bonds.
2930 ! implicit real*8 (a-h,o-z)
2934 ! include 'DIMENSIONS'
2935 ! include 'COMMON.CONTROL'
2936 ! include 'COMMON.SETUP'
2937 ! include 'COMMON.IOUNITS'
2938 ! include 'COMMON.GEO'
2939 ! include 'COMMON.VAR'
2940 ! include 'COMMON.LOCAL'
2941 ! include 'COMMON.CHAIN'
2942 ! include 'COMMON.DERIV'
2943 ! include 'COMMON.INTERACT'
2944 ! include 'COMMON.CONTACTS'
2945 ! include 'COMMON.TORSION'
2946 ! include 'COMMON.VECTORS'
2947 ! include 'COMMON.FFIELD'
2948 ! include 'COMMON.TIME1'
2949 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
2950 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
2951 real(kind=8),dimension(2,2) :: acipa !el,a_temp
2952 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
2953 real(kind=8),dimension(4) :: muij
2954 !el integer :: num_conti,j1,j2
2955 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
2956 !el dz_normi,xmedi,ymedi,zmedi
2958 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
2959 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
2962 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2964 real(kind=8) :: scal_el=1.0d0
2966 real(kind=8) :: scal_el=0.5d0
2969 ! 13-go grudnia roku pamietnego...
2970 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
2972 0.0d0,0.0d0,1.0d0/),shape(unmat))
2975 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
2976 real(kind=8) :: fac,t_eelecij,fracinbuf
2979 !d write(iout,*) 'In EELEC'
2980 ! print *,"IN EELEC"
2982 !d write(iout,*) 'Type',i
2983 !d write(iout,*) 'B1',B1(:,i)
2984 !d write(iout,*) 'B2',B2(:,i)
2985 !d write(iout,*) 'CC',CC(:,:,i)
2986 !d write(iout,*) 'DD',DD(:,:,i)
2987 !d write(iout,*) 'EE',EE(:,:,i)
2989 !d call check_vecgrad
3004 if (icheckgrad.eq.1) then
3007 ! dc_norm(1,i)=0.0d0
3008 ! dc_norm(2,i)=0.0d0
3009 ! dc_norm(3,i)=0.0d0
3012 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3014 dc_norm(k,i)=dc(k,i)*fac
3016 ! write (iout,*) 'i',i,' fac',fac
3019 ! print *,wel_loc,"wel_loc",wcorr4,wcorr5,wcorr6,wturn3,wturn4, &
3021 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3022 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
3023 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3024 ! call vec_and_deriv
3028 ! print *, "before set matrices"
3030 ! print *, "after set matrices"
3033 time_mat=time_mat+MPI_Wtime()-time01
3036 ! print *, "after set matrices"
3038 !d write (iout,*) 'i=',i
3040 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3043 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3044 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3057 !d print '(a)','Enter EELEC'
3058 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3059 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
3060 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
3062 gel_loc_loc(i)=0.0d0
3067 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3069 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
3073 ! print *,"before iturn3 loop"
3074 do i=iturn3_start,iturn3_end
3075 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
3076 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
3080 dx_normi=dc_norm(1,i)
3081 dy_normi=dc_norm(2,i)
3082 dz_normi=dc_norm(3,i)
3083 xmedi=c(1,i)+0.5d0*dxi
3084 ymedi=c(2,i)+0.5d0*dyi
3085 zmedi=c(3,i)+0.5d0*dzi
3086 xmedi=dmod(xmedi,boxxsize)
3087 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3088 ymedi=dmod(ymedi,boxysize)
3089 if (ymedi.lt.0) ymedi=ymedi+boxysize
3090 zmedi=dmod(zmedi,boxzsize)
3091 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3093 if ((zmedi.gt.bordlipbot) &
3094 .and.(zmedi.lt.bordliptop)) then
3095 !C the energy transfer exist
3096 if (zmedi.lt.buflipbot) then
3097 !C what fraction I am in
3099 ((zmedi-bordlipbot)/lipbufthick)
3100 !C lipbufthick is thickenes of lipid buffore
3101 sslipi=sscalelip(fracinbuf)
3102 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3103 elseif (zmedi.gt.bufliptop) then
3104 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3105 sslipi=sscalelip(fracinbuf)
3106 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3115 ! print *,i,sslipi,ssgradlipi
3116 call eelecij(i,i+2,ees,evdw1,eel_loc)
3117 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3118 num_cont_hb(i)=num_conti
3120 do i=iturn4_start,iturn4_end
3121 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
3122 .or. itype(i+3,1).eq.ntyp1 &
3123 .or. itype(i+4,1).eq.ntyp1) cycle
3127 dx_normi=dc_norm(1,i)
3128 dy_normi=dc_norm(2,i)
3129 dz_normi=dc_norm(3,i)
3130 xmedi=c(1,i)+0.5d0*dxi
3131 ymedi=c(2,i)+0.5d0*dyi
3132 zmedi=c(3,i)+0.5d0*dzi
3133 xmedi=dmod(xmedi,boxxsize)
3134 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3135 ymedi=dmod(ymedi,boxysize)
3136 if (ymedi.lt.0) ymedi=ymedi+boxysize
3137 zmedi=dmod(zmedi,boxzsize)
3138 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3139 if ((zmedi.gt.bordlipbot) &
3140 .and.(zmedi.lt.bordliptop)) then
3141 !C the energy transfer exist
3142 if (zmedi.lt.buflipbot) then
3143 !C what fraction I am in
3145 ((zmedi-bordlipbot)/lipbufthick)
3146 !C lipbufthick is thickenes of lipid buffore
3147 sslipi=sscalelip(fracinbuf)
3148 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3149 elseif (zmedi.gt.bufliptop) then
3150 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3151 sslipi=sscalelip(fracinbuf)
3152 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3162 num_conti=num_cont_hb(i)
3163 call eelecij(i,i+3,ees,evdw1,eel_loc)
3164 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
3165 call eturn4(i,eello_turn4)
3166 num_cont_hb(i)=num_conti
3169 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3171 ! print *,"iatel_s,iatel_e,",iatel_s,iatel_e
3172 do i=iatel_s,iatel_e
3173 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
3177 dx_normi=dc_norm(1,i)
3178 dy_normi=dc_norm(2,i)
3179 dz_normi=dc_norm(3,i)
3180 xmedi=c(1,i)+0.5d0*dxi
3181 ymedi=c(2,i)+0.5d0*dyi
3182 zmedi=c(3,i)+0.5d0*dzi
3183 xmedi=dmod(xmedi,boxxsize)
3184 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3185 ymedi=dmod(ymedi,boxysize)
3186 if (ymedi.lt.0) ymedi=ymedi+boxysize
3187 zmedi=dmod(zmedi,boxzsize)
3188 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3189 if ((zmedi.gt.bordlipbot) &
3190 .and.(zmedi.lt.bordliptop)) then
3191 !C the energy transfer exist
3192 if (zmedi.lt.buflipbot) then
3193 !C what fraction I am in
3195 ((zmedi-bordlipbot)/lipbufthick)
3196 !C lipbufthick is thickenes of lipid buffore
3197 sslipi=sscalelip(fracinbuf)
3198 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3199 elseif (zmedi.gt.bufliptop) then
3200 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3201 sslipi=sscalelip(fracinbuf)
3202 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3212 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3213 num_conti=num_cont_hb(i)
3214 do j=ielstart(i),ielend(i)
3215 ! write (iout,*) i,j,itype(i,1),itype(j,1)
3216 if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
3217 call eelecij(i,j,ees,evdw1,eel_loc)
3219 num_cont_hb(i)=num_conti
3221 ! write (iout,*) "Number of loop steps in EELEC:",ind
3223 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
3224 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3226 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3227 !cc eel_loc=eel_loc+eello_turn3
3228 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
3230 end subroutine eelec
3231 !-----------------------------------------------------------------------------
3232 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3235 ! implicit real*8 (a-h,o-z)
3236 ! include 'DIMENSIONS'
3240 ! include 'COMMON.CONTROL'
3241 ! include 'COMMON.IOUNITS'
3242 ! include 'COMMON.GEO'
3243 ! include 'COMMON.VAR'
3244 ! include 'COMMON.LOCAL'
3245 ! include 'COMMON.CHAIN'
3246 ! include 'COMMON.DERIV'
3247 ! include 'COMMON.INTERACT'
3248 ! include 'COMMON.CONTACTS'
3249 ! include 'COMMON.TORSION'
3250 ! include 'COMMON.VECTORS'
3251 ! include 'COMMON.FFIELD'
3252 ! include 'COMMON.TIME1'
3253 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
3254 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
3255 real(kind=8),dimension(2,2) :: acipa !el,a_temp
3256 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3257 real(kind=8),dimension(4) :: muij
3258 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
3259 dist_temp, dist_init,rlocshield,fracinbuf
3260 integer xshift,yshift,zshift,ilist,iresshield
3261 !el integer :: num_conti,j1,j2
3262 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3263 !el dz_normi,xmedi,ymedi,zmedi
3265 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3266 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3269 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3271 real(kind=8) :: scal_el=1.0d0
3273 real(kind=8) :: scal_el=0.5d0
3276 ! 13-go grudnia roku pamietnego...
3277 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
3279 0.0d0,0.0d0,1.0d0/),shape(unmat))
3280 ! integer :: maxconts=nres/4
3282 integer :: k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap
3283 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
3284 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
3285 real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
3286 rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
3287 evdwij,el1,el2,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
3288 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
3289 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
3290 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
3291 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
3292 ecosgp,ecosam,ecosbm,ecosgm,ghalf
3294 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
3295 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
3297 ! time00=MPI_Wtime()
3298 !d write (iout,*) "eelecij",i,j
3302 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3303 aaa=app(iteli,itelj)
3304 bbb=bpp(iteli,itelj)
3305 ael6i=ael6(iteli,itelj)
3306 ael3i=ael3(iteli,itelj)
3310 dx_normj=dc_norm(1,j)
3311 dy_normj=dc_norm(2,j)
3312 dz_normj=dc_norm(3,j)
3313 ! xj=c(1,j)+0.5D0*dxj-xmedi
3314 ! yj=c(2,j)+0.5D0*dyj-ymedi
3315 ! zj=c(3,j)+0.5D0*dzj-zmedi
3320 if (xj.lt.0) xj=xj+boxxsize
3322 if (yj.lt.0) yj=yj+boxysize
3324 if (zj.lt.0) zj=zj+boxzsize
3325 if ((zj.gt.bordlipbot) &
3326 .and.(zj.lt.bordliptop)) then
3327 !C the energy transfer exist
3328 if (zj.lt.buflipbot) then
3329 !C what fraction I am in
3331 ((zj-bordlipbot)/lipbufthick)
3332 !C lipbufthick is thickenes of lipid buffore
3333 sslipj=sscalelip(fracinbuf)
3334 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
3335 elseif (zj.gt.bufliptop) then
3336 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
3337 sslipj=sscalelip(fracinbuf)
3338 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
3349 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3356 xj=xj_safe+xshift*boxxsize
3357 yj=yj_safe+yshift*boxysize
3358 zj=zj_safe+zshift*boxzsize
3359 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3360 if(dist_temp.lt.dist_init) then
3370 if (isubchap.eq.1) then
3381 rij=xj*xj+yj*yj+zj*zj
3384 !C print *,xmedi,ymedi,zmedi,xj,yj,zj,boxxsize,rij
3385 sss_ele_cut=sscale_ele(rij)
3386 sss_ele_grad=sscagrad_ele(rij)
3388 ! sss_ele_grad=0.0d0
3389 ! print *,sss_ele_cut,sss_ele_grad,&
3390 ! (rij),r_cut_ele,rlamb_ele
3391 ! if (sss_ele_cut.le.0.0) go to 128
3396 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3397 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3398 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3399 fac=cosa-3.0D0*cosb*cosg
3401 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3402 if (j.eq.i+2) ev1=scal_el*ev1
3407 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3410 if (shield_mode.gt.0) then
3411 !C fac_shield(i)=0.4
3412 !C fac_shield(j)=0.6
3413 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3414 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3416 ees=ees+eesij*sss_ele_cut
3417 !C FOR NOW SHIELD IS NOT USED WITH LIPSCALE
3418 !C & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3424 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)*sss_ele_cut
3425 !C print *,"TUCC",(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
3428 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
3429 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3430 ! ees=ees+eesij*sss_ele_cut
3431 evdw1=evdw1+evdwij*sss_ele_cut &
3432 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3433 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3434 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3435 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3436 !d & xmedi,ymedi,zmedi,xj,yj,zj
3438 if (energy_dec) then
3439 ! write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') &
3440 ! 'evdw1',i,j,evdwij,&
3441 ! iteli,itelj,aaa,evdw1
3442 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3443 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3446 ! Calculate contributions to the Cartesian gradient.
3449 facvdw=-6*rrmij*(ev1+evdwij)*sss_ele_cut &
3450 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3451 facel=-3*rrmij*(el1+eesij)*sss_ele_cut &
3452 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3458 ! Radial derivatives. First process both termini of the fragment (i,j)
3460 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj* &
3461 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3462 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj* &
3463 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3464 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj* &
3465 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3467 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3468 (shield_mode.gt.0)) then
3470 do ilist=1,ishield_list(i)
3471 iresshield=shield_list(ilist,i)
3473 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)&
3475 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3477 +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0 &
3479 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3482 do ilist=1,ishield_list(j)
3483 iresshield=shield_list(ilist,j)
3485 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j) &
3487 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3489 +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0 &
3491 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3495 gshieldc(k,i)=gshieldc(k,i)+ &
3496 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3499 gshieldc(k,j)=gshieldc(k,j)+ &
3500 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3503 gshieldc(k,i-1)=gshieldc(k,i-1)+ &
3504 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3507 gshieldc(k,j-1)=gshieldc(k,j-1)+ &
3508 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3516 ! ghalf=0.5D0*ggg(k)
3517 ! gelc(k,i)=gelc(k,i)+ghalf
3518 ! gelc(k,j)=gelc(k,j)+ghalf
3520 ! 9/28/08 AL Gradient compotents will be summed only at the end
3522 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3523 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3525 gelc_long(3,j)=gelc_long(3,j)+ &
3526 ssgradlipj*eesij/2.0d0*lipscale**2&
3529 gelc_long(3,i)=gelc_long(3,i)+ &
3530 ssgradlipi*eesij/2.0d0*lipscale**2&
3535 ! Loop over residues i+1 thru j-1.
3539 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3542 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj &
3543 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3544 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj &
3545 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3546 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj &
3547 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3550 ! ghalf=0.5D0*ggg(k)
3551 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3552 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3554 ! 9/28/08 AL Gradient compotents will be summed only at the end
3556 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3557 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3560 !C Lipidic part for scaling weight
3561 gvdwpp(3,j)=gvdwpp(3,j)+ &
3562 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3563 gvdwpp(3,i)=gvdwpp(3,i)+ &
3564 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3565 !! Loop over residues i+1 thru j-1.
3569 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3573 facvdw=(ev1+evdwij)*sss_ele_cut &
3574 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3576 facel=(el1+eesij)*sss_ele_cut
3578 fac=-3*rrmij*(facvdw+facvdw+facel)
3583 ! Radial derivatives. First process both termini of the fragment (i,j)
3585 ggg(1)=fac*xj+sss_ele_grad*rmij*(eesij+evdwij)*xj
3586 ggg(2)=fac*yj+sss_ele_grad*rmij*(eesij+evdwij)*yj
3587 ggg(3)=fac*zj+sss_ele_grad*rmij*(eesij+evdwij)*zj
3589 ! ghalf=0.5D0*ggg(k)
3590 ! gelc(k,i)=gelc(k,i)+ghalf
3591 ! gelc(k,j)=gelc(k,j)+ghalf
3593 ! 9/28/08 AL Gradient compotents will be summed only at the end
3595 gelc_long(k,j)=gelc(k,j)+ggg(k)
3596 gelc_long(k,i)=gelc(k,i)-ggg(k)
3599 ! Loop over residues i+1 thru j-1.
3603 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3606 ! 9/28/08 AL Gradient compotents will be summed only at the end
3608 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3610 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3612 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3615 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3616 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3618 gvdwpp(3,j)=gvdwpp(3,j)+ &
3619 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3620 gvdwpp(3,i)=gvdwpp(3,i)+ &
3621 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3627 ecosa=2.0D0*fac3*fac1+fac4
3630 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3631 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3633 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3634 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3636 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3637 !d & (dcosg(k),k=1,3)
3639 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*sss_ele_cut &
3640 *fac_shield(i)**2*fac_shield(j)**2 &
3641 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3645 ! ghalf=0.5D0*ggg(k)
3646 ! gelc(k,i)=gelc(k,i)+ghalf
3647 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3648 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3649 ! gelc(k,j)=gelc(k,j)+ghalf
3650 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3651 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3655 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3659 gelc(k,i)=gelc(k,i) &
3660 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3661 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
3663 *fac_shield(i)**2*fac_shield(j)**2 &
3664 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3666 gelc(k,j)=gelc(k,j) &
3667 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3668 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
3670 *fac_shield(i)**2*fac_shield(j)**2 &
3671 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3673 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3674 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3677 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3678 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
3679 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3681 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3682 ! energy of a peptide unit is assumed in the form of a second-order
3683 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3684 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3685 ! are computed for EVERY pair of non-contiguous peptide groups.
3687 if (j.lt.nres-1) then
3698 muij(kkk)=mu(k,i)*mu(l,j)
3701 !d write (iout,*) 'EELEC: i',i,' j',j
3702 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
3703 !d write(iout,*) 'muij',muij
3704 ury=scalar(uy(1,i),erij)
3705 urz=scalar(uz(1,i),erij)
3706 vry=scalar(uy(1,j),erij)
3707 vrz=scalar(uz(1,j),erij)
3708 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3709 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3710 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3711 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3712 fac=dsqrt(-ael6i)*r3ij
3717 !d write (iout,'(4i5,4f10.5)')
3718 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
3719 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3720 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3721 !d & uy(:,j),uz(:,j)
3722 !d write (iout,'(4f10.5)')
3723 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3724 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3725 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
3726 !d write (iout,'(9f10.5/)')
3727 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3728 ! Derivatives of the elements of A in virtual-bond vectors
3729 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3731 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3732 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3733 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3734 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3735 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3736 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3737 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3738 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3739 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3740 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3741 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3742 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3744 ! Compute radial contributions to the gradient
3762 ! Add the contributions coming from er
3765 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3766 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3767 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3768 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3771 ! Derivatives in DC(i)
3772 !grad ghalf1=0.5d0*agg(k,1)
3773 !grad ghalf2=0.5d0*agg(k,2)
3774 !grad ghalf3=0.5d0*agg(k,3)
3775 !grad ghalf4=0.5d0*agg(k,4)
3776 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
3777 -3.0d0*uryg(k,2)*vry)!+ghalf1
3778 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
3779 -3.0d0*uryg(k,2)*vrz)!+ghalf2
3780 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
3781 -3.0d0*urzg(k,2)*vry)!+ghalf3
3782 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
3783 -3.0d0*urzg(k,2)*vrz)!+ghalf4
3784 ! Derivatives in DC(i+1)
3785 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
3786 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3787 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
3788 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3789 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
3790 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3791 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
3792 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3793 ! Derivatives in DC(j)
3794 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
3795 -3.0d0*vryg(k,2)*ury)!+ghalf1
3796 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
3797 -3.0d0*vrzg(k,2)*ury)!+ghalf2
3798 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
3799 -3.0d0*vryg(k,2)*urz)!+ghalf3
3800 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
3801 -3.0d0*vrzg(k,2)*urz)!+ghalf4
3802 ! Derivatives in DC(j+1) or DC(nres-1)
3803 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
3804 -3.0d0*vryg(k,3)*ury)
3805 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
3806 -3.0d0*vrzg(k,3)*ury)
3807 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
3808 -3.0d0*vryg(k,3)*urz)
3809 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
3810 -3.0d0*vrzg(k,3)*urz)
3811 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
3813 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3826 aggi(k,l)=-aggi(k,l)
3827 aggi1(k,l)=-aggi1(k,l)
3828 aggj(k,l)=-aggj(k,l)
3829 aggj1(k,l)=-aggj1(k,l)
3832 if (j.lt.nres-1) then
3838 aggi(k,l)=-aggi(k,l)
3839 aggi1(k,l)=-aggi1(k,l)
3840 aggj(k,l)=-aggj(k,l)
3841 aggj1(k,l)=-aggj1(k,l)
3852 aggi(k,l)=-aggi(k,l)
3853 aggi1(k,l)=-aggi1(k,l)
3854 aggj(k,l)=-aggj(k,l)
3855 aggj1(k,l)=-aggj1(k,l)
3860 IF (wel_loc.gt.0.0d0) THEN
3861 ! Contribution to the local-electrostatic energy coming from the i-j pair
3862 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
3864 if (shield_mode.eq.0) then
3868 eel_loc_ij=eel_loc_ij &
3869 *fac_shield(i)*fac_shield(j) &
3870 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3871 !C Now derivative over eel_loc
3872 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3873 (shield_mode.gt.0)) then
3876 do ilist=1,ishield_list(i)
3877 iresshield=shield_list(ilist,i)
3879 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij &
3882 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
3884 +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i) &
3887 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
3891 do ilist=1,ishield_list(j)
3892 iresshield=shield_list(ilist,j)
3894 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij &
3897 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
3899 +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j) &
3902 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
3909 gshieldc_ll(k,i)=gshieldc_ll(k,i)+ &
3910 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
3912 gshieldc_ll(k,j)=gshieldc_ll(k,j)+ &
3913 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
3915 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+ &
3916 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
3918 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+ &
3919 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
3926 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3928 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3929 'eelloc',i,j,eel_loc_ij
3930 ! if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33
3931 ! if (energy_dec) write (iout,*) "muij",muij
3932 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3934 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
3935 ! Partial derivatives in virtual-bond dihedral angles gamma
3937 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
3938 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
3939 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
3941 *fac_shield(i)*fac_shield(j) &
3942 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3944 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
3945 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
3946 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
3948 *fac_shield(i)*fac_shield(j) &
3949 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3950 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3952 ! ggg(1)=(agg(1,1)*muij(1)+ &
3953 ! agg(1,2)*muij(2)+agg(1,3)*muij(3)+agg(1,4)*muij(4)) &
3955 ! +eel_loc_ij*sss_ele_grad*rmij*xj
3956 ! ggg(2)=(agg(2,1)*muij(1)+ &
3957 ! agg(2,2)*muij(2)+agg(2,3)*muij(3)+agg(2,4)*muij(4)) &
3959 ! +eel_loc_ij*sss_ele_grad*rmij*yj
3960 ! ggg(3)=(agg(3,1)*muij(1)+ &
3961 ! agg(3,2)*muij(2)+agg(3,3)*muij(3)+agg(3,4)*muij(4)) &
3963 ! +eel_loc_ij*sss_ele_grad*rmij*zj
3969 ggg(l)=(agg(l,1)*muij(1)+ &
3970 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
3972 *fac_shield(i)*fac_shield(j) &
3973 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) &
3974 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3977 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3978 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3979 !grad ghalf=0.5d0*ggg(l)
3980 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
3981 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
3983 gel_loc_long(3,j)=gel_loc_long(3,j)+ &
3984 ssgradlipj*eel_loc_ij/2.0d0*lipscale/ &
3985 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
3987 gel_loc_long(3,i)=gel_loc_long(3,i)+ &
3988 ssgradlipi*eel_loc_ij/2.0d0*lipscale/ &
3989 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
3993 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3996 ! Remaining derivatives of eello
3998 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
3999 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
4001 *fac_shield(i)*fac_shield(j) &
4002 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4004 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4005 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
4006 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3) &
4007 +aggi1(l,4)*muij(4))&
4009 *fac_shield(i)*fac_shield(j) &
4010 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4012 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4013 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
4014 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
4016 *fac_shield(i)*fac_shield(j) &
4017 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4019 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4020 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
4021 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3) &
4022 +aggj1(l,4)*muij(4))&
4024 *fac_shield(i)*fac_shield(j) &
4025 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4027 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4030 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
4031 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
4032 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
4033 .and. num_conti.le.maxconts) then
4034 ! write (iout,*) i,j," entered corr"
4036 ! Calculate the contact function. The ith column of the array JCONT will
4037 ! contain the numbers of atoms that make contacts with the atom I (of numbers
4038 ! greater than I). The arrays FACONT and GACONT will contain the values of
4039 ! the contact function and its derivative.
4040 ! r0ij=1.02D0*rpp(iteli,itelj)
4041 ! r0ij=1.11D0*rpp(iteli,itelj)
4042 r0ij=2.20D0*rpp(iteli,itelj)
4043 ! r0ij=1.55D0*rpp(iteli,itelj)
4044 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4045 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
4046 if (fcont.gt.0.0D0) then
4047 num_conti=num_conti+1
4048 if (num_conti.gt.maxconts) then
4049 !el write (iout,*) "esrgresgdsrgdfsrgdswrgaresfgaerwgae"
4050 !el write (iout,*) "num_conti",num_conti, "maxconts",maxconts
4051 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
4052 ' will skip next contacts for this conf.', num_conti
4054 jcont_hb(num_conti,i)=j
4055 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
4056 !d & " jcont_hb",jcont_hb(num_conti,i)
4057 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
4058 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4059 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4061 d_cont(num_conti,i)=rij
4062 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4063 ! --- Electrostatic-interaction matrix ---
4064 a_chuj(1,1,num_conti,i)=a22
4065 a_chuj(1,2,num_conti,i)=a23
4066 a_chuj(2,1,num_conti,i)=a32
4067 a_chuj(2,2,num_conti,i)=a33
4068 ! --- Gradient of rij
4070 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4077 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4078 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4079 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4080 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4081 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4086 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4087 ! Calculate contact energies
4089 wij=cosa-3.0D0*cosb*cosg
4092 ! fac3=dsqrt(-ael6i)/r0ij**3
4093 fac3=dsqrt(-ael6i)*r3ij
4094 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4095 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4096 if (ees0tmp.gt.0) then
4097 ees0pij=dsqrt(ees0tmp)
4101 if (shield_mode.eq.0) then
4105 ees0plist(num_conti,i)=j
4107 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4108 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4109 if (ees0tmp.gt.0) then
4110 ees0mij=dsqrt(ees0tmp)
4115 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
4117 *fac_shield(i)*fac_shield(j)
4119 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
4121 *fac_shield(i)*fac_shield(j)
4123 ! Diagnostics. Comment out or remove after debugging!
4124 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4125 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4126 ! ees0m(num_conti,i)=0.0D0
4128 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4129 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4130 ! Angular derivatives of the contact function
4131 ees0pij1=fac3/ees0pij
4132 ees0mij1=fac3/ees0mij
4133 fac3p=-3.0D0*fac3*rrmij
4134 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4135 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4137 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4138 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4139 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4140 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4141 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4142 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4143 ecosap=ecosa1+ecosa2
4144 ecosbp=ecosb1+ecosb2
4145 ecosgp=ecosg1+ecosg2
4146 ecosam=ecosa1-ecosa2
4147 ecosbm=ecosb1-ecosb2
4148 ecosgm=ecosg1-ecosg2
4157 facont_hb(num_conti,i)=fcont
4158 fprimcont=fprimcont/rij
4159 !d facont_hb(num_conti,i)=1.0D0
4160 ! Following line is for diagnostics.
4163 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4164 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4167 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4168 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4170 gggp(1)=gggp(1)+ees0pijp*xj &
4171 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
4172 gggp(2)=gggp(2)+ees0pijp*yj &
4173 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
4174 gggp(3)=gggp(3)+ees0pijp*zj &
4175 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
4177 gggm(1)=gggm(1)+ees0mijp*xj &
4178 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
4180 gggm(2)=gggm(2)+ees0mijp*yj &
4181 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
4183 gggm(3)=gggm(3)+ees0mijp*zj &
4184 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
4186 ! Derivatives due to the contact function
4187 gacont_hbr(1,num_conti,i)=fprimcont*xj
4188 gacont_hbr(2,num_conti,i)=fprimcont*yj
4189 gacont_hbr(3,num_conti,i)=fprimcont*zj
4192 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
4193 ! following the change of gradient-summation algorithm.
4195 !grad ghalfp=0.5D0*gggp(k)
4196 !grad ghalfm=0.5D0*gggm(k)
4197 gacontp_hb1(k,num_conti,i)= & !ghalfp+
4198 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4199 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
4200 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4202 gacontp_hb2(k,num_conti,i)= & !ghalfp+
4203 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4204 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
4205 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4207 gacontp_hb3(k,num_conti,i)=gggp(k) &
4208 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4210 gacontm_hb1(k,num_conti,i)= & !ghalfm+
4211 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4212 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
4213 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4215 gacontm_hb2(k,num_conti,i)= & !ghalfm+
4216 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4217 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
4218 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4220 gacontm_hb3(k,num_conti,i)=gggm(k) &
4221 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4224 ! Diagnostics. Comment out or remove after debugging!
4226 !diag gacontp_hb1(k,num_conti,i)=0.0D0
4227 !diag gacontp_hb2(k,num_conti,i)=0.0D0
4228 !diag gacontp_hb3(k,num_conti,i)=0.0D0
4229 !diag gacontm_hb1(k,num_conti,i)=0.0D0
4230 !diag gacontm_hb2(k,num_conti,i)=0.0D0
4231 !diag gacontm_hb3(k,num_conti,i)=0.0D0
4234 endif ! num_conti.le.maxconts
4237 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4240 ghalf=0.5d0*agg(l,k)
4241 aggi(l,k)=aggi(l,k)+ghalf
4242 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4243 aggj(l,k)=aggj(l,k)+ghalf
4246 if (j.eq.nres-1 .and. i.lt.j-2) then
4249 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4255 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
4257 end subroutine eelecij
4258 !-----------------------------------------------------------------------------
4259 subroutine eturn3(i,eello_turn3)
4260 ! Third- and fourth-order contributions from turns
4263 ! implicit real*8 (a-h,o-z)
4264 ! include 'DIMENSIONS'
4265 ! include 'COMMON.IOUNITS'
4266 ! include 'COMMON.GEO'
4267 ! include 'COMMON.VAR'
4268 ! include 'COMMON.LOCAL'
4269 ! include 'COMMON.CHAIN'
4270 ! include 'COMMON.DERIV'
4271 ! include 'COMMON.INTERACT'
4272 ! include 'COMMON.CONTACTS'
4273 ! include 'COMMON.TORSION'
4274 ! include 'COMMON.VECTORS'
4275 ! include 'COMMON.FFIELD'
4276 ! include 'COMMON.CONTROL'
4277 real(kind=8),dimension(3) :: ggg
4278 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4279 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
4280 real(kind=8),dimension(2) :: auxvec,auxvec1
4281 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4282 real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
4283 !el integer :: num_conti,j1,j2
4284 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4285 !el dz_normi,xmedi,ymedi,zmedi
4287 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4288 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4291 integer :: i,j,l,k,ilist,iresshield
4292 real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield
4295 ! write (iout,*) "eturn3",i,j,j1,j2
4296 zj=(c(3,j)+c(3,j+1))/2.0d0
4298 if (zj.lt.0) zj=zj+boxzsize
4299 if ((zj.lt.0)) write (*,*) "CHUJ"
4300 if ((zj.gt.bordlipbot) &
4301 .and.(zj.lt.bordliptop)) then
4302 !C the energy transfer exist
4303 if (zj.lt.buflipbot) then
4304 !C what fraction I am in
4306 ((zj-bordlipbot)/lipbufthick)
4307 !C lipbufthick is thickenes of lipid buffore
4308 sslipj=sscalelip(fracinbuf)
4309 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4310 elseif (zj.gt.bufliptop) then
4311 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4312 sslipj=sscalelip(fracinbuf)
4313 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4327 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4329 ! Third-order contributions
4336 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4337 !d call checkint_turn3(i,a_temp,eello_turn3_num)
4338 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4339 call transpose2(auxmat(1,1),auxmat1(1,1))
4340 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4341 if (shield_mode.eq.0) then
4346 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) &
4347 *fac_shield(i)*fac_shield(j) &
4348 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4350 0.5d0*(pizda(1,1)+pizda(2,2)) &
4351 *fac_shield(i)*fac_shield(j)
4353 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4354 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4355 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4356 (shield_mode.gt.0)) then
4359 do ilist=1,ishield_list(i)
4360 iresshield=shield_list(ilist,i)
4362 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4363 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4365 +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4366 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4370 do ilist=1,ishield_list(j)
4371 iresshield=shield_list(ilist,j)
4373 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4374 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4376 +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4377 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4384 gshieldc_t3(k,i)=gshieldc_t3(k,i)+ &
4385 grad_shield(k,i)*eello_t3/fac_shield(i)
4386 gshieldc_t3(k,j)=gshieldc_t3(k,j)+ &
4387 grad_shield(k,j)*eello_t3/fac_shield(j)
4388 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+ &
4389 grad_shield(k,i)*eello_t3/fac_shield(i)
4390 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+ &
4391 grad_shield(k,j)*eello_t3/fac_shield(j)
4395 !d write (2,*) 'i,',i,' j',j,'eello_turn3',
4396 !d & 0.5d0*(pizda(1,1)+pizda(2,2)),
4397 !d & ' eello_turn3_num',4*eello_turn3_num
4398 ! Derivatives in gamma(i)
4399 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4400 call transpose2(auxmat2(1,1),auxmat3(1,1))
4401 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4402 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))&
4403 *fac_shield(i)*fac_shield(j) &
4404 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4405 ! Derivatives in gamma(i+1)
4406 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4407 call transpose2(auxmat2(1,1),auxmat3(1,1))
4408 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4409 gel_loc_turn3(i+1)=gel_loc_turn3(i+1) &
4410 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4411 *fac_shield(i)*fac_shield(j) &
4412 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4414 ! Cartesian derivatives
4416 ! ghalf1=0.5d0*agg(l,1)
4417 ! ghalf2=0.5d0*agg(l,2)
4418 ! ghalf3=0.5d0*agg(l,3)
4419 ! ghalf4=0.5d0*agg(l,4)
4420 a_temp(1,1)=aggi(l,1)!+ghalf1
4421 a_temp(1,2)=aggi(l,2)!+ghalf2
4422 a_temp(2,1)=aggi(l,3)!+ghalf3
4423 a_temp(2,2)=aggi(l,4)!+ghalf4
4424 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4425 gcorr3_turn(l,i)=gcorr3_turn(l,i) &
4426 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4427 *fac_shield(i)*fac_shield(j) &
4428 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4430 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4431 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4432 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4433 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4434 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4435 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) &
4436 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4437 *fac_shield(i)*fac_shield(j) &
4438 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4440 a_temp(1,1)=aggj(l,1)!+ghalf1
4441 a_temp(1,2)=aggj(l,2)!+ghalf2
4442 a_temp(2,1)=aggj(l,3)!+ghalf3
4443 a_temp(2,2)=aggj(l,4)!+ghalf4
4444 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4445 gcorr3_turn(l,j)=gcorr3_turn(l,j) &
4446 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4447 *fac_shield(i)*fac_shield(j) &
4448 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4450 a_temp(1,1)=aggj1(l,1)
4451 a_temp(1,2)=aggj1(l,2)
4452 a_temp(2,1)=aggj1(l,3)
4453 a_temp(2,2)=aggj1(l,4)
4454 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4455 gcorr3_turn(l,j1)=gcorr3_turn(l,j1) &
4456 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4457 *fac_shield(i)*fac_shield(j) &
4458 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4460 gshieldc_t3(3,i)=gshieldc_t3(3,i)+ &
4461 ssgradlipi*eello_t3/4.0d0*lipscale
4462 gshieldc_t3(3,j)=gshieldc_t3(3,j)+ &
4463 ssgradlipj*eello_t3/4.0d0*lipscale
4464 gshieldc_t3(3,i-1)=gshieldc_t3(3,i-1)+ &
4465 ssgradlipi*eello_t3/4.0d0*lipscale
4466 gshieldc_t3(3,j-1)=gshieldc_t3(3,j-1)+ &
4467 ssgradlipj*eello_t3/4.0d0*lipscale
4470 end subroutine eturn3
4471 !-----------------------------------------------------------------------------
4472 subroutine eturn4(i,eello_turn4)
4473 ! Third- and fourth-order contributions from turns
4476 ! implicit real*8 (a-h,o-z)
4477 ! include 'DIMENSIONS'
4478 ! include 'COMMON.IOUNITS'
4479 ! include 'COMMON.GEO'
4480 ! include 'COMMON.VAR'
4481 ! include 'COMMON.LOCAL'
4482 ! include 'COMMON.CHAIN'
4483 ! include 'COMMON.DERIV'
4484 ! include 'COMMON.INTERACT'
4485 ! include 'COMMON.CONTACTS'
4486 ! include 'COMMON.TORSION'
4487 ! include 'COMMON.VECTORS'
4488 ! include 'COMMON.FFIELD'
4489 ! include 'COMMON.CONTROL'
4490 real(kind=8),dimension(3) :: ggg
4491 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4492 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
4493 real(kind=8),dimension(2) :: auxvec,auxvec1
4494 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4495 real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
4496 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4497 !el dz_normi,xmedi,ymedi,zmedi
4498 !el integer :: num_conti,j1,j2
4499 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4500 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4503 integer :: i,j,iti1,iti2,iti3,l,k,ilist,iresshield
4504 real(kind=8) :: eello_turn4,s1,s2,s3,zj,fracinbuf,eello_t4,&
4508 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4510 ! Fourth-order contributions
4518 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4519 !d call checkint_turn4(i,a_temp,eello_turn4_num)
4520 ! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4521 zj=(c(3,j)+c(3,j+1))/2.0d0
4523 if (zj.lt.0) zj=zj+boxzsize
4524 if ((zj.gt.bordlipbot) &
4525 .and.(zj.lt.bordliptop)) then
4526 !C the energy transfer exist
4527 if (zj.lt.buflipbot) then
4528 !C what fraction I am in
4530 ((zj-bordlipbot)/lipbufthick)
4531 !C lipbufthick is thickenes of lipid buffore
4532 sslipj=sscalelip(fracinbuf)
4533 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4534 elseif (zj.gt.bufliptop) then
4535 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4536 sslipj=sscalelip(fracinbuf)
4537 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4551 iti1=itortyp(itype(i+1,1))
4552 iti2=itortyp(itype(i+2,1))
4553 iti3=itortyp(itype(i+3,1))
4554 ! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4555 call transpose2(EUg(1,1,i+1),e1t(1,1))
4556 call transpose2(Eug(1,1,i+2),e2t(1,1))
4557 call transpose2(Eug(1,1,i+3),e3t(1,1))
4558 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4559 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4560 s1=scalar2(b1(1,iti2),auxvec(1))
4561 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4562 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4563 s2=scalar2(b1(1,iti1),auxvec(1))
4564 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4565 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4566 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4567 if (shield_mode.eq.0) then
4572 eello_turn4=eello_turn4-(s1+s2+s3) &
4573 *fac_shield(i)*fac_shield(j) &
4574 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4575 eello_t4=-(s1+s2+s3) &
4576 *fac_shield(i)*fac_shield(j)
4577 !C Now derivative over shield:
4578 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4579 (shield_mode.gt.0)) then
4582 do ilist=1,ishield_list(i)
4583 iresshield=shield_list(ilist,i)
4585 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
4586 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
4588 +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
4589 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
4593 do ilist=1,ishield_list(j)
4594 iresshield=shield_list(ilist,j)
4596 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
4597 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
4599 +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
4600 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
4607 gshieldc_t4(k,i)=gshieldc_t4(k,i)+ &
4608 grad_shield(k,i)*eello_t4/fac_shield(i)
4609 gshieldc_t4(k,j)=gshieldc_t4(k,j)+ &
4610 grad_shield(k,j)*eello_t4/fac_shield(j)
4611 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+ &
4612 grad_shield(k,i)*eello_t4/fac_shield(i)
4613 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+ &
4614 grad_shield(k,j)*eello_t4/fac_shield(j)
4618 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4619 'eturn4',i,j,-(s1+s2+s3)
4620 !d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4621 !d & ' eello_turn4_num',8*eello_turn4_num
4622 ! Derivatives in gamma(i)
4623 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4624 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4625 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4626 s1=scalar2(b1(1,iti2),auxvec(1))
4627 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4628 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4629 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) &
4630 *fac_shield(i)*fac_shield(j) &
4631 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4633 ! Derivatives in gamma(i+1)
4634 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4635 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4636 s2=scalar2(b1(1,iti1),auxvec(1))
4637 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4638 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4639 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4640 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) &
4641 *fac_shield(i)*fac_shield(j) &
4642 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4644 ! Derivatives in gamma(i+2)
4645 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4646 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4647 s1=scalar2(b1(1,iti2),auxvec(1))
4648 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4649 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4650 s2=scalar2(b1(1,iti1),auxvec(1))
4651 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4652 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4653 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4654 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) &
4655 *fac_shield(i)*fac_shield(j) &
4656 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4658 ! Cartesian derivatives
4659 ! Derivatives of this turn contributions in DC(i+2)
4660 if (j.lt.nres-1) then
4662 a_temp(1,1)=agg(l,1)
4663 a_temp(1,2)=agg(l,2)
4664 a_temp(2,1)=agg(l,3)
4665 a_temp(2,2)=agg(l,4)
4666 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4667 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4668 s1=scalar2(b1(1,iti2),auxvec(1))
4669 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4670 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4671 s2=scalar2(b1(1,iti1),auxvec(1))
4672 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4673 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4674 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4676 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)&
4677 *fac_shield(i)*fac_shield(j) &
4678 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4682 ! Remaining derivatives of this turn contribution
4684 a_temp(1,1)=aggi(l,1)
4685 a_temp(1,2)=aggi(l,2)
4686 a_temp(2,1)=aggi(l,3)
4687 a_temp(2,2)=aggi(l,4)
4688 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4689 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4690 s1=scalar2(b1(1,iti2),auxvec(1))
4691 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4692 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4693 s2=scalar2(b1(1,iti1),auxvec(1))
4694 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4695 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4696 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4697 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) &
4698 *fac_shield(i)*fac_shield(j) &
4699 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4702 a_temp(1,1)=aggi1(l,1)
4703 a_temp(1,2)=aggi1(l,2)
4704 a_temp(2,1)=aggi1(l,3)
4705 a_temp(2,2)=aggi1(l,4)
4706 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4707 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4708 s1=scalar2(b1(1,iti2),auxvec(1))
4709 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4710 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4711 s2=scalar2(b1(1,iti1),auxvec(1))
4712 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4713 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4714 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4715 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) &
4716 *fac_shield(i)*fac_shield(j) &
4717 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4720 a_temp(1,1)=aggj(l,1)
4721 a_temp(1,2)=aggj(l,2)
4722 a_temp(2,1)=aggj(l,3)
4723 a_temp(2,2)=aggj(l,4)
4724 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4725 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4726 s1=scalar2(b1(1,iti2),auxvec(1))
4727 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4728 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4729 s2=scalar2(b1(1,iti1),auxvec(1))
4730 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4731 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4732 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4733 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) &
4734 *fac_shield(i)*fac_shield(j) &
4735 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4738 a_temp(1,1)=aggj1(l,1)
4739 a_temp(1,2)=aggj1(l,2)
4740 a_temp(2,1)=aggj1(l,3)
4741 a_temp(2,2)=aggj1(l,4)
4742 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4743 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4744 s1=scalar2(b1(1,iti2),auxvec(1))
4745 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4746 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4747 s2=scalar2(b1(1,iti1),auxvec(1))
4748 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4749 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4750 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4751 ! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4752 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) &
4753 *fac_shield(i)*fac_shield(j) &
4754 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4757 gshieldc_t4(3,i)=gshieldc_t4(3,i)+ &
4758 ssgradlipi*eello_t4/4.0d0*lipscale
4759 gshieldc_t4(3,j)=gshieldc_t4(3,j)+ &
4760 ssgradlipj*eello_t4/4.0d0*lipscale
4761 gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+ &
4762 ssgradlipi*eello_t4/4.0d0*lipscale
4763 gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+ &
4764 ssgradlipj*eello_t4/4.0d0*lipscale
4767 end subroutine eturn4
4768 !-----------------------------------------------------------------------------
4769 subroutine unormderiv(u,ugrad,unorm,ungrad)
4770 ! This subroutine computes the derivatives of a normalized vector u, given
4771 ! the derivatives computed without normalization conditions, ugrad. Returns
4774 real(kind=8),dimension(3) :: u,vec
4775 real(kind=8),dimension(3,3) ::ugrad,ungrad
4776 real(kind=8) :: unorm !,scalar
4778 ! write (2,*) 'ugrad',ugrad
4781 vec(i)=scalar(ugrad(1,i),u(1))
4783 ! write (2,*) 'vec',vec
4786 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4789 ! write (2,*) 'ungrad',ungrad
4791 end subroutine unormderiv
4792 !-----------------------------------------------------------------------------
4793 subroutine escp_soft_sphere(evdw2,evdw2_14)
4795 ! This subroutine calculates the excluded-volume interaction energy between
4796 ! peptide-group centers and side chains and its gradient in virtual-bond and
4797 ! side-chain vectors.
4799 ! implicit real*8 (a-h,o-z)
4800 ! include 'DIMENSIONS'
4801 ! include 'COMMON.GEO'
4802 ! include 'COMMON.VAR'
4803 ! include 'COMMON.LOCAL'
4804 ! include 'COMMON.CHAIN'
4805 ! include 'COMMON.DERIV'
4806 ! include 'COMMON.INTERACT'
4807 ! include 'COMMON.FFIELD'
4808 ! include 'COMMON.IOUNITS'
4809 ! include 'COMMON.CONTROL'
4810 real(kind=8),dimension(3) :: ggg
4812 integer :: i,iint,j,k,iteli,itypj
4813 real(kind=8) :: evdw2,evdw2_14,r0_scp,xi,yi,zi,xj,yj,zj,&
4814 fac,rij,r0ij,r0ijsq,evdwij,e1,e2
4819 !d print '(a)','Enter ESCP'
4820 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4821 do i=iatscp_s,iatscp_e
4822 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
4824 xi=0.5D0*(c(1,i)+c(1,i+1))
4825 yi=0.5D0*(c(2,i)+c(2,i+1))
4826 zi=0.5D0*(c(3,i)+c(3,i+1))
4828 do iint=1,nscp_gr(i)
4830 do j=iscpstart(i,iint),iscpend(i,iint)
4831 if (itype(j,1).eq.ntyp1) cycle
4832 itypj=iabs(itype(j,1))
4833 ! Uncomment following three lines for SC-p interactions
4837 ! Uncomment following three lines for Ca-p interactions
4841 rij=xj*xj+yj*yj+zj*zj
4844 if (rij.lt.r0ijsq) then
4845 evdwij=0.25d0*(rij-r0ijsq)**2
4853 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
4858 !grad if (j.lt.i) then
4859 !d write (iout,*) 'j<i'
4860 ! Uncomment following three lines for SC-p interactions
4862 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4865 !d write (iout,*) 'j>i'
4867 !grad ggg(k)=-ggg(k)
4868 ! Uncomment following line for SC-p interactions
4869 ! gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4873 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4875 !grad kstart=min0(i+1,j)
4876 !grad kend=max0(i-1,j-1)
4877 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4878 !d write (iout,*) ggg(1),ggg(2),ggg(3)
4879 !grad do k=kstart,kend
4881 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4885 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4886 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4893 end subroutine escp_soft_sphere
4894 !-----------------------------------------------------------------------------
4895 subroutine escp(evdw2,evdw2_14)
4897 ! This subroutine calculates the excluded-volume interaction energy between
4898 ! peptide-group centers and side chains and its gradient in virtual-bond and
4899 ! side-chain vectors.
4901 ! implicit real*8 (a-h,o-z)
4902 ! include 'DIMENSIONS'
4903 ! include 'COMMON.GEO'
4904 ! include 'COMMON.VAR'
4905 ! include 'COMMON.LOCAL'
4906 ! include 'COMMON.CHAIN'
4907 ! include 'COMMON.DERIV'
4908 ! include 'COMMON.INTERACT'
4909 ! include 'COMMON.FFIELD'
4910 ! include 'COMMON.IOUNITS'
4911 ! include 'COMMON.CONTROL'
4912 real(kind=8),dimension(3) :: ggg
4914 integer :: i,iint,j,k,iteli,itypj,subchap
4915 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
4917 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
4918 dist_temp, dist_init
4919 integer xshift,yshift,zshift
4923 !d print '(a)','Enter ESCP'
4924 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4925 do i=iatscp_s,iatscp_e
4926 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
4928 xi=0.5D0*(c(1,i)+c(1,i+1))
4929 yi=0.5D0*(c(2,i)+c(2,i+1))
4930 zi=0.5D0*(c(3,i)+c(3,i+1))
4932 if (xi.lt.0) xi=xi+boxxsize
4934 if (yi.lt.0) yi=yi+boxysize
4936 if (zi.lt.0) zi=zi+boxzsize
4938 do iint=1,nscp_gr(i)
4940 do j=iscpstart(i,iint),iscpend(i,iint)
4941 itypj=iabs(itype(j,1))
4942 if (itypj.eq.ntyp1) cycle
4943 ! Uncomment following three lines for SC-p interactions
4947 ! Uncomment following three lines for Ca-p interactions
4955 if (xj.lt.0) xj=xj+boxxsize
4957 if (yj.lt.0) yj=yj+boxysize
4959 if (zj.lt.0) zj=zj+boxzsize
4960 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4968 xj=xj_safe+xshift*boxxsize
4969 yj=yj_safe+yshift*boxysize
4970 zj=zj_safe+zshift*boxzsize
4971 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4972 if(dist_temp.lt.dist_init) then
4982 if (subchap.eq.1) then
4992 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4993 rij=dsqrt(1.0d0/rrij)
4994 sss_ele_cut=sscale_ele(rij)
4995 sss_ele_grad=sscagrad_ele(rij)
4996 ! print *,sss_ele_cut,sss_ele_grad,&
4997 ! (rij),r_cut_ele,rlamb_ele
4998 if (sss_ele_cut.le.0.0) cycle
5000 e1=fac*fac*aad(itypj,iteli)
5001 e2=fac*bad(itypj,iteli)
5002 if (iabs(j-i) .le. 2) then
5005 evdw2_14=evdw2_14+(e1+e2)*sss_ele_cut
5008 evdw2=evdw2+evdwij*sss_ele_cut
5009 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') &
5010 ! 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),&
5011 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
5014 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
5016 fac=-(evdwij+e1)*rrij*sss_ele_cut
5017 fac=fac+evdwij*sss_ele_grad/rij/expon
5021 !grad if (j.lt.i) then
5022 !d write (iout,*) 'j<i'
5023 ! Uncomment following three lines for SC-p interactions
5025 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5028 !d write (iout,*) 'j>i'
5030 !grad ggg(k)=-ggg(k)
5031 ! Uncomment following line for SC-p interactions
5032 !cgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5033 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5037 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5039 !grad kstart=min0(i+1,j)
5040 !grad kend=max0(i-1,j-1)
5041 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5042 !d write (iout,*) ggg(1),ggg(2),ggg(3)
5043 !grad do k=kstart,kend
5045 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5049 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5050 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5058 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5059 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5060 gradx_scp(j,i)=expon*gradx_scp(j,i)
5063 !******************************************************************************
5067 ! To save time the factor EXPON has been extracted from ALL components
5068 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
5071 !******************************************************************************
5074 !-----------------------------------------------------------------------------
5075 subroutine edis(ehpb)
5077 ! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5079 ! implicit real*8 (a-h,o-z)
5080 ! include 'DIMENSIONS'
5081 ! include 'COMMON.SBRIDGE'
5082 ! include 'COMMON.CHAIN'
5083 ! include 'COMMON.DERIV'
5084 ! include 'COMMON.VAR'
5085 ! include 'COMMON.INTERACT'
5086 ! include 'COMMON.IOUNITS'
5087 real(kind=8),dimension(3) :: ggg
5089 integer :: i,j,ii,jj,iii,jjj,k
5090 real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
5093 !d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5094 !d write(iout,*)'link_start=',link_start,' link_end=',link_end
5095 if (link_end.eq.0) return
5096 do i=link_start,link_end
5097 ! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5098 ! CA-CA distance used in regularization of structure.
5101 ! iii and jjj point to the residues for which the distance is assigned.
5102 if (ii.gt.nres) then
5109 ! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5110 ! & dhpb(i),dhpb1(i),forcon(i)
5111 ! 24/11/03 AL: SS bridges handled separately because of introducing a specific
5112 ! distance and angle dependent SS bond potential.
5113 !mc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5114 ! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5115 if (.not.dyn_ss .and. i.le.nss) then
5116 ! 15/02/13 CC dynamic SSbond - additional check
5117 if (ii.gt.nres .and. iabs(itype(iii,1)).eq.1 .and. &
5118 iabs(itype(jjj,1)).eq.1) then
5119 call ssbond_ene(iii,jjj,eij)
5121 !d write (iout,*) "eij",eij
5123 else if (ii.gt.nres .and. jj.gt.nres) then
5124 !c Restraints from contact prediction
5126 if (constr_dist.eq.11) then
5127 ehpb=ehpb+fordepth(i)**4.0d0 &
5128 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5129 fac=fordepth(i)**4.0d0 &
5130 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5131 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
5134 if (dhpb1(i).gt.0.0d0) then
5135 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5136 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5137 !c write (iout,*) "beta nmr",
5138 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5142 !C Get the force constant corresponding to this distance.
5144 !C Calculate the contribution to energy.
5145 ehpb=ehpb+waga*rdis*rdis
5146 !c write (iout,*) "beta reg",dd,waga*rdis*rdis
5148 !C Evaluate gradient.
5154 ggg(j)=fac*(c(j,jj)-c(j,ii))
5157 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5158 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5161 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5162 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5166 if (constr_dist.eq.11) then
5167 ehpb=ehpb+fordepth(i)**4.0d0 &
5168 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5169 fac=fordepth(i)**4.0d0 &
5170 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5171 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
5174 if (dhpb1(i).gt.0.0d0) then
5175 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5176 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5177 !c write (iout,*) "alph nmr",
5178 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5181 !C Get the force constant corresponding to this distance.
5183 !C Calculate the contribution to energy.
5184 ehpb=ehpb+waga*rdis*rdis
5185 !c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5187 !C Evaluate gradient.
5194 ggg(j)=fac*(c(j,jj)-c(j,ii))
5196 !cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5197 !C If this is a SC-SC distance, we need to calculate the contributions to the
5198 !C Cartesian gradient in the SC vectors (ghpbx).
5201 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5202 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5205 !cgrad do j=iii,jjj-1
5207 !cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5211 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5212 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5216 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5220 !-----------------------------------------------------------------------------
5221 subroutine ssbond_ene(i,j,eij)
5223 ! Calculate the distance and angle dependent SS-bond potential energy
5224 ! using a free-energy function derived based on RHF/6-31G** ab initio
5225 ! calculations of diethyl disulfide.
5227 ! A. Liwo and U. Kozlowska, 11/24/03
5229 ! implicit real*8 (a-h,o-z)
5230 ! include 'DIMENSIONS'
5231 ! include 'COMMON.SBRIDGE'
5232 ! include 'COMMON.CHAIN'
5233 ! include 'COMMON.DERIV'
5234 ! include 'COMMON.LOCAL'
5235 ! include 'COMMON.INTERACT'
5236 ! include 'COMMON.VAR'
5237 ! include 'COMMON.IOUNITS'
5238 real(kind=8),dimension(3) :: erij,dcosom1,dcosom2,gg
5240 integer :: i,j,itypi,itypj,k
5241 real(kind=8) :: eij,rij,rrij,xi,yi,zi,dxi,dyi,dzi,dsci_inv,&
5242 xj,yj,zj,dxj,dyj,dzj,om1,om2,om12,deltad,dscj_inv,&
5243 deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,&
5246 itypi=iabs(itype(i,1))
5250 dxi=dc_norm(1,nres+i)
5251 dyi=dc_norm(2,nres+i)
5252 dzi=dc_norm(3,nres+i)
5253 ! dsci_inv=dsc_inv(itypi)
5254 dsci_inv=vbld_inv(nres+i)
5255 itypj=iabs(itype(j,1))
5256 ! dscj_inv=dsc_inv(itypj)
5257 dscj_inv=vbld_inv(nres+j)
5261 dxj=dc_norm(1,nres+j)
5262 dyj=dc_norm(2,nres+j)
5263 dzj=dc_norm(3,nres+j)
5264 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5269 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5270 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5271 om12=dxi*dxj+dyi*dyj+dzi*dzj
5273 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5274 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5280 deltat12=om2-om1+2.0d0
5282 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
5283 +akct*deltad*deltat12 &
5284 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5285 ! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5286 ! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5287 ! & " deltat12",deltat12," eij",eij
5288 ed=2*akcm*deltad+akct*deltat12
5290 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5291 eom1=-2*akth*deltat1-pom1-om2*pom2
5292 eom2= 2*akth*deltat2+pom1-om1*pom2
5295 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5296 ghpbx(k,i)=ghpbx(k,i)-ggk &
5297 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
5298 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5299 ghpbx(k,j)=ghpbx(k,j)+ggk &
5300 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
5301 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5302 ghpbc(k,i)=ghpbc(k,i)-ggk
5303 ghpbc(k,j)=ghpbc(k,j)+ggk
5306 ! Calculate the components of the gradient in DC and X
5310 !grad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5314 end subroutine ssbond_ene
5315 !-----------------------------------------------------------------------------
5316 subroutine ebond(estr)
5318 ! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5320 ! implicit real*8 (a-h,o-z)
5321 ! include 'DIMENSIONS'
5322 ! include 'COMMON.LOCAL'
5323 ! include 'COMMON.GEO'
5324 ! include 'COMMON.INTERACT'
5325 ! include 'COMMON.DERIV'
5326 ! include 'COMMON.VAR'
5327 ! include 'COMMON.CHAIN'
5328 ! include 'COMMON.IOUNITS'
5329 ! include 'COMMON.NAMES'
5330 ! include 'COMMON.FFIELD'
5331 ! include 'COMMON.CONTROL'
5332 ! include 'COMMON.SETUP'
5333 real(kind=8),dimension(3) :: u,ud
5335 integer :: i,j,iti,nbi,k
5336 real(kind=8) :: estr,estr1,diff,uprod,usum,usumsqder,&
5341 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
5342 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
5344 do i=ibondp_start,ibondp_end
5345 if (itype(i-1,1).eq.ntyp1 .and. itype(i,1).eq.ntyp1) cycle
5346 if (itype(i-1,1).eq.ntyp1 .or. itype(i,1).eq.ntyp1) then
5347 !C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5349 !C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) &
5350 !C *dc(j,i-1)/vbld(i)
5352 !C if (energy_dec) write(iout,*) &
5353 !C "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5354 diff = vbld(i)-vbldpDUM
5356 diff = vbld(i)-vbldp0
5358 if (energy_dec) write (iout,'(a7,i5,4f7.3)') &
5359 "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5362 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5364 ! write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5367 estr=0.5d0*AKP*estr+estr1
5368 ! print *,"estr_bb",estr,AKP
5370 ! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5372 do i=ibond_start,ibond_end
5373 iti=iabs(itype(i,1))
5374 if (iti.eq.0) print *,"WARNING WRONG SETTTING",i
5375 if (iti.ne.10 .and. iti.ne.ntyp1) then
5378 diff=vbld(i+nres)-vbldsc0(1,iti)
5379 if (energy_dec) write (iout,*) &
5380 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5381 AKSC(1,iti),AKSC(1,iti)*diff*diff
5382 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5383 ! print *,"estr_sc",estr
5385 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5389 diff=vbld(i+nres)-vbldsc0(j,iti)
5390 ud(j)=aksc(j,iti)*diff
5391 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5405 uprod2=uprod2*u(k)*u(k)
5409 usumsqder=usumsqder+ud(j)*uprod2
5411 estr=estr+uprod/usum
5412 ! print *,"estr_sc",estr,i
5414 if (energy_dec) write (iout,*) &
5415 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5416 AKSC(1,iti),uprod/usum
5418 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5424 end subroutine ebond
5426 !-----------------------------------------------------------------------------
5427 subroutine ebend(etheta)
5429 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5430 ! angles gamma and its derivatives in consecutive thetas and gammas.
5433 ! implicit real*8 (a-h,o-z)
5434 ! include 'DIMENSIONS'
5435 ! include 'COMMON.LOCAL'
5436 ! include 'COMMON.GEO'
5437 ! include 'COMMON.INTERACT'
5438 ! include 'COMMON.DERIV'
5439 ! include 'COMMON.VAR'
5440 ! include 'COMMON.CHAIN'
5441 ! include 'COMMON.IOUNITS'
5442 ! include 'COMMON.NAMES'
5443 ! include 'COMMON.FFIELD'
5444 ! include 'COMMON.CONTROL'
5445 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5446 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5447 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5449 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5450 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5451 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5453 integer :: i,k,ichir1,ichir2,itype1,ichir11,ichir12,itype2,&
5455 real(kind=8) :: etheta,delta,ss,ssd,phii,phii1,thet_pred_mean,&
5456 athetk,bthetk,dthett,dthetg1,dthetg2,f0,fprim0,E_tc0,fprim_tc0,&
5457 f1,fprim1,E_tc1,ethetai,E_theta,E_tc
5458 real(kind=8),dimension(2) :: y,z
5461 ! time11=dexp(-2*time)
5464 ! write (*,'(a,i2)') 'EBEND ICG=',icg
5465 do i=ithet_start,ithet_end
5466 if (itype(i-1,1).eq.ntyp1) cycle
5467 ! Zero the energy function and its derivative at 0 or pi.
5468 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5470 ichir1=isign(1,itype(i-2,1))
5471 ichir2=isign(1,itype(i,1))
5472 if (itype(i-2,1).eq.10) ichir1=isign(1,itype(i-1,1))
5473 if (itype(i,1).eq.10) ichir2=isign(1,itype(i-1,1))
5474 if (itype(i-1,1).eq.10) then
5475 itype1=isign(10,itype(i-2,1))
5476 ichir11=isign(1,itype(i-2,1))
5477 ichir12=isign(1,itype(i-2,1))
5478 itype2=isign(10,itype(i,1))
5479 ichir21=isign(1,itype(i,1))
5480 ichir22=isign(1,itype(i,1))
5483 if (i.gt.3 .and. itype(i-2,1).ne.ntyp1) then
5486 if (phii.ne.phii) phii=150.0
5496 if (i.lt.nres .and. itype(i,1).ne.ntyp1) then
5499 if (phii1.ne.phii1) phii1=150.0
5511 ! Calculate the "mean" value of theta from the part of the distribution
5512 ! dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5513 ! In following comments this theta will be referred to as t_c.
5514 thet_pred_mean=0.0d0
5516 athetk=athet(k,it,ichir1,ichir2)
5517 bthetk=bthet(k,it,ichir1,ichir2)
5519 athetk=athet(k,itype1,ichir11,ichir12)
5520 bthetk=bthet(k,itype2,ichir21,ichir22)
5522 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5524 dthett=thet_pred_mean*ssd
5525 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5526 ! Derivatives of the "mean" values in gamma1 and gamma2.
5527 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) &
5528 +athet(2,it,ichir1,ichir2)*y(1))*ss
5529 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) &
5530 +bthet(2,it,ichir1,ichir2)*z(1))*ss
5532 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) &
5533 +athet(2,itype1,ichir11,ichir12)*y(1))*ss
5534 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) &
5535 +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5537 if (theta(i).gt.pi-delta) then
5538 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,&
5540 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5541 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5542 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,&
5544 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,&
5546 else if (theta(i).lt.delta) then
5547 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5548 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5549 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,&
5551 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5552 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,&
5555 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,&
5558 etheta=etheta+ethetai
5559 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5561 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5562 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5563 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
5565 ! print *,ithetaconstr_start,ithetaconstr_end,"TU"
5567 ! Ufff.... We've done all this!!!
5569 end subroutine ebend
5570 !-----------------------------------------------------------------------------
5571 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
5574 ! implicit real*8 (a-h,o-z)
5575 ! include 'DIMENSIONS'
5576 ! include 'COMMON.LOCAL'
5577 ! include 'COMMON.IOUNITS'
5578 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5579 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5580 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5582 real(kind=8) :: thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc
5584 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5585 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5586 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5588 real(kind=8) :: sig,fac,escloci0,escloci1,esclocbi0,dersc12,&
5589 esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5591 ! Calculate the contributions to both Gaussian lobes.
5592 ! 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5593 ! The "polynomial part" of the "standard deviation" of this part of
5597 sig=sig*thet_pred_mean+polthet(j,it)
5599 ! Derivative of the "interior part" of the "standard deviation of the"
5600 ! gamma-dependent Gaussian lobe in t_c.
5601 sigtc=3*polthet(3,it)
5603 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5606 ! Set the parameters of both Gaussian lobes of the distribution.
5607 ! "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5608 fac=sig*sig+sigc0(it)
5611 ! Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5612 sigsqtc=-4.0D0*sigcsq*sigtc
5613 ! print *,i,sig,sigtc,sigsqtc
5614 ! Following variable (sigtc) is d[sigma(t_c)]/dt_c
5615 sigtc=-sigtc/(fac*fac)
5616 ! Following variable is sigma(t_c)**(-2)
5617 sigcsq=sigcsq*sigcsq
5619 sig0inv=1.0D0/sig0i**2
5620 delthec=thetai-thet_pred_mean
5621 delthe0=thetai-theta0i
5622 term1=-0.5D0*sigcsq*delthec*delthec
5623 term2=-0.5D0*sig0inv*delthe0*delthe0
5624 ! Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5625 ! NaNs in taking the logarithm. We extract the largest exponent which is added
5626 ! to the energy (this being the log of the distribution) at the end of energy
5627 ! term evaluation for this virtual-bond angle.
5628 if (term1.gt.term2) then
5630 term2=dexp(term2-termm)
5634 term1=dexp(term1-termm)
5637 ! The ratio between the gamma-independent and gamma-dependent lobes of
5638 ! the distribution is a Gaussian function of thet_pred_mean too.
5639 diffak=gthet(2,it)-thet_pred_mean
5640 ratak=diffak/gthet(3,it)**2
5641 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5642 ! Let's differentiate it in thet_pred_mean NOW.
5644 ! Now put together the distribution terms to make complete distribution.
5645 termexp=term1+ak*term2
5646 termpre=sigc+ak*sig0i
5647 ! Contribution of the bending energy from this theta is just the -log of
5648 ! the sum of the contributions from the two lobes and the pre-exponential
5649 ! factor. Simple enough, isn't it?
5650 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5651 ! NOW the derivatives!!!
5652 ! 6/6/97 Take into account the deformation.
5653 E_theta=(delthec*sigcsq*term1 &
5654 +ak*delthe0*sig0inv*term2)/termexp
5655 E_tc=((sigtc+aktc*sig0i)/termpre &
5656 -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ &
5657 aktc*term2)/termexp)
5659 end subroutine theteng
5661 !-----------------------------------------------------------------------------
5662 subroutine ebend(etheta,ethetacnstr)
5664 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5665 ! angles gamma and its derivatives in consecutive thetas and gammas.
5666 ! ab initio-derived potentials from
5667 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5669 ! implicit real*8 (a-h,o-z)
5670 ! include 'DIMENSIONS'
5671 ! include 'COMMON.LOCAL'
5672 ! include 'COMMON.GEO'
5673 ! include 'COMMON.INTERACT'
5674 ! include 'COMMON.DERIV'
5675 ! include 'COMMON.VAR'
5676 ! include 'COMMON.CHAIN'
5677 ! include 'COMMON.IOUNITS'
5678 ! include 'COMMON.NAMES'
5679 ! include 'COMMON.FFIELD'
5680 ! include 'COMMON.CONTROL'
5681 real(kind=8),dimension(nntheterm) :: coskt,sinkt !mmaxtheterm
5682 real(kind=8),dimension(nsingle) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
5683 real(kind=8),dimension(ndouble,ndouble) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
5684 logical :: lprn=.false., lprn1=.false.
5686 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
5687 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
5688 real(kind=8) :: aux,etheta,ccl,ssl,scl,csl,ethetacnstr
5689 ! local variables for constrains
5690 real(kind=8) :: difi,thetiii
5694 do i=ithet_start,ithet_end
5695 if (itype(i-1,1).eq.ntyp1) cycle
5696 if (itype(i-2,1).eq.ntyp1.or.itype(i,1).eq.ntyp1) cycle
5697 if (iabs(itype(i+1,1)).eq.20) iblock=2
5698 if (iabs(itype(i+1,1)).ne.20) iblock=1
5702 theti2=0.5d0*theta(i)
5703 ityp2=ithetyp((itype(i-1,1)))
5705 coskt(k)=dcos(k*theti2)
5706 sinkt(k)=dsin(k*theti2)
5708 if (i.gt.3 .and. itype(max0(i-3,1),1).ne.ntyp1) then
5711 if (phii.ne.phii) phii=150.0
5715 ityp1=ithetyp((itype(i-2,1)))
5716 ! propagation of chirality for glycine type
5718 cosph1(k)=dcos(k*phii)
5719 sinph1(k)=dsin(k*phii)
5723 ityp1=ithetyp(itype(i-2,1))
5729 if (i.lt.nres .and. itype(i+1,1).ne.ntyp1) then
5732 if (phii1.ne.phii1) phii1=150.0
5737 ityp3=ithetyp((itype(i,1)))
5739 cosph2(k)=dcos(k*phii1)
5740 sinph2(k)=dsin(k*phii1)
5744 ityp3=ithetyp(itype(i,1))
5750 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5753 ccl=cosph1(l)*cosph2(k-l)
5754 ssl=sinph1(l)*sinph2(k-l)
5755 scl=sinph1(l)*cosph2(k-l)
5756 csl=cosph1(l)*sinph2(k-l)
5757 cosph1ph2(l,k)=ccl-ssl
5758 cosph1ph2(k,l)=ccl+ssl
5759 sinph1ph2(l,k)=scl+csl
5760 sinph1ph2(k,l)=scl-csl
5764 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
5765 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5766 write (iout,*) "coskt and sinkt"
5768 write (iout,*) k,coskt(k),sinkt(k)
5772 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5773 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) &
5776 write (iout,*) "k",k,&
5777 "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),&
5781 write (iout,*) "cosph and sinph"
5783 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5785 write (iout,*) "cosph1ph2 and sinph2ph2"
5788 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
5789 sinph1ph2(l,k),sinph1ph2(k,l)
5792 write(iout,*) "ethetai",ethetai
5796 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) &
5797 +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) &
5798 +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) &
5799 +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5800 ethetai=ethetai+sinkt(m)*aux
5801 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5802 dephii=dephii+k*sinkt(m)* &
5803 (ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- &
5804 bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5805 dephii1=dephii1+k*sinkt(m)* &
5806 (eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- &
5807 ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5809 write (iout,*) "m",m," k",k," bbthet", &
5810 bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", &
5811 ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", &
5812 ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", &
5813 eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5817 write(iout,*) "ethetai",ethetai
5821 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
5822 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ &
5823 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
5824 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5825 ethetai=ethetai+sinkt(m)*aux
5826 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5827 dephii=dephii+l*sinkt(m)* &
5828 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- &
5829 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
5830 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
5831 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5832 dephii1=dephii1+(k-l)*sinkt(m)* &
5833 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
5834 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
5835 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- &
5836 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5838 write (iout,*) "m",m," k",k," l",l," ffthet",&
5839 ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
5840 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",&
5841 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
5842 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),&
5844 write (iout,*) cosph1ph2(l,k)*sinkt(m),&
5845 cosph1ph2(k,l)*sinkt(m),&
5846 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5854 write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
5855 i,theta(i)*rad2deg,phii*rad2deg,&
5856 phii1*rad2deg,ethetai
5858 etheta=etheta+ethetai
5859 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5861 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5862 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5863 gloc(nphi+i-2,icg)=wang*dethetai
5865 !-----------thete constrains
5866 ! if (tor_mode.ne.2) then
5868 ! print *,ithetaconstr_start,ithetaconstr_end,"TU"
5869 do i=ithetaconstr_start,ithetaconstr_end
5870 itheta=itheta_constr(i)
5871 thetiii=theta(itheta)
5872 difi=pinorm(thetiii-theta_constr0(i))
5873 if (difi.gt.theta_drange(i)) then
5874 difi=difi-theta_drange(i)
5875 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5876 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
5877 +for_thet_constr(i)*difi**3
5878 else if (difi.lt.-drange(i)) then
5880 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5881 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
5882 +for_thet_constr(i)*difi**3
5886 if (energy_dec) then
5887 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc", &
5888 i,itheta,rad2deg*thetiii, &
5889 rad2deg*theta_constr0(i), rad2deg*theta_drange(i), &
5890 rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4, &
5891 gloc(itheta+nphi-2,icg)
5897 end subroutine ebend
5900 !-----------------------------------------------------------------------------
5901 subroutine esc(escloc)
5902 ! Calculate the local energy of a side chain and its derivatives in the
5903 ! corresponding virtual-bond valence angles THETA and the spherical angles
5907 ! implicit real*8 (a-h,o-z)
5908 ! include 'DIMENSIONS'
5909 ! include 'COMMON.GEO'
5910 ! include 'COMMON.LOCAL'
5911 ! include 'COMMON.VAR'
5912 ! include 'COMMON.INTERACT'
5913 ! include 'COMMON.DERIV'
5914 ! include 'COMMON.CHAIN'
5915 ! include 'COMMON.IOUNITS'
5916 ! include 'COMMON.NAMES'
5917 ! include 'COMMON.FFIELD'
5918 ! include 'COMMON.CONTROL'
5919 real(kind=8),dimension(3) :: x,dersc,xemp,dersc0,dersc1,&
5920 ddersc0,ddummy,xtemp,temp
5921 !el real(kind=8) :: time11,time12,time112,theti
5922 real(kind=8) :: escloc,delta
5923 !el integer :: it,nlobit
5924 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5927 real(kind=8) :: escloci0,escloci1,escloci,esclocbi0,&
5928 dersc12,esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5931 ! write (iout,'(a)') 'ESC'
5932 do i=loc_start,loc_end
5934 if (it.eq.ntyp1) cycle
5935 if (it.eq.10) goto 1
5936 nlobit=nlob(iabs(it))
5937 ! print *,'i=',i,' it=',it,' nlobit=',nlobit
5938 ! write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5939 theti=theta(i+1)-pipol
5944 if (x(2).gt.pi-delta) then
5948 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5950 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5951 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),&
5953 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
5954 ddersc0(1),dersc(1))
5955 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),&
5956 ddersc0(3),dersc(3))
5958 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5960 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5961 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,&
5962 dersc0(2),esclocbi,dersc02)
5963 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
5965 call splinthet(x(2),0.5d0*delta,ss,ssd)
5970 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5972 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5973 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5975 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5977 ! write (iout,*) escloci
5978 else if (x(2).lt.delta) then
5982 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5984 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5985 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),&
5987 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
5988 ddersc0(1),dersc(1))
5989 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),&
5990 ddersc0(3),dersc(3))
5992 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5994 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5995 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,&
5996 dersc0(2),esclocbi,dersc02)
5997 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
6002 call splinthet(x(2),0.5d0*delta,ss,ssd)
6004 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6006 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6007 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6009 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6010 ! write (iout,*) escloci
6012 call enesc(x,escloci,dersc,ddummy,.false.)
6015 escloc=escloc+escloci
6016 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6018 ! write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6020 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ &
6022 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6023 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6028 !-----------------------------------------------------------------------------
6029 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6032 ! implicit real*8 (a-h,o-z)
6033 ! include 'DIMENSIONS'
6034 ! include 'COMMON.GEO'
6035 ! include 'COMMON.LOCAL'
6036 ! include 'COMMON.IOUNITS'
6037 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6038 real(kind=8),dimension(3) :: x,z,dersc,ddersc
6039 real(kind=8),dimension(3,nlobit,-1:1) :: Ax !(3,maxlob,-1:1)
6040 real(kind=8),dimension(nlobit,-1:1) :: contr !(maxlob,-1:1)
6041 real(kind=8) :: escloci
6044 integer :: j,iii,l,k !el,it,nlobit
6045 real(kind=8) :: escloc_i,x3,Axk,expfac,emin !el,theti,&
6046 !el time11,time12,time112
6047 ! write (iout,*) 'it=',it,' nlobit=',nlobit
6051 if (mixed) ddersc(j)=0.0d0
6055 ! Because of periodicity of the dependence of the SC energy in omega we have
6056 ! to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6057 ! To avoid underflows, first compute & store the exponents.
6065 z(k)=x(k)-censc(k,j,it)
6070 Axk=Axk+gaussc(l,k,j,it)*z(l)
6076 expfac=expfac+Ax(k,j,iii)*z(k)
6084 ! As in the case of ebend, we want to avoid underflows in exponentiation and
6085 ! subsequent NaNs and INFs in energy calculation.
6086 ! Find the largest exponent
6090 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6094 !d print *,'it=',it,' emin=',emin
6096 ! Compute the contribution to SC energy and derivatives
6101 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6102 if(adexp.ne.adexp) adexp=1.0
6105 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6107 !d print *,'j=',j,' expfac=',expfac
6108 escloc_i=escloc_i+expfac
6110 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6114 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) &
6115 +gaussc(k,2,j,it))*expfac
6122 dersc(1)=dersc(1)/cos(theti)**2
6123 ddersc(1)=ddersc(1)/cos(theti)**2
6126 escloci=-(dlog(escloc_i)-emin)
6128 dersc(j)=dersc(j)/escloc_i
6132 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6136 end subroutine enesc
6137 !-----------------------------------------------------------------------------
6138 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6141 ! implicit real*8 (a-h,o-z)
6142 ! include 'DIMENSIONS'
6143 ! include 'COMMON.GEO'
6144 ! include 'COMMON.LOCAL'
6145 ! include 'COMMON.IOUNITS'
6146 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6147 real(kind=8),dimension(3) :: x,z,dersc
6148 real(kind=8),dimension(3,nlobit) :: Ax !(3,maxlob)
6149 real(kind=8),dimension(nlobit) :: contr !(maxlob)
6150 real(kind=8) :: escloci,dersc12,emin
6153 integer :: j,k,l !el,it,nlobit
6154 real(kind=8) :: escloc_i,Axk,expfac !el,time11,time12,time112,theti
6164 z(k)=x(k)-censc(k,j,it)
6170 Axk=Axk+gaussc(l,k,j,it)*z(l)
6176 expfac=expfac+Ax(k,j)*z(k)
6181 ! As in the case of ebend, we want to avoid underflows in exponentiation and
6182 ! subsequent NaNs and INFs in energy calculation.
6183 ! Find the largest exponent
6186 if (emin.gt.contr(j)) emin=contr(j)
6190 ! Compute the contribution to SC energy and derivatives
6194 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6195 escloc_i=escloc_i+expfac
6197 dersc(k)=dersc(k)+Ax(k,j)*expfac
6199 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) &
6200 +gaussc(1,2,j,it))*expfac
6204 dersc(1)=dersc(1)/cos(theti)**2
6205 dersc12=dersc12/cos(theti)**2
6206 escloci=-(dlog(escloc_i)-emin)
6208 dersc(j)=dersc(j)/escloc_i
6210 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6212 end subroutine enesc_bound
6214 !-----------------------------------------------------------------------------
6215 subroutine esc(escloc)
6216 ! Calculate the local energy of a side chain and its derivatives in the
6217 ! corresponding virtual-bond valence angles THETA and the spherical angles
6218 ! ALPHA and OMEGA derived from AM1 all-atom calculations.
6219 ! added by Urszula Kozlowska. 07/11/2007
6222 ! implicit real*8 (a-h,o-z)
6223 ! include 'DIMENSIONS'
6224 ! include 'COMMON.GEO'
6225 ! include 'COMMON.LOCAL'
6226 ! include 'COMMON.VAR'
6227 ! include 'COMMON.SCROT'
6228 ! include 'COMMON.INTERACT'
6229 ! include 'COMMON.DERIV'
6230 ! include 'COMMON.CHAIN'
6231 ! include 'COMMON.IOUNITS'
6232 ! include 'COMMON.NAMES'
6233 ! include 'COMMON.FFIELD'
6234 ! include 'COMMON.CONTROL'
6235 ! include 'COMMON.VECTORS'
6236 real(kind=8),dimension(3) :: x_prime,y_prime,z_prime
6237 real(kind=8),dimension(65) :: x
6238 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1,sumene2,sumene3,&
6239 sumene4,s1,s1_6,s2,s2_6,de_dxx,de_dyy,de_dzz,de_dt
6240 real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
6241 real(kind=8),dimension(3) :: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,dYY_Ci,&
6242 dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
6244 integer :: i,j,k !el,it,nlobit
6245 real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
6246 !el real(kind=8) :: time11,time12,time112,theti
6247 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6248 real(kind=8) :: dscp1,dscp2,pom_s1,pom_s16,pom_s2,pom_s26,&
6249 pom,pom_dx,pom_dy,pom_dt1,pom_dt2,pom1,pom2,&
6250 sumene1x,sumene2x,sumene3x,sumene4x,&
6251 sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,&
6254 real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,&
6255 de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,&
6258 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
6262 do i=loc_start,loc_end
6263 if (itype(i,1).eq.ntyp1) cycle
6264 costtab(i+1) =dcos(theta(i+1))
6265 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6266 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6267 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6268 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6269 cosfac=dsqrt(cosfac2)
6270 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6271 sinfac=dsqrt(sinfac2)
6273 if (it.eq.10) goto 1
6275 ! Compute the axes of tghe local cartesian coordinates system; store in
6276 ! x_prime, y_prime and z_prime
6283 ! write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6284 ! & dc_norm(3,i+nres)
6286 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6287 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6290 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i,1)))
6293 ! write (2,*) "x_prime",(x_prime(j),j=1,3)
6294 ! write (2,*) "y_prime",(y_prime(j),j=1,3)
6295 ! write (2,*) "z_prime",(z_prime(j),j=1,3)
6296 ! write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6297 ! & " xy",scalar(x_prime(1),y_prime(1)),
6298 ! & " xz",scalar(x_prime(1),z_prime(1)),
6299 ! & " yy",scalar(y_prime(1),y_prime(1)),
6300 ! & " yz",scalar(y_prime(1),z_prime(1)),
6301 ! & " zz",scalar(z_prime(1),z_prime(1))
6303 ! Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6304 ! to local coordinate system. Store in xx, yy, zz.
6310 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6311 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6312 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6319 ! Compute the energy of the ith side cbain
6321 ! write (2,*) "xx",xx," yy",yy," zz",zz
6324 x(j) = sc_parmin(j,it)
6327 !c diagnostics - remove later
6329 yy1 = dsin(alph(2))*dcos(omeg(2))
6330 zz1 = -dsign(1.0,dfloat(itype(i,1)))*dsin(alph(2))*dsin(omeg(2))
6331 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
6332 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
6334 !," --- ", xx_w,yy_w,zz_w
6337 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6338 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6340 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6341 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6343 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6344 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6345 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6346 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6347 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6349 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6350 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6351 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6352 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6353 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6355 dsc_i = 0.743d0+x(61)
6357 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6358 *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6359 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6360 *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6361 s1=(1+x(63))/(0.1d0 + dscp1)
6362 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6363 s2=(1+x(65))/(0.1d0 + dscp2)
6364 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6365 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) &
6366 + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6367 ! write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6369 ! & dscp1,dscp2,sumene
6370 ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6371 escloc = escloc + sumene
6372 ! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i,1)
6377 ! This section to check the numerical derivatives of the energy of ith side
6378 ! chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6379 ! #define DEBUG in the code to turn it on.
6381 write (2,*) "sumene =",sumene
6385 write (2,*) xx,yy,zz
6386 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6387 de_dxx_num=(sumenep-sumene)/aincr
6389 write (2,*) "xx+ sumene from enesc=",sumenep
6392 write (2,*) xx,yy,zz
6393 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6394 de_dyy_num=(sumenep-sumene)/aincr
6396 write (2,*) "yy+ sumene from enesc=",sumenep
6399 write (2,*) xx,yy,zz
6400 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6401 de_dzz_num=(sumenep-sumene)/aincr
6403 write (2,*) "zz+ sumene from enesc=",sumenep
6404 costsave=cost2tab(i+1)
6405 sintsave=sint2tab(i+1)
6406 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6407 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6408 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6409 de_dt_num=(sumenep-sumene)/aincr
6410 write (2,*) " t+ sumene from enesc=",sumenep
6411 cost2tab(i+1)=costsave
6412 sint2tab(i+1)=sintsave
6413 ! End of diagnostics section.
6416 ! Compute the gradient of esc
6418 ! zz=zz*dsign(1.0,dfloat(itype(i,1)))
6419 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6420 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6421 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6422 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6423 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6424 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6425 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6426 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6427 pom1=(sumene3*sint2tab(i+1)+sumene1) &
6428 *(pom_s1/dscp1+pom_s16*dscp1**4)
6429 pom2=(sumene4*cost2tab(i+1)+sumene2) &
6430 *(pom_s2/dscp2+pom_s26*dscp2**4)
6431 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6432 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 &
6433 +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) &
6435 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6436 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 &
6437 +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) &
6439 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) &
6440 +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
6443 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i,1)
6446 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6447 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 &
6448 +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) &
6450 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6451 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz &
6452 +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz &
6453 +x(59)*zz**2 +x(60)*xx*zz
6454 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) &
6455 +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
6458 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i,1)
6461 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
6462 +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx &
6463 +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) &
6464 +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) &
6465 +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 &
6466 +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy &
6467 +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
6468 + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6470 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i,1)
6473 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
6474 -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
6475 +pom1*pom_dt1+pom2*pom_dt2
6477 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i,1)
6481 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6482 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6483 cosfac2xx=cosfac2*xx
6484 sinfac2yy=sinfac2*yy
6486 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* &
6488 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* &
6490 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6491 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6492 ! write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6493 ! & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6494 ! write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6495 ! & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6496 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6497 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6498 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6499 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6503 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
6504 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
6505 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
6506 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
6509 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6510 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6511 dZZ_XYZ(k)=vbld_inv(i+nres)* &
6512 (z_prime(k)-zz*dC_norm(k,i+nres))
6514 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6515 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6519 dXX_Ctab(k,i)=dXX_Ci(k)
6520 dXX_C1tab(k,i)=dXX_Ci1(k)
6521 dYY_Ctab(k,i)=dYY_Ci(k)
6522 dYY_C1tab(k,i)=dYY_Ci1(k)
6523 dZZ_Ctab(k,i)=dZZ_Ci(k)
6524 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6525 dXX_XYZtab(k,i)=dXX_XYZ(k)
6526 dYY_XYZtab(k,i)=dYY_XYZ(k)
6527 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6531 ! write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6532 ! & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6533 ! write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6534 ! & dyy_ci(k)," dzz_ci",dzz_ci(k)
6535 ! write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6537 ! write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6538 ! & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6539 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) &
6540 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6541 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) &
6542 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6543 gsclocx(k,i)= de_dxx*dxx_XYZ(k) &
6544 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6546 ! write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6547 ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6549 ! to check gradient call subroutine check_grad
6555 !-----------------------------------------------------------------------------
6556 real(kind=8) function enesc(x,xx,yy,zz,cost2,sint2)
6558 real(kind=8),dimension(65) :: x
6559 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2,sumene3,&
6560 sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6562 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6563 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6565 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6566 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6568 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6569 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6570 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6571 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6572 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6574 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6575 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6576 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6577 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6578 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6580 dsc_i = 0.743d0+x(61)
6582 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6583 *(xx*cost2+yy*sint2))
6584 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6585 *(xx*cost2-yy*sint2))
6586 s1=(1+x(63))/(0.1d0 + dscp1)
6587 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6588 s2=(1+x(65))/(0.1d0 + dscp2)
6589 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6590 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) &
6591 + (sumene4*cost2 +sumene2)*(s2+s2_6)
6596 !-----------------------------------------------------------------------------
6597 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6599 ! This procedure calculates two-body contact function g(rij) and its derivative:
6602 ! g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6605 ! where x=(rij-r0ij)/delta
6607 ! rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6610 real(kind=8) :: rij,r0ij,eps0ij,fcont,fprimcont
6611 real(kind=8) :: x,x2,x4,delta
6615 if (x.lt.-1.0D0) then
6618 else if (x.le.1.0D0) then
6621 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6622 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6628 end subroutine gcont
6629 !-----------------------------------------------------------------------------
6630 subroutine splinthet(theti,delta,ss,ssder)
6631 ! implicit real*8 (a-h,o-z)
6632 ! include 'DIMENSIONS'
6633 ! include 'COMMON.VAR'
6634 ! include 'COMMON.GEO'
6635 real(kind=8) :: theti,delta,ss,ssder
6636 real(kind=8) :: thetup,thetlow
6639 if (theti.gt.pipol) then
6640 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6642 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6646 end subroutine splinthet
6647 !-----------------------------------------------------------------------------
6648 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6650 real(kind=8) :: x,x0,delta,f0,f1,fprim0,f,fprim
6651 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6652 a1=fprim0*delta/(f1-f0)
6658 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6659 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6661 end subroutine spline1
6662 !-----------------------------------------------------------------------------
6663 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6665 real(kind=8) :: x,x0,delta,f0x,f1x,fprim0x,fx
6666 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6671 a2=3*(f1x-f0x)-2*fprim0x*delta
6672 a3=fprim0x*delta-2*(f1x-f0x)
6673 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6675 end subroutine spline2
6676 !-----------------------------------------------------------------------------
6678 !-----------------------------------------------------------------------------
6679 subroutine etor(etors,edihcnstr)
6680 ! implicit real*8 (a-h,o-z)
6681 ! include 'DIMENSIONS'
6682 ! include 'COMMON.VAR'
6683 ! include 'COMMON.GEO'
6684 ! include 'COMMON.LOCAL'
6685 ! include 'COMMON.TORSION'
6686 ! include 'COMMON.INTERACT'
6687 ! include 'COMMON.DERIV'
6688 ! include 'COMMON.CHAIN'
6689 ! include 'COMMON.NAMES'
6690 ! include 'COMMON.IOUNITS'
6691 ! include 'COMMON.FFIELD'
6692 ! include 'COMMON.TORCNSTR'
6693 ! include 'COMMON.CONTROL'
6694 real(kind=8) :: etors,edihcnstr
6698 real(kind=8) :: phii,fac,etors_ii
6700 ! Set lprn=.true. for debugging
6704 do i=iphi_start,iphi_end
6706 if (itype(i-2,1).eq.ntyp1.or. itype(i-1,1).eq.ntyp1 &
6707 .or. itype(i,1).eq.ntyp1) cycle
6708 itori=itortyp(itype(i-2,1))
6709 itori1=itortyp(itype(i-1,1))
6712 ! Proline-Proline pair is a special case...
6713 if (itori.eq.3 .and. itori1.eq.3) then
6714 if (phii.gt.-dwapi3) then
6716 fac=1.0D0/(1.0D0-cosphi)
6717 etorsi=v1(1,3,3)*fac
6718 etorsi=etorsi+etorsi
6719 etors=etors+etorsi-v1(1,3,3)
6720 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6721 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6724 v1ij=v1(j+1,itori,itori1)
6725 v2ij=v2(j+1,itori,itori1)
6728 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6729 if (energy_dec) etors_ii=etors_ii+ &
6730 v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6731 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6735 v1ij=v1(j,itori,itori1)
6736 v2ij=v2(j,itori,itori1)
6739 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6740 if (energy_dec) etors_ii=etors_ii+ &
6741 v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6742 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6745 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6748 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6749 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
6750 (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6751 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6752 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6754 ! 6/20/98 - dihedral angle constraints
6757 itori=idih_constr(i)
6760 if (difi.gt.drange(i)) then
6762 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6763 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6764 else if (difi.lt.-drange(i)) then
6766 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6767 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6769 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6770 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6772 ! write (iout,*) 'edihcnstr',edihcnstr
6775 !-----------------------------------------------------------------------------
6776 subroutine etor_d(etors_d)
6777 real(kind=8) :: etors_d
6780 end subroutine etor_d
6782 !-----------------------------------------------------------------------------
6783 subroutine etor(etors,edihcnstr)
6784 ! implicit real*8 (a-h,o-z)
6785 ! include 'DIMENSIONS'
6786 ! include 'COMMON.VAR'
6787 ! include 'COMMON.GEO'
6788 ! include 'COMMON.LOCAL'
6789 ! include 'COMMON.TORSION'
6790 ! include 'COMMON.INTERACT'
6791 ! include 'COMMON.DERIV'
6792 ! include 'COMMON.CHAIN'
6793 ! include 'COMMON.NAMES'
6794 ! include 'COMMON.IOUNITS'
6795 ! include 'COMMON.FFIELD'
6796 ! include 'COMMON.TORCNSTR'
6797 ! include 'COMMON.CONTROL'
6798 real(kind=8) :: etors,edihcnstr
6801 integer :: i,j,iblock,itori,itori1
6802 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
6803 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
6804 ! Set lprn=.true. for debugging
6808 do i=iphi_start,iphi_end
6809 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
6810 .or. itype(i-3,1).eq.ntyp1 &
6811 .or. itype(i,1).eq.ntyp1) cycle
6813 if (iabs(itype(i,1)).eq.20) then
6818 itori=itortyp(itype(i-2,1))
6819 itori1=itortyp(itype(i-1,1))
6822 ! Regular cosine and sine terms
6823 do j=1,nterm(itori,itori1,iblock)
6824 v1ij=v1(j,itori,itori1,iblock)
6825 v2ij=v2(j,itori,itori1,iblock)
6828 etors=etors+v1ij*cosphi+v2ij*sinphi
6829 if (energy_dec) etors_ii=etors_ii+ &
6830 v1ij*cosphi+v2ij*sinphi
6831 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6835 ! E = SUM ----------------------------------- - v1
6836 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6838 cosphi=dcos(0.5d0*phii)
6839 sinphi=dsin(0.5d0*phii)
6840 do j=1,nlor(itori,itori1,iblock)
6841 vl1ij=vlor1(j,itori,itori1)
6842 vl2ij=vlor2(j,itori,itori1)
6843 vl3ij=vlor3(j,itori,itori1)
6844 pom=vl2ij*cosphi+vl3ij*sinphi
6845 pom1=1.0d0/(pom*pom+1.0d0)
6846 etors=etors+vl1ij*pom1
6847 if (energy_dec) etors_ii=etors_ii+ &
6850 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6852 ! Subtract the constant term
6853 etors=etors-v0(itori,itori1,iblock)
6854 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6855 'etor',i,etors_ii-v0(itori,itori1,iblock)
6857 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6858 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
6859 (v1(j,itori,itori1,iblock),j=1,6),&
6860 (v2(j,itori,itori1,iblock),j=1,6)
6861 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6862 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6864 ! 6/20/98 - dihedral angle constraints
6866 ! do i=1,ndih_constr
6867 do i=idihconstr_start,idihconstr_end
6868 itori=idih_constr(i)
6870 difi=pinorm(phii-phi0(i))
6871 if (difi.gt.drange(i)) then
6873 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6874 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6875 else if (difi.lt.-drange(i)) then
6877 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6878 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6882 !d write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6883 !d & rad2deg*phi0(i), rad2deg*drange(i),
6884 !d & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6886 !d write (iout,*) 'edihcnstr',edihcnstr
6889 !-----------------------------------------------------------------------------
6890 subroutine etor_d(etors_d)
6891 ! 6/23/01 Compute double torsional energy
6892 ! implicit real*8 (a-h,o-z)
6893 ! include 'DIMENSIONS'
6894 ! include 'COMMON.VAR'
6895 ! include 'COMMON.GEO'
6896 ! include 'COMMON.LOCAL'
6897 ! include 'COMMON.TORSION'
6898 ! include 'COMMON.INTERACT'
6899 ! include 'COMMON.DERIV'
6900 ! include 'COMMON.CHAIN'
6901 ! include 'COMMON.NAMES'
6902 ! include 'COMMON.IOUNITS'
6903 ! include 'COMMON.FFIELD'
6904 ! include 'COMMON.TORCNSTR'
6905 real(kind=8) :: etors_d,etors_d_ii
6908 integer :: i,j,k,l,itori,itori1,itori2,iblock
6909 real(kind=8) :: phii,phii1,gloci1,gloci2,&
6910 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
6911 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
6912 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
6913 ! Set lprn=.true. for debugging
6917 ! write(iout,*) "a tu??"
6918 do i=iphid_start,iphid_end
6920 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
6921 .or. itype(i-3,1).eq.ntyp1 &
6922 .or. itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
6923 itori=itortyp(itype(i-2,1))
6924 itori1=itortyp(itype(i-1,1))
6925 itori2=itortyp(itype(i,1))
6931 if (iabs(itype(i+1,1)).eq.20) iblock=2
6933 ! Regular cosine and sine terms
6934 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6935 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6936 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6937 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6938 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6939 cosphi1=dcos(j*phii)
6940 sinphi1=dsin(j*phii)
6941 cosphi2=dcos(j*phii1)
6942 sinphi2=dsin(j*phii1)
6943 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
6944 v2cij*cosphi2+v2sij*sinphi2
6945 if (energy_dec) etors_d_ii=etors_d_ii+ &
6946 v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
6947 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6948 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6950 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6952 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6953 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6954 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6955 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6956 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6957 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6958 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6959 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6960 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
6961 v1sdij*sinphi1p2+v2sdij*sinphi1m2
6962 if (energy_dec) etors_d_ii=etors_d_ii+ &
6963 v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
6964 v1sdij*sinphi1p2+v2sdij*sinphi1m2
6965 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
6966 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6967 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
6968 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6971 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6972 'etor_d',i,etors_d_ii
6973 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6974 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6977 end subroutine etor_d
6979 !-----------------------------------------------------------------------------
6980 subroutine eback_sc_corr(esccor)
6981 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
6982 ! conformational states; temporarily implemented as differences
6983 ! between UNRES torsional potentials (dependent on three types of
6984 ! residues) and the torsional potentials dependent on all 20 types
6985 ! of residues computed from AM1 energy surfaces of terminally-blocked
6986 ! amino-acid residues.
6987 ! implicit real*8 (a-h,o-z)
6988 ! include 'DIMENSIONS'
6989 ! include 'COMMON.VAR'
6990 ! include 'COMMON.GEO'
6991 ! include 'COMMON.LOCAL'
6992 ! include 'COMMON.TORSION'
6993 ! include 'COMMON.SCCOR'
6994 ! include 'COMMON.INTERACT'
6995 ! include 'COMMON.DERIV'
6996 ! include 'COMMON.CHAIN'
6997 ! include 'COMMON.NAMES'
6998 ! include 'COMMON.IOUNITS'
6999 ! include 'COMMON.FFIELD'
7000 ! include 'COMMON.CONTROL'
7001 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
7004 integer :: i,interty,j,isccori,isccori1,intertyp
7005 ! Set lprn=.true. for debugging
7008 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7010 do i=itau_start,itau_end
7011 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1)) cycle
7013 isccori=isccortyp(itype(i-2,1))
7014 isccori1=isccortyp(itype(i-1,1))
7016 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7018 do intertyp=1,3 !intertyp
7020 !c Added 09 May 2012 (Adasko)
7021 !c Intertyp means interaction type of backbone mainchain correlation:
7022 ! 1 = SC...Ca...Ca...Ca
7023 ! 2 = Ca...Ca...Ca...SC
7024 ! 3 = SC...Ca...Ca...SCi
7026 if (((intertyp.eq.3).and.((itype(i-2,1).eq.10).or. &
7027 (itype(i-1,1).eq.10).or.(itype(i-2,1).eq.ntyp1).or. &
7028 (itype(i-1,1).eq.ntyp1))) &
7029 .or. ((intertyp.eq.1).and.((itype(i-2,1).eq.10) &
7030 .or.(itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1) &
7031 .or.(itype(i,1).eq.ntyp1))) &
7032 .or.((intertyp.eq.2).and.((itype(i-1,1).eq.10).or. &
7033 (itype(i-1,1).eq.ntyp1).or.(itype(i-2,1).eq.ntyp1).or. &
7034 (itype(i-3,1).eq.ntyp1)))) cycle
7035 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1,1).eq.ntyp1)) cycle
7036 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres,1).eq.ntyp1)) &
7038 do j=1,nterm_sccor(isccori,isccori1)
7039 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7040 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7041 cosphi=dcos(j*tauangle(intertyp,i))
7042 sinphi=dsin(j*tauangle(intertyp,i))
7043 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
7044 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7045 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7047 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
7048 'esccor',i,intertyp,esccor_ii
7049 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7050 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7052 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
7053 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,isccori,isccori1,&
7054 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
7055 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7056 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7061 end subroutine eback_sc_corr
7062 !-----------------------------------------------------------------------------
7063 subroutine multibody(ecorr)
7064 ! This subroutine calculates multi-body contributions to energy following
7065 ! the idea of Skolnick et al. If side chains I and J make a contact and
7066 ! at the same time side chains I+1 and J+1 make a contact, an extra
7067 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7068 ! implicit real*8 (a-h,o-z)
7069 ! include 'DIMENSIONS'
7070 ! include 'COMMON.IOUNITS'
7071 ! include 'COMMON.DERIV'
7072 ! include 'COMMON.INTERACT'
7073 ! include 'COMMON.CONTACTS'
7074 real(kind=8),dimension(3) :: gx,gx1
7076 real(kind=8) :: ecorr
7077 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
7078 ! Set lprn=.true. for debugging
7082 write (iout,'(a)') 'Contact function values:'
7084 write (iout,'(i2,20(1x,i2,f10.5))') &
7085 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7090 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7091 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7103 num_conti=num_cont(i)
7104 num_conti1=num_cont(i1)
7109 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7110 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7111 !d & ' ishift=',ishift
7112 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7113 ! The system gains extra energy.
7114 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7115 endif ! j1==j+-ishift
7123 end subroutine multibody
7124 !-----------------------------------------------------------------------------
7125 real(kind=8) function esccorr(i,j,k,l,jj,kk)
7126 ! implicit real*8 (a-h,o-z)
7127 ! include 'DIMENSIONS'
7128 ! include 'COMMON.IOUNITS'
7129 ! include 'COMMON.DERIV'
7130 ! include 'COMMON.INTERACT'
7131 ! include 'COMMON.CONTACTS'
7132 real(kind=8),dimension(3) :: gx,gx1
7134 integer :: i,j,k,l,jj,kk,m,ll
7135 real(kind=8) :: eij,ekl
7139 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7140 ! Calculate the multi-body contribution to energy.
7141 ! Calculate multi-body contributions to the gradient.
7142 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7143 !d & k,l,(gacont(m,kk,k),m=1,3)
7145 gx(m) =ekl*gacont(m,jj,i)
7146 gx1(m)=eij*gacont(m,kk,k)
7147 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7148 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7149 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7150 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7154 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7159 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7164 end function esccorr
7165 !-----------------------------------------------------------------------------
7166 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7167 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7168 ! implicit real*8 (a-h,o-z)
7169 ! include 'DIMENSIONS'
7170 ! include 'COMMON.IOUNITS'
7173 ! integer :: maxconts !max_cont=maxconts =nres/4
7174 integer,parameter :: max_dim=26
7175 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7176 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7177 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7178 !el common /przechowalnia/ zapas
7179 integer :: status(MPI_STATUS_SIZE)
7180 integer,dimension((nres/4)*2) :: req !maxconts*2
7181 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
7183 ! include 'COMMON.SETUP'
7184 ! include 'COMMON.FFIELD'
7185 ! include 'COMMON.DERIV'
7186 ! include 'COMMON.INTERACT'
7187 ! include 'COMMON.CONTACTS'
7188 ! include 'COMMON.CONTROL'
7189 ! include 'COMMON.LOCAL'
7190 real(kind=8),dimension(3) :: gx,gx1
7191 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
7192 logical :: lprn,ldone
7194 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
7195 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
7197 ! Set lprn=.true. for debugging
7201 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7204 if (nfgtasks.le.1) goto 30
7206 write (iout,'(a)') 'Contact function values before RECEIVE:'
7208 write (iout,'(2i3,50(1x,i2,f5.2))') &
7209 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7214 do i=1,ntask_cont_from
7217 do i=1,ntask_cont_to
7220 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7222 ! Make the list of contacts to send to send to other procesors
7223 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7225 do i=iturn3_start,iturn3_end
7226 ! write (iout,*) "make contact list turn3",i," num_cont",
7228 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7230 do i=iturn4_start,iturn4_end
7231 ! write (iout,*) "make contact list turn4",i," num_cont",
7233 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7237 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7239 do j=1,num_cont_hb(i)
7242 iproc=iint_sent_local(k,jjc,ii)
7243 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7244 if (iproc.gt.0) then
7245 ncont_sent(iproc)=ncont_sent(iproc)+1
7246 nn=ncont_sent(iproc)
7248 zapas(2,nn,iproc)=jjc
7249 zapas(3,nn,iproc)=facont_hb(j,i)
7250 zapas(4,nn,iproc)=ees0p(j,i)
7251 zapas(5,nn,iproc)=ees0m(j,i)
7252 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7253 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7254 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7255 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7256 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7257 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7258 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7259 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7260 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7261 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7262 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7263 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7264 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7265 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7266 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7267 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7268 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7269 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7270 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7271 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7272 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7279 "Numbers of contacts to be sent to other processors",&
7280 (ncont_sent(i),i=1,ntask_cont_to)
7281 write (iout,*) "Contacts sent"
7282 do ii=1,ntask_cont_to
7284 iproc=itask_cont_to(ii)
7285 write (iout,*) nn," contacts to processor",iproc,&
7286 " of CONT_TO_COMM group"
7288 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7296 CorrelID1=nfgtasks+fg_rank+1
7298 ! Receive the numbers of needed contacts from other processors
7299 do ii=1,ntask_cont_from
7300 iproc=itask_cont_from(ii)
7302 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7303 FG_COMM,req(ireq),IERR)
7305 ! write (iout,*) "IRECV ended"
7307 ! Send the number of contacts needed by other processors
7308 do ii=1,ntask_cont_to
7309 iproc=itask_cont_to(ii)
7311 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7312 FG_COMM,req(ireq),IERR)
7314 ! write (iout,*) "ISEND ended"
7315 ! write (iout,*) "number of requests (nn)",ireq
7318 call MPI_Waitall(ireq,req,status_array,ierr)
7320 ! & "Numbers of contacts to be received from other processors",
7321 ! & (ncont_recv(i),i=1,ntask_cont_from)
7325 do ii=1,ntask_cont_from
7326 iproc=itask_cont_from(ii)
7328 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7329 ! & " of CONT_TO_COMM group"
7333 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7334 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7335 ! write (iout,*) "ireq,req",ireq,req(ireq)
7338 ! Send the contacts to processors that need them
7339 do ii=1,ntask_cont_to
7340 iproc=itask_cont_to(ii)
7342 ! write (iout,*) nn," contacts to processor",iproc,
7343 ! & " of CONT_TO_COMM group"
7346 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7347 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7348 ! write (iout,*) "ireq,req",ireq,req(ireq)
7350 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7354 ! write (iout,*) "number of requests (contacts)",ireq
7355 ! write (iout,*) "req",(req(i),i=1,4)
7358 call MPI_Waitall(ireq,req,status_array,ierr)
7359 do iii=1,ntask_cont_from
7360 iproc=itask_cont_from(iii)
7363 write (iout,*) "Received",nn," contacts from processor",iproc,&
7364 " of CONT_FROM_COMM group"
7367 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7372 ii=zapas_recv(1,i,iii)
7373 ! Flag the received contacts to prevent double-counting
7374 jj=-zapas_recv(2,i,iii)
7375 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7377 nnn=num_cont_hb(ii)+1
7380 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7381 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7382 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7383 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7384 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7385 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7386 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7387 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7388 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7389 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7390 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7391 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7392 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7393 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7394 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7395 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7396 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7397 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7398 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7399 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7400 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7401 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7402 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7403 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7408 write (iout,'(a)') 'Contact function values after receive:'
7410 write (iout,'(2i3,50(1x,i3,f5.2))') &
7411 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7419 write (iout,'(a)') 'Contact function values:'
7421 write (iout,'(2i3,50(1x,i3,f5.2))') &
7422 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7428 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7429 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7430 ! Remove the loop below after debugging !!!
7437 ! Calculate the local-electrostatic correlation terms
7438 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7440 num_conti=num_cont_hb(i)
7441 num_conti1=num_cont_hb(i+1)
7448 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
7449 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
7450 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7451 .or. j.lt.0 .and. j1.gt.0) .and. &
7452 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7453 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7454 ! The system gains extra energy.
7455 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7456 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
7457 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7459 else if (j1.eq.j) then
7460 ! Contacts I-J and I-(J+1) occur simultaneously.
7461 ! The system loses extra energy.
7462 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7467 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7468 ! & ' jj=',jj,' kk=',kk
7470 ! Contacts I-J and (I+1)-J occur simultaneously.
7471 ! The system loses extra energy.
7472 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7478 end subroutine multibody_hb
7479 !-----------------------------------------------------------------------------
7480 subroutine add_hb_contact(ii,jj,itask)
7481 ! implicit real*8 (a-h,o-z)
7482 ! include "DIMENSIONS"
7483 ! include "COMMON.IOUNITS"
7484 ! include "COMMON.CONTACTS"
7485 ! integer,parameter :: maxconts=nres/4
7486 integer,parameter :: max_dim=26
7487 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7488 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7489 ! common /przechowalnia/ zapas
7490 integer :: i,j,ii,jj,iproc,nn,jjc
7491 integer,dimension(4) :: itask
7492 ! write (iout,*) "itask",itask
7495 if (iproc.gt.0) then
7496 do j=1,num_cont_hb(ii)
7498 ! write (iout,*) "i",ii," j",jj," jjc",jjc
7500 ncont_sent(iproc)=ncont_sent(iproc)+1
7501 nn=ncont_sent(iproc)
7502 zapas(1,nn,iproc)=ii
7503 zapas(2,nn,iproc)=jjc
7504 zapas(3,nn,iproc)=facont_hb(j,ii)
7505 zapas(4,nn,iproc)=ees0p(j,ii)
7506 zapas(5,nn,iproc)=ees0m(j,ii)
7507 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7508 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7509 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7510 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7511 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7512 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7513 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7514 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7515 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7516 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7517 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7518 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7519 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7520 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7521 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7522 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7523 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7524 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7525 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7526 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7527 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7534 end subroutine add_hb_contact
7535 !-----------------------------------------------------------------------------
7536 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
7537 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7538 ! implicit real*8 (a-h,o-z)
7539 ! include 'DIMENSIONS'
7540 ! include 'COMMON.IOUNITS'
7541 integer,parameter :: max_dim=70
7544 ! integer :: maxconts !max_cont=maxconts=nres/4
7545 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7546 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7547 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7548 ! common /przechowalnia/ zapas
7549 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
7550 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
7553 ! include 'COMMON.SETUP'
7554 ! include 'COMMON.FFIELD'
7555 ! include 'COMMON.DERIV'
7556 ! include 'COMMON.LOCAL'
7557 ! include 'COMMON.INTERACT'
7558 ! include 'COMMON.CONTACTS'
7559 ! include 'COMMON.CHAIN'
7560 ! include 'COMMON.CONTROL'
7561 real(kind=8),dimension(3) :: gx,gx1
7562 integer,dimension(nres) :: num_cont_hb_old
7563 logical :: lprn,ldone
7564 !EL double precision eello4,eello5,eelo6,eello_turn6
7565 !EL external eello4,eello5,eello6,eello_turn6
7567 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
7568 j1,jp1,i1,num_conti1
7569 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
7570 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
7572 ! Set lprn=.true. for debugging
7577 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7579 num_cont_hb_old(i)=num_cont_hb(i)
7583 if (nfgtasks.le.1) goto 30
7585 write (iout,'(a)') 'Contact function values before RECEIVE:'
7587 write (iout,'(2i3,50(1x,i2,f5.2))') &
7588 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7593 do i=1,ntask_cont_from
7596 do i=1,ntask_cont_to
7599 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7601 ! Make the list of contacts to send to send to other procesors
7602 do i=iturn3_start,iturn3_end
7603 ! write (iout,*) "make contact list turn3",i," num_cont",
7605 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7607 do i=iturn4_start,iturn4_end
7608 ! write (iout,*) "make contact list turn4",i," num_cont",
7610 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7614 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7616 do j=1,num_cont_hb(i)
7619 iproc=iint_sent_local(k,jjc,ii)
7620 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7621 if (iproc.ne.0) then
7622 ncont_sent(iproc)=ncont_sent(iproc)+1
7623 nn=ncont_sent(iproc)
7625 zapas(2,nn,iproc)=jjc
7626 zapas(3,nn,iproc)=d_cont(j,i)
7630 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7635 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7643 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7654 "Numbers of contacts to be sent to other processors",&
7655 (ncont_sent(i),i=1,ntask_cont_to)
7656 write (iout,*) "Contacts sent"
7657 do ii=1,ntask_cont_to
7659 iproc=itask_cont_to(ii)
7660 write (iout,*) nn," contacts to processor",iproc,&
7661 " of CONT_TO_COMM group"
7663 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7671 CorrelID1=nfgtasks+fg_rank+1
7673 ! Receive the numbers of needed contacts from other processors
7674 do ii=1,ntask_cont_from
7675 iproc=itask_cont_from(ii)
7677 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7678 FG_COMM,req(ireq),IERR)
7680 ! write (iout,*) "IRECV ended"
7682 ! Send the number of contacts needed by other processors
7683 do ii=1,ntask_cont_to
7684 iproc=itask_cont_to(ii)
7686 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7687 FG_COMM,req(ireq),IERR)
7689 ! write (iout,*) "ISEND ended"
7690 ! write (iout,*) "number of requests (nn)",ireq
7693 call MPI_Waitall(ireq,req,status_array,ierr)
7695 ! & "Numbers of contacts to be received from other processors",
7696 ! & (ncont_recv(i),i=1,ntask_cont_from)
7700 do ii=1,ntask_cont_from
7701 iproc=itask_cont_from(ii)
7703 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7704 ! & " of CONT_TO_COMM group"
7708 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7709 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7710 ! write (iout,*) "ireq,req",ireq,req(ireq)
7713 ! Send the contacts to processors that need them
7714 do ii=1,ntask_cont_to
7715 iproc=itask_cont_to(ii)
7717 ! write (iout,*) nn," contacts to processor",iproc,
7718 ! & " of CONT_TO_COMM group"
7721 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7722 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7723 ! write (iout,*) "ireq,req",ireq,req(ireq)
7725 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7729 ! write (iout,*) "number of requests (contacts)",ireq
7730 ! write (iout,*) "req",(req(i),i=1,4)
7733 call MPI_Waitall(ireq,req,status_array,ierr)
7734 do iii=1,ntask_cont_from
7735 iproc=itask_cont_from(iii)
7738 write (iout,*) "Received",nn," contacts from processor",iproc,&
7739 " of CONT_FROM_COMM group"
7742 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7747 ii=zapas_recv(1,i,iii)
7748 ! Flag the received contacts to prevent double-counting
7749 jj=-zapas_recv(2,i,iii)
7750 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7752 nnn=num_cont_hb(ii)+1
7755 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7759 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7764 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7772 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7781 write (iout,'(a)') 'Contact function values after receive:'
7783 write (iout,'(2i3,50(1x,i3,5f6.3))') &
7784 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
7785 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7792 write (iout,'(a)') 'Contact function values:'
7794 write (iout,'(2i3,50(1x,i2,5f6.3))') &
7795 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
7796 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7803 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7804 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7805 ! Remove the loop below after debugging !!!
7812 ! Calculate the dipole-dipole interaction energies
7813 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7814 do i=iatel_s,iatel_e+1
7815 num_conti=num_cont_hb(i)
7824 ! Calculate the local-electrostatic correlation terms
7825 ! write (iout,*) "gradcorr5 in eello5 before loop"
7827 ! write (iout,'(i5,3f10.5)')
7828 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7830 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7831 ! write (iout,*) "corr loop i",i
7833 num_conti=num_cont_hb(i)
7834 num_conti1=num_cont_hb(i+1)
7841 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7842 ! & ' jj=',jj,' kk=',kk
7843 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
7844 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7845 .or. j.lt.0 .and. j1.gt.0) .and. &
7846 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7847 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7848 ! The system gains extra energy.
7850 sqd1=dsqrt(d_cont(jj,i))
7851 sqd2=dsqrt(d_cont(kk,i1))
7852 sred_geom = sqd1*sqd2
7853 IF (sred_geom.lt.cutoff_corr) THEN
7854 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
7856 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7857 !d & ' jj=',jj,' kk=',kk
7858 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7859 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7861 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7862 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7865 !d write (iout,*) 'sred_geom=',sred_geom,
7866 !d & ' ekont=',ekont,' fprim=',fprimcont,
7867 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7868 !d write (iout,*) "g_contij",g_contij
7869 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7870 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7871 call calc_eello(i,jp,i+1,jp1,jj,kk)
7872 if (wcorr4.gt.0.0d0) &
7873 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7874 if (energy_dec.and.wcorr4.gt.0.0d0) &
7875 write (iout,'(a6,4i5,0pf7.3)') &
7876 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7877 ! write (iout,*) "gradcorr5 before eello5"
7879 ! write (iout,'(i5,3f10.5)')
7880 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7882 if (wcorr5.gt.0.0d0) &
7883 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7884 ! write (iout,*) "gradcorr5 after eello5"
7886 ! write (iout,'(i5,3f10.5)')
7887 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7889 if (energy_dec.and.wcorr5.gt.0.0d0) &
7890 write (iout,'(a6,4i5,0pf7.3)') &
7891 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7892 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7893 !d write(2,*)'ijkl',i,jp,i+1,jp1
7894 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
7895 .or. wturn6.eq.0.0d0))then
7896 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7897 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7898 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
7899 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7900 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7901 !d & 'ecorr6=',ecorr6
7902 !d write (iout,'(4e15.5)') sred_geom,
7903 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7904 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7905 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7906 else if (wturn6.gt.0.0d0 &
7907 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7908 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7909 eturn6=eturn6+eello_turn6(i,jj,kk)
7910 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
7911 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7912 !d write (2,*) 'multibody_eello:eturn6',eturn6
7921 num_cont_hb(i)=num_cont_hb_old(i)
7923 ! write (iout,*) "gradcorr5 in eello5"
7925 ! write (iout,'(i5,3f10.5)')
7926 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7929 end subroutine multibody_eello
7930 !-----------------------------------------------------------------------------
7931 subroutine add_hb_contact_eello(ii,jj,itask)
7932 ! implicit real*8 (a-h,o-z)
7933 ! include "DIMENSIONS"
7934 ! include "COMMON.IOUNITS"
7935 ! include "COMMON.CONTACTS"
7936 ! integer,parameter :: maxconts=nres/4
7937 integer,parameter :: max_dim=70
7938 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7939 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7940 ! common /przechowalnia/ zapas
7942 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
7943 integer,dimension(4) ::itask
7944 ! write (iout,*) "itask",itask
7947 if (iproc.gt.0) then
7948 do j=1,num_cont_hb(ii)
7950 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7952 ncont_sent(iproc)=ncont_sent(iproc)+1
7953 nn=ncont_sent(iproc)
7954 zapas(1,nn,iproc)=ii
7955 zapas(2,nn,iproc)=jjc
7956 zapas(3,nn,iproc)=d_cont(j,ii)
7960 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7965 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7973 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7984 end subroutine add_hb_contact_eello
7985 !-----------------------------------------------------------------------------
7986 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7987 ! implicit real*8 (a-h,o-z)
7988 ! include 'DIMENSIONS'
7989 ! include 'COMMON.IOUNITS'
7990 ! include 'COMMON.DERIV'
7991 ! include 'COMMON.INTERACT'
7992 ! include 'COMMON.CONTACTS'
7993 real(kind=8),dimension(3) :: gx,gx1
7996 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
7997 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
7998 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
7999 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
8010 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8011 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8012 ! Following 4 lines for diagnostics.
8017 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8018 ! & 'Contacts ',i,j,
8019 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8020 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8022 ! Calculate the multi-body contribution to energy.
8023 ! ecorr=ecorr+ekont*ees
8024 ! Calculate multi-body contributions to the gradient.
8025 coeffpees0pij=coeffp*ees0pij
8026 coeffmees0mij=coeffm*ees0mij
8027 coeffpees0pkl=coeffp*ees0pkl
8028 coeffmees0mkl=coeffm*ees0mkl
8030 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8031 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
8032 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
8033 coeffmees0mkl*gacontm_hb1(ll,jj,i))
8034 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
8035 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
8036 coeffmees0mkl*gacontm_hb2(ll,jj,i))
8037 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8038 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
8039 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
8040 coeffmees0mij*gacontm_hb1(ll,kk,k))
8041 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
8042 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
8043 coeffmees0mij*gacontm_hb2(ll,kk,k))
8044 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
8045 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
8046 coeffmees0mkl*gacontm_hb3(ll,jj,i))
8047 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8048 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8049 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
8050 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
8051 coeffmees0mij*gacontm_hb3(ll,kk,k))
8052 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8053 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8054 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8059 !grad gradcorr(ll,m)=gradcorr(ll,m)+
8060 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
8061 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8062 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8067 !grad gradcorr(ll,m)=gradcorr(ll,m)+
8068 !grad & ees*eij*gacont_hbr(ll,kk,k)-
8069 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8070 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8073 ! write (iout,*) "ehbcorr",ekont*ees
8075 if (shield_mode.gt.0) then
8078 !C print *,i,j,fac_shield(i),fac_shield(j),
8079 !C &fac_shield(k),fac_shield(l)
8080 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
8081 (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
8082 do ilist=1,ishield_list(i)
8083 iresshield=shield_list(ilist,i)
8085 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
8086 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8088 +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
8089 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8093 do ilist=1,ishield_list(j)
8094 iresshield=shield_list(ilist,j)
8096 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
8097 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8099 +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
8100 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8105 do ilist=1,ishield_list(k)
8106 iresshield=shield_list(ilist,k)
8108 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
8109 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8111 +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
8112 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8116 do ilist=1,ishield_list(l)
8117 iresshield=shield_list(ilist,l)
8119 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
8120 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8122 +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
8123 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8128 gshieldc_ec(m,i)=gshieldc_ec(m,i)+ &
8129 grad_shield(m,i)*ehbcorr/fac_shield(i)
8130 gshieldc_ec(m,j)=gshieldc_ec(m,j)+ &
8131 grad_shield(m,j)*ehbcorr/fac_shield(j)
8132 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ &
8133 grad_shield(m,i)*ehbcorr/fac_shield(i)
8134 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ &
8135 grad_shield(m,j)*ehbcorr/fac_shield(j)
8137 gshieldc_ec(m,k)=gshieldc_ec(m,k)+ &
8138 grad_shield(m,k)*ehbcorr/fac_shield(k)
8139 gshieldc_ec(m,l)=gshieldc_ec(m,l)+ &
8140 grad_shield(m,l)*ehbcorr/fac_shield(l)
8141 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ &
8142 grad_shield(m,k)*ehbcorr/fac_shield(k)
8143 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ &
8144 grad_shield(m,l)*ehbcorr/fac_shield(l)
8150 end function ehbcorr
8152 !-----------------------------------------------------------------------------
8153 subroutine dipole(i,j,jj)
8154 ! implicit real*8 (a-h,o-z)
8155 ! include 'DIMENSIONS'
8156 ! include 'COMMON.IOUNITS'
8157 ! include 'COMMON.CHAIN'
8158 ! include 'COMMON.FFIELD'
8159 ! include 'COMMON.DERIV'
8160 ! include 'COMMON.INTERACT'
8161 ! include 'COMMON.CONTACTS'
8162 ! include 'COMMON.TORSION'
8163 ! include 'COMMON.VAR'
8164 ! include 'COMMON.GEO'
8165 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
8166 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
8167 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
8169 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
8170 allocate(dipderx(3,5,4,maxconts,nres))
8173 iti1 = itortyp(itype(i+1,1))
8174 if (j.lt.nres-1) then
8175 itj1 = itortyp(itype(j+1,1))
8180 dipi(iii,1)=Ub2(iii,i)
8181 dipderi(iii)=Ub2der(iii,i)
8182 dipi(iii,2)=b1(iii,iti1)
8183 dipj(iii,1)=Ub2(iii,j)
8184 dipderj(iii)=Ub2der(iii,j)
8185 dipj(iii,2)=b1(iii,itj1)
8189 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8192 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8199 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
8203 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8208 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8209 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8211 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8213 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8215 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8218 end subroutine dipole
8220 !-----------------------------------------------------------------------------
8221 subroutine calc_eello(i,j,k,l,jj,kk)
8223 ! This subroutine computes matrices and vectors needed to calculate
8224 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
8227 ! implicit real*8 (a-h,o-z)
8228 ! include 'DIMENSIONS'
8229 ! include 'COMMON.IOUNITS'
8230 ! include 'COMMON.CHAIN'
8231 ! include 'COMMON.DERIV'
8232 ! include 'COMMON.INTERACT'
8233 ! include 'COMMON.CONTACTS'
8234 ! include 'COMMON.TORSION'
8235 ! include 'COMMON.VAR'
8236 ! include 'COMMON.GEO'
8237 ! include 'COMMON.FFIELD'
8238 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
8239 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
8240 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
8243 !el common /kutas/ lprn
8244 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8245 !d & ' jj=',jj,' kk=',kk
8246 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8247 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8248 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8251 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8252 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8255 call transpose2(aa1(1,1),aa1t(1,1))
8256 call transpose2(aa2(1,1),aa2t(1,1))
8259 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
8260 aa1tder(1,1,lll,kkk))
8261 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
8262 aa2tder(1,1,lll,kkk))
8266 ! parallel orientation of the two CA-CA-CA frames.
8268 iti=itortyp(itype(i,1))
8272 itk1=itortyp(itype(k+1,1))
8273 itj=itortyp(itype(j,1))
8274 if (l.lt.nres-1) then
8275 itl1=itortyp(itype(l+1,1))
8279 ! A1 kernel(j+1) A2T
8281 !d write (iout,'(3f10.5,5x,3f10.5)')
8282 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8284 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8285 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
8286 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8287 ! Following matrices are needed only for 6-th order cumulants
8288 IF (wcorr6.gt.0.0d0) THEN
8289 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8290 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
8291 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8292 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8293 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
8294 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8295 ADtEAderx(1,1,1,1,1,1))
8297 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8298 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
8299 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8300 ADtEA1derx(1,1,1,1,1,1))
8302 ! End 6-th order cumulants
8305 !d write (2,*) 'In calc_eello6'
8307 !d write (2,*) 'iii=',iii
8309 !d write (2,*) 'kkk=',kkk
8311 !d write (2,'(3(2f10.5),5x)')
8312 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8317 call transpose2(EUgder(1,1,k),auxmat(1,1))
8318 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8319 call transpose2(EUg(1,1,k),auxmat(1,1))
8320 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8321 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8325 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8326 EAEAderx(1,1,lll,kkk,iii,1))
8330 ! A1T kernel(i+1) A2
8331 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8332 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
8333 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8334 ! Following matrices are needed only for 6-th order cumulants
8335 IF (wcorr6.gt.0.0d0) THEN
8336 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8337 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
8338 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8339 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8340 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
8341 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8342 ADtEAderx(1,1,1,1,1,2))
8343 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8344 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
8345 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8346 ADtEA1derx(1,1,1,1,1,2))
8348 ! End 6-th order cumulants
8349 call transpose2(EUgder(1,1,l),auxmat(1,1))
8350 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8351 call transpose2(EUg(1,1,l),auxmat(1,1))
8352 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8353 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8357 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8358 EAEAderx(1,1,lll,kkk,iii,2))
8363 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8364 ! They are needed only when the fifth- or the sixth-order cumulants are
8366 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8367 call transpose2(AEA(1,1,1),auxmat(1,1))
8368 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8369 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8370 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8371 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8372 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8373 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8374 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8375 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8376 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8377 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8378 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8379 call transpose2(AEA(1,1,2),auxmat(1,1))
8380 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
8381 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8382 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8383 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8384 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
8385 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8386 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
8387 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
8388 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8389 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8390 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8391 ! Calculate the Cartesian derivatives of the vectors.
8395 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8396 call matvec2(auxmat(1,1),b1(1,iti),&
8397 AEAb1derx(1,lll,kkk,iii,1,1))
8398 call matvec2(auxmat(1,1),Ub2(1,i),&
8399 AEAb2derx(1,lll,kkk,iii,1,1))
8400 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8401 AEAb1derx(1,lll,kkk,iii,2,1))
8402 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8403 AEAb2derx(1,lll,kkk,iii,2,1))
8404 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8405 call matvec2(auxmat(1,1),b1(1,itj),&
8406 AEAb1derx(1,lll,kkk,iii,1,2))
8407 call matvec2(auxmat(1,1),Ub2(1,j),&
8408 AEAb2derx(1,lll,kkk,iii,1,2))
8409 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
8410 AEAb1derx(1,lll,kkk,iii,2,2))
8411 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
8412 AEAb2derx(1,lll,kkk,iii,2,2))
8419 ! Antiparallel orientation of the two CA-CA-CA frames.
8421 iti=itortyp(itype(i,1))
8425 itk1=itortyp(itype(k+1,1))
8426 itl=itortyp(itype(l,1))
8427 itj=itortyp(itype(j,1))
8428 if (j.lt.nres-1) then
8429 itj1=itortyp(itype(j+1,1))
8433 ! A2 kernel(j-1)T A1T
8434 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8435 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
8436 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8437 ! Following matrices are needed only for 6-th order cumulants
8438 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8439 j.eq.i+4 .and. l.eq.i+3)) THEN
8440 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8441 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
8442 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8443 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8444 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
8445 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8446 ADtEAderx(1,1,1,1,1,1))
8447 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8448 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
8449 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8450 ADtEA1derx(1,1,1,1,1,1))
8452 ! End 6-th order cumulants
8453 call transpose2(EUgder(1,1,k),auxmat(1,1))
8454 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8455 call transpose2(EUg(1,1,k),auxmat(1,1))
8456 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8457 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8461 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8462 EAEAderx(1,1,lll,kkk,iii,1))
8466 ! A2T kernel(i+1)T A1
8467 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8468 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
8469 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8470 ! Following matrices are needed only for 6-th order cumulants
8471 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8472 j.eq.i+4 .and. l.eq.i+3)) THEN
8473 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8474 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
8475 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8476 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8477 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
8478 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8479 ADtEAderx(1,1,1,1,1,2))
8480 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8481 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
8482 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8483 ADtEA1derx(1,1,1,1,1,2))
8485 ! End 6-th order cumulants
8486 call transpose2(EUgder(1,1,j),auxmat(1,1))
8487 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8488 call transpose2(EUg(1,1,j),auxmat(1,1))
8489 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8490 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8494 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8495 EAEAderx(1,1,lll,kkk,iii,2))
8500 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8501 ! They are needed only when the fifth- or the sixth-order cumulants are
8503 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
8504 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8505 call transpose2(AEA(1,1,1),auxmat(1,1))
8506 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8507 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8508 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8509 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8510 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8511 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8512 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8513 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8514 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8515 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8516 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8517 call transpose2(AEA(1,1,2),auxmat(1,1))
8518 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
8519 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8520 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8521 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8522 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
8523 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8524 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
8525 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
8526 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8527 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8528 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8529 ! Calculate the Cartesian derivatives of the vectors.
8533 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8534 call matvec2(auxmat(1,1),b1(1,iti),&
8535 AEAb1derx(1,lll,kkk,iii,1,1))
8536 call matvec2(auxmat(1,1),Ub2(1,i),&
8537 AEAb2derx(1,lll,kkk,iii,1,1))
8538 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8539 AEAb1derx(1,lll,kkk,iii,2,1))
8540 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8541 AEAb2derx(1,lll,kkk,iii,2,1))
8542 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8543 call matvec2(auxmat(1,1),b1(1,itl),&
8544 AEAb1derx(1,lll,kkk,iii,1,2))
8545 call matvec2(auxmat(1,1),Ub2(1,l),&
8546 AEAb2derx(1,lll,kkk,iii,1,2))
8547 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
8548 AEAb1derx(1,lll,kkk,iii,2,2))
8549 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
8550 AEAb2derx(1,lll,kkk,iii,2,2))
8558 end subroutine calc_eello
8559 !-----------------------------------------------------------------------------
8560 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
8565 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
8566 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
8567 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
8568 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
8569 integer :: iii,kkk,lll
8572 !el common /kutas/ lprn
8573 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8575 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
8578 !d if (lprn) write (2,*) 'In kernel'
8580 !d if (lprn) write (2,*) 'kkk=',kkk
8582 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
8583 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8585 !d write (2,*) 'lll=',lll
8586 !d write (2,*) 'iii=1'
8588 !d write (2,'(3(2f10.5),5x)')
8589 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8592 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
8593 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8595 !d write (2,*) 'lll=',lll
8596 !d write (2,*) 'iii=2'
8598 !d write (2,'(3(2f10.5),5x)')
8599 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8605 end subroutine kernel
8606 !-----------------------------------------------------------------------------
8607 real(kind=8) function eello4(i,j,k,l,jj,kk)
8608 ! implicit real*8 (a-h,o-z)
8609 ! include 'DIMENSIONS'
8610 ! include 'COMMON.IOUNITS'
8611 ! include 'COMMON.CHAIN'
8612 ! include 'COMMON.DERIV'
8613 ! include 'COMMON.INTERACT'
8614 ! include 'COMMON.CONTACTS'
8615 ! include 'COMMON.TORSION'
8616 ! include 'COMMON.VAR'
8617 ! include 'COMMON.GEO'
8618 real(kind=8),dimension(2,2) :: pizda
8619 real(kind=8),dimension(3) :: ggg1,ggg2
8620 real(kind=8) :: eel4,glongij,glongkl
8621 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
8622 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8626 !d print *,'eello4:',i,j,k,l,jj,kk
8627 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
8628 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
8629 !old eij=facont_hb(jj,i)
8630 !old ekl=facont_hb(kk,k)
8632 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8633 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8634 gcorr_loc(k-1)=gcorr_loc(k-1) &
8635 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8637 gcorr_loc(l-1)=gcorr_loc(l-1) &
8638 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8640 gcorr_loc(j-1)=gcorr_loc(j-1) &
8641 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8646 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
8647 -EAEAderx(2,2,lll,kkk,iii,1)
8648 !d derx(lll,kkk,iii)=0.0d0
8652 !d gcorr_loc(l-1)=0.0d0
8653 !d gcorr_loc(j-1)=0.0d0
8654 !d gcorr_loc(k-1)=0.0d0
8656 !d write (iout,*)'Contacts have occurred for peptide groups',
8657 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
8658 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8659 if (j.lt.nres-1) then
8666 if (l.lt.nres-1) then
8674 !grad ggg1(ll)=eel4*g_contij(ll,1)
8675 !grad ggg2(ll)=eel4*g_contij(ll,2)
8676 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8677 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8678 !grad ghalf=0.5d0*ggg1(ll)
8679 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8680 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8681 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8682 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8683 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8684 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8685 !grad ghalf=0.5d0*ggg2(ll)
8686 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8687 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8688 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8689 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8690 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8691 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8695 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8700 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8705 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8710 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8714 !d write (2,*) iii,gcorr_loc(iii)
8717 !d write (2,*) 'ekont',ekont
8718 !d write (iout,*) 'eello4',ekont*eel4
8721 !-----------------------------------------------------------------------------
8722 real(kind=8) function eello5(i,j,k,l,jj,kk)
8723 ! implicit real*8 (a-h,o-z)
8724 ! include 'DIMENSIONS'
8725 ! include 'COMMON.IOUNITS'
8726 ! include 'COMMON.CHAIN'
8727 ! include 'COMMON.DERIV'
8728 ! include 'COMMON.INTERACT'
8729 ! include 'COMMON.CONTACTS'
8730 ! include 'COMMON.TORSION'
8731 ! include 'COMMON.VAR'
8732 ! include 'COMMON.GEO'
8733 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8734 real(kind=8),dimension(2) :: vv
8735 real(kind=8),dimension(3) :: ggg1,ggg2
8736 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
8737 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
8738 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
8739 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8744 ! /l\ / \ \ / \ / \ / C
8745 ! / \ / \ \ / \ / \ / C
8746 ! j| o |l1 | o | o| o | | o |o C
8747 ! \ |/k\| |/ \| / |/ \| |/ \| C
8748 ! \i/ \ / \ / / \ / \ C
8750 ! (I) (II) (III) (IV) C
8752 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8754 ! Antiparallel chains C
8757 ! /j\ / \ \ / \ / \ / C
8758 ! / \ / \ \ / \ / \ / C
8759 ! j1| o |l | o | o| o | | o |o C
8760 ! \ |/k\| |/ \| / |/ \| |/ \| C
8761 ! \i/ \ / \ / / \ / \ C
8763 ! (I) (II) (III) (IV) C
8765 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8767 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
8769 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8770 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8775 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8777 itk=itortyp(itype(k,1))
8778 itl=itortyp(itype(l,1))
8779 itj=itortyp(itype(j,1))
8784 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8785 !d & eel5_3_num,eel5_4_num)
8789 derx(lll,kkk,iii)=0.0d0
8793 !d eij=facont_hb(jj,i)
8794 !d ekl=facont_hb(kk,k)
8796 !d write (iout,*)'Contacts have occurred for peptide groups',
8797 !d & i,j,' fcont:',eij,' eij',' and ',k,l
8799 ! Contribution from the graph I.
8800 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8801 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8802 call transpose2(EUg(1,1,k),auxmat(1,1))
8803 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8804 vv(1)=pizda(1,1)-pizda(2,2)
8805 vv(2)=pizda(1,2)+pizda(2,1)
8806 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
8807 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8808 ! Explicit gradient in virtual-dihedral angles.
8809 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
8810 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
8811 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8812 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8813 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8814 vv(1)=pizda(1,1)-pizda(2,2)
8815 vv(2)=pizda(1,2)+pizda(2,1)
8816 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8817 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
8818 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8819 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8820 vv(1)=pizda(1,1)-pizda(2,2)
8821 vv(2)=pizda(1,2)+pizda(2,1)
8823 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8824 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
8825 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8827 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8828 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
8829 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8831 ! Cartesian gradient
8835 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
8837 vv(1)=pizda(1,1)-pizda(2,2)
8838 vv(2)=pizda(1,2)+pizda(2,1)
8839 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8840 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
8841 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8847 ! Contribution from graph II
8848 call transpose2(EE(1,1,itk),auxmat(1,1))
8849 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8850 vv(1)=pizda(1,1)+pizda(2,2)
8851 vv(2)=pizda(2,1)-pizda(1,2)
8852 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
8853 -0.5d0*scalar2(vv(1),Ctobr(1,k))
8854 ! Explicit gradient in virtual-dihedral angles.
8855 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8856 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8857 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8858 vv(1)=pizda(1,1)+pizda(2,2)
8859 vv(2)=pizda(2,1)-pizda(1,2)
8861 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8862 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
8863 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8865 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8866 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
8867 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8869 ! Cartesian gradient
8873 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8875 vv(1)=pizda(1,1)+pizda(2,2)
8876 vv(2)=pizda(2,1)-pizda(1,2)
8877 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8878 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
8879 -0.5d0*scalar2(vv(1),Ctobr(1,k))
8887 ! Parallel orientation
8888 ! Contribution from graph III
8889 call transpose2(EUg(1,1,l),auxmat(1,1))
8890 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8891 vv(1)=pizda(1,1)-pizda(2,2)
8892 vv(2)=pizda(1,2)+pizda(2,1)
8893 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
8894 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8895 ! Explicit gradient in virtual-dihedral angles.
8896 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8897 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
8898 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8899 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8900 vv(1)=pizda(1,1)-pizda(2,2)
8901 vv(2)=pizda(1,2)+pizda(2,1)
8902 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8903 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
8904 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8905 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8906 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8907 vv(1)=pizda(1,1)-pizda(2,2)
8908 vv(2)=pizda(1,2)+pizda(2,1)
8909 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8910 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
8911 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8912 ! Cartesian gradient
8916 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
8918 vv(1)=pizda(1,1)-pizda(2,2)
8919 vv(2)=pizda(1,2)+pizda(2,1)
8920 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8921 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
8922 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8927 ! Contribution from graph IV
8929 call transpose2(EE(1,1,itl),auxmat(1,1))
8930 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8931 vv(1)=pizda(1,1)+pizda(2,2)
8932 vv(2)=pizda(2,1)-pizda(1,2)
8933 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
8934 -0.5d0*scalar2(vv(1),Ctobr(1,l))
8935 ! Explicit gradient in virtual-dihedral angles.
8936 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8937 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8938 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8939 vv(1)=pizda(1,1)+pizda(2,2)
8940 vv(2)=pizda(2,1)-pizda(1,2)
8941 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8942 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
8943 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8944 ! Cartesian gradient
8948 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8950 vv(1)=pizda(1,1)+pizda(2,2)
8951 vv(2)=pizda(2,1)-pizda(1,2)
8952 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8953 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
8954 -0.5d0*scalar2(vv(1),Ctobr(1,l))
8959 ! Antiparallel orientation
8960 ! Contribution from graph III
8962 call transpose2(EUg(1,1,j),auxmat(1,1))
8963 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8964 vv(1)=pizda(1,1)-pizda(2,2)
8965 vv(2)=pizda(1,2)+pizda(2,1)
8966 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
8967 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8968 ! Explicit gradient in virtual-dihedral angles.
8969 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8970 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
8971 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8972 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8973 vv(1)=pizda(1,1)-pizda(2,2)
8974 vv(2)=pizda(1,2)+pizda(2,1)
8975 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8976 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
8977 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8978 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8979 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8980 vv(1)=pizda(1,1)-pizda(2,2)
8981 vv(2)=pizda(1,2)+pizda(2,1)
8982 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8983 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
8984 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8985 ! Cartesian gradient
8989 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
8991 vv(1)=pizda(1,1)-pizda(2,2)
8992 vv(2)=pizda(1,2)+pizda(2,1)
8993 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
8994 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
8995 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9000 ! Contribution from graph IV
9002 call transpose2(EE(1,1,itj),auxmat(1,1))
9003 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9004 vv(1)=pizda(1,1)+pizda(2,2)
9005 vv(2)=pizda(2,1)-pizda(1,2)
9006 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
9007 -0.5d0*scalar2(vv(1),Ctobr(1,j))
9008 ! Explicit gradient in virtual-dihedral angles.
9009 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9010 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9011 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9012 vv(1)=pizda(1,1)+pizda(2,2)
9013 vv(2)=pizda(2,1)-pizda(1,2)
9014 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9015 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
9016 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9017 ! Cartesian gradient
9021 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
9023 vv(1)=pizda(1,1)+pizda(2,2)
9024 vv(2)=pizda(2,1)-pizda(1,2)
9025 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
9026 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
9027 -0.5d0*scalar2(vv(1),Ctobr(1,j))
9033 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9034 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9035 !d write (2,*) 'ijkl',i,j,k,l
9036 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9037 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
9039 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9040 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9041 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9042 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9043 if (j.lt.nres-1) then
9050 if (l.lt.nres-1) then
9060 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9061 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
9062 ! summed up outside the subrouine as for the other subroutines
9063 ! handling long-range interactions. The old code is commented out
9064 ! with "cgrad" to keep track of changes.
9066 !grad ggg1(ll)=eel5*g_contij(ll,1)
9067 !grad ggg2(ll)=eel5*g_contij(ll,2)
9068 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9069 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9070 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9071 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9072 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9073 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9074 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9075 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9077 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9078 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9079 !grad ghalf=0.5d0*ggg1(ll)
9081 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9082 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9083 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9084 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9085 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9086 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9087 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9088 !grad ghalf=0.5d0*ggg2(ll)
9090 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
9091 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9092 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
9093 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9094 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9095 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9100 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9101 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9106 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9107 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9113 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9118 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9122 !d write (2,*) iii,g_corr5_loc(iii)
9125 !d write (2,*) 'ekont',ekont
9126 !d write (iout,*) 'eello5',ekont*eel5
9129 !-----------------------------------------------------------------------------
9130 real(kind=8) function eello6(i,j,k,l,jj,kk)
9131 ! implicit real*8 (a-h,o-z)
9132 ! include 'DIMENSIONS'
9133 ! include 'COMMON.IOUNITS'
9134 ! include 'COMMON.CHAIN'
9135 ! include 'COMMON.DERIV'
9136 ! include 'COMMON.INTERACT'
9137 ! include 'COMMON.CONTACTS'
9138 ! include 'COMMON.TORSION'
9139 ! include 'COMMON.VAR'
9140 ! include 'COMMON.GEO'
9141 ! include 'COMMON.FFIELD'
9142 real(kind=8),dimension(3) :: ggg1,ggg2
9143 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
9145 real(kind=8) :: gradcorr6ij,gradcorr6kl
9146 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
9147 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9152 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9160 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9161 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9165 derx(lll,kkk,iii)=0.0d0
9169 !d eij=facont_hb(jj,i)
9170 !d ekl=facont_hb(kk,k)
9176 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9177 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9178 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9179 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9180 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9181 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9183 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9184 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9185 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9186 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9187 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9188 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9192 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9194 ! If turn contributions are considered, they will be handled separately.
9195 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9196 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9197 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9198 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9199 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9200 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9201 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9203 if (j.lt.nres-1) then
9210 if (l.lt.nres-1) then
9218 !grad ggg1(ll)=eel6*g_contij(ll,1)
9219 !grad ggg2(ll)=eel6*g_contij(ll,2)
9220 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9221 !grad ghalf=0.5d0*ggg1(ll)
9223 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9224 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9225 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9226 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9227 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9228 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9229 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9230 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9231 !grad ghalf=0.5d0*ggg2(ll)
9232 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9234 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9235 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9236 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9237 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9238 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9239 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9244 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9245 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9250 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9251 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9257 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9262 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9266 !d write (2,*) iii,g_corr6_loc(iii)
9269 !d write (2,*) 'ekont',ekont
9270 !d write (iout,*) 'eello6',ekont*eel6
9273 !-----------------------------------------------------------------------------
9274 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
9276 ! implicit real*8 (a-h,o-z)
9277 ! include 'DIMENSIONS'
9278 ! include 'COMMON.IOUNITS'
9279 ! include 'COMMON.CHAIN'
9280 ! include 'COMMON.DERIV'
9281 ! include 'COMMON.INTERACT'
9282 ! include 'COMMON.CONTACTS'
9283 ! include 'COMMON.TORSION'
9284 ! include 'COMMON.VAR'
9285 ! include 'COMMON.GEO'
9286 real(kind=8),dimension(2) :: vv,vv1
9287 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
9290 !el common /kutas/ lprn
9291 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
9292 real(kind=8) :: s1,s2,s3,s4,s5
9293 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9295 ! Parallel Antiparallel C
9301 ! \ j|/k\| / \ |/k\|l / C
9306 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9307 itk=itortyp(itype(k,1))
9308 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9309 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9310 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9311 call transpose2(EUgC(1,1,k),auxmat(1,1))
9312 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9313 vv1(1)=pizda1(1,1)-pizda1(2,2)
9314 vv1(2)=pizda1(1,2)+pizda1(2,1)
9315 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9316 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
9317 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
9318 s5=scalar2(vv(1),Dtobr2(1,i))
9319 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9320 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9321 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
9322 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
9323 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
9324 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
9325 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
9326 +scalar2(vv(1),Dtobr2der(1,i)))
9327 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9328 vv1(1)=pizda1(1,1)-pizda1(2,2)
9329 vv1(2)=pizda1(1,2)+pizda1(2,1)
9330 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
9331 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
9333 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
9334 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
9335 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
9336 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
9337 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9339 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
9340 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
9341 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
9342 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
9343 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9345 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9346 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9347 vv1(1)=pizda1(1,1)-pizda1(2,2)
9348 vv1(2)=pizda1(1,2)+pizda1(2,1)
9349 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
9350 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
9351 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
9352 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9361 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9362 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9363 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9364 call transpose2(EUgC(1,1,k),auxmat(1,1))
9365 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
9367 vv1(1)=pizda1(1,1)-pizda1(2,2)
9368 vv1(2)=pizda1(1,2)+pizda1(2,1)
9369 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9370 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
9371 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
9372 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
9373 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
9374 s5=scalar2(vv(1),Dtobr2(1,i))
9375 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9380 end function eello6_graph1
9381 !-----------------------------------------------------------------------------
9382 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
9384 ! implicit real*8 (a-h,o-z)
9385 ! include 'DIMENSIONS'
9386 ! include 'COMMON.IOUNITS'
9387 ! include 'COMMON.CHAIN'
9388 ! include 'COMMON.DERIV'
9389 ! include 'COMMON.INTERACT'
9390 ! include 'COMMON.CONTACTS'
9391 ! include 'COMMON.TORSION'
9392 ! include 'COMMON.VAR'
9393 ! include 'COMMON.GEO'
9395 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
9396 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9398 !el common /kutas/ lprn
9399 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
9400 real(kind=8) :: s2,s3,s4
9401 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9403 ! Parallel Antiparallel C
9409 ! \ j|/k\| \ |/k\|l C
9414 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9415 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9416 ! AL 7/4/01 s1 would occur in the sixth-order moment,
9417 ! but not in a cluster cumulant
9419 s1=dip(1,jj,i)*dip(1,kk,k)
9421 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9422 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9423 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9424 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9425 call transpose2(EUg(1,1,k),auxmat(1,1))
9426 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9427 vv(1)=pizda(1,1)-pizda(2,2)
9428 vv(2)=pizda(1,2)+pizda(2,1)
9429 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9430 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9432 eello6_graph2=-(s1+s2+s3+s4)
9434 eello6_graph2=-(s2+s3+s4)
9437 ! Derivatives in gamma(i-1)
9440 s1=dipderg(1,jj,i)*dip(1,kk,k)
9442 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9443 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9444 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9445 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9447 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9449 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9451 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9453 ! Derivatives in gamma(k-1)
9455 s1=dip(1,jj,i)*dipderg(1,kk,k)
9457 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9458 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9459 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9460 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9461 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9462 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9463 vv(1)=pizda(1,1)-pizda(2,2)
9464 vv(2)=pizda(1,2)+pizda(2,1)
9465 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9467 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9469 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9471 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9472 ! Derivatives in gamma(j-1) or gamma(l-1)
9475 s1=dipderg(3,jj,i)*dip(1,kk,k)
9477 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9478 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9479 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9480 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9481 vv(1)=pizda(1,1)-pizda(2,2)
9482 vv(2)=pizda(1,2)+pizda(2,1)
9483 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9486 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9488 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9491 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9492 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9494 ! Derivatives in gamma(l-1) or gamma(j-1)
9497 s1=dip(1,jj,i)*dipderg(3,kk,k)
9499 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9500 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9501 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9502 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9503 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9504 vv(1)=pizda(1,1)-pizda(2,2)
9505 vv(2)=pizda(1,2)+pizda(2,1)
9506 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9509 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9511 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9514 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9515 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9517 ! Cartesian derivatives.
9519 write (2,*) 'In eello6_graph2'
9521 write (2,*) 'iii=',iii
9523 write (2,*) 'kkk=',kkk
9525 write (2,'(3(2f10.5),5x)') &
9526 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9536 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9538 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9541 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
9543 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9544 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
9546 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9547 call transpose2(EUg(1,1,k),auxmat(1,1))
9548 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
9550 vv(1)=pizda(1,1)-pizda(2,2)
9551 vv(2)=pizda(1,2)+pizda(2,1)
9552 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9553 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9555 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9557 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9560 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9562 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9568 end function eello6_graph2
9569 !-----------------------------------------------------------------------------
9570 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
9571 ! implicit real*8 (a-h,o-z)
9572 ! include 'DIMENSIONS'
9573 ! include 'COMMON.IOUNITS'
9574 ! include 'COMMON.CHAIN'
9575 ! include 'COMMON.DERIV'
9576 ! include 'COMMON.INTERACT'
9577 ! include 'COMMON.CONTACTS'
9578 ! include 'COMMON.TORSION'
9579 ! include 'COMMON.VAR'
9580 ! include 'COMMON.GEO'
9581 real(kind=8),dimension(2) :: vv,auxvec
9582 real(kind=8),dimension(2,2) :: pizda,auxmat
9584 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
9585 real(kind=8) :: s1,s2,s3,s4
9586 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9588 ! Parallel Antiparallel C
9594 ! j|/k\| / |/k\|l / C
9599 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9601 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9602 ! energy moment and not to the cluster cumulant.
9603 iti=itortyp(itype(i,1))
9604 if (j.lt.nres-1) then
9605 itj1=itortyp(itype(j+1,1))
9609 itk=itortyp(itype(k,1))
9610 itk1=itortyp(itype(k+1,1))
9611 if (l.lt.nres-1) then
9612 itl1=itortyp(itype(l+1,1))
9617 s1=dip(4,jj,i)*dip(4,kk,k)
9619 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
9620 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9621 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
9622 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9623 call transpose2(EE(1,1,itk),auxmat(1,1))
9624 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9625 vv(1)=pizda(1,1)+pizda(2,2)
9626 vv(2)=pizda(2,1)-pizda(1,2)
9627 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9628 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9629 !d & "sum",-(s2+s3+s4)
9631 eello6_graph3=-(s1+s2+s3+s4)
9633 eello6_graph3=-(s2+s3+s4)
9636 ! Derivatives in gamma(k-1)
9637 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
9638 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9639 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9640 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9641 ! Derivatives in gamma(l-1)
9642 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
9643 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9644 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9645 vv(1)=pizda(1,1)+pizda(2,2)
9646 vv(2)=pizda(2,1)-pizda(1,2)
9647 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9648 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9649 ! Cartesian derivatives.
9655 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9657 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9660 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
9662 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9663 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
9665 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9666 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
9668 vv(1)=pizda(1,1)+pizda(2,2)
9669 vv(2)=pizda(2,1)-pizda(1,2)
9670 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9672 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9674 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9677 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9679 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9681 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9686 end function eello6_graph3
9687 !-----------------------------------------------------------------------------
9688 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9689 ! implicit real*8 (a-h,o-z)
9690 ! include 'DIMENSIONS'
9691 ! include 'COMMON.IOUNITS'
9692 ! include 'COMMON.CHAIN'
9693 ! include 'COMMON.DERIV'
9694 ! include 'COMMON.INTERACT'
9695 ! include 'COMMON.CONTACTS'
9696 ! include 'COMMON.TORSION'
9697 ! include 'COMMON.VAR'
9698 ! include 'COMMON.GEO'
9699 ! include 'COMMON.FFIELD'
9700 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
9701 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9703 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
9705 real(kind=8) :: s1,s2,s3,s4
9706 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9708 ! Parallel Antiparallel C
9714 ! \ j|/k\| \ |/k\|l C
9719 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9721 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9722 ! energy moment and not to the cluster cumulant.
9723 !d write (2,*) 'eello_graph4: wturn6',wturn6
9724 iti=itortyp(itype(i,1))
9725 itj=itortyp(itype(j,1))
9726 if (j.lt.nres-1) then
9727 itj1=itortyp(itype(j+1,1))
9731 itk=itortyp(itype(k,1))
9732 if (k.lt.nres-1) then
9733 itk1=itortyp(itype(k+1,1))
9737 itl=itortyp(itype(l,1))
9738 if (l.lt.nres-1) then
9739 itl1=itortyp(itype(l+1,1))
9743 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9744 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9745 !d & ' itl',itl,' itl1',itl1
9748 s1=dip(3,jj,i)*dip(3,kk,k)
9750 s1=dip(2,jj,j)*dip(2,kk,l)
9753 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9754 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9756 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9757 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9759 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9760 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9762 call transpose2(EUg(1,1,k),auxmat(1,1))
9763 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9764 vv(1)=pizda(1,1)-pizda(2,2)
9765 vv(2)=pizda(2,1)+pizda(1,2)
9766 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9767 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9769 eello6_graph4=-(s1+s2+s3+s4)
9771 eello6_graph4=-(s2+s3+s4)
9773 ! Derivatives in gamma(i-1)
9777 s1=dipderg(2,jj,i)*dip(3,kk,k)
9779 s1=dipderg(4,jj,j)*dip(2,kk,l)
9782 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9784 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9785 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9787 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9788 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9790 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9791 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9792 !d write (2,*) 'turn6 derivatives'
9794 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9796 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9800 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9802 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9806 ! Derivatives in gamma(k-1)
9809 s1=dip(3,jj,i)*dipderg(2,kk,k)
9811 s1=dip(2,jj,j)*dipderg(4,kk,l)
9814 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9815 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9817 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9818 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9820 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9821 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9823 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9824 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9825 vv(1)=pizda(1,1)-pizda(2,2)
9826 vv(2)=pizda(2,1)+pizda(1,2)
9827 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9828 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9830 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9832 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9836 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9838 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9841 ! Derivatives in gamma(j-1) or gamma(l-1)
9842 if (l.eq.j+1 .and. l.gt.1) then
9843 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9844 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9845 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9846 vv(1)=pizda(1,1)-pizda(2,2)
9847 vv(2)=pizda(2,1)+pizda(1,2)
9848 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9849 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9850 else if (j.gt.1) then
9851 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9852 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9853 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9854 vv(1)=pizda(1,1)-pizda(2,2)
9855 vv(2)=pizda(2,1)+pizda(1,2)
9856 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9857 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9858 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9860 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9863 ! Cartesian derivatives.
9870 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9872 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9876 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9878 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9882 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
9884 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9886 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
9887 b1(1,itj1),auxvec(1))
9888 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9890 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
9891 b1(1,itl1),auxvec(1))
9892 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9894 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
9896 vv(1)=pizda(1,1)-pizda(2,2)
9897 vv(2)=pizda(2,1)+pizda(1,2)
9898 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9900 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9902 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
9905 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
9908 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9911 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9913 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9915 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9919 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9921 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9924 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9926 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9933 end function eello6_graph4
9934 !-----------------------------------------------------------------------------
9935 real(kind=8) function eello_turn6(i,jj,kk)
9936 ! implicit real*8 (a-h,o-z)
9937 ! include 'DIMENSIONS'
9938 ! include 'COMMON.IOUNITS'
9939 ! include 'COMMON.CHAIN'
9940 ! include 'COMMON.DERIV'
9941 ! include 'COMMON.INTERACT'
9942 ! include 'COMMON.CONTACTS'
9943 ! include 'COMMON.TORSION'
9944 ! include 'COMMON.VAR'
9945 ! include 'COMMON.GEO'
9946 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
9947 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
9948 real(kind=8),dimension(3) :: ggg1,ggg2
9949 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
9950 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
9951 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9952 ! the respective energy moment and not to the cluster cumulant.
9954 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
9955 integer :: j1,j2,l1,l2,ll
9956 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
9957 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
9966 iti=itortyp(itype(i,1))
9967 itk=itortyp(itype(k,1))
9968 itk1=itortyp(itype(k+1,1))
9969 itl=itortyp(itype(l,1))
9970 itj=itortyp(itype(j,1))
9971 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9972 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
9973 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9978 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9980 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
9984 derx_turn(lll,kkk,iii)=0.0d0
9991 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9993 !d write (2,*) 'eello6_5',eello6_5
9995 call transpose2(AEA(1,1,1),auxmat(1,1))
9996 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9997 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9998 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10000 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
10001 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10002 s2 = scalar2(b1(1,itk),vtemp1(1))
10004 call transpose2(AEA(1,1,2),atemp(1,1))
10005 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10006 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10007 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10009 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10010 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10011 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10013 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10014 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10015 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10016 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10017 ss13 = scalar2(b1(1,itk),vtemp4(1))
10018 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10020 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10026 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10027 ! Derivatives in gamma(i+2)
10031 call transpose2(AEA(1,1,1),auxmatd(1,1))
10032 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10033 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10034 call transpose2(AEAderg(1,1,2),atempd(1,1))
10035 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10036 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10038 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10039 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10040 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10046 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10047 ! Derivatives in gamma(i+3)
10049 call transpose2(AEA(1,1,1),auxmatd(1,1))
10050 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10051 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
10052 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10054 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
10055 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10056 s2d = scalar2(b1(1,itk),vtemp1d(1))
10058 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10059 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10061 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10063 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10064 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10065 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10073 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
10074 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10076 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
10077 -0.5d0*ekont*(s2d+s12d)
10079 ! Derivatives in gamma(i+4)
10080 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10081 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10082 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10084 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10085 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10086 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10094 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10096 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10098 ! Derivatives in gamma(i+5)
10100 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10101 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10102 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10104 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
10105 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10106 s2d = scalar2(b1(1,itk),vtemp1d(1))
10108 call transpose2(AEA(1,1,2),atempd(1,1))
10109 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10110 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10112 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10113 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10115 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10116 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10117 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10125 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
10126 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10128 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
10129 -0.5d0*ekont*(s2d+s12d)
10131 ! Cartesian derivatives
10136 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10137 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10138 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10140 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
10141 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
10143 s2d = scalar2(b1(1,itk),vtemp1d(1))
10145 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10146 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10147 s8d = -(atempd(1,1)+atempd(2,2))* &
10148 scalar2(cc(1,1,itl),vtemp2(1))
10150 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
10152 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10153 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10160 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
10163 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
10167 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
10170 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
10179 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
10181 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10182 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10183 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10184 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10185 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
10187 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10188 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10189 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10193 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10194 !d & 16*eel_turn6_num
10196 if (j.lt.nres-1) then
10203 if (l.lt.nres-1) then
10211 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
10212 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
10213 !grad ghalf=0.5d0*ggg1(ll)
10215 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10216 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10217 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
10218 +ekont*derx_turn(ll,2,1)
10219 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10220 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
10221 +ekont*derx_turn(ll,4,1)
10222 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10223 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10224 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10225 !grad ghalf=0.5d0*ggg2(ll)
10227 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
10228 +ekont*derx_turn(ll,2,2)
10229 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10230 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
10231 +ekont*derx_turn(ll,4,2)
10232 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10233 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10234 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10239 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10244 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10250 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10255 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10259 !d write (2,*) iii,g_corr6_loc(iii)
10261 eello_turn6=ekont*eel_turn6
10262 !d write (2,*) 'ekont',ekont
10263 !d write (2,*) 'eel_turn6',ekont*eel_turn6
10265 end function eello_turn6
10266 !-----------------------------------------------------------------------------
10267 subroutine MATVEC2(A1,V1,V2)
10268 !DIR$ INLINEALWAYS MATVEC2
10270 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10272 ! implicit real*8 (a-h,o-z)
10273 ! include 'DIMENSIONS'
10274 real(kind=8),dimension(2) :: V1,V2
10275 real(kind=8),dimension(2,2) :: A1
10276 real(kind=8) :: vaux1,vaux2
10280 ! 3 VI=VI+A1(I,K)*V1(K)
10284 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10285 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10289 end subroutine MATVEC2
10290 !-----------------------------------------------------------------------------
10291 subroutine MATMAT2(A1,A2,A3)
10293 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10295 ! implicit real*8 (a-h,o-z)
10296 ! include 'DIMENSIONS'
10297 real(kind=8),dimension(2,2) :: A1,A2,A3
10298 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
10299 ! DIMENSION AI3(2,2)
10303 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
10309 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10310 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10311 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10312 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10318 end subroutine MATMAT2
10319 !-----------------------------------------------------------------------------
10320 real(kind=8) function scalar2(u,v)
10321 !DIR$ INLINEALWAYS scalar2
10323 real(kind=8),dimension(2) :: u,v
10326 scalar2=u(1)*v(1)+u(2)*v(2)
10328 end function scalar2
10329 !-----------------------------------------------------------------------------
10330 subroutine transpose2(a,at)
10331 !DIR$ INLINEALWAYS transpose2
10333 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
10336 real(kind=8),dimension(2,2) :: a,at
10342 end subroutine transpose2
10343 !-----------------------------------------------------------------------------
10344 subroutine transpose(n,a,at)
10347 real(kind=8),dimension(n,n) :: a,at
10354 end subroutine transpose
10355 !-----------------------------------------------------------------------------
10356 subroutine prodmat3(a1,a2,kk,transp,prod)
10357 !DIR$ INLINEALWAYS prodmat3
10359 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
10363 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
10365 !rc double precision auxmat(2,2),prod_(2,2)
10368 !rc call transpose2(kk(1,1),auxmat(1,1))
10369 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10370 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10372 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
10373 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10374 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
10375 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10376 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
10377 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10378 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
10379 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10382 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10383 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10385 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
10386 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10387 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
10388 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10389 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
10390 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10391 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
10392 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10395 ! call transpose2(a2(1,1),a2t(1,1))
10398 !rc print *,((prod_(i,j),i=1,2),j=1,2)
10399 !rc print *,((prod(i,j),i=1,2),j=1,2)
10402 end subroutine prodmat3
10403 !-----------------------------------------------------------------------------
10404 ! energy_p_new_barrier.F
10405 !-----------------------------------------------------------------------------
10406 subroutine sum_gradient
10407 ! implicit real*8 (a-h,o-z)
10408 use io_base, only: pdbout
10409 ! include 'DIMENSIONS'
10413 !MS$ATTRIBUTES C :: proc_proc
10419 real(kind=8),dimension(3,-1:nres) :: gradbufc,gradbufx,gradbufc_sum,&
10420 gloc_scbuf !(3,maxres)
10422 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
10424 !el local variables
10425 integer :: i,j,k,ierror,ierr
10426 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
10427 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
10428 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
10429 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
10430 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
10431 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
10432 gsccorr_max,gsccorrx_max,time00
10434 ! include 'COMMON.SETUP'
10435 ! include 'COMMON.IOUNITS'
10436 ! include 'COMMON.FFIELD'
10437 ! include 'COMMON.DERIV'
10438 ! include 'COMMON.INTERACT'
10439 ! include 'COMMON.SBRIDGE'
10440 ! include 'COMMON.CHAIN'
10441 ! include 'COMMON.VAR'
10442 ! include 'COMMON.CONTROL'
10443 ! include 'COMMON.TIME1'
10444 ! include 'COMMON.MAXGRAD'
10445 ! include 'COMMON.SCCOR'
10450 write (iout,*) "sum_gradient gvdwc, gvdwx"
10452 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10453 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
10463 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
10464 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
10465 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
10468 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
10469 ! in virtual-bond-vector coordinates
10472 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
10474 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
10475 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
10477 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
10479 ! write (iout,'(i5,3f10.5,2x,f10.5)')
10480 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
10482 write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
10484 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10485 i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
10486 (gvdwc_scpp(j,i),j=1,3)
10488 write (iout,*) "gelc_long gvdwpp gel_loc_long"
10490 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10491 i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
10492 (gelc_loc_long(j,i),j=1,3)
10499 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10500 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10501 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10502 wel_loc*gel_loc_long(j,i)+ &
10503 wcorr*gradcorr_long(j,i)+ &
10504 wcorr5*gradcorr5_long(j,i)+ &
10505 wcorr6*gradcorr6_long(j,i)+ &
10506 wturn6*gcorr6_turn_long(j,i)+ &
10507 wstrain*ghpbc(j,i) &
10508 +wliptran*gliptranc(j,i) &
10510 +welec*gshieldc(j,i) &
10511 +wcorr*gshieldc_ec(j,i) &
10512 +wturn3*gshieldc_t3(j,i)&
10513 +wturn4*gshieldc_t4(j,i)&
10514 +wel_loc*gshieldc_ll(j,i)&
10515 +wtube*gg_tube(j,i) &
10516 +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
10517 wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
10518 wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
10519 wcorr_nucl*gradcorr_nucl(j,i)&
10520 +wcorr3_nucl*gradcorr3_nucl(j,i)+&
10521 wcatprot* gradpepcat(j,i)+ &
10522 wcatcat*gradcatcat(j,i)+ &
10523 wscbase*gvdwc_scbase(j,i)+ &
10524 wpepbase*gvdwc_pepbase(j,i)+&
10525 wscpho*gvdwc_scpho(j,i)+ &
10526 wpeppho*gvdwc_peppho(j,i)
10537 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10538 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10539 welec*gelc_long(j,i)+ &
10540 wbond*gradb(j,i)+ &
10541 wel_loc*gel_loc_long(j,i)+ &
10542 wcorr*gradcorr_long(j,i)+ &
10543 wcorr5*gradcorr5_long(j,i)+ &
10544 wcorr6*gradcorr6_long(j,i)+ &
10545 wturn6*gcorr6_turn_long(j,i)+ &
10546 wstrain*ghpbc(j,i) &
10547 +wliptran*gliptranc(j,i) &
10549 +welec*gshieldc(j,i)&
10550 +wcorr*gshieldc_ec(j,i) &
10551 +wturn4*gshieldc_t4(j,i) &
10552 +wel_loc*gshieldc_ll(j,i)&
10553 +wtube*gg_tube(j,i) &
10554 +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
10555 wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
10556 wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
10557 wcorr_nucl*gradcorr_nucl(j,i) &
10558 +wcorr3_nucl*gradcorr3_nucl(j,i) +&
10559 wcatprot* gradpepcat(j,i)+ &
10560 wcatcat*gradcatcat(j,i)+ &
10561 wscbase*gvdwc_scbase(j,i) &
10562 wpepbase*gvdwc_pepbase(j,i)+&
10563 wscpho*gvdwc_scpho(j,i)+&
10564 wpeppho*gvdwc_peppho(j,i)
10571 if (nfgtasks.gt.1) then
10574 write (iout,*) "gradbufc before allreduce"
10576 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10582 gradbufc_sum(j,i)=gradbufc(j,i)
10585 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
10586 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
10587 ! time_reduce=time_reduce+MPI_Wtime()-time00
10589 ! write (iout,*) "gradbufc_sum after allreduce"
10591 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
10596 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
10600 gradbufc(k,i)=0.0d0
10604 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
10605 write (iout,*) (i," jgrad_start",jgrad_start(i),&
10606 " jgrad_end ",jgrad_end(i),&
10607 i=igrad_start,igrad_end)
10610 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
10611 ! do not parallelize this part.
10613 ! do i=igrad_start,igrad_end
10614 ! do j=jgrad_start(i),jgrad_end(i)
10616 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
10621 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10625 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10629 write (iout,*) "gradbufc after summing"
10631 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10639 write (iout,*) "gradbufc"
10641 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10648 gradbufc_sum(j,i)=gradbufc(j,i)
10649 gradbufc(j,i)=0.0d0
10653 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10657 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10662 ! gradbufc(k,i)=0.0d0
10666 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
10672 write (iout,*) "gradbufc after summing"
10674 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10683 gradbufc(k,nres)=0.0d0
10685 !el----------------
10686 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
10687 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
10688 !el-----------------
10692 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10693 wel_loc*gel_loc(j,i)+ &
10694 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10695 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10696 wel_loc*gel_loc_long(j,i)+ &
10697 wcorr*gradcorr_long(j,i)+ &
10698 wcorr5*gradcorr5_long(j,i)+ &
10699 wcorr6*gradcorr6_long(j,i)+ &
10700 wturn6*gcorr6_turn_long(j,i))+ &
10701 wbond*gradb(j,i)+ &
10702 wcorr*gradcorr(j,i)+ &
10703 wturn3*gcorr3_turn(j,i)+ &
10704 wturn4*gcorr4_turn(j,i)+ &
10705 wcorr5*gradcorr5(j,i)+ &
10706 wcorr6*gradcorr6(j,i)+ &
10707 wturn6*gcorr6_turn(j,i)+ &
10708 wsccor*gsccorc(j,i) &
10709 +wscloc*gscloc(j,i) &
10710 +wliptran*gliptranc(j,i) &
10712 +welec*gshieldc(j,i) &
10713 +welec*gshieldc_loc(j,i) &
10714 +wcorr*gshieldc_ec(j,i) &
10715 +wcorr*gshieldc_loc_ec(j,i) &
10716 +wturn3*gshieldc_t3(j,i) &
10717 +wturn3*gshieldc_loc_t3(j,i) &
10718 +wturn4*gshieldc_t4(j,i) &
10719 +wturn4*gshieldc_loc_t4(j,i) &
10720 +wel_loc*gshieldc_ll(j,i) &
10721 +wel_loc*gshieldc_loc_ll(j,i) &
10722 +wtube*gg_tube(j,i) &
10723 +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
10724 +wvdwpsb*gvdwpsb1(j,i))&
10725 +wbond_nucl*gradb_nucl(j,i)+wsbloc*gsbloc(j,i)
10727 ! if ((i.le.2).and.(i.ge.1))
10728 ! print *,gradc(j,i,icg),&
10729 ! gradbufc(j,i),welec*gelc(j,i), &
10730 ! wel_loc*gel_loc(j,i), &
10731 ! wscp*gvdwc_scpp(j,i), &
10732 ! welec*gelc_long(j,i),wvdwpp*gvdwpp(j,i), &
10733 ! wel_loc*gel_loc_long(j,i), &
10734 ! wcorr*gradcorr_long(j,i), &
10735 ! wcorr5*gradcorr5_long(j,i), &
10736 ! wcorr6*gradcorr6_long(j,i), &
10737 ! wturn6*gcorr6_turn_long(j,i), &
10738 ! wbond*gradb(j,i), &
10739 ! wcorr*gradcorr(j,i), &
10740 ! wturn3*gcorr3_turn(j,i), &
10741 ! wturn4*gcorr4_turn(j,i), &
10742 ! wcorr5*gradcorr5(j,i), &
10743 ! wcorr6*gradcorr6(j,i), &
10744 ! wturn6*gcorr6_turn(j,i), &
10745 ! wsccor*gsccorc(j,i) &
10746 ! ,wscloc*gscloc(j,i) &
10747 ! ,wliptran*gliptranc(j,i) &
10749 ! ,welec*gshieldc(j,i) &
10750 ! ,welec*gshieldc_loc(j,i) &
10751 ! ,wcorr*gshieldc_ec(j,i) &
10752 ! ,wcorr*gshieldc_loc_ec(j,i) &
10753 ! ,wturn3*gshieldc_t3(j,i) &
10754 ! ,wturn3*gshieldc_loc_t3(j,i) &
10755 ! ,wturn4*gshieldc_t4(j,i) &
10756 ! ,wturn4*gshieldc_loc_t4(j,i) &
10757 ! ,wel_loc*gshieldc_ll(j,i) &
10758 ! ,wel_loc*gshieldc_loc_ll(j,i) &
10759 ! ,wtube*gg_tube(j,i) &
10760 ! ,wbond_nucl*gradb_nucl(j,i) &
10761 ! ,wvdwpp_nucl*gvdwpp_nucl(j,i),welpp*gelpp(j,i),&
10762 ! wvdwpsb*gvdwpsb1(j,i)&
10763 ! ,wbond_nucl*gradb_nucl(j,i),wsbloc*gsbloc(j,i)
10767 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10768 wel_loc*gel_loc(j,i)+ &
10769 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10770 welec*gelc_long(j,i)+ &
10771 wel_loc*gel_loc_long(j,i)+ &
10772 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
10773 wcorr5*gradcorr5_long(j,i)+ &
10774 wcorr6*gradcorr6_long(j,i)+ &
10775 wturn6*gcorr6_turn_long(j,i))+ &
10776 wbond*gradb(j,i)+ &
10777 wcorr*gradcorr(j,i)+ &
10778 wturn3*gcorr3_turn(j,i)+ &
10779 wturn4*gcorr4_turn(j,i)+ &
10780 wcorr5*gradcorr5(j,i)+ &
10781 wcorr6*gradcorr6(j,i)+ &
10782 wturn6*gcorr6_turn(j,i)+ &
10783 wsccor*gsccorc(j,i) &
10784 +wscloc*gscloc(j,i) &
10786 +wliptran*gliptranc(j,i) &
10787 +welec*gshieldc(j,i) &
10788 +welec*gshieldc_loc(j,) &
10789 +wcorr*gshieldc_ec(j,i) &
10790 +wcorr*gshieldc_loc_ec(j,i) &
10791 +wturn3*gshieldc_t3(j,i) &
10792 +wturn3*gshieldc_loc_t3(j,i) &
10793 +wturn4*gshieldc_t4(j,i) &
10794 +wturn4*gshieldc_loc_t4(j,i) &
10795 +wel_loc*gshieldc_ll(j,i) &
10796 +wel_loc*gshieldc_loc_ll(j,i) &
10797 +wtube*gg_tube(j,i) &
10798 +wbond_nucl*gradb_nucl(j,i) &
10799 +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
10800 +wvdwpsb*gvdwpsb1(j,i))&
10801 +wsbloc*gsbloc(j,i)
10807 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
10808 wbond*gradbx(j,i)+ &
10809 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
10810 wsccor*gsccorx(j,i) &
10811 +wscloc*gsclocx(j,i) &
10812 +wliptran*gliptranx(j,i) &
10813 +welec*gshieldx(j,i) &
10814 +wcorr*gshieldx_ec(j,i) &
10815 +wturn3*gshieldx_t3(j,i) &
10816 +wturn4*gshieldx_t4(j,i) &
10817 +wel_loc*gshieldx_ll(j,i)&
10818 +wtube*gg_tube_sc(j,i) &
10819 +wbond_nucl*gradbx_nucl(j,i) &
10820 +wvdwsb*gvdwsbx(j,i) &
10821 +welsb*gelsbx(j,i) &
10822 +wcorr_nucl*gradxorr_nucl(j,i)&
10823 +wcorr3_nucl*gradxorr3_nucl(j,i) &
10824 +wsbloc*gsblocx(j,i) &
10825 +wcatprot* gradpepcatx(j,i)&
10826 +wscbase*gvdwx_scbase(j,i) &
10827 +wpepbase*gvdwx_pepbase(j,i)&
10828 +wscpho*gvdwx_scpho(j,i)
10829 ! if (i.eq.3) print *,"tu?", wscpho,gvdwx_scpho(j,i)
10834 write (iout,*) "gloc before adding corr"
10836 write (iout,*) i,gloc(i,icg)
10840 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
10841 +wcorr5*g_corr5_loc(i) &
10842 +wcorr6*g_corr6_loc(i) &
10843 +wturn4*gel_loc_turn4(i) &
10844 +wturn3*gel_loc_turn3(i) &
10845 +wturn6*gel_loc_turn6(i) &
10846 +wel_loc*gel_loc_loc(i)
10849 write (iout,*) "gloc after adding corr"
10851 write (iout,*) i,gloc(i,icg)
10855 if (nfgtasks.gt.1) then
10858 gradbufc(j,i)=gradc(j,i,icg)
10859 gradbufx(j,i)=gradx(j,i,icg)
10863 glocbuf(i)=gloc(i,icg)
10867 write (iout,*) "gloc_sc before reduce"
10870 write (iout,*) i,j,gloc_sc(j,i,icg)
10877 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
10881 call MPI_Barrier(FG_COMM,IERR)
10882 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
10884 call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,&
10885 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10886 call MPI_Reduce(gradbufx(1,0),gradx(1,0,icg),3*nres+3,&
10887 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10888 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
10889 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10890 time_reduce=time_reduce+MPI_Wtime()-time00
10891 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
10892 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10893 time_reduce=time_reduce+MPI_Wtime()-time00
10895 ! print *,"gradbuf",gradbufc(1,1),gradc(1,1,icg)
10897 write (iout,*) "gloc_sc after reduce"
10900 write (iout,*) i,j,gloc_sc(j,i,icg)
10906 write (iout,*) "gloc after reduce"
10908 write (iout,*) i,gloc(i,icg)
10913 if (gnorm_check) then
10915 ! Compute the maximum elements of the gradient
10918 gvdwc_scp_max=0.0d0
10925 gcorr3_turn_max=0.0d0
10926 gcorr4_turn_max=0.0d0
10927 gradcorr5_max=0.0d0
10928 gradcorr6_max=0.0d0
10929 gcorr6_turn_max=0.0d0
10933 gradx_scp_max=0.0d0
10939 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
10940 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
10941 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
10942 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
10943 gvdwc_scp_max=gvdwc_scp_norm
10944 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
10945 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
10946 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
10947 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
10948 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
10949 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
10950 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
10951 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
10952 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
10953 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
10954 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
10955 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
10956 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
10958 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
10959 gcorr3_turn_max=gcorr3_turn_norm
10960 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
10962 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
10963 gcorr4_turn_max=gcorr4_turn_norm
10964 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
10965 if (gradcorr5_norm.gt.gradcorr5_max) &
10966 gradcorr5_max=gradcorr5_norm
10967 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
10968 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
10969 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
10971 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
10972 gcorr6_turn_max=gcorr6_turn_norm
10973 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
10974 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
10975 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
10976 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
10977 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
10978 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
10979 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
10980 if (gradx_scp_norm.gt.gradx_scp_max) &
10981 gradx_scp_max=gradx_scp_norm
10982 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
10983 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
10984 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
10985 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
10986 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
10987 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
10988 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
10989 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
10993 open(istat,file=statname,position="append")
10995 open(istat,file=statname,access="append")
10997 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
10998 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
10999 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
11000 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
11001 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
11002 gsccorx_max,gsclocx_max
11004 if (gvdwc_max.gt.1.0d4) then
11005 write (iout,*) "gvdwc gvdwx gradb gradbx"
11007 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
11008 gradb(j,i),gradbx(j,i),j=1,3)
11010 call pdbout(0.0d0,'cipiszcze',iout)
11017 write (iout,*) "gradc gradx gloc"
11019 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
11020 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
11025 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
11028 end subroutine sum_gradient
11029 !-----------------------------------------------------------------------------
11031 ! implicit real*8 (a-h,o-z)
11033 ! include 'DIMENSIONS'
11034 ! include 'COMMON.CHAIN'
11035 ! include 'COMMON.DERIV'
11036 ! include 'COMMON.CALC'
11037 ! include 'COMMON.IOUNITS'
11038 real(kind=8), dimension(3) :: dcosom1,dcosom2
11039 ! print *,"wchodze"
11040 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
11041 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
11042 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
11043 -2.0D0*alf12*eps3der+sigder*sigsq_om12
11047 ! eom12=evdwij*eps1_om12
11049 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
11051 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
11052 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
11053 !C print *,sss_ele_cut,'in sc_grad'
11055 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
11056 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
11059 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
11060 !C print *,'gg',k,gg(k)
11062 ! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
11063 ! write (iout,*) "gg",(gg(k),k=1,3)
11065 gvdwx(k,i)=gvdwx(k,i)-gg(k) +gg_lipi(k)&
11066 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
11067 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
11070 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)&
11071 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
11072 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv &
11075 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
11076 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
11077 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
11078 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
11081 ! Calculate the components of the gradient in DC and X
11085 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
11089 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
11090 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
11093 end subroutine sc_grad
11095 !-----------------------------------------------------------------------------
11096 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
11099 ! implicit real*8 (a-h,o-z)
11100 ! include 'DIMENSIONS'
11101 ! include 'COMMON.LOCAL'
11102 ! include 'COMMON.IOUNITS'
11103 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
11104 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
11105 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
11106 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
11107 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
11109 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
11110 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
11111 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
11112 !el local variables
11114 delthec=thetai-thet_pred_mean
11115 delthe0=thetai-theta0i
11116 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
11117 t3 = thetai-thet_pred_mean
11121 t14 = t12+t6*sigsqtc
11123 t21 = thetai-theta0i
11129 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
11130 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
11131 *(-t12*t9-ak*sig0inv*t27)
11133 end subroutine mixder
11135 !-----------------------------------------------------------------------------
11137 !-----------------------------------------------------------------------------
11139 !-----------------------------------------------------------------------------
11140 ! This subroutine calculates the derivatives of the consecutive virtual
11141 ! bond vectors and the SC vectors in the virtual-bond angles theta and
11142 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
11143 ! in the angles alpha and omega, describing the location of a side chain
11144 ! in its local coordinate system.
11146 ! The derivatives are stored in the following arrays:
11148 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
11149 ! The structure is as follows:
11151 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
11152 ! 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)
11153 ! . . . . . . . . . . . . . . . . . .
11154 ! 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)
11158 ! 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)
11160 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
11161 ! The structure is same as above.
11163 ! DCDS - the derivatives of the side chain vectors in the local spherical
11164 ! andgles alph and omega:
11166 ! 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)
11167 ! 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)
11171 ! 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)
11173 ! Version of March '95, based on an early version of November '91.
11175 !**********************************************************************
11176 ! implicit real*8 (a-h,o-z)
11177 ! include 'DIMENSIONS'
11178 ! include 'COMMON.VAR'
11179 ! include 'COMMON.CHAIN'
11180 ! include 'COMMON.DERIV'
11181 ! include 'COMMON.GEO'
11182 ! include 'COMMON.LOCAL'
11183 ! include 'COMMON.INTERACT'
11184 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
11185 real(kind=8),dimension(3,3) :: dp,temp
11186 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
11187 real(kind=8),dimension(3) :: xx,xx1
11188 !el local variables
11189 integer :: i,k,l,j,m,ind,ind1,jjj
11190 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
11191 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
11192 sint2,xp,yp,xxp,yyp,zzp,dj
11194 ! common /przechowalnia/ fromto
11195 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
11196 ! get the position of the jth ijth fragment of the chain coordinate system
11197 ! in the fromto array.
11198 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
11200 ! maxdim=(nres-1)*(nres-2)/2
11201 ! allocate(dcdv(6,maxdim),dxds(6,nres))
11202 ! calculate the derivatives of transformation matrix elements in theta
11205 !el call flush(iout) !el
11207 rdt(1,1,i)=-rt(1,2,i)
11208 rdt(1,2,i)= rt(1,1,i)
11210 rdt(2,1,i)=-rt(2,2,i)
11211 rdt(2,2,i)= rt(2,1,i)
11213 rdt(3,1,i)=-rt(3,2,i)
11214 rdt(3,2,i)= rt(3,1,i)
11218 ! derivatives in phi
11224 drt(2,1,i)= rt(3,1,i)
11225 drt(2,2,i)= rt(3,2,i)
11226 drt(2,3,i)= rt(3,3,i)
11227 drt(3,1,i)=-rt(2,1,i)
11228 drt(3,2,i)=-rt(2,2,i)
11229 drt(3,3,i)=-rt(2,3,i)
11232 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
11238 temp(k,l)=rt(k,l,i)
11243 fromto(k,l,ind)=temp(k,l)
11252 dpkl=dpkl+temp(k,m)*rt(m,l,j)
11255 fromto(k,l,ind)=dpkl
11266 ! Calculate derivatives.
11272 ! Derivatives of DC(i+1) in theta(i+2)
11278 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
11281 prordt(j,k,i)=dp(j,k)
11284 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
11287 ! Derivatives of SC(i+1) in theta(i+2)
11289 xx1(1)=-0.5D0*xloc(2,i+1)
11290 xx1(2)= 0.5D0*xloc(1,i+1)
11294 xj=xj+r(j,k,i)*xx1(k)
11301 rj=rj+prod(j,k,i)*xx(k)
11306 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
11307 ! than the other off-diagonal derivatives.
11312 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
11314 dxdv(j,ind1+1)=dxoiij
11316 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
11318 ! Derivatives of DC(i+1) in phi(i+2)
11324 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
11327 prodrt(j,k,i)=dp(j,k)
11329 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
11332 ! Derivatives of SC(i+1) in phi(i+2)
11335 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
11336 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
11340 rj=rj+prod(j,k,i)*xx(k)
11345 ! Derivatives of SC(i+1) in phi(i+3).
11350 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
11352 dxdv(j+3,ind1+1)=dxoiij
11355 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
11356 ! theta(nres) and phi(i+3) thru phi(nres).
11360 ind=indmat(i+1,j+1)
11361 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
11366 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
11371 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
11372 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
11373 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
11374 ! Derivatives of virtual-bond vectors in theta
11376 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
11378 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
11379 ! Derivatives of SC vectors in theta
11383 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
11385 dxdv(k,ind1+1)=dxoijk
11388 !--- Calculate the derivatives in phi
11394 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
11400 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
11405 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
11407 dxdv(k+3,ind1+1)=dxoijk
11412 ! Derivatives in alpha and omega:
11415 ! dsci=dsc(itype(i,1))
11420 if(alphi.ne.alphi) alphi=100.0
11421 if(omegi.ne.omegi) omegi=-100.0
11426 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
11427 cosalphi=dcos(alphi)
11428 sinalphi=dsin(alphi)
11429 cosomegi=dcos(omegi)
11430 sinomegi=dsin(omegi)
11431 temp(1,1)=-dsci*sinalphi
11432 temp(2,1)= dsci*cosalphi*cosomegi
11433 temp(3,1)=-dsci*cosalphi*sinomegi
11435 temp(2,2)=-dsci*sinalphi*sinomegi
11436 temp(3,2)=-dsci*sinalphi*cosomegi
11437 theta2=pi-0.5D0*theta(i+1)
11441 !d print *,((temp(l,k),l=1,3),k=1,2)
11445 xxp= xp*cost2+yp*sint2
11446 yyp=-xp*sint2+yp*cost2
11449 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
11450 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
11454 dj=dj+prod(k,l,i-1)*xx(l)
11462 end subroutine cartder
11463 !-----------------------------------------------------------------------------
11465 !-----------------------------------------------------------------------------
11466 subroutine check_cartgrad
11467 ! Check the gradient of Cartesian coordinates in internal coordinates.
11468 ! implicit real*8 (a-h,o-z)
11469 ! include 'DIMENSIONS'
11470 ! include 'COMMON.IOUNITS'
11471 ! include 'COMMON.VAR'
11472 ! include 'COMMON.CHAIN'
11473 ! include 'COMMON.GEO'
11474 ! include 'COMMON.LOCAL'
11475 ! include 'COMMON.DERIV'
11476 real(kind=8),dimension(6,nres) :: temp
11477 real(kind=8),dimension(3) :: xx,gg
11478 integer :: i,k,j,ii
11479 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
11480 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
11482 ! Check the gradient of the virtual-bond and SC vectors in the internal
11488 write (iout,'(a)') '**************** dx/dalpha'
11492 alph(i)=alph(i)+aincr
11494 temp(k,i)=dc(k,nres+i)
11498 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11499 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
11501 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11502 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
11508 write (iout,'(a)') '**************** dx/domega'
11512 omeg(i)=omeg(i)+aincr
11514 temp(k,i)=dc(k,nres+i)
11518 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11519 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
11520 (aincr*dabs(dxds(k+3,i))+aincr))
11522 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11523 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
11529 write (iout,'(a)') '**************** dx/dtheta'
11533 theta(i)=theta(i)+aincr
11536 temp(k,j)=dc(k,nres+j)
11542 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
11544 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11545 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
11546 (aincr*dabs(dxdv(k,ii))+aincr))
11548 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11549 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
11556 write (iout,'(a)') '***************** dx/dphi'
11559 phi(i)=phi(i)+aincr
11562 temp(k,j)=dc(k,nres+j)
11570 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11571 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
11572 (aincr*dabs(dxdv(k+3,ii))+aincr))
11574 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11575 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11578 phi(i)=phi(i)-aincr
11581 write (iout,'(a)') '****************** ddc/dtheta'
11584 theta(i+2)=thet+aincr
11595 gg(k)=(dc(k,j)-temp(k,j))/aincr
11596 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
11597 (aincr*dabs(dcdv(k,ii))+aincr))
11599 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11600 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
11610 write (iout,'(a)') '******************* ddc/dphi'
11613 phi(i+3)=phii+aincr
11624 gg(k)=(dc(k,j)-temp(k,j))/aincr
11625 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
11626 (aincr*dabs(dcdv(k+3,ii))+aincr))
11628 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11629 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11640 end subroutine check_cartgrad
11641 !-----------------------------------------------------------------------------
11642 subroutine check_ecart
11643 ! Check the gradient of the energy in Cartesian coordinates.
11644 ! implicit real*8 (a-h,o-z)
11645 ! include 'DIMENSIONS'
11646 ! include 'COMMON.CHAIN'
11647 ! include 'COMMON.DERIV'
11648 ! include 'COMMON.IOUNITS'
11649 ! include 'COMMON.VAR'
11650 ! include 'COMMON.CONTACTS'
11652 !el integer :: icall
11653 !el common /srutu/ icall
11654 real(kind=8),dimension(6) :: ggg
11655 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
11656 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11657 real(kind=8),dimension(6,nres) :: grad_s
11658 real(kind=8),dimension(0:n_ene) :: energia,energia1
11659 integer :: uiparm(1)
11660 real(kind=8) :: urparm(1)
11662 integer :: nf,i,j,k
11663 real(kind=8) :: aincr,etot,etot1
11669 print '(a)','CG processor',me,' calling CHECK_CART.',aincr
11672 call geom_to_var(nvar,x)
11673 call etotal(energia)
11675 !el call enerprint(energia)
11676 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
11679 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11683 grad_s(j,i)=gradc(j,i,icg)
11684 grad_s(j+3,i)=gradx(j,i,icg)
11688 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11693 ddx(j)=dc(j,i+nres)
11696 dc(j,i)=dc(j,i)+aincr
11698 c(j,k)=c(j,k)+aincr
11699 c(j,k+nres)=c(j,k+nres)+aincr
11701 call etotal(energia1)
11703 ggg(j)=(etot1-etot)/aincr
11706 c(j,k)=c(j,k)-aincr
11707 c(j,k+nres)=c(j,k+nres)-aincr
11711 c(j,i+nres)=c(j,i+nres)+aincr
11712 dc(j,i+nres)=dc(j,i+nres)+aincr
11713 call etotal(energia1)
11715 ggg(j+3)=(etot1-etot)/aincr
11717 dc(j,i+nres)=ddx(j)
11719 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
11720 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
11723 end subroutine check_ecart
11725 !-----------------------------------------------------------------------------
11726 subroutine check_ecartint
11727 ! Check the gradient of the energy in Cartesian coordinates.
11728 use io_base, only: intout
11729 ! implicit real*8 (a-h,o-z)
11730 ! include 'DIMENSIONS'
11731 ! include 'COMMON.CONTROL'
11732 ! include 'COMMON.CHAIN'
11733 ! include 'COMMON.DERIV'
11734 ! include 'COMMON.IOUNITS'
11735 ! include 'COMMON.VAR'
11736 ! include 'COMMON.CONTACTS'
11737 ! include 'COMMON.MD'
11738 ! include 'COMMON.LOCAL'
11739 ! include 'COMMON.SPLITELE'
11741 !el integer :: icall
11742 !el common /srutu/ icall
11743 real(kind=8),dimension(6) :: ggg,ggg1
11744 real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
11745 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11746 real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
11747 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
11748 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
11749 real(kind=8),dimension(0:n_ene) :: energia,energia1
11750 integer :: uiparm(1)
11751 real(kind=8) :: urparm(1)
11753 integer :: i,j,k,nf
11754 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
11762 ! call intcartderiv
11763 ! call checkintcartgrad
11766 write(iout,*) 'Calling CHECK_ECARTINT.'
11769 write (iout,*) "Before geom_to_var"
11770 call geom_to_var(nvar,x)
11771 write (iout,*) "after geom_to_var"
11772 write (iout,*) "split_ene ",split_ene
11774 if (.not.split_ene) then
11775 write(iout,*) 'Calling CHECK_ECARTINT if'
11776 call etotal(energia)
11777 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11779 write (iout,*) "etot",etot
11781 !el call enerprint(energia)
11782 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11784 write (iout,*) "enter cartgrad"
11787 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11788 write (iout,*) "exit cartgrad"
11792 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11795 grad_s(j,0)=gcart(j,0)
11797 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11800 grad_s(j,i)=gcart(j,i)
11801 grad_s(j+3,i)=gxcart(j,i)
11805 write(iout,*) 'Calling CHECK_ECARTIN else.'
11806 !- split gradient check
11808 call etotal_long(energia)
11809 !el call enerprint(energia)
11811 write (iout,*) "enter cartgrad"
11814 write (iout,*) "exit cartgrad"
11817 write (iout,*) "longrange grad"
11819 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11820 (gxcart(j,i),j=1,3)
11823 grad_s(j,0)=gcart(j,0)
11827 grad_s(j,i)=gcart(j,i)
11828 grad_s(j+3,i)=gxcart(j,i)
11832 call etotal_short(energia)
11833 call enerprint(energia)
11835 write (iout,*) "enter cartgrad"
11838 write (iout,*) "exit cartgrad"
11841 write (iout,*) "shortrange grad"
11843 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11844 (gxcart(j,i),j=1,3)
11847 grad_s1(j,0)=gcart(j,0)
11851 grad_s1(j,i)=gcart(j,i)
11852 grad_s1(j+3,i)=gxcart(j,i)
11856 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11860 if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
11861 if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
11864 dcnorm_safe1(j)=dc_norm(j,i-1)
11865 dcnorm_safe2(j)=dc_norm(j,i)
11866 dxnorm_safe(j)=dc_norm(j,i+nres)
11869 c(j,i)=ddc(j)+aincr
11870 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
11871 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
11872 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11873 dc(j,i)=c(j,i+1)-c(j,i)
11874 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11875 call int_from_cart1(.false.)
11876 if (.not.split_ene) then
11877 call etotal(energia1)
11879 write (iout,*) "ij",i,j," etot1",etot1
11882 call etotal_long(energia1)
11884 call etotal_short(energia1)
11887 !- end split gradient
11888 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11889 c(j,i)=ddc(j)-aincr
11890 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
11891 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
11892 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11893 dc(j,i)=c(j,i+1)-c(j,i)
11894 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11895 call int_from_cart1(.false.)
11896 if (.not.split_ene) then
11897 call etotal(energia1)
11899 write (iout,*) "ij",i,j," etot2",etot2
11900 ggg(j)=(etot1-etot2)/(2*aincr)
11903 call etotal_long(energia1)
11905 ggg(j)=(etot11-etot21)/(2*aincr)
11906 call etotal_short(energia1)
11908 ggg1(j)=(etot12-etot22)/(2*aincr)
11909 !- end split gradient
11910 ! write (iout,*) "etot21",etot21," etot22",etot22
11912 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11914 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
11915 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
11916 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11917 dc(j,i)=c(j,i+1)-c(j,i)
11918 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11919 dc_norm(j,i-1)=dcnorm_safe1(j)
11920 dc_norm(j,i)=dcnorm_safe2(j)
11921 dc_norm(j,i+nres)=dxnorm_safe(j)
11924 c(j,i+nres)=ddx(j)+aincr
11925 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11926 call int_from_cart1(.false.)
11927 if (.not.split_ene) then
11928 call etotal(energia1)
11932 call etotal_long(energia1)
11934 call etotal_short(energia1)
11937 !- end split gradient
11938 c(j,i+nres)=ddx(j)-aincr
11939 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11940 call int_from_cart1(.false.)
11941 if (.not.split_ene) then
11942 call etotal(energia1)
11944 ggg(j+3)=(etot1-etot2)/(2*aincr)
11947 call etotal_long(energia1)
11949 ggg(j+3)=(etot11-etot21)/(2*aincr)
11950 call etotal_short(energia1)
11952 ggg1(j+3)=(etot12-etot22)/(2*aincr)
11953 !- end split gradient
11955 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11957 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11958 dc_norm(j,i+nres)=dxnorm_safe(j)
11959 call int_from_cart1(.false.)
11961 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11962 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
11963 if (split_ene) then
11964 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11965 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
11967 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11968 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
11969 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
11973 end subroutine check_ecartint
11975 !-----------------------------------------------------------------------------
11976 subroutine check_ecartint
11977 ! Check the gradient of the energy in Cartesian coordinates.
11978 use io_base, only: intout
11979 ! implicit real*8 (a-h,o-z)
11980 ! include 'DIMENSIONS'
11981 ! include 'COMMON.CONTROL'
11982 ! include 'COMMON.CHAIN'
11983 ! include 'COMMON.DERIV'
11984 ! include 'COMMON.IOUNITS'
11985 ! include 'COMMON.VAR'
11986 ! include 'COMMON.CONTACTS'
11987 ! include 'COMMON.MD'
11988 ! include 'COMMON.LOCAL'
11989 ! include 'COMMON.SPLITELE'
11991 !el integer :: icall
11992 !el common /srutu/ icall
11993 real(kind=8),dimension(6) :: ggg,ggg1
11994 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
11995 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11996 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
11997 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
11998 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
11999 real(kind=8),dimension(0:n_ene) :: energia,energia1
12000 integer :: uiparm(1)
12001 real(kind=8) :: urparm(1)
12003 integer :: i,j,k,nf
12004 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
12012 ! call intcartderiv
12013 ! call checkintcartgrad
12016 write(iout,*) 'Calling CHECK_ECARTINT.',aincr
12019 call geom_to_var(nvar,x)
12020 if (.not.split_ene) then
12021 call etotal(energia)
12023 !el call enerprint(energia)
12025 write (iout,*) "enter cartgrad"
12028 write (iout,*) "exit cartgrad"
12032 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
12035 grad_s(j,0)=gcart(j,0)
12039 grad_s(j,i)=gcart(j,i)
12040 ! if (i.le.2) print *,"tu?!",gcart(j,i),grad_s(j,i),gxcart(j,i)
12041 grad_s(j+3,i)=gxcart(j,i)
12045 !- split gradient check
12047 call etotal_long(energia)
12048 !el call enerprint(energia)
12050 write (iout,*) "enter cartgrad"
12053 write (iout,*) "exit cartgrad"
12056 write (iout,*) "longrange grad"
12058 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12059 (gxcart(j,i),j=1,3)
12062 grad_s(j,0)=gcart(j,0)
12066 grad_s(j,i)=gcart(j,i)
12067 grad_s(j+3,i)=gxcart(j,i)
12071 call etotal_short(energia)
12072 !el call enerprint(energia)
12074 write (iout,*) "enter cartgrad"
12077 write (iout,*) "exit cartgrad"
12080 write (iout,*) "shortrange grad"
12082 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12083 (gxcart(j,i),j=1,3)
12086 grad_s1(j,0)=gcart(j,0)
12090 grad_s1(j,i)=gcart(j,i)
12091 grad_s1(j+3,i)=gxcart(j,i)
12095 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
12100 ddx(j)=dc(j,i+nres)
12102 dcnorm_safe(k)=dc_norm(k,i)
12103 dxnorm_safe(k)=dc_norm(k,i+nres)
12107 dc(j,i)=ddc(j)+aincr
12108 call chainbuild_cart
12110 ! Broadcast the order to compute internal coordinates to the slaves.
12111 ! if (nfgtasks.gt.1)
12112 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
12114 ! call int_from_cart1(.false.)
12115 if (.not.split_ene) then
12116 call etotal(energia1)
12118 ! call enerprint(energia1)
12121 call etotal_long(energia1)
12123 call etotal_short(energia1)
12125 ! write (iout,*) "etot11",etot11," etot12",etot12
12127 !- end split gradient
12128 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12129 dc(j,i)=ddc(j)-aincr
12130 call chainbuild_cart
12131 ! call int_from_cart1(.false.)
12132 if (.not.split_ene) then
12133 call etotal(energia1)
12135 ggg(j)=(etot1-etot2)/(2*aincr)
12138 call etotal_long(energia1)
12140 ggg(j)=(etot11-etot21)/(2*aincr)
12141 call etotal_short(energia1)
12143 ggg1(j)=(etot12-etot22)/(2*aincr)
12144 !- end split gradient
12145 ! write (iout,*) "etot21",etot21," etot22",etot22
12147 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12149 call chainbuild_cart
12152 dc(j,i+nres)=ddx(j)+aincr
12153 call chainbuild_cart
12154 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
12155 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
12156 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
12157 ! write (iout,*) "dxnormnorm",dsqrt(
12158 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
12159 ! write (iout,*) "dxnormnormsafe",dsqrt(
12160 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
12162 if (.not.split_ene) then
12163 call etotal(energia1)
12167 call etotal_long(energia1)
12169 call etotal_short(energia1)
12172 !- end split gradient
12173 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12174 dc(j,i+nres)=ddx(j)-aincr
12175 call chainbuild_cart
12176 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
12177 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
12178 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
12180 ! write (iout,*) "dxnormnorm",dsqrt(
12181 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
12182 ! write (iout,*) "dxnormnormsafe",dsqrt(
12183 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
12184 if (.not.split_ene) then
12185 call etotal(energia1)
12187 ggg(j+3)=(etot1-etot2)/(2*aincr)
12190 call etotal_long(energia1)
12192 ggg(j+3)=(etot11-etot21)/(2*aincr)
12193 call etotal_short(energia1)
12195 ggg1(j+3)=(etot12-etot22)/(2*aincr)
12196 !- end split gradient
12198 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12199 dc(j,i+nres)=ddx(j)
12200 call chainbuild_cart
12202 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12203 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
12204 if (split_ene) then
12205 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12206 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
12208 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12209 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
12210 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
12214 end subroutine check_ecartint
12216 !-----------------------------------------------------------------------------
12217 subroutine check_eint
12218 ! Check the gradient of energy in internal coordinates.
12219 ! implicit real*8 (a-h,o-z)
12220 ! include 'DIMENSIONS'
12221 ! include 'COMMON.CHAIN'
12222 ! include 'COMMON.DERIV'
12223 ! include 'COMMON.IOUNITS'
12224 ! include 'COMMON.VAR'
12225 ! include 'COMMON.GEO'
12227 !el integer :: icall
12228 !el common /srutu/ icall
12229 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
12230 integer :: uiparm(1)
12231 real(kind=8) :: urparm(1)
12232 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
12233 character(len=6) :: key
12236 real(kind=8) :: xi,aincr,etot,etot1,etot2
12239 print '(a)','Calling CHECK_INT.'
12243 call geom_to_var(nvar,x)
12244 call var_to_geom(nvar,x)
12247 ! print *,'ICG=',ICG
12248 call etotal(energia)
12250 !el call enerprint(energia)
12251 ! print *,'ICG=',ICG
12253 if (MyID.ne.BossID) then
12254 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
12262 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
12263 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
12264 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
12268 x(i)=xi-0.5D0*aincr
12269 call var_to_geom(nvar,x)
12271 call etotal(energia1)
12273 x(i)=xi+0.5D0*aincr
12274 call var_to_geom(nvar,x)
12276 call etotal(energia2)
12278 gg(i)=(etot2-etot1)/aincr
12279 write (iout,*) i,etot1,etot2
12282 write (iout,'(/2a)')' Variable Numerical Analytical',&
12285 if (i.le.nphi) then
12288 else if (i.le.nphi+ntheta) then
12291 else if (i.le.nphi+ntheta+nside) then
12295 ii=i-(nphi+ntheta+nside)
12298 write (iout,'(i3,a,i3,3(1pd16.6))') &
12299 i,key,ii,gg(i),gana(i),&
12300 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
12303 end subroutine check_eint
12304 !-----------------------------------------------------------------------------
12306 !-----------------------------------------------------------------------------
12307 subroutine Econstr_back
12308 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
12309 ! implicit real*8 (a-h,o-z)
12310 ! include 'DIMENSIONS'
12311 ! include 'COMMON.CONTROL'
12312 ! include 'COMMON.VAR'
12313 ! include 'COMMON.MD'
12316 ! include 'COMMON.LANGEVIN'
12318 ! include 'COMMON.LANGEVIN.lang0'
12320 ! include 'COMMON.CHAIN'
12321 ! include 'COMMON.DERIV'
12322 ! include 'COMMON.GEO'
12323 ! include 'COMMON.LOCAL'
12324 ! include 'COMMON.INTERACT'
12325 ! include 'COMMON.IOUNITS'
12326 ! include 'COMMON.NAMES'
12327 ! include 'COMMON.TIME1'
12328 integer :: i,j,ii,k
12329 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
12331 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
12332 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
12333 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
12340 duscdiff(j,i)=0.0d0
12341 duscdiffx(j,i)=0.0d0
12345 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
12347 ! Deviations from theta angles
12350 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
12351 dtheta_i=theta(j)-thetaref(j)
12352 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
12353 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
12355 utheta(i)=utheta_i/(ii-1)
12357 ! Deviations from gamma angles
12360 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
12361 dgamma_i=pinorm(phi(j)-phiref(j))
12362 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
12363 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
12364 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
12365 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
12367 ugamma(i)=ugamma_i/(ii-2)
12369 ! Deviations from local SC geometry
12372 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
12373 dxx=xxtab(j)-xxref(j)
12374 dyy=yytab(j)-yyref(j)
12375 dzz=zztab(j)-zzref(j)
12376 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
12378 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
12379 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
12381 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
12382 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
12384 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
12385 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
12388 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
12389 ! & xxref(j),yyref(j),zzref(j)
12391 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
12392 ! write (iout,*) i," uscdiff",uscdiff(i)
12394 ! Put together deviations from local geometry
12396 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
12397 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
12398 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
12399 ! & " uconst_back",uconst_back
12400 utheta(i)=dsqrt(utheta(i))
12401 ugamma(i)=dsqrt(ugamma(i))
12402 uscdiff(i)=dsqrt(uscdiff(i))
12405 end subroutine Econstr_back
12406 !-----------------------------------------------------------------------------
12407 ! energy_p_new-sep_barrier.F
12408 !-----------------------------------------------------------------------------
12409 real(kind=8) function sscale(r)
12410 ! include "COMMON.SPLITELE"
12411 real(kind=8) :: r,gamm
12412 if(r.lt.r_cut-rlamb) then
12414 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
12415 gamm=(r-(r_cut-rlamb))/rlamb
12416 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12421 end function sscale
12422 real(kind=8) function sscale_grad(r)
12423 ! include "COMMON.SPLITELE"
12424 real(kind=8) :: r,gamm
12425 if(r.lt.r_cut-rlamb) then
12427 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
12428 gamm=(r-(r_cut-rlamb))/rlamb
12429 sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
12434 end function sscale_grad
12436 !!!!!!!!!! PBCSCALE
12437 real(kind=8) function sscale_ele(r)
12438 ! include "COMMON.SPLITELE"
12439 real(kind=8) :: r,gamm
12440 if(r.lt.r_cut_ele-rlamb_ele) then
12442 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12443 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12444 sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12449 end function sscale_ele
12451 real(kind=8) function sscagrad_ele(r)
12452 real(kind=8) :: r,gamm
12453 ! include "COMMON.SPLITELE"
12454 if(r.lt.r_cut_ele-rlamb_ele) then
12456 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12457 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12458 sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
12463 end function sscagrad_ele
12464 real(kind=8) function sscalelip(r)
12465 real(kind=8) r,gamm
12466 sscalelip=1.0d0+r*r*(2.0d0*r-3.0d0)
12468 end function sscalelip
12469 !C-----------------------------------------------------------------------
12470 real(kind=8) function sscagradlip(r)
12471 real(kind=8) r,gamm
12472 sscagradlip=r*(6.0d0*r-6.0d0)
12474 end function sscagradlip
12477 !-----------------------------------------------------------------------------
12478 subroutine elj_long(evdw)
12480 ! This subroutine calculates the interaction energy of nonbonded side chains
12481 ! assuming the LJ potential of interaction.
12483 ! implicit real*8 (a-h,o-z)
12484 ! include 'DIMENSIONS'
12485 ! include 'COMMON.GEO'
12486 ! include 'COMMON.VAR'
12487 ! include 'COMMON.LOCAL'
12488 ! include 'COMMON.CHAIN'
12489 ! include 'COMMON.DERIV'
12490 ! include 'COMMON.INTERACT'
12491 ! include 'COMMON.TORSION'
12492 ! include 'COMMON.SBRIDGE'
12493 ! include 'COMMON.NAMES'
12494 ! include 'COMMON.IOUNITS'
12495 ! include 'COMMON.CONTACTS'
12496 real(kind=8),parameter :: accur=1.0d-10
12497 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12498 !el local variables
12499 integer :: i,iint,j,k,itypi,itypi1,itypj
12500 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12501 real(kind=8) :: e1,e2,evdwij,evdw
12502 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12504 do i=iatsc_s,iatsc_e
12506 if (itypi.eq.ntyp1) cycle
12507 itypi1=itype(i+1,1)
12512 ! Calculate SC interaction energy.
12514 do iint=1,nint_gr(i)
12515 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12516 !d & 'iend=',iend(i,iint)
12517 do j=istart(i,iint),iend(i,iint)
12519 if (itypj.eq.ntyp1) cycle
12523 rij=xj*xj+yj*yj+zj*zj
12524 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12525 if (sss.lt.1.0d0) then
12527 eps0ij=eps(itypi,itypj)
12529 e1=fac*fac*aa_aq(itypi,itypj)
12530 e2=fac*bb_aq(itypi,itypj)
12532 evdw=evdw+(1.0d0-sss)*evdwij
12534 ! Calculate the components of the gradient in DC and X
12536 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
12541 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12542 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12543 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12544 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12552 gvdwc(j,i)=expon*gvdwc(j,i)
12553 gvdwx(j,i)=expon*gvdwx(j,i)
12556 !******************************************************************************
12560 ! To save time, the factor of EXPON has been extracted from ALL components
12561 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12564 !******************************************************************************
12566 end subroutine elj_long
12567 !-----------------------------------------------------------------------------
12568 subroutine elj_short(evdw)
12570 ! This subroutine calculates the interaction energy of nonbonded side chains
12571 ! assuming the LJ potential of interaction.
12573 ! implicit real*8 (a-h,o-z)
12574 ! include 'DIMENSIONS'
12575 ! include 'COMMON.GEO'
12576 ! include 'COMMON.VAR'
12577 ! include 'COMMON.LOCAL'
12578 ! include 'COMMON.CHAIN'
12579 ! include 'COMMON.DERIV'
12580 ! include 'COMMON.INTERACT'
12581 ! include 'COMMON.TORSION'
12582 ! include 'COMMON.SBRIDGE'
12583 ! include 'COMMON.NAMES'
12584 ! include 'COMMON.IOUNITS'
12585 ! include 'COMMON.CONTACTS'
12586 real(kind=8),parameter :: accur=1.0d-10
12587 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12588 !el local variables
12589 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
12590 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12591 real(kind=8) :: e1,e2,evdwij,evdw
12592 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12594 do i=iatsc_s,iatsc_e
12596 if (itypi.eq.ntyp1) cycle
12597 itypi1=itype(i+1,1)
12604 ! Calculate SC interaction energy.
12606 do iint=1,nint_gr(i)
12607 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12608 !d & 'iend=',iend(i,iint)
12609 do j=istart(i,iint),iend(i,iint)
12611 if (itypj.eq.ntyp1) cycle
12615 ! Change 12/1/95 to calculate four-body interactions
12616 rij=xj*xj+yj*yj+zj*zj
12617 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12618 if (sss.gt.0.0d0) then
12620 eps0ij=eps(itypi,itypj)
12622 e1=fac*fac*aa_aq(itypi,itypj)
12623 e2=fac*bb_aq(itypi,itypj)
12625 evdw=evdw+sss*evdwij
12627 ! Calculate the components of the gradient in DC and X
12629 fac=-rrij*(e1+evdwij)*sss
12634 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12635 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12636 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12637 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12645 gvdwc(j,i)=expon*gvdwc(j,i)
12646 gvdwx(j,i)=expon*gvdwx(j,i)
12649 !******************************************************************************
12653 ! To save time, the factor of EXPON has been extracted from ALL components
12654 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12657 !******************************************************************************
12659 end subroutine elj_short
12660 !-----------------------------------------------------------------------------
12661 subroutine eljk_long(evdw)
12663 ! This subroutine calculates the interaction energy of nonbonded side chains
12664 ! assuming the LJK potential of interaction.
12666 ! implicit real*8 (a-h,o-z)
12667 ! include 'DIMENSIONS'
12668 ! include 'COMMON.GEO'
12669 ! include 'COMMON.VAR'
12670 ! include 'COMMON.LOCAL'
12671 ! include 'COMMON.CHAIN'
12672 ! include 'COMMON.DERIV'
12673 ! include 'COMMON.INTERACT'
12674 ! include 'COMMON.IOUNITS'
12675 ! include 'COMMON.NAMES'
12676 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12678 !el local variables
12679 integer :: i,iint,j,k,itypi,itypi1,itypj
12680 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12681 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12682 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12684 do i=iatsc_s,iatsc_e
12686 if (itypi.eq.ntyp1) cycle
12687 itypi1=itype(i+1,1)
12692 ! Calculate SC interaction energy.
12694 do iint=1,nint_gr(i)
12695 do j=istart(i,iint),iend(i,iint)
12697 if (itypj.eq.ntyp1) cycle
12701 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12702 fac_augm=rrij**expon
12703 e_augm=augm(itypi,itypj)*fac_augm
12704 r_inv_ij=dsqrt(rrij)
12706 sss=sscale(rij/sigma(itypi,itypj))
12707 if (sss.lt.1.0d0) then
12708 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12709 fac=r_shift_inv**expon
12710 e1=fac*fac*aa_aq(itypi,itypj)
12711 e2=fac*bb_aq(itypi,itypj)
12712 evdwij=e_augm+e1+e2
12713 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12714 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12715 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12716 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
12717 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12718 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12719 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12720 evdw=evdw+(1.0d0-sss)*evdwij
12722 ! Calculate the components of the gradient in DC and X
12724 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12725 fac=fac*(1.0d0-sss)
12730 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12731 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12732 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12733 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12741 gvdwc(j,i)=expon*gvdwc(j,i)
12742 gvdwx(j,i)=expon*gvdwx(j,i)
12746 end subroutine eljk_long
12747 !-----------------------------------------------------------------------------
12748 subroutine eljk_short(evdw)
12750 ! This subroutine calculates the interaction energy of nonbonded side chains
12751 ! assuming the LJK potential of interaction.
12753 ! implicit real*8 (a-h,o-z)
12754 ! include 'DIMENSIONS'
12755 ! include 'COMMON.GEO'
12756 ! include 'COMMON.VAR'
12757 ! include 'COMMON.LOCAL'
12758 ! include 'COMMON.CHAIN'
12759 ! include 'COMMON.DERIV'
12760 ! include 'COMMON.INTERACT'
12761 ! include 'COMMON.IOUNITS'
12762 ! include 'COMMON.NAMES'
12763 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12765 !el local variables
12766 integer :: i,iint,j,k,itypi,itypi1,itypj
12767 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12768 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12769 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12771 do i=iatsc_s,iatsc_e
12773 if (itypi.eq.ntyp1) cycle
12774 itypi1=itype(i+1,1)
12779 ! Calculate SC interaction energy.
12781 do iint=1,nint_gr(i)
12782 do j=istart(i,iint),iend(i,iint)
12784 if (itypj.eq.ntyp1) cycle
12788 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12789 fac_augm=rrij**expon
12790 e_augm=augm(itypi,itypj)*fac_augm
12791 r_inv_ij=dsqrt(rrij)
12793 sss=sscale(rij/sigma(itypi,itypj))
12794 if (sss.gt.0.0d0) then
12795 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12796 fac=r_shift_inv**expon
12797 e1=fac*fac*aa_aq(itypi,itypj)
12798 e2=fac*bb_aq(itypi,itypj)
12799 evdwij=e_augm+e1+e2
12800 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12801 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12802 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12803 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
12804 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12805 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12806 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12807 evdw=evdw+sss*evdwij
12809 ! Calculate the components of the gradient in DC and X
12811 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12817 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12818 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12819 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12820 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12828 gvdwc(j,i)=expon*gvdwc(j,i)
12829 gvdwx(j,i)=expon*gvdwx(j,i)
12833 end subroutine eljk_short
12834 !-----------------------------------------------------------------------------
12835 subroutine ebp_long(evdw)
12837 ! This subroutine calculates the interaction energy of nonbonded side chains
12838 ! assuming the Berne-Pechukas potential of interaction.
12841 ! implicit real*8 (a-h,o-z)
12842 ! include 'DIMENSIONS'
12843 ! include 'COMMON.GEO'
12844 ! include 'COMMON.VAR'
12845 ! include 'COMMON.LOCAL'
12846 ! include 'COMMON.CHAIN'
12847 ! include 'COMMON.DERIV'
12848 ! include 'COMMON.NAMES'
12849 ! include 'COMMON.INTERACT'
12850 ! include 'COMMON.IOUNITS'
12851 ! include 'COMMON.CALC'
12853 !el integer :: icall
12854 !el common /srutu/ icall
12855 ! double precision rrsave(maxdim)
12857 !el local variables
12858 integer :: iint,itypi,itypi1,itypj
12859 real(kind=8) :: rrij,xi,yi,zi,fac
12860 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
12862 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
12864 ! if (icall.eq.0) then
12870 do i=iatsc_s,iatsc_e
12872 if (itypi.eq.ntyp1) cycle
12873 itypi1=itype(i+1,1)
12877 dxi=dc_norm(1,nres+i)
12878 dyi=dc_norm(2,nres+i)
12879 dzi=dc_norm(3,nres+i)
12880 ! dsci_inv=dsc_inv(itypi)
12881 dsci_inv=vbld_inv(i+nres)
12883 ! Calculate SC interaction energy.
12885 do iint=1,nint_gr(i)
12886 do j=istart(i,iint),iend(i,iint)
12889 if (itypj.eq.ntyp1) cycle
12890 ! dscj_inv=dsc_inv(itypj)
12891 dscj_inv=vbld_inv(j+nres)
12892 chi1=chi(itypi,itypj)
12893 chi2=chi(itypj,itypi)
12900 alf12=0.5D0*(alf1+alf2)
12904 dxj=dc_norm(1,nres+j)
12905 dyj=dc_norm(2,nres+j)
12906 dzj=dc_norm(3,nres+j)
12907 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12909 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12911 if (sss.lt.1.0d0) then
12913 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
12915 ! Calculate whole angle-dependent part of epsilon and contributions
12916 ! to its derivatives
12917 fac=(rrij*sigsq)**expon2
12918 e1=fac*fac*aa_aq(itypi,itypj)
12919 e2=fac*bb_aq(itypi,itypj)
12920 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12921 eps2der=evdwij*eps3rt
12922 eps3der=evdwij*eps2rt
12923 evdwij=evdwij*eps2rt*eps3rt
12924 evdw=evdw+evdwij*(1.0d0-sss)
12926 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
12927 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
12928 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
12929 !d & restyp(itypi,1),i,restyp(itypj,1),j,
12930 !d & epsi,sigm,chi1,chi2,chip1,chip2,
12931 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
12932 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
12935 ! Calculate gradient components.
12936 e1=e1*eps1*eps2rt**2*eps3rt**2
12937 fac=-expon*(e1+evdwij)
12940 ! Calculate radial part of the gradient
12944 ! Calculate the angular part of the gradient and sum add the contributions
12945 ! to the appropriate components of the Cartesian gradient.
12946 call sc_grad_scale(1.0d0-sss)
12953 end subroutine ebp_long
12954 !-----------------------------------------------------------------------------
12955 subroutine ebp_short(evdw)
12957 ! This subroutine calculates the interaction energy of nonbonded side chains
12958 ! assuming the Berne-Pechukas potential of interaction.
12961 ! implicit real*8 (a-h,o-z)
12962 ! include 'DIMENSIONS'
12963 ! include 'COMMON.GEO'
12964 ! include 'COMMON.VAR'
12965 ! include 'COMMON.LOCAL'
12966 ! include 'COMMON.CHAIN'
12967 ! include 'COMMON.DERIV'
12968 ! include 'COMMON.NAMES'
12969 ! include 'COMMON.INTERACT'
12970 ! include 'COMMON.IOUNITS'
12971 ! include 'COMMON.CALC'
12973 !el integer :: icall
12974 !el common /srutu/ icall
12975 ! double precision rrsave(maxdim)
12977 !el local variables
12978 integer :: iint,itypi,itypi1,itypj
12979 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
12980 real(kind=8) :: sss,e1,e2,evdw
12982 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
12984 ! if (icall.eq.0) then
12990 do i=iatsc_s,iatsc_e
12992 if (itypi.eq.ntyp1) cycle
12993 itypi1=itype(i+1,1)
12997 dxi=dc_norm(1,nres+i)
12998 dyi=dc_norm(2,nres+i)
12999 dzi=dc_norm(3,nres+i)
13000 ! dsci_inv=dsc_inv(itypi)
13001 dsci_inv=vbld_inv(i+nres)
13003 ! Calculate SC interaction energy.
13005 do iint=1,nint_gr(i)
13006 do j=istart(i,iint),iend(i,iint)
13009 if (itypj.eq.ntyp1) cycle
13010 ! dscj_inv=dsc_inv(itypj)
13011 dscj_inv=vbld_inv(j+nres)
13012 chi1=chi(itypi,itypj)
13013 chi2=chi(itypj,itypi)
13020 alf12=0.5D0*(alf1+alf2)
13024 dxj=dc_norm(1,nres+j)
13025 dyj=dc_norm(2,nres+j)
13026 dzj=dc_norm(3,nres+j)
13027 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13029 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13031 if (sss.gt.0.0d0) then
13033 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
13035 ! Calculate whole angle-dependent part of epsilon and contributions
13036 ! to its derivatives
13037 fac=(rrij*sigsq)**expon2
13038 e1=fac*fac*aa_aq(itypi,itypj)
13039 e2=fac*bb_aq(itypi,itypj)
13040 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13041 eps2der=evdwij*eps3rt
13042 eps3der=evdwij*eps2rt
13043 evdwij=evdwij*eps2rt*eps3rt
13044 evdw=evdw+evdwij*sss
13046 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13047 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13048 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
13049 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13050 !d & epsi,sigm,chi1,chi2,chip1,chip2,
13051 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
13052 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
13055 ! Calculate gradient components.
13056 e1=e1*eps1*eps2rt**2*eps3rt**2
13057 fac=-expon*(e1+evdwij)
13060 ! Calculate radial part of the gradient
13064 ! Calculate the angular part of the gradient and sum add the contributions
13065 ! to the appropriate components of the Cartesian gradient.
13066 call sc_grad_scale(sss)
13073 end subroutine ebp_short
13074 !-----------------------------------------------------------------------------
13075 subroutine egb_long(evdw)
13077 ! This subroutine calculates the interaction energy of nonbonded side chains
13078 ! assuming the Gay-Berne potential of interaction.
13081 ! implicit real*8 (a-h,o-z)
13082 ! include 'DIMENSIONS'
13083 ! include 'COMMON.GEO'
13084 ! include 'COMMON.VAR'
13085 ! include 'COMMON.LOCAL'
13086 ! include 'COMMON.CHAIN'
13087 ! include 'COMMON.DERIV'
13088 ! include 'COMMON.NAMES'
13089 ! include 'COMMON.INTERACT'
13090 ! include 'COMMON.IOUNITS'
13091 ! include 'COMMON.CALC'
13092 ! include 'COMMON.CONTROL'
13094 !el local variables
13095 integer :: iint,itypi,itypi1,itypj,subchap
13096 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
13097 real(kind=8) :: sss,e1,e2,evdw,sss_grad
13098 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13099 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13100 ssgradlipi,ssgradlipj
13104 !cccc energy_dec=.false.
13105 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13108 ! if (icall.eq.0) lprn=.false.
13110 do i=iatsc_s,iatsc_e
13112 if (itypi.eq.ntyp1) cycle
13113 itypi1=itype(i+1,1)
13117 xi=mod(xi,boxxsize)
13118 if (xi.lt.0) xi=xi+boxxsize
13119 yi=mod(yi,boxysize)
13120 if (yi.lt.0) yi=yi+boxysize
13121 zi=mod(zi,boxzsize)
13122 if (zi.lt.0) zi=zi+boxzsize
13123 if ((zi.gt.bordlipbot) &
13124 .and.(zi.lt.bordliptop)) then
13125 !C the energy transfer exist
13126 if (zi.lt.buflipbot) then
13127 !C what fraction I am in
13129 ((zi-bordlipbot)/lipbufthick)
13130 !C lipbufthick is thickenes of lipid buffore
13131 sslipi=sscalelip(fracinbuf)
13132 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
13133 elseif (zi.gt.bufliptop) then
13134 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
13135 sslipi=sscalelip(fracinbuf)
13136 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
13146 dxi=dc_norm(1,nres+i)
13147 dyi=dc_norm(2,nres+i)
13148 dzi=dc_norm(3,nres+i)
13149 ! dsci_inv=dsc_inv(itypi)
13150 dsci_inv=vbld_inv(i+nres)
13151 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
13152 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
13154 ! Calculate SC interaction energy.
13156 do iint=1,nint_gr(i)
13157 do j=istart(i,iint),iend(i,iint)
13158 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
13159 ! call dyn_ssbond_ene(i,j,evdwij)
13161 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13162 ! 'evdw',i,j,evdwij,' ss'
13163 ! if (energy_dec) write (iout,*) &
13164 ! 'evdw',i,j,evdwij,' ss'
13165 ! do k=j+1,iend(i,iint)
13166 !C search over all next residues
13167 ! if (dyn_ss_mask(k)) then
13168 !C check if they are cysteins
13169 !C write(iout,*) 'k=',k
13171 !c write(iout,*) "PRZED TRI", evdwij
13172 ! evdwij_przed_tri=evdwij
13173 ! call triple_ssbond_ene(i,j,k,evdwij)
13174 !c if(evdwij_przed_tri.ne.evdwij) then
13175 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
13178 !c write(iout,*) "PO TRI", evdwij
13179 !C call the energy function that removes the artifical triple disulfide
13180 !C bond the soubroutine is located in ssMD.F
13182 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13183 'evdw',i,j,evdwij,'tss'
13184 ! endif!dyn_ss_mask(k)
13190 if (itypj.eq.ntyp1) cycle
13191 ! dscj_inv=dsc_inv(itypj)
13192 dscj_inv=vbld_inv(j+nres)
13193 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
13194 ! & 1.0d0/vbld(j+nres)
13195 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
13196 sig0ij=sigma(itypi,itypj)
13197 chi1=chi(itypi,itypj)
13198 chi2=chi(itypj,itypi)
13205 alf12=0.5D0*(alf1+alf2)
13209 ! Searching for nearest neighbour
13210 xj=mod(xj,boxxsize)
13211 if (xj.lt.0) xj=xj+boxxsize
13212 yj=mod(yj,boxysize)
13213 if (yj.lt.0) yj=yj+boxysize
13214 zj=mod(zj,boxzsize)
13215 if (zj.lt.0) zj=zj+boxzsize
13216 if ((zj.gt.bordlipbot) &
13217 .and.(zj.lt.bordliptop)) then
13218 !C the energy transfer exist
13219 if (zj.lt.buflipbot) then
13220 !C what fraction I am in
13222 ((zj-bordlipbot)/lipbufthick)
13223 !C lipbufthick is thickenes of lipid buffore
13224 sslipj=sscalelip(fracinbuf)
13225 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
13226 elseif (zj.gt.bufliptop) then
13227 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
13228 sslipj=sscalelip(fracinbuf)
13229 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13238 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13239 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13240 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13241 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13243 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13251 xj=xj_safe+xshift*boxxsize
13252 yj=yj_safe+yshift*boxysize
13253 zj=zj_safe+zshift*boxzsize
13254 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13255 if(dist_temp.lt.dist_init) then
13256 dist_init=dist_temp
13265 if (subchap.eq.1) then
13275 dxj=dc_norm(1,nres+j)
13276 dyj=dc_norm(2,nres+j)
13277 dzj=dc_norm(3,nres+j)
13278 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13280 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13281 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
13282 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
13283 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13284 if (sss_ele_cut.le.0.0) cycle
13285 if (sss.lt.1.0d0) then
13287 ! Calculate angle-dependent terms of energy and contributions to their
13291 sig=sig0ij*dsqrt(sigsq)
13292 rij_shift=1.0D0/rij-sig+sig0ij
13293 ! for diagnostics; uncomment
13294 ! rij_shift=1.2*sig0ij
13295 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13296 if (rij_shift.le.0.0D0) then
13298 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13299 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13300 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13304 !---------------------------------------------------------------
13305 rij_shift=1.0D0/rij_shift
13306 fac=rij_shift**expon
13309 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13310 eps2der=evdwij*eps3rt
13311 eps3der=evdwij*eps2rt
13312 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13313 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13314 evdwij=evdwij*eps2rt*eps3rt
13315 evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
13317 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13318 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13319 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13320 restyp(itypi,1),i,restyp(itypj,1),j,&
13321 epsi,sigm,chi1,chi2,chip1,chip2,&
13322 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13323 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13327 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13329 ! if (energy_dec) write (iout,*) &
13330 ! 'evdw',i,j,evdwij,"egb_long"
13332 ! Calculate gradient components.
13333 e1=e1*eps1*eps2rt**2*eps3rt**2
13334 fac=-expon*(e1+evdwij)*rij_shift
13337 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13338 /sigma(itypi,itypj)*rij-sss_grad/(1.0-sss)*rij &
13339 /sigmaii(itypi,itypj))
13341 ! Calculate the radial part of the gradient
13345 ! Calculate angular part of the gradient.
13346 call sc_grad_scale(1.0d0-sss)
13352 ! write (iout,*) "Number of loop steps in EGB:",ind
13353 !ccc energy_dec=.false.
13355 end subroutine egb_long
13356 !-----------------------------------------------------------------------------
13357 subroutine egb_short(evdw)
13359 ! This subroutine calculates the interaction energy of nonbonded side chains
13360 ! assuming the Gay-Berne potential of interaction.
13363 ! implicit real*8 (a-h,o-z)
13364 ! include 'DIMENSIONS'
13365 ! include 'COMMON.GEO'
13366 ! include 'COMMON.VAR'
13367 ! include 'COMMON.LOCAL'
13368 ! include 'COMMON.CHAIN'
13369 ! include 'COMMON.DERIV'
13370 ! include 'COMMON.NAMES'
13371 ! include 'COMMON.INTERACT'
13372 ! include 'COMMON.IOUNITS'
13373 ! include 'COMMON.CALC'
13374 ! include 'COMMON.CONTROL'
13376 !el local variables
13377 integer :: iint,itypi,itypi1,itypj,subchap
13378 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
13379 real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad
13380 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13381 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13382 ssgradlipi,ssgradlipj
13384 !cccc energy_dec=.false.
13385 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13388 ! if (icall.eq.0) lprn=.false.
13390 do i=iatsc_s,iatsc_e
13392 if (itypi.eq.ntyp1) cycle
13393 itypi1=itype(i+1,1)
13397 xi=mod(xi,boxxsize)
13398 if (xi.lt.0) xi=xi+boxxsize
13399 yi=mod(yi,boxysize)
13400 if (yi.lt.0) yi=yi+boxysize
13401 zi=mod(zi,boxzsize)
13402 if (zi.lt.0) zi=zi+boxzsize
13403 if ((zi.gt.bordlipbot) &
13404 .and.(zi.lt.bordliptop)) then
13405 !C the energy transfer exist
13406 if (zi.lt.buflipbot) then
13407 !C what fraction I am in
13409 ((zi-bordlipbot)/lipbufthick)
13410 !C lipbufthick is thickenes of lipid buffore
13411 sslipi=sscalelip(fracinbuf)
13412 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
13413 elseif (zi.gt.bufliptop) then
13414 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
13415 sslipi=sscalelip(fracinbuf)
13416 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
13426 dxi=dc_norm(1,nres+i)
13427 dyi=dc_norm(2,nres+i)
13428 dzi=dc_norm(3,nres+i)
13429 ! dsci_inv=dsc_inv(itypi)
13430 dsci_inv=vbld_inv(i+nres)
13432 dxi=dc_norm(1,nres+i)
13433 dyi=dc_norm(2,nres+i)
13434 dzi=dc_norm(3,nres+i)
13435 ! dsci_inv=dsc_inv(itypi)
13436 dsci_inv=vbld_inv(i+nres)
13437 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
13438 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
13440 ! Calculate SC interaction energy.
13442 do iint=1,nint_gr(i)
13443 do j=istart(i,iint),iend(i,iint)
13444 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
13445 call dyn_ssbond_ene(i,j,evdwij)
13447 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13448 'evdw',i,j,evdwij,' ss'
13449 do k=j+1,iend(i,iint)
13450 !C search over all next residues
13451 if (dyn_ss_mask(k)) then
13452 !C check if they are cysteins
13453 !C write(iout,*) 'k=',k
13455 !c write(iout,*) "PRZED TRI", evdwij
13456 ! evdwij_przed_tri=evdwij
13457 call triple_ssbond_ene(i,j,k,evdwij)
13458 !c if(evdwij_przed_tri.ne.evdwij) then
13459 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
13462 !c write(iout,*) "PO TRI", evdwij
13463 !C call the energy function that removes the artifical triple disulfide
13464 !C bond the soubroutine is located in ssMD.F
13466 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13467 'evdw',i,j,evdwij,'tss'
13468 endif!dyn_ss_mask(k)
13471 ! if (energy_dec) write (iout,*) &
13472 ! 'evdw',i,j,evdwij,' ss'
13476 if (itypj.eq.ntyp1) cycle
13477 ! dscj_inv=dsc_inv(itypj)
13478 dscj_inv=vbld_inv(j+nres)
13479 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
13480 ! & 1.0d0/vbld(j+nres)
13481 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
13482 sig0ij=sigma(itypi,itypj)
13483 chi1=chi(itypi,itypj)
13484 chi2=chi(itypj,itypi)
13491 alf12=0.5D0*(alf1+alf2)
13492 ! xj=c(1,nres+j)-xi
13493 ! yj=c(2,nres+j)-yi
13494 ! zj=c(3,nres+j)-zi
13498 ! Searching for nearest neighbour
13499 xj=mod(xj,boxxsize)
13500 if (xj.lt.0) xj=xj+boxxsize
13501 yj=mod(yj,boxysize)
13502 if (yj.lt.0) yj=yj+boxysize
13503 zj=mod(zj,boxzsize)
13504 if (zj.lt.0) zj=zj+boxzsize
13505 if ((zj.gt.bordlipbot) &
13506 .and.(zj.lt.bordliptop)) then
13507 !C the energy transfer exist
13508 if (zj.lt.buflipbot) then
13509 !C what fraction I am in
13511 ((zj-bordlipbot)/lipbufthick)
13512 !C lipbufthick is thickenes of lipid buffore
13513 sslipj=sscalelip(fracinbuf)
13514 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
13515 elseif (zj.gt.bufliptop) then
13516 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
13517 sslipj=sscalelip(fracinbuf)
13518 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13527 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13528 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13529 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13530 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13532 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13541 xj=xj_safe+xshift*boxxsize
13542 yj=yj_safe+yshift*boxysize
13543 zj=zj_safe+zshift*boxzsize
13544 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13545 if(dist_temp.lt.dist_init) then
13546 dist_init=dist_temp
13555 if (subchap.eq.1) then
13565 dxj=dc_norm(1,nres+j)
13566 dyj=dc_norm(2,nres+j)
13567 dzj=dc_norm(3,nres+j)
13568 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13570 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13571 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13572 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
13573 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
13574 if (sss_ele_cut.le.0.0) cycle
13576 if (sss.gt.0.0d0) then
13578 ! Calculate angle-dependent terms of energy and contributions to their
13582 sig=sig0ij*dsqrt(sigsq)
13583 rij_shift=1.0D0/rij-sig+sig0ij
13584 ! for diagnostics; uncomment
13585 ! rij_shift=1.2*sig0ij
13586 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13587 if (rij_shift.le.0.0D0) then
13589 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13590 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13591 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13595 !---------------------------------------------------------------
13596 rij_shift=1.0D0/rij_shift
13597 fac=rij_shift**expon
13600 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13601 eps2der=evdwij*eps3rt
13602 eps3der=evdwij*eps2rt
13603 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13604 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13605 evdwij=evdwij*eps2rt*eps3rt
13606 evdw=evdw+evdwij*sss*sss_ele_cut
13608 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13609 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13610 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13611 restyp(itypi,1),i,restyp(itypj,1),j,&
13612 epsi,sigm,chi1,chi2,chip1,chip2,&
13613 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13614 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13618 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13620 ! if (energy_dec) write (iout,*) &
13621 ! 'evdw',i,j,evdwij,"egb_short"
13623 ! Calculate gradient components.
13624 e1=e1*eps1*eps2rt**2*eps3rt**2
13625 fac=-expon*(e1+evdwij)*rij_shift
13628 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13629 /sigma(itypi,itypj)*rij+sss_grad/sss*rij &
13630 /sigmaii(itypi,itypj))
13633 ! Calculate the radial part of the gradient
13637 ! Calculate angular part of the gradient.
13638 call sc_grad_scale(sss)
13644 ! write (iout,*) "Number of loop steps in EGB:",ind
13645 !ccc energy_dec=.false.
13647 end subroutine egb_short
13648 !-----------------------------------------------------------------------------
13649 subroutine egbv_long(evdw)
13651 ! This subroutine calculates the interaction energy of nonbonded side chains
13652 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13655 ! implicit real*8 (a-h,o-z)
13656 ! include 'DIMENSIONS'
13657 ! include 'COMMON.GEO'
13658 ! include 'COMMON.VAR'
13659 ! include 'COMMON.LOCAL'
13660 ! include 'COMMON.CHAIN'
13661 ! include 'COMMON.DERIV'
13662 ! include 'COMMON.NAMES'
13663 ! include 'COMMON.INTERACT'
13664 ! include 'COMMON.IOUNITS'
13665 ! include 'COMMON.CALC'
13667 !el integer :: icall
13668 !el common /srutu/ icall
13670 !el local variables
13671 integer :: iint,itypi,itypi1,itypj
13672 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
13673 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
13675 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13678 ! if (icall.eq.0) lprn=.true.
13680 do i=iatsc_s,iatsc_e
13682 if (itypi.eq.ntyp1) cycle
13683 itypi1=itype(i+1,1)
13687 dxi=dc_norm(1,nres+i)
13688 dyi=dc_norm(2,nres+i)
13689 dzi=dc_norm(3,nres+i)
13690 ! dsci_inv=dsc_inv(itypi)
13691 dsci_inv=vbld_inv(i+nres)
13693 ! Calculate SC interaction energy.
13695 do iint=1,nint_gr(i)
13696 do j=istart(i,iint),iend(i,iint)
13699 if (itypj.eq.ntyp1) cycle
13700 ! dscj_inv=dsc_inv(itypj)
13701 dscj_inv=vbld_inv(j+nres)
13702 sig0ij=sigma(itypi,itypj)
13703 r0ij=r0(itypi,itypj)
13704 chi1=chi(itypi,itypj)
13705 chi2=chi(itypj,itypi)
13712 alf12=0.5D0*(alf1+alf2)
13716 dxj=dc_norm(1,nres+j)
13717 dyj=dc_norm(2,nres+j)
13718 dzj=dc_norm(3,nres+j)
13719 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13722 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13724 if (sss.lt.1.0d0) then
13726 ! Calculate angle-dependent terms of energy and contributions to their
13730 sig=sig0ij*dsqrt(sigsq)
13731 rij_shift=1.0D0/rij-sig+r0ij
13732 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13733 if (rij_shift.le.0.0D0) then
13738 !---------------------------------------------------------------
13739 rij_shift=1.0D0/rij_shift
13740 fac=rij_shift**expon
13741 e1=fac*fac*aa_aq(itypi,itypj)
13742 e2=fac*bb_aq(itypi,itypj)
13743 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13744 eps2der=evdwij*eps3rt
13745 eps3der=evdwij*eps2rt
13746 fac_augm=rrij**expon
13747 e_augm=augm(itypi,itypj)*fac_augm
13748 evdwij=evdwij*eps2rt*eps3rt
13749 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
13751 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13752 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13753 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13754 restyp(itypi,1),i,restyp(itypj,1),j,&
13755 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13756 chi1,chi2,chip1,chip2,&
13757 eps1,eps2rt**2,eps3rt**2,&
13758 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13761 ! Calculate gradient components.
13762 e1=e1*eps1*eps2rt**2*eps3rt**2
13763 fac=-expon*(e1+evdwij)*rij_shift
13765 fac=rij*fac-2*expon*rrij*e_augm
13766 ! Calculate the radial part of the gradient
13770 ! Calculate angular part of the gradient.
13771 call sc_grad_scale(1.0d0-sss)
13776 end subroutine egbv_long
13777 !-----------------------------------------------------------------------------
13778 subroutine egbv_short(evdw)
13780 ! This subroutine calculates the interaction energy of nonbonded side chains
13781 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13784 ! implicit real*8 (a-h,o-z)
13785 ! include 'DIMENSIONS'
13786 ! include 'COMMON.GEO'
13787 ! include 'COMMON.VAR'
13788 ! include 'COMMON.LOCAL'
13789 ! include 'COMMON.CHAIN'
13790 ! include 'COMMON.DERIV'
13791 ! include 'COMMON.NAMES'
13792 ! include 'COMMON.INTERACT'
13793 ! include 'COMMON.IOUNITS'
13794 ! include 'COMMON.CALC'
13796 !el integer :: icall
13797 !el common /srutu/ icall
13799 !el local variables
13800 integer :: iint,itypi,itypi1,itypj
13801 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
13802 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
13804 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13807 ! if (icall.eq.0) lprn=.true.
13809 do i=iatsc_s,iatsc_e
13811 if (itypi.eq.ntyp1) cycle
13812 itypi1=itype(i+1,1)
13816 dxi=dc_norm(1,nres+i)
13817 dyi=dc_norm(2,nres+i)
13818 dzi=dc_norm(3,nres+i)
13819 ! dsci_inv=dsc_inv(itypi)
13820 dsci_inv=vbld_inv(i+nres)
13822 ! Calculate SC interaction energy.
13824 do iint=1,nint_gr(i)
13825 do j=istart(i,iint),iend(i,iint)
13828 if (itypj.eq.ntyp1) cycle
13829 ! dscj_inv=dsc_inv(itypj)
13830 dscj_inv=vbld_inv(j+nres)
13831 sig0ij=sigma(itypi,itypj)
13832 r0ij=r0(itypi,itypj)
13833 chi1=chi(itypi,itypj)
13834 chi2=chi(itypj,itypi)
13841 alf12=0.5D0*(alf1+alf2)
13845 dxj=dc_norm(1,nres+j)
13846 dyj=dc_norm(2,nres+j)
13847 dzj=dc_norm(3,nres+j)
13848 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13851 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13853 if (sss.gt.0.0d0) then
13855 ! Calculate angle-dependent terms of energy and contributions to their
13859 sig=sig0ij*dsqrt(sigsq)
13860 rij_shift=1.0D0/rij-sig+r0ij
13861 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13862 if (rij_shift.le.0.0D0) then
13867 !---------------------------------------------------------------
13868 rij_shift=1.0D0/rij_shift
13869 fac=rij_shift**expon
13870 e1=fac*fac*aa_aq(itypi,itypj)
13871 e2=fac*bb_aq(itypi,itypj)
13872 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13873 eps2der=evdwij*eps3rt
13874 eps3der=evdwij*eps2rt
13875 fac_augm=rrij**expon
13876 e_augm=augm(itypi,itypj)*fac_augm
13877 evdwij=evdwij*eps2rt*eps3rt
13878 evdw=evdw+(evdwij+e_augm)*sss
13880 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13881 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13882 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13883 restyp(itypi,1),i,restyp(itypj,1),j,&
13884 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13885 chi1,chi2,chip1,chip2,&
13886 eps1,eps2rt**2,eps3rt**2,&
13887 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13890 ! Calculate gradient components.
13891 e1=e1*eps1*eps2rt**2*eps3rt**2
13892 fac=-expon*(e1+evdwij)*rij_shift
13894 fac=rij*fac-2*expon*rrij*e_augm
13895 ! Calculate the radial part of the gradient
13899 ! Calculate angular part of the gradient.
13900 call sc_grad_scale(sss)
13905 end subroutine egbv_short
13906 !-----------------------------------------------------------------------------
13907 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
13909 ! This subroutine calculates the average interaction energy and its gradient
13910 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
13911 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
13912 ! The potential depends both on the distance of peptide-group centers and on
13913 ! the orientation of the CA-CA virtual bonds.
13915 ! implicit real*8 (a-h,o-z)
13921 ! include 'DIMENSIONS'
13922 ! include 'COMMON.CONTROL'
13923 ! include 'COMMON.SETUP'
13924 ! include 'COMMON.IOUNITS'
13925 ! include 'COMMON.GEO'
13926 ! include 'COMMON.VAR'
13927 ! include 'COMMON.LOCAL'
13928 ! include 'COMMON.CHAIN'
13929 ! include 'COMMON.DERIV'
13930 ! include 'COMMON.INTERACT'
13931 ! include 'COMMON.CONTACTS'
13932 ! include 'COMMON.TORSION'
13933 ! include 'COMMON.VECTORS'
13934 ! include 'COMMON.FFIELD'
13935 ! include 'COMMON.TIME1'
13936 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
13937 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
13938 real(kind=8),dimension(2,2) :: acipa !el,a_temp
13939 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
13940 real(kind=8),dimension(4) :: muij
13941 !el integer :: num_conti,j1,j2
13942 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
13943 !el dz_normi,xmedi,ymedi,zmedi
13944 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
13945 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
13946 !el num_conti,j1,j2
13947 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
13949 real(kind=8) :: scal_el=1.0d0
13951 real(kind=8) :: scal_el=0.5d0
13954 ! 13-go grudnia roku pamietnego...
13955 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
13956 0.0d0,1.0d0,0.0d0,&
13957 0.0d0,0.0d0,1.0d0/),shape(unmat))
13958 !el local variables
13960 real(kind=8) :: fac
13961 real(kind=8) :: dxj,dyj,dzj
13962 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
13964 ! allocate(num_cont_hb(nres)) !(maxres)
13965 !d write(iout,*) 'In EELEC'
13967 !d write(iout,*) 'Type',i
13968 !d write(iout,*) 'B1',B1(:,i)
13969 !d write(iout,*) 'B2',B2(:,i)
13970 !d write(iout,*) 'CC',CC(:,:,i)
13971 !d write(iout,*) 'DD',DD(:,:,i)
13972 !d write(iout,*) 'EE',EE(:,:,i)
13974 !d call check_vecgrad
13976 if (icheckgrad.eq.1) then
13978 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
13980 dc_norm(k,i)=dc(k,i)*fac
13982 ! write (iout,*) 'i',i,' fac',fac
13985 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
13986 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
13987 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
13988 ! call vec_and_deriv
13992 ! print *, "before set matrices"
13994 ! print *,"after set martices"
13996 time_mat=time_mat+MPI_Wtime()-time01
14000 !d write (iout,*) 'i=',i
14002 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
14005 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
14006 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
14019 !d print '(a)','Enter EELEC'
14020 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
14021 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
14022 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
14024 gel_loc_loc(i)=0.0d0
14029 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
14031 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
14033 do i=iturn3_start,iturn3_end
14034 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1 &
14035 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
14039 dx_normi=dc_norm(1,i)
14040 dy_normi=dc_norm(2,i)
14041 dz_normi=dc_norm(3,i)
14042 xmedi=c(1,i)+0.5d0*dxi
14043 ymedi=c(2,i)+0.5d0*dyi
14044 zmedi=c(3,i)+0.5d0*dzi
14045 xmedi=dmod(xmedi,boxxsize)
14046 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14047 ymedi=dmod(ymedi,boxysize)
14048 if (ymedi.lt.0) ymedi=ymedi+boxysize
14049 zmedi=dmod(zmedi,boxzsize)
14050 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14052 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
14053 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
14054 num_cont_hb(i)=num_conti
14056 do i=iturn4_start,iturn4_end
14057 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
14058 .or. itype(i+3,1).eq.ntyp1 &
14059 .or. itype(i+4,1).eq.ntyp1) cycle
14063 dx_normi=dc_norm(1,i)
14064 dy_normi=dc_norm(2,i)
14065 dz_normi=dc_norm(3,i)
14066 xmedi=c(1,i)+0.5d0*dxi
14067 ymedi=c(2,i)+0.5d0*dyi
14068 zmedi=c(3,i)+0.5d0*dzi
14069 xmedi=dmod(xmedi,boxxsize)
14070 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14071 ymedi=dmod(ymedi,boxysize)
14072 if (ymedi.lt.0) ymedi=ymedi+boxysize
14073 zmedi=dmod(zmedi,boxzsize)
14074 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14075 num_conti=num_cont_hb(i)
14076 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
14077 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
14078 call eturn4(i,eello_turn4)
14079 num_cont_hb(i)=num_conti
14082 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
14084 do i=iatel_s,iatel_e
14085 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
14089 dx_normi=dc_norm(1,i)
14090 dy_normi=dc_norm(2,i)
14091 dz_normi=dc_norm(3,i)
14092 xmedi=c(1,i)+0.5d0*dxi
14093 ymedi=c(2,i)+0.5d0*dyi
14094 zmedi=c(3,i)+0.5d0*dzi
14095 xmedi=dmod(xmedi,boxxsize)
14096 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14097 ymedi=dmod(ymedi,boxysize)
14098 if (ymedi.lt.0) ymedi=ymedi+boxysize
14099 zmedi=dmod(zmedi,boxzsize)
14100 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14101 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
14102 num_conti=num_cont_hb(i)
14103 do j=ielstart(i),ielend(i)
14104 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
14105 call eelecij_scale(i,j,ees,evdw1,eel_loc)
14107 num_cont_hb(i)=num_conti
14109 ! write (iout,*) "Number of loop steps in EELEC:",ind
14111 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
14112 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
14114 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
14115 !cc eel_loc=eel_loc+eello_turn3
14116 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
14118 end subroutine eelec_scale
14119 !-----------------------------------------------------------------------------
14120 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
14121 ! implicit real*8 (a-h,o-z)
14124 ! include 'DIMENSIONS'
14128 ! include 'COMMON.CONTROL'
14129 ! include 'COMMON.IOUNITS'
14130 ! include 'COMMON.GEO'
14131 ! include 'COMMON.VAR'
14132 ! include 'COMMON.LOCAL'
14133 ! include 'COMMON.CHAIN'
14134 ! include 'COMMON.DERIV'
14135 ! include 'COMMON.INTERACT'
14136 ! include 'COMMON.CONTACTS'
14137 ! include 'COMMON.TORSION'
14138 ! include 'COMMON.VECTORS'
14139 ! include 'COMMON.FFIELD'
14140 ! include 'COMMON.TIME1'
14141 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
14142 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
14143 real(kind=8),dimension(2,2) :: acipa !el,a_temp
14144 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
14145 real(kind=8),dimension(4) :: muij
14146 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14147 dist_temp, dist_init,sss_grad
14148 integer xshift,yshift,zshift
14150 !el integer :: num_conti,j1,j2
14151 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
14152 !el dz_normi,xmedi,ymedi,zmedi
14153 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
14154 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14155 !el num_conti,j1,j2
14156 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14158 real(kind=8) :: scal_el=1.0d0
14160 real(kind=8) :: scal_el=0.5d0
14163 ! 13-go grudnia roku pamietnego...
14164 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
14165 0.0d0,1.0d0,0.0d0,&
14166 0.0d0,0.0d0,1.0d0/),shape(unmat))
14167 !el local variables
14168 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m,isubchap
14169 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
14170 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
14171 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
14172 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
14173 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
14174 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
14175 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
14176 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
14177 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
14178 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
14179 ecosam,ecosbm,ecosgm,ghalf,time00
14180 ! integer :: maxconts
14181 ! maxconts = nres/4
14182 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14183 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14184 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14185 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14186 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14187 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14188 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14189 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14190 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
14191 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
14192 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
14193 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
14194 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
14196 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
14197 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
14202 !d write (iout,*) "eelecij",i,j
14206 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
14207 aaa=app(iteli,itelj)
14208 bbb=bpp(iteli,itelj)
14209 ael6i=ael6(iteli,itelj)
14210 ael3i=ael3(iteli,itelj)
14214 dx_normj=dc_norm(1,j)
14215 dy_normj=dc_norm(2,j)
14216 dz_normj=dc_norm(3,j)
14217 ! xj=c(1,j)+0.5D0*dxj-xmedi
14218 ! yj=c(2,j)+0.5D0*dyj-ymedi
14219 ! zj=c(3,j)+0.5D0*dzj-zmedi
14220 xj=c(1,j)+0.5D0*dxj
14221 yj=c(2,j)+0.5D0*dyj
14222 zj=c(3,j)+0.5D0*dzj
14223 xj=mod(xj,boxxsize)
14224 if (xj.lt.0) xj=xj+boxxsize
14225 yj=mod(yj,boxysize)
14226 if (yj.lt.0) yj=yj+boxysize
14227 zj=mod(zj,boxzsize)
14228 if (zj.lt.0) zj=zj+boxzsize
14230 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14237 xj=xj_safe+xshift*boxxsize
14238 yj=yj_safe+yshift*boxysize
14239 zj=zj_safe+zshift*boxzsize
14240 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14241 if(dist_temp.lt.dist_init) then
14242 dist_init=dist_temp
14251 if (isubchap.eq.1) then
14262 rij=xj*xj+yj*yj+zj*zj
14266 ! For extracting the short-range part of Evdwpp
14267 sss=sscale(rij/rpp(iteli,itelj))
14268 sss_ele_cut=sscale_ele(rij)
14269 sss_ele_grad=sscagrad_ele(rij)
14270 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
14271 ! sss_ele_cut=1.0d0
14272 ! sss_ele_grad=0.0d0
14273 if (sss_ele_cut.le.0.0) go to 128
14277 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
14278 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
14279 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
14280 fac=cosa-3.0D0*cosb*cosg
14282 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
14283 if (j.eq.i+2) ev1=scal_el*ev1
14288 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
14291 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
14292 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
14293 ees=ees+eesij*sss_ele_cut
14294 evdw1=evdw1+evdwij*(1.0d0-sss)*sss_ele_cut
14295 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
14296 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
14297 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
14298 !d & xmedi,ymedi,zmedi,xj,yj,zj
14300 if (energy_dec) then
14301 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
14302 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
14306 ! Calculate contributions to the Cartesian gradient.
14309 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
14310 facel=-3*rrmij*(el1+eesij)*sss_ele_cut
14316 ! Radial derivatives. First process both termini of the fragment (i,j)
14318 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj
14319 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj
14320 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj
14322 ! ghalf=0.5D0*ggg(k)
14323 ! gelc(k,i)=gelc(k,i)+ghalf
14324 ! gelc(k,j)=gelc(k,j)+ghalf
14326 ! 9/28/08 AL Gradient compotents will be summed only at the end
14328 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14329 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14332 ! Loop over residues i+1 thru j-1.
14336 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14339 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*(1.0d0-sss) &
14340 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
14341 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*(1.0d0-sss) &
14342 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
14343 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*(1.0d0-sss) &
14344 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
14346 ! ghalf=0.5D0*ggg(k)
14347 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
14348 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
14350 ! 9/28/08 AL Gradient compotents will be summed only at the end
14352 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14353 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14356 ! Loop over residues i+1 thru j-1.
14360 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
14364 facvdw=(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
14365 facel=(el1+eesij)*sss_ele_cut
14367 fac=-3*rrmij*(facvdw+facvdw+facel)
14372 ! Radial derivatives. First process both termini of the fragment (i,j)
14378 ! ghalf=0.5D0*ggg(k)
14379 ! gelc(k,i)=gelc(k,i)+ghalf
14380 ! gelc(k,j)=gelc(k,j)+ghalf
14382 ! 9/28/08 AL Gradient compotents will be summed only at the end
14384 gelc_long(k,j)=gelc(k,j)+ggg(k)
14385 gelc_long(k,i)=gelc(k,i)-ggg(k)
14388 ! Loop over residues i+1 thru j-1.
14392 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14395 ! 9/28/08 AL Gradient compotents will be summed only at the end
14400 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14401 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14407 ecosa=2.0D0*fac3*fac1+fac4
14410 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
14411 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
14413 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14414 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14416 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
14417 !d & (dcosg(k),k=1,3)
14419 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k) )*sss_ele_cut
14422 ! ghalf=0.5D0*ggg(k)
14423 ! gelc(k,i)=gelc(k,i)+ghalf
14424 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
14425 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14426 ! gelc(k,j)=gelc(k,j)+ghalf
14427 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
14428 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14432 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14436 gelc(k,i)=gelc(k,i) &
14437 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14438 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
14440 gelc(k,j)=gelc(k,j) &
14441 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14442 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14444 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14445 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14447 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
14448 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
14449 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14451 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
14452 ! energy of a peptide unit is assumed in the form of a second-order
14453 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
14454 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
14455 ! are computed for EVERY pair of non-contiguous peptide groups.
14457 if (j.lt.nres-1) then
14468 muij(kkk)=mu(k,i)*mu(l,j)
14471 !d write (iout,*) 'EELEC: i',i,' j',j
14472 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
14473 !d write(iout,*) 'muij',muij
14474 ury=scalar(uy(1,i),erij)
14475 urz=scalar(uz(1,i),erij)
14476 vry=scalar(uy(1,j),erij)
14477 vrz=scalar(uz(1,j),erij)
14478 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
14479 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
14480 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
14481 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
14482 fac=dsqrt(-ael6i)*r3ij
14487 !d write (iout,'(4i5,4f10.5)')
14488 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
14489 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
14490 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
14491 !d & uy(:,j),uz(:,j)
14492 !d write (iout,'(4f10.5)')
14493 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
14494 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
14495 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
14496 !d write (iout,'(9f10.5/)')
14497 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
14498 ! Derivatives of the elements of A in virtual-bond vectors
14499 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
14501 uryg(k,1)=scalar(erder(1,k),uy(1,i))
14502 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
14503 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
14504 urzg(k,1)=scalar(erder(1,k),uz(1,i))
14505 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
14506 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
14507 vryg(k,1)=scalar(erder(1,k),uy(1,j))
14508 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
14509 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
14510 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
14511 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
14512 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
14514 ! Compute radial contributions to the gradient
14532 ! Add the contributions coming from er
14535 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
14536 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
14537 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
14538 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
14541 ! Derivatives in DC(i)
14542 !grad ghalf1=0.5d0*agg(k,1)
14543 !grad ghalf2=0.5d0*agg(k,2)
14544 !grad ghalf3=0.5d0*agg(k,3)
14545 !grad ghalf4=0.5d0*agg(k,4)
14546 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
14547 -3.0d0*uryg(k,2)*vry)!+ghalf1
14548 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
14549 -3.0d0*uryg(k,2)*vrz)!+ghalf2
14550 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
14551 -3.0d0*urzg(k,2)*vry)!+ghalf3
14552 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
14553 -3.0d0*urzg(k,2)*vrz)!+ghalf4
14554 ! Derivatives in DC(i+1)
14555 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
14556 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
14557 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
14558 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
14559 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
14560 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
14561 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
14562 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
14563 ! Derivatives in DC(j)
14564 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
14565 -3.0d0*vryg(k,2)*ury)!+ghalf1
14566 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
14567 -3.0d0*vrzg(k,2)*ury)!+ghalf2
14568 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
14569 -3.0d0*vryg(k,2)*urz)!+ghalf3
14570 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
14571 -3.0d0*vrzg(k,2)*urz)!+ghalf4
14572 ! Derivatives in DC(j+1) or DC(nres-1)
14573 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
14574 -3.0d0*vryg(k,3)*ury)
14575 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
14576 -3.0d0*vrzg(k,3)*ury)
14577 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
14578 -3.0d0*vryg(k,3)*urz)
14579 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
14580 -3.0d0*vrzg(k,3)*urz)
14581 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
14583 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
14596 aggi(k,l)=-aggi(k,l)
14597 aggi1(k,l)=-aggi1(k,l)
14598 aggj(k,l)=-aggj(k,l)
14599 aggj1(k,l)=-aggj1(k,l)
14602 if (j.lt.nres-1) then
14608 aggi(k,l)=-aggi(k,l)
14609 aggi1(k,l)=-aggi1(k,l)
14610 aggj(k,l)=-aggj(k,l)
14611 aggj1(k,l)=-aggj1(k,l)
14622 aggi(k,l)=-aggi(k,l)
14623 aggi1(k,l)=-aggi1(k,l)
14624 aggj(k,l)=-aggj(k,l)
14625 aggj1(k,l)=-aggj1(k,l)
14630 IF (wel_loc.gt.0.0d0) THEN
14631 ! Contribution to the local-electrostatic energy coming from the i-j pair
14632 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
14634 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
14636 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
14637 'eelloc',i,j,eel_loc_ij
14638 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
14640 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
14641 ! Partial derivatives in virtual-bond dihedral angles gamma
14643 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
14644 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
14645 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
14647 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
14648 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
14649 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
14655 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
14657 ggg(l)=(agg(l,1)*muij(1)+ &
14658 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
14660 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
14662 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
14663 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
14664 !grad ghalf=0.5d0*ggg(l)
14665 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
14666 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
14670 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
14673 ! Remaining derivatives of eello
14675 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
14676 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
14679 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
14680 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))&
14683 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
14684 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
14687 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
14688 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))&
14693 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
14694 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
14695 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
14696 .and. num_conti.le.maxconts) then
14697 ! write (iout,*) i,j," entered corr"
14699 ! Calculate the contact function. The ith column of the array JCONT will
14700 ! contain the numbers of atoms that make contacts with the atom I (of numbers
14701 ! greater than I). The arrays FACONT and GACONT will contain the values of
14702 ! the contact function and its derivative.
14703 ! r0ij=1.02D0*rpp(iteli,itelj)
14704 ! r0ij=1.11D0*rpp(iteli,itelj)
14705 r0ij=2.20D0*rpp(iteli,itelj)
14706 ! r0ij=1.55D0*rpp(iteli,itelj)
14707 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
14708 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14709 if (fcont.gt.0.0D0) then
14710 num_conti=num_conti+1
14711 if (num_conti.gt.maxconts) then
14712 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14713 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
14714 ' will skip next contacts for this conf.',num_conti
14716 jcont_hb(num_conti,i)=j
14717 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
14718 !d & " jcont_hb",jcont_hb(num_conti,i)
14719 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
14720 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14721 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
14723 d_cont(num_conti,i)=rij
14724 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
14725 ! --- Electrostatic-interaction matrix ---
14726 a_chuj(1,1,num_conti,i)=a22
14727 a_chuj(1,2,num_conti,i)=a23
14728 a_chuj(2,1,num_conti,i)=a32
14729 a_chuj(2,2,num_conti,i)=a33
14730 ! --- Gradient of rij
14732 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
14739 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
14740 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
14741 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
14742 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
14743 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
14748 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
14749 ! Calculate contact energies
14751 wij=cosa-3.0D0*cosb*cosg
14754 ! fac3=dsqrt(-ael6i)/r0ij**3
14755 fac3=dsqrt(-ael6i)*r3ij
14756 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
14757 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
14758 if (ees0tmp.gt.0) then
14759 ees0pij=dsqrt(ees0tmp)
14763 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
14764 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
14765 if (ees0tmp.gt.0) then
14766 ees0mij=dsqrt(ees0tmp)
14771 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
14774 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
14777 ! Diagnostics. Comment out or remove after debugging!
14778 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
14779 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
14780 ! ees0m(num_conti,i)=0.0D0
14782 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
14783 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
14784 ! Angular derivatives of the contact function
14785 ees0pij1=fac3/ees0pij
14786 ees0mij1=fac3/ees0mij
14787 fac3p=-3.0D0*fac3*rrmij
14788 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
14789 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
14791 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
14792 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
14793 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
14794 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
14795 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
14796 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
14797 ecosap=ecosa1+ecosa2
14798 ecosbp=ecosb1+ecosb2
14799 ecosgp=ecosg1+ecosg2
14800 ecosam=ecosa1-ecosa2
14801 ecosbm=ecosb1-ecosb2
14802 ecosgm=ecosg1-ecosg2
14811 facont_hb(num_conti,i)=fcont
14812 fprimcont=fprimcont/rij
14813 !d facont_hb(num_conti,i)=1.0D0
14814 ! Following line is for diagnostics.
14817 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14818 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14821 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
14822 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
14824 ! gggp(1)=gggp(1)+ees0pijp*xj
14825 ! gggp(2)=gggp(2)+ees0pijp*yj
14826 ! gggp(3)=gggp(3)+ees0pijp*zj
14827 ! gggm(1)=gggm(1)+ees0mijp*xj
14828 ! gggm(2)=gggm(2)+ees0mijp*yj
14829 ! gggm(3)=gggm(3)+ees0mijp*zj
14830 gggp(1)=gggp(1)+ees0pijp*xj &
14831 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14832 gggp(2)=gggp(2)+ees0pijp*yj &
14833 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14834 gggp(3)=gggp(3)+ees0pijp*zj &
14835 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14837 gggm(1)=gggm(1)+ees0mijp*xj &
14838 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14840 gggm(2)=gggm(2)+ees0mijp*yj &
14841 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14843 gggm(3)=gggm(3)+ees0mijp*zj &
14844 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14846 ! Derivatives due to the contact function
14847 gacont_hbr(1,num_conti,i)=fprimcont*xj
14848 gacont_hbr(2,num_conti,i)=fprimcont*yj
14849 gacont_hbr(3,num_conti,i)=fprimcont*zj
14852 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
14853 ! following the change of gradient-summation algorithm.
14855 !grad ghalfp=0.5D0*gggp(k)
14856 !grad ghalfm=0.5D0*gggm(k)
14857 ! gacontp_hb1(k,num_conti,i)= & !ghalfp
14858 ! +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14859 ! + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14860 ! gacontp_hb2(k,num_conti,i)= & !ghalfp
14861 ! +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14862 ! + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14863 ! gacontp_hb3(k,num_conti,i)=gggp(k)
14864 ! gacontm_hb1(k,num_conti,i)= &!ghalfm
14865 ! +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14866 ! + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14867 ! gacontm_hb2(k,num_conti,i)= & !ghalfm
14868 ! +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14869 ! + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14870 ! gacontm_hb3(k,num_conti,i)=gggm(k)
14871 gacontp_hb1(k,num_conti,i)= & !ghalfp+
14872 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14873 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14876 gacontp_hb2(k,num_conti,i)= & !ghalfp+
14877 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14878 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14881 gacontp_hb3(k,num_conti,i)=gggp(k) &
14884 gacontm_hb1(k,num_conti,i)= & !ghalfm+
14885 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14886 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14889 gacontm_hb2(k,num_conti,i)= & !ghalfm+
14890 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14891 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
14894 gacontm_hb3(k,num_conti,i)=gggm(k) &
14899 endif ! num_conti.le.maxconts
14902 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
14905 ghalf=0.5d0*agg(l,k)
14906 aggi(l,k)=aggi(l,k)+ghalf
14907 aggi1(l,k)=aggi1(l,k)+agg(l,k)
14908 aggj(l,k)=aggj(l,k)+ghalf
14911 if (j.eq.nres-1 .and. i.lt.j-2) then
14914 aggj1(l,k)=aggj1(l,k)+agg(l,k)
14920 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
14922 end subroutine eelecij_scale
14923 !-----------------------------------------------------------------------------
14924 subroutine evdwpp_short(evdw1)
14928 ! implicit real*8 (a-h,o-z)
14929 ! include 'DIMENSIONS'
14930 ! include 'COMMON.CONTROL'
14931 ! include 'COMMON.IOUNITS'
14932 ! include 'COMMON.GEO'
14933 ! include 'COMMON.VAR'
14934 ! include 'COMMON.LOCAL'
14935 ! include 'COMMON.CHAIN'
14936 ! include 'COMMON.DERIV'
14937 ! include 'COMMON.INTERACT'
14938 ! include 'COMMON.CONTACTS'
14939 ! include 'COMMON.TORSION'
14940 ! include 'COMMON.VECTORS'
14941 ! include 'COMMON.FFIELD'
14942 real(kind=8),dimension(3) :: ggg
14943 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14945 real(kind=8) :: scal_el=1.0d0
14947 real(kind=8) :: scal_el=0.5d0
14949 !el local variables
14950 integer :: i,j,k,iteli,itelj,num_conti,isubchap
14951 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
14952 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
14953 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14954 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
14955 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14956 dist_temp, dist_init,sss_grad
14957 integer xshift,yshift,zshift
14961 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
14962 ! & " iatel_e_vdw",iatel_e_vdw
14964 do i=iatel_s_vdw,iatel_e_vdw
14965 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1) cycle
14969 dx_normi=dc_norm(1,i)
14970 dy_normi=dc_norm(2,i)
14971 dz_normi=dc_norm(3,i)
14972 xmedi=c(1,i)+0.5d0*dxi
14973 ymedi=c(2,i)+0.5d0*dyi
14974 zmedi=c(3,i)+0.5d0*dzi
14975 xmedi=dmod(xmedi,boxxsize)
14976 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14977 ymedi=dmod(ymedi,boxysize)
14978 if (ymedi.lt.0) ymedi=ymedi+boxysize
14979 zmedi=dmod(zmedi,boxzsize)
14980 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14982 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
14983 ! & ' ielend',ielend_vdw(i)
14985 do j=ielstart_vdw(i),ielend_vdw(i)
14986 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
14990 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
14991 aaa=app(iteli,itelj)
14992 bbb=bpp(iteli,itelj)
14996 dx_normj=dc_norm(1,j)
14997 dy_normj=dc_norm(2,j)
14998 dz_normj=dc_norm(3,j)
14999 ! xj=c(1,j)+0.5D0*dxj-xmedi
15000 ! yj=c(2,j)+0.5D0*dyj-ymedi
15001 ! zj=c(3,j)+0.5D0*dzj-zmedi
15002 xj=c(1,j)+0.5D0*dxj
15003 yj=c(2,j)+0.5D0*dyj
15004 zj=c(3,j)+0.5D0*dzj
15005 xj=mod(xj,boxxsize)
15006 if (xj.lt.0) xj=xj+boxxsize
15007 yj=mod(yj,boxysize)
15008 if (yj.lt.0) yj=yj+boxysize
15009 zj=mod(zj,boxzsize)
15010 if (zj.lt.0) zj=zj+boxzsize
15012 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15019 xj=xj_safe+xshift*boxxsize
15020 yj=yj_safe+yshift*boxysize
15021 zj=zj_safe+zshift*boxzsize
15022 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15023 if(dist_temp.lt.dist_init) then
15024 dist_init=dist_temp
15033 if (isubchap.eq.1) then
15044 rij=xj*xj+yj*yj+zj*zj
15047 sss=sscale(rij/rpp(iteli,itelj))
15048 sss_ele_cut=sscale_ele(rij)
15049 sss_ele_grad=sscagrad_ele(rij)
15050 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
15051 if (sss_ele_cut.le.0.0) cycle
15052 if (sss.gt.0.0d0) then
15057 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
15058 if (j.eq.i+2) ev1=scal_el*ev1
15061 if (energy_dec) then
15062 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
15064 evdw1=evdw1+evdwij*sss*sss_ele_cut
15066 ! Calculate contributions to the Cartesian gradient.
15068 facvdw=-6*rrmij*(ev1+evdwij)*sss*sss_ele_cut
15072 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*sss &
15073 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
15074 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*sss &
15075 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
15076 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*sss &
15077 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
15080 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
15081 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
15087 end subroutine evdwpp_short
15088 !-----------------------------------------------------------------------------
15089 subroutine escp_long(evdw2,evdw2_14)
15091 ! This subroutine calculates the excluded-volume interaction energy between
15092 ! peptide-group centers and side chains and its gradient in virtual-bond and
15093 ! side-chain vectors.
15095 ! implicit real*8 (a-h,o-z)
15096 ! include 'DIMENSIONS'
15097 ! include 'COMMON.GEO'
15098 ! include 'COMMON.VAR'
15099 ! include 'COMMON.LOCAL'
15100 ! include 'COMMON.CHAIN'
15101 ! include 'COMMON.DERIV'
15102 ! include 'COMMON.INTERACT'
15103 ! include 'COMMON.FFIELD'
15104 ! include 'COMMON.IOUNITS'
15105 ! include 'COMMON.CONTROL'
15106 real(kind=8),dimension(3) :: ggg
15107 !el local variables
15108 integer :: i,iint,j,k,iteli,itypj,subchap
15109 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
15110 real(kind=8) :: evdw2,evdw2_14,evdwij
15111 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15112 dist_temp, dist_init
15116 !d print '(a)','Enter ESCP'
15117 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
15118 do i=iatscp_s,iatscp_e
15119 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
15121 xi=0.5D0*(c(1,i)+c(1,i+1))
15122 yi=0.5D0*(c(2,i)+c(2,i+1))
15123 zi=0.5D0*(c(3,i)+c(3,i+1))
15124 xi=mod(xi,boxxsize)
15125 if (xi.lt.0) xi=xi+boxxsize
15126 yi=mod(yi,boxysize)
15127 if (yi.lt.0) yi=yi+boxysize
15128 zi=mod(zi,boxzsize)
15129 if (zi.lt.0) zi=zi+boxzsize
15131 do iint=1,nscp_gr(i)
15133 do j=iscpstart(i,iint),iscpend(i,iint)
15135 if (itypj.eq.ntyp1) cycle
15136 ! Uncomment following three lines for SC-p interactions
15137 ! xj=c(1,nres+j)-xi
15138 ! yj=c(2,nres+j)-yi
15139 ! zj=c(3,nres+j)-zi
15140 ! Uncomment following three lines for Ca-p interactions
15144 xj=mod(xj,boxxsize)
15145 if (xj.lt.0) xj=xj+boxxsize
15146 yj=mod(yj,boxysize)
15147 if (yj.lt.0) yj=yj+boxysize
15148 zj=mod(zj,boxzsize)
15149 if (zj.lt.0) zj=zj+boxzsize
15150 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15158 xj=xj_safe+xshift*boxxsize
15159 yj=yj_safe+yshift*boxysize
15160 zj=zj_safe+zshift*boxzsize
15161 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15162 if(dist_temp.lt.dist_init) then
15163 dist_init=dist_temp
15172 if (subchap.eq.1) then
15181 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15183 rij=dsqrt(1.0d0/rrij)
15184 sss_ele_cut=sscale_ele(rij)
15185 sss_ele_grad=sscagrad_ele(rij)
15186 ! print *,sss_ele_cut,sss_ele_grad,&
15187 ! (rij),r_cut_ele,rlamb_ele
15188 if (sss_ele_cut.le.0.0) cycle
15189 sss=sscale((rij/rscp(itypj,iteli)))
15190 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
15191 if (sss.lt.1.0d0) then
15194 e1=fac*fac*aad(itypj,iteli)
15195 e2=fac*bad(itypj,iteli)
15196 if (iabs(j-i) .le. 2) then
15199 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)*sss_ele_cut
15202 evdw2=evdw2+evdwij*(1.0d0-sss)*sss_ele_cut
15203 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15204 'evdw2',i,j,sss,evdwij
15206 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15208 fac=-(evdwij+e1)*rrij*(1.0d0-sss)*sss_ele_cut
15209 fac=fac+evdwij*sss_ele_grad/rij/expon*(1.0d0-sss)&
15210 -evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15214 ! Uncomment following three lines for SC-p interactions
15216 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15218 ! Uncomment following line for SC-p interactions
15219 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15221 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15222 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15231 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15232 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15233 gradx_scp(j,i)=expon*gradx_scp(j,i)
15236 !******************************************************************************
15240 ! To save time the factor EXPON has been extracted from ALL components
15241 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15244 !******************************************************************************
15246 end subroutine escp_long
15247 !-----------------------------------------------------------------------------
15248 subroutine escp_short(evdw2,evdw2_14)
15250 ! This subroutine calculates the excluded-volume interaction energy between
15251 ! peptide-group centers and side chains and its gradient in virtual-bond and
15252 ! side-chain vectors.
15254 ! implicit real*8 (a-h,o-z)
15255 ! include 'DIMENSIONS'
15256 ! include 'COMMON.GEO'
15257 ! include 'COMMON.VAR'
15258 ! include 'COMMON.LOCAL'
15259 ! include 'COMMON.CHAIN'
15260 ! include 'COMMON.DERIV'
15261 ! include 'COMMON.INTERACT'
15262 ! include 'COMMON.FFIELD'
15263 ! include 'COMMON.IOUNITS'
15264 ! include 'COMMON.CONTROL'
15265 real(kind=8),dimension(3) :: ggg
15266 !el local variables
15267 integer :: i,iint,j,k,iteli,itypj,subchap
15268 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
15269 real(kind=8) :: evdw2,evdw2_14,evdwij
15270 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15271 dist_temp, dist_init
15275 !d print '(a)','Enter ESCP'
15276 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
15277 do i=iatscp_s,iatscp_e
15278 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
15280 xi=0.5D0*(c(1,i)+c(1,i+1))
15281 yi=0.5D0*(c(2,i)+c(2,i+1))
15282 zi=0.5D0*(c(3,i)+c(3,i+1))
15283 xi=mod(xi,boxxsize)
15284 if (xi.lt.0) xi=xi+boxxsize
15285 yi=mod(yi,boxysize)
15286 if (yi.lt.0) yi=yi+boxysize
15287 zi=mod(zi,boxzsize)
15288 if (zi.lt.0) zi=zi+boxzsize
15290 do iint=1,nscp_gr(i)
15292 do j=iscpstart(i,iint),iscpend(i,iint)
15294 if (itypj.eq.ntyp1) cycle
15295 ! Uncomment following three lines for SC-p interactions
15296 ! xj=c(1,nres+j)-xi
15297 ! yj=c(2,nres+j)-yi
15298 ! zj=c(3,nres+j)-zi
15299 ! Uncomment following three lines for Ca-p interactions
15306 xj=mod(xj,boxxsize)
15307 if (xj.lt.0) xj=xj+boxxsize
15308 yj=mod(yj,boxysize)
15309 if (yj.lt.0) yj=yj+boxysize
15310 zj=mod(zj,boxzsize)
15311 if (zj.lt.0) zj=zj+boxzsize
15312 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15320 xj=xj_safe+xshift*boxxsize
15321 yj=yj_safe+yshift*boxysize
15322 zj=zj_safe+zshift*boxzsize
15323 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15324 if(dist_temp.lt.dist_init) then
15325 dist_init=dist_temp
15334 if (subchap.eq.1) then
15344 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15345 rij=dsqrt(1.0d0/rrij)
15346 sss_ele_cut=sscale_ele(rij)
15347 sss_ele_grad=sscagrad_ele(rij)
15348 ! print *,sss_ele_cut,sss_ele_grad,&
15349 ! (rij),r_cut_ele,rlamb_ele
15350 if (sss_ele_cut.le.0.0) cycle
15351 sss=sscale(rij/rscp(itypj,iteli))
15352 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
15353 if (sss.gt.0.0d0) then
15356 e1=fac*fac*aad(itypj,iteli)
15357 e2=fac*bad(itypj,iteli)
15358 if (iabs(j-i) .le. 2) then
15361 evdw2_14=evdw2_14+(e1+e2)*sss*sss_ele_cut
15364 evdw2=evdw2+evdwij*sss*sss_ele_cut
15365 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15366 'evdw2',i,j,sss,evdwij
15368 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15370 fac=-(evdwij+e1)*rrij*sss*sss_ele_cut
15371 fac=fac+evdwij*sss_ele_grad/rij/expon*sss &
15372 +evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15377 ! Uncomment following three lines for SC-p interactions
15379 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15381 ! Uncomment following line for SC-p interactions
15382 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15384 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15385 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15394 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15395 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15396 gradx_scp(j,i)=expon*gradx_scp(j,i)
15399 !******************************************************************************
15403 ! To save time the factor EXPON has been extracted from ALL components
15404 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15407 !******************************************************************************
15409 end subroutine escp_short
15410 !-----------------------------------------------------------------------------
15411 ! energy_p_new-sep_barrier.F
15412 !-----------------------------------------------------------------------------
15413 subroutine sc_grad_scale(scalfac)
15414 ! implicit real*8 (a-h,o-z)
15416 ! include 'DIMENSIONS'
15417 ! include 'COMMON.CHAIN'
15418 ! include 'COMMON.DERIV'
15419 ! include 'COMMON.CALC'
15420 ! include 'COMMON.IOUNITS'
15421 real(kind=8),dimension(3) :: dcosom1,dcosom2
15422 real(kind=8) :: scalfac
15423 !el local variables
15424 ! integer :: i,j,k,l
15426 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
15427 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
15428 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
15429 -2.0D0*alf12*eps3der+sigder*sigsq_om12
15433 ! eom12=evdwij*eps1_om12
15435 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
15436 ! & " sigder",sigder
15437 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
15438 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
15440 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
15441 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
15444 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac&
15447 ! write (iout,*) "gg",(gg(k),k=1,3)
15449 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
15450 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
15451 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
15453 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
15454 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
15455 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac&
15457 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
15458 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
15459 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
15460 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
15463 ! Calculate the components of the gradient in DC and X
15466 gvdwc(l,i)=gvdwc(l,i)-gg(l)
15467 gvdwc(l,j)=gvdwc(l,j)+gg(l)
15470 end subroutine sc_grad_scale
15471 !-----------------------------------------------------------------------------
15472 ! energy_split-sep.F
15473 !-----------------------------------------------------------------------------
15474 subroutine etotal_long(energia)
15476 ! Compute the long-range slow-varying contributions to the energy
15478 ! implicit real*8 (a-h,o-z)
15479 ! include 'DIMENSIONS'
15480 use MD_data, only: totT,usampl,eq_time
15484 !MS$ATTRIBUTES C :: proc_proc
15489 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
15491 ! include 'COMMON.SETUP'
15492 ! include 'COMMON.IOUNITS'
15493 ! include 'COMMON.FFIELD'
15494 ! include 'COMMON.DERIV'
15495 ! include 'COMMON.INTERACT'
15496 ! include 'COMMON.SBRIDGE'
15497 ! include 'COMMON.CHAIN'
15498 ! include 'COMMON.VAR'
15499 ! include 'COMMON.LOCAL'
15500 ! include 'COMMON.MD'
15501 real(kind=8),dimension(0:n_ene) :: energia
15502 !el local variables
15503 integer :: i,n_corr,n_corr1,ierror,ierr
15504 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
15505 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
15506 ecorr,ecorr5,ecorr6,eturn6,time00
15507 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
15508 !elwrite(iout,*)"in etotal long"
15510 if (modecalc.eq.12.or.modecalc.eq.14) then
15512 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
15514 call int_from_cart1(.false.)
15517 !elwrite(iout,*)"in etotal long"
15520 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
15521 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15523 if (nfgtasks.gt.1) then
15525 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15526 if (fg_rank.eq.0) then
15527 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
15528 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15530 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15531 ! FG slaves as WEIGHTS array.
15538 weights_(7)=wel_loc
15541 weights_(10)=wturn6
15543 weights_(12)=wscloc
15545 weights_(14)=wtor_d
15546 weights_(15)=wstrain
15547 weights_(16)=wvdwpp
15549 weights_(18)=scal14
15550 weights_(21)=wsccor
15551 ! FG Master broadcasts the WEIGHTS_ array
15552 call MPI_Bcast(weights_(1),n_ene,&
15553 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15555 ! FG slaves receive the WEIGHTS array
15556 call MPI_Bcast(weights(1),n_ene,&
15557 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15572 wstrain=weights(15)
15578 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
15580 time_Bcast=time_Bcast+MPI_Wtime()-time00
15581 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
15582 ! call chainbuild_cart
15583 ! call int_from_cart1(.false.)
15585 ! write (iout,*) 'Processor',myrank,
15586 ! & ' calling etotal_short ipot=',ipot
15588 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15590 !d print *,'nnt=',nnt,' nct=',nct
15592 !elwrite(iout,*)"in etotal long"
15593 ! Compute the side-chain and electrostatic interaction energy
15595 goto (101,102,103,104,105,106) ipot
15596 ! Lennard-Jones potential.
15597 101 call elj_long(evdw)
15598 !d print '(a)','Exit ELJ'
15600 ! Lennard-Jones-Kihara potential (shifted).
15601 102 call eljk_long(evdw)
15603 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15604 103 call ebp_long(evdw)
15606 ! Gay-Berne potential (shifted LJ, angular dependence).
15607 104 call egb_long(evdw)
15609 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15610 105 call egbv_long(evdw)
15612 ! Soft-sphere potential
15613 106 call e_softsphere(evdw)
15615 ! Calculate electrostatic (H-bonding) energy of the main chain.
15619 if (ipot.lt.6) then
15621 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
15622 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15623 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15624 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15626 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
15627 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15628 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15629 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15631 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
15640 ! write (iout,*) "Soft-spheer ELEC potential"
15641 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
15645 ! Calculate excluded-volume interaction energy between peptide groups
15648 if (ipot.lt.6) then
15649 if(wscp.gt.0d0) then
15650 call escp_long(evdw2,evdw2_14)
15656 call escp_soft_sphere(evdw2,evdw2_14)
15659 ! 12/1/95 Multi-body terms
15663 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
15664 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
15665 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
15666 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
15667 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
15674 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
15675 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
15678 ! If performing constraint dynamics, call the constraint energy
15679 ! after the equilibration time
15680 if(usampl.and.totT.gt.eq_time) then
15695 energia(2)=evdw2-evdw2_14
15696 energia(18)=evdw2_14
15705 energia(3)=ees+evdw1
15712 energia(8)=eello_turn3
15713 energia(9)=eello_turn4
15715 energia(20)=Uconst+Uconst_back
15716 call sum_energy(energia,.true.)
15717 ! write (iout,*) "Exit ETOTAL_LONG"
15720 end subroutine etotal_long
15721 !-----------------------------------------------------------------------------
15722 subroutine etotal_short(energia)
15724 ! Compute the short-range fast-varying contributions to the energy
15726 ! implicit real*8 (a-h,o-z)
15727 ! include 'DIMENSIONS'
15731 !MS$ATTRIBUTES C :: proc_proc
15736 integer :: ierror,ierr
15737 real(kind=8),dimension(n_ene) :: weights_
15738 real(kind=8) :: time00
15740 ! include 'COMMON.SETUP'
15741 ! include 'COMMON.IOUNITS'
15742 ! include 'COMMON.FFIELD'
15743 ! include 'COMMON.DERIV'
15744 ! include 'COMMON.INTERACT'
15745 ! include 'COMMON.SBRIDGE'
15746 ! include 'COMMON.CHAIN'
15747 ! include 'COMMON.VAR'
15748 ! include 'COMMON.LOCAL'
15749 real(kind=8),dimension(0:n_ene) :: energia
15750 !el local variables
15752 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
15753 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr
15756 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
15758 if (modecalc.eq.12.or.modecalc.eq.14) then
15760 if (fg_rank.eq.0) call int_from_cart1(.false.)
15762 call int_from_cart1(.false.)
15766 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
15767 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15769 if (nfgtasks.gt.1) then
15771 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15772 if (fg_rank.eq.0) then
15773 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
15774 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15776 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15777 ! FG slaves as WEIGHTS array.
15784 weights_(7)=wel_loc
15787 weights_(10)=wturn6
15789 weights_(12)=wscloc
15791 weights_(14)=wtor_d
15792 weights_(15)=wstrain
15793 weights_(16)=wvdwpp
15795 weights_(18)=scal14
15796 weights_(21)=wsccor
15797 ! FG Master broadcasts the WEIGHTS_ array
15798 call MPI_Bcast(weights_(1),n_ene,&
15799 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15801 ! FG slaves receive the WEIGHTS array
15802 call MPI_Bcast(weights(1),n_ene,&
15803 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15818 wstrain=weights(15)
15824 ! write (iout,*),"Processor",myrank," BROADCAST weights"
15825 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
15827 ! write (iout,*) "Processor",myrank," BROADCAST c"
15828 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
15830 ! write (iout,*) "Processor",myrank," BROADCAST dc"
15831 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
15833 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
15834 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
15836 ! write (iout,*) "Processor",myrank," BROADCAST theta"
15837 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
15839 ! write (iout,*) "Processor",myrank," BROADCAST phi"
15840 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
15842 ! write (iout,*) "Processor",myrank," BROADCAST alph"
15843 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
15845 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
15846 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
15848 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
15849 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
15851 time_Bcast=time_Bcast+MPI_Wtime()-time00
15852 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
15854 ! write (iout,*) 'Processor',myrank,
15855 ! & ' calling etotal_short ipot=',ipot
15857 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15859 ! call int_from_cart1(.false.)
15861 ! Compute the side-chain and electrostatic interaction energy
15863 goto (101,102,103,104,105,106) ipot
15864 ! Lennard-Jones potential.
15865 101 call elj_short(evdw)
15866 !d print '(a)','Exit ELJ'
15868 ! Lennard-Jones-Kihara potential (shifted).
15869 102 call eljk_short(evdw)
15871 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15872 103 call ebp_short(evdw)
15874 ! Gay-Berne potential (shifted LJ, angular dependence).
15875 104 call egb_short(evdw)
15877 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15878 105 call egbv_short(evdw)
15880 ! Soft-sphere potential - already dealt with in the long-range part
15882 ! 106 call e_softsphere_short(evdw)
15884 ! Calculate electrostatic (H-bonding) energy of the main chain.
15888 ! Calculate the short-range part of Evdwpp
15890 call evdwpp_short(evdw1)
15892 ! Calculate the short-range part of ESCp
15894 if (ipot.lt.6) then
15895 call escp_short(evdw2,evdw2_14)
15898 ! Calculate the bond-stretching energy
15902 ! Calculate the disulfide-bridge and other energy and the contributions
15903 ! from other distance constraints.
15906 ! Calculate the virtual-bond-angle energy.
15908 call ebend(ebe,ethetacnstr)
15910 ! Calculate the SC local energy.
15915 ! Calculate the virtual-bond torsional energy.
15917 call etor(etors,edihcnstr)
15919 ! 6/23/01 Calculate double-torsional energy
15921 call etor_d(etors_d)
15923 ! 21/5/07 Calculate local sicdechain correlation energy
15925 if (wsccor.gt.0.0d0) then
15926 call eback_sc_corr(esccor)
15931 ! Put energy components into an array
15938 energia(2)=evdw2-evdw2_14
15939 energia(18)=evdw2_14
15952 energia(14)=etors_d
15955 energia(19)=edihcnstr
15957 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
15959 call sum_energy(energia,.true.)
15960 ! write (iout,*) "Exit ETOTAL_SHORT"
15963 end subroutine etotal_short
15964 !-----------------------------------------------------------------------------
15966 !-----------------------------------------------------------------------------
15967 real(kind=8) function gnmr1(y,ymin,ymax)
15969 real(kind=8) :: y,ymin,ymax
15970 real(kind=8) :: wykl=4.0d0
15971 if (y.lt.ymin) then
15972 gnmr1=(ymin-y)**wykl/wykl
15973 else if (y.gt.ymax) then
15974 gnmr1=(y-ymax)**wykl/wykl
15980 !-----------------------------------------------------------------------------
15981 real(kind=8) function gnmr1prim(y,ymin,ymax)
15983 real(kind=8) :: y,ymin,ymax
15984 real(kind=8) :: wykl=4.0d0
15985 if (y.lt.ymin) then
15986 gnmr1prim=-(ymin-y)**(wykl-1)
15987 else if (y.gt.ymax) then
15988 gnmr1prim=(y-ymax)**(wykl-1)
15993 end function gnmr1prim
15994 !----------------------------------------------------------------------------
15995 real(kind=8) function rlornmr1(y,ymin,ymax,sigma)
15996 real(kind=8) y,ymin,ymax,sigma
15997 real(kind=8) wykl /4.0d0/
15998 if (y.lt.ymin) then
15999 rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl)
16000 else if (y.gt.ymax) then
16001 rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
16006 end function rlornmr1
16007 !------------------------------------------------------------------------------
16008 real(kind=8) function rlornmr1prim(y,ymin,ymax,sigma)
16009 real(kind=8) y,ymin,ymax,sigma
16010 real(kind=8) wykl /4.0d0/
16011 if (y.lt.ymin) then
16012 rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ &
16013 ((ymin-y)**wykl+sigma**wykl)**2
16014 else if (y.gt.ymax) then
16015 rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ &
16016 ((y-ymax)**wykl+sigma**wykl)**2
16021 end function rlornmr1prim
16023 real(kind=8) function harmonic(y,ymax)
16025 real(kind=8) :: y,ymax
16026 real(kind=8) :: wykl=2.0d0
16027 harmonic=(y-ymax)**wykl
16029 end function harmonic
16030 !-----------------------------------------------------------------------------
16031 real(kind=8) function harmonicprim(y,ymax)
16032 real(kind=8) :: y,ymin,ymax
16033 real(kind=8) :: wykl=2.0d0
16034 harmonicprim=(y-ymax)*wykl
16036 end function harmonicprim
16037 !-----------------------------------------------------------------------------
16039 !-----------------------------------------------------------------------------
16040 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
16042 use io_base, only:intout,briefout
16043 ! implicit real*8 (a-h,o-z)
16044 ! include 'DIMENSIONS'
16045 ! include 'COMMON.CHAIN'
16046 ! include 'COMMON.DERIV'
16047 ! include 'COMMON.VAR'
16048 ! include 'COMMON.INTERACT'
16049 ! include 'COMMON.FFIELD'
16050 ! include 'COMMON.MD'
16051 ! include 'COMMON.IOUNITS'
16052 real(kind=8),external :: ufparm
16053 integer :: uiparm(1)
16054 real(kind=8) :: urparm(1)
16055 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
16056 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
16057 integer :: n,nf,ind,ind1,i,k,j
16059 ! This subroutine calculates total internal coordinate gradient.
16060 ! Depending on the number of function evaluations, either whole energy
16061 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
16062 ! internal coordinates are reevaluated or only the cartesian-in-internal
16063 ! coordinate derivatives are evaluated. The subroutine was designed to work
16069 !d print *,'grad',nf,icg
16070 if (nf-nfl+1) 20,30,40
16071 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
16072 ! write (iout,*) 'grad 20'
16073 if (nf.eq.0) return
16075 30 call var_to_geom(n,x)
16077 ! write (iout,*) 'grad 30'
16079 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
16082 ! write (iout,*) 'grad 40'
16083 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
16085 ! Convert the Cartesian gradient into internal-coordinate gradient.
16095 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
16097 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
16100 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
16106 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
16108 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
16109 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
16112 if (i.gt.1) g(i-1)=gphii
16113 if (n.gt.nphi) g(nphi+i)=gthetai
16115 if (n.le.nphi+ntheta) goto 10
16117 if (itype(i,1).ne.10) then
16121 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
16124 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
16126 g(ialph(i,1))=galphai
16127 g(ialph(i,1)+nside)=gomegai
16131 ! Add the components corresponding to local energy terms.
16135 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
16136 g(i)=g(i)+gloc(i,icg)
16138 ! Uncomment following three lines for diagnostics.
16140 !elwrite(iout,*) "in gradient after calling intout"
16141 !d call briefout(0,0.0d0)
16142 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
16144 end subroutine gradient
16145 !-----------------------------------------------------------------------------
16146 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
16149 ! implicit real*8 (a-h,o-z)
16150 ! include 'DIMENSIONS'
16151 ! include 'COMMON.DERIV'
16152 ! include 'COMMON.IOUNITS'
16153 ! include 'COMMON.GEO'
16156 !el common /chuju/ jjj
16157 real(kind=8) :: energia(0:n_ene)
16158 integer :: uiparm(1)
16159 real(kind=8) :: urparm(1)
16161 real(kind=8),external :: ufparm
16162 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
16163 ! if (jjj.gt.0) then
16164 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
16168 !d print *,'func',nf,nfl,icg
16169 call var_to_geom(n,x)
16172 !d write (iout,*) 'ETOTAL called from FUNC'
16173 call etotal(energia)
16176 ! if (jjj.gt.0) then
16177 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
16178 ! write (iout,*) 'f=',etot
16182 end subroutine func
16183 !-----------------------------------------------------------------------------
16184 subroutine cartgrad
16185 ! implicit real*8 (a-h,o-z)
16186 ! include 'DIMENSIONS'
16188 use MD_data, only: totT,usampl,eq_time
16192 ! include 'COMMON.CHAIN'
16193 ! include 'COMMON.DERIV'
16194 ! include 'COMMON.VAR'
16195 ! include 'COMMON.INTERACT'
16196 ! include 'COMMON.FFIELD'
16197 ! include 'COMMON.MD'
16198 ! include 'COMMON.IOUNITS'
16199 ! include 'COMMON.TIME1'
16203 ! This subrouting calculates total Cartesian coordinate gradient.
16204 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
16214 !el write (iout,*) "After sum_gradient"
16216 !el write (iout,*) "After sum_gradient"
16218 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
16219 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
16222 ! If performing constraint dynamics, add the gradients of the constraint energy
16223 if(usampl.and.totT.gt.eq_time) then
16226 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
16227 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
16231 gloc(i,icg)=gloc(i,icg)+dugamma(i)
16234 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
16237 !elwrite (iout,*) "After sum_gradient"
16242 !elwrite (iout,*) "After sum_gradient"
16244 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
16246 ! call checkintcartgrad
16247 ! write(iout,*) 'calling int_to_cart'
16249 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
16253 gcart(j,i)=gradc(j,i,icg)
16254 gxcart(j,i)=gradx(j,i,icg)
16255 ! if (i.le.2) print *,"gcart_one",gcart(j,i),gradc(j,i,icg)
16258 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
16259 (gxcart(j,i),j=1,3),gloc(i,icg)
16265 ! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
16267 ! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
16270 time_inttocart=time_inttocart+MPI_Wtime()-time01
16273 write (iout,*) "gcart and gxcart after int_to_cart"
16275 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
16276 (gxcart(j,i),j=1,3)
16281 write (iout,*) "CARGRAD"
16285 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
16286 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
16288 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
16289 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
16291 ! Correction: dummy residues
16294 ! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
16295 gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
16298 if (nct.lt.nres) then
16300 ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
16301 gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
16306 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
16310 end subroutine cartgrad
16311 !-----------------------------------------------------------------------------
16312 subroutine zerograd
16313 ! implicit real*8 (a-h,o-z)
16314 ! include 'DIMENSIONS'
16315 ! include 'COMMON.DERIV'
16316 ! include 'COMMON.CHAIN'
16317 ! include 'COMMON.VAR'
16318 ! include 'COMMON.MD'
16319 ! include 'COMMON.SCCOR'
16321 !el local variables
16322 integer :: i,j,intertyp,k
16323 ! Initialize Cartesian-coordinate gradient
16325 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
16326 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
16328 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
16329 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
16330 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
16331 ! allocate(gradcorr_long(3,nres))
16332 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
16333 ! allocate(gcorr6_turn_long(3,nres))
16334 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
16336 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
16338 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
16339 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
16341 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
16342 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
16344 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
16345 ! allocate(gscloc(3,nres)) !(3,maxres)
16346 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
16350 ! common /deriv_scloc/
16351 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
16352 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
16353 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
16355 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
16359 ! gradc(j,i,icg)=0.0d0
16360 ! gradx(j,i,icg)=0.0d0
16362 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
16363 !elwrite(iout,*) "icg",icg
16367 gradx_scp(j,i)=0.0D0
16369 gvdwc_scp(j,i)=0.0D0
16370 gvdwc_scpp(j,i)=0.0d0
16372 gelc_long(j,i)=0.0D0
16377 gel_loc_long(j,i)=0.0d0
16380 gcorr3_turn(j,i)=0.0d0
16381 gcorr4_turn(j,i)=0.0d0
16382 gradcorr(j,i)=0.0d0
16383 gradcorr_long(j,i)=0.0d0
16384 gradcorr5_long(j,i)=0.0d0
16385 gradcorr6_long(j,i)=0.0d0
16386 gcorr6_turn_long(j,i)=0.0d0
16387 gradcorr5(j,i)=0.0d0
16388 gradcorr6(j,i)=0.0d0
16389 gcorr6_turn(j,i)=0.0d0
16392 gradc(j,i,icg)=0.0d0
16393 gradx(j,i,icg)=0.0d0
16396 gliptran(j,i)=0.0d0
16397 gliptranx(j,i)=0.0d0
16398 gliptranc(j,i)=0.0d0
16399 gshieldx(j,i)=0.0d0
16400 gshieldc(j,i)=0.0d0
16401 gshieldc_loc(j,i)=0.0d0
16402 gshieldx_ec(j,i)=0.0d0
16403 gshieldc_ec(j,i)=0.0d0
16404 gshieldc_loc_ec(j,i)=0.0d0
16405 gshieldx_t3(j,i)=0.0d0
16406 gshieldc_t3(j,i)=0.0d0
16407 gshieldc_loc_t3(j,i)=0.0d0
16408 gshieldx_t4(j,i)=0.0d0
16409 gshieldc_t4(j,i)=0.0d0
16410 gshieldc_loc_t4(j,i)=0.0d0
16411 gshieldx_ll(j,i)=0.0d0
16412 gshieldc_ll(j,i)=0.0d0
16413 gshieldc_loc_ll(j,i)=0.0d0
16415 gg_tube_sc(j,i)=0.0d0
16417 gradb_nucl(j,i)=0.0d0
16418 gradbx_nucl(j,i)=0.0d0
16419 gvdwpp_nucl(j,i)=0.0d0
16423 gvdwpsb1(j,i)=0.0d0
16427 gradcorr_nucl(j,i)=0.0d0
16428 gradcorr3_nucl(j,i)=0.0d0
16429 gradxorr_nucl(j,i)=0.0d0
16430 gradxorr3_nucl(j,i)=0.0d0
16434 gradpepcat(j,i)=0.0d0
16435 gradpepcatx(j,i)=0.0d0
16436 gradcatcat(j,i)=0.0d0
16437 gvdwx_scbase(j,i)=0.0d0
16438 gvdwc_scbase(j,i)=0.0d0
16439 gvdwx_pepbase(j,i)=0.0d0
16440 gvdwc_pepbase(j,i)=0.0d0
16441 gvdwx_scpho(j,i)=0.0d0
16442 gvdwc_scpho(j,i)=0.0d0
16443 gvdwc_peppho(j,i)=0.0d0
16449 gloc_sc(intertyp,i,icg)=0.0d0
16458 grad_shield_side(k,j,i)=0.0d0
16459 grad_shield_loc(k,j,i)=0.0d0
16466 ! Initialize the gradient of local energy terms.
16468 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
16469 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
16470 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
16471 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
16472 ! allocate(gel_loc_turn3(nres))
16473 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
16474 ! allocate(gsccor_loc(nres)) !(maxres)
16480 gel_loc_loc(i)=0.0d0
16482 g_corr5_loc(i)=0.0d0
16483 g_corr6_loc(i)=0.0d0
16484 gel_loc_turn3(i)=0.0d0
16485 gel_loc_turn4(i)=0.0d0
16486 gel_loc_turn6(i)=0.0d0
16487 gsccor_loc(i)=0.0d0
16489 ! initialize gcart and gxcart
16490 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
16498 end subroutine zerograd
16499 !-----------------------------------------------------------------------------
16500 real(kind=8) function fdum()
16504 !-----------------------------------------------------------------------------
16506 !-----------------------------------------------------------------------------
16507 subroutine intcartderiv
16508 ! implicit real*8 (a-h,o-z)
16509 ! include 'DIMENSIONS'
16513 ! include 'COMMON.SETUP'
16514 ! include 'COMMON.CHAIN'
16515 ! include 'COMMON.VAR'
16516 ! include 'COMMON.GEO'
16517 ! include 'COMMON.INTERACT'
16518 ! include 'COMMON.DERIV'
16519 ! include 'COMMON.IOUNITS'
16520 ! include 'COMMON.LOCAL'
16521 ! include 'COMMON.SCCOR'
16522 real(kind=8) :: pi4,pi34
16523 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
16524 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
16525 dcosomega,dsinomega !(3,3,maxres)
16526 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
16529 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
16530 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
16531 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
16532 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
16536 !el from module energy-------------
16537 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
16538 !el allocate(dsintau(3,3,3,itau_start:itau_end))
16539 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
16541 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
16542 !el allocate(dsintau(3,3,3,0:nres2))
16543 !el allocate(dtauangle(3,3,3,0:nres2))
16544 !el allocate(domicron(3,2,2,0:nres2))
16545 !el allocate(dcosomicron(3,2,2,0:nres2))
16549 #if defined(MPI) && defined(PARINTDER)
16550 if (nfgtasks.gt.1 .and. me.eq.king) &
16551 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
16556 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
16557 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
16559 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
16562 dtheta(j,1,i)=0.0d0
16563 dtheta(j,2,i)=0.0d0
16569 ! Derivatives of theta's
16570 #if defined(MPI) && defined(PARINTDER)
16571 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16572 do i=max0(ithet_start-1,3),ithet_end
16576 cost=dcos(theta(i))
16577 sint=sqrt(1-cost*cost)
16579 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
16581 if (itype(i-1,1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
16582 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
16584 if (itype(i-1,1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
16587 #if defined(MPI) && defined(PARINTDER)
16588 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16589 do i=max0(ithet_start-1,3),ithet_end
16593 if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1)) then
16594 cost1=dcos(omicron(1,i))
16595 sint1=sqrt(1-cost1*cost1)
16596 cost2=dcos(omicron(2,i))
16597 sint2=sqrt(1-cost2*cost2)
16599 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
16600 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
16601 cost1*dc_norm(j,i-2))/ &
16603 domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i)
16604 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
16605 +cost1*(dc_norm(j,i-1+nres)))/ &
16607 domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i)
16608 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
16609 !C Looks messy but better than if in loop
16610 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
16611 +cost2*dc_norm(j,i-1))/ &
16613 domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i)
16614 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
16615 +cost2*(-dc_norm(j,i-1+nres)))/ &
16617 ! write(iout,*) "vbld", i,itype(i,1),vbld(i-1+nres)
16618 domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i)
16622 !elwrite(iout,*) "after vbld write"
16623 ! Derivatives of phi:
16624 ! If phi is 0 or 180 degrees, then the formulas
16625 ! have to be derived by power series expansion of the
16626 ! conventional formulas around 0 and 180.
16628 do i=iphi1_start,iphi1_end
16632 ! if (itype(i-1,1).eq.21 .or. itype(i-2,1).eq.21 ) cycle
16633 ! the conventional case
16634 sint=dsin(theta(i))
16635 sint1=dsin(theta(i-1))
16637 cost=dcos(theta(i))
16638 cost1=dcos(theta(i-1))
16640 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
16641 fac0=1.0d0/(sint1*sint)
16644 fac3=cosg*cost1/(sint1*sint1)
16645 fac4=cosg*cost/(sint*sint)
16646 ! Obtaining the gamma derivatives from sine derivative
16647 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
16648 phi(i).gt.pi34.and.phi(i).le.pi.or. &
16649 phi(i).ge.-pi.and.phi(i).le.-pi34) then
16650 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16651 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
16652 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16656 cosg_inv=1.0d0/cosg
16657 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
16658 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16659 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
16660 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
16662 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
16663 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16664 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
16665 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
16666 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16667 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16668 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
16670 ! Bug fixed 3/24/05 (AL)
16672 ! Obtaining the gamma derivatives from cosine derivative
16675 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
16676 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16677 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16678 dc_norm(j,i-3))/vbld(i-2)
16679 dphi(j,1,i)=-1/sing*dcosphi(j,1,i)
16680 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16681 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16683 dphi(j,2,i)=-1/sing*dcosphi(j,2,i)
16684 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16685 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16686 dc_norm(j,i-1))/vbld(i)
16687 dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
16692 !alculate derivative of Tauangle
16694 do i=itau_start,itau_end
16697 !elwrite(iout,*) " vecpr",i,nres
16699 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
16700 ! if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10).or.
16701 ! & (itype(i-1,1).eq.ntyp1).or.(itype(i,1).eq.ntyp1)) cycle
16702 !c dtauangle(j,intertyp,dervityp,residue number)
16703 !c INTERTYP=1 SC...Ca...Ca..Ca
16704 ! the conventional case
16705 sint=dsin(theta(i))
16706 sint1=dsin(omicron(2,i-1))
16707 sing=dsin(tauangle(1,i))
16708 cost=dcos(theta(i))
16709 cost1=dcos(omicron(2,i-1))
16710 cosg=dcos(tauangle(1,i))
16711 !elwrite(iout,*) " vecpr5",i,nres
16713 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
16714 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
16715 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16716 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
16718 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
16719 fac0=1.0d0/(sint1*sint)
16722 fac3=cosg*cost1/(sint1*sint1)
16723 fac4=cosg*cost/(sint*sint)
16724 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
16725 ! Obtaining the gamma derivatives from sine derivative
16726 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
16727 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
16728 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
16729 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16730 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
16731 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16735 cosg_inv=1.0d0/cosg
16736 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16737 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
16738 *vbld_inv(i-2+nres)
16739 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
16740 dsintau(j,1,2,i)= &
16741 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
16742 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16743 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
16744 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
16745 ! Bug fixed 3/24/05 (AL)
16746 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
16747 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16748 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16749 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
16751 ! Obtaining the gamma derivatives from cosine derivative
16754 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16755 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16756 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
16757 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
16758 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16759 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16761 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
16762 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16763 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
16764 dc_norm(j,i-1))/vbld(i)
16765 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
16766 ! write (iout,*) "else",i
16770 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
16773 !C Second case Ca...Ca...Ca...SC
16775 do i=itau_start,itau_end
16779 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
16780 (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle
16781 ! the conventional case
16782 sint=dsin(omicron(1,i))
16783 sint1=dsin(theta(i-1))
16784 sing=dsin(tauangle(2,i))
16785 cost=dcos(omicron(1,i))
16786 cost1=dcos(theta(i-1))
16787 cosg=dcos(tauangle(2,i))
16789 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16791 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
16792 fac0=1.0d0/(sint1*sint)
16795 fac3=cosg*cost1/(sint1*sint1)
16796 fac4=cosg*cost/(sint*sint)
16797 ! Obtaining the gamma derivatives from sine derivative
16798 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
16799 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
16800 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
16801 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
16802 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
16803 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16807 cosg_inv=1.0d0/cosg
16808 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16809 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
16810 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
16811 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
16812 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
16813 dsintau(j,2,2,i)= &
16814 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
16815 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16816 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
16817 ! & sing*ctgt*domicron(j,1,2,i),
16818 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16819 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
16820 ! Bug fixed 3/24/05 (AL)
16821 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16822 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
16823 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16824 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
16826 ! Obtaining the gamma derivatives from cosine derivative
16829 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16830 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16831 dc_norm(j,i-3))/vbld(i-2)
16832 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
16833 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16834 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16835 dcosomicron(j,1,1,i)
16836 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
16837 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16838 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16839 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16840 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
16841 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
16846 !CC third case SC...Ca...Ca...SC
16849 do i=itau_start,itau_end
16853 ! the conventional case
16854 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
16855 (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
16856 sint=dsin(omicron(1,i))
16857 sint1=dsin(omicron(2,i-1))
16858 sing=dsin(tauangle(3,i))
16859 cost=dcos(omicron(1,i))
16860 cost1=dcos(omicron(2,i-1))
16861 cosg=dcos(tauangle(3,i))
16863 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16864 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16866 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
16867 fac0=1.0d0/(sint1*sint)
16870 fac3=cosg*cost1/(sint1*sint1)
16871 fac4=cosg*cost/(sint*sint)
16872 ! Obtaining the gamma derivatives from sine derivative
16873 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
16874 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
16875 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
16876 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
16877 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
16878 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16882 cosg_inv=1.0d0/cosg
16883 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16884 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
16885 *vbld_inv(i-2+nres)
16886 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
16887 dsintau(j,3,2,i)= &
16888 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
16889 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16890 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
16891 ! Bug fixed 3/24/05 (AL)
16892 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16893 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
16894 *vbld_inv(i-1+nres)
16895 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16896 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
16898 ! Obtaining the gamma derivatives from cosine derivative
16901 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16902 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16903 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
16904 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
16905 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16906 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16907 dcosomicron(j,1,1,i)
16908 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
16909 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16910 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
16911 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16912 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
16913 ! write(iout,*) "else",i
16919 ! Derivatives of side-chain angles alpha and omega
16920 #if defined(MPI) && defined(PARINTDER)
16921 do i=ibond_start,ibond_end
16925 if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
16926 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
16929 fac8=fac5/vbld(i+1)
16930 fac9=fac5/vbld(i+nres)
16931 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
16932 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
16933 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
16934 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
16935 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
16936 sina=sqrt(1-cosa*cosa)
16938 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
16940 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
16941 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
16942 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
16943 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
16944 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
16945 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
16946 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
16947 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
16949 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
16951 ! obtaining the derivatives of omega from sines
16952 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
16953 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
16954 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
16955 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
16957 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
16958 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
16959 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
16960 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
16961 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
16962 coso_inv=1.0d0/dcos(omeg(i))
16964 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
16965 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
16966 (sino*dc_norm(j,i-1))/vbld(i)
16967 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
16968 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
16969 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
16970 -sino*dc_norm(j,i)/vbld(i+1)
16971 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
16972 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
16973 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
16975 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
16978 ! obtaining the derivatives of omega from cosines
16979 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
16980 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
16985 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
16986 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
16987 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
16988 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
16989 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
16990 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
16991 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
16992 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
16993 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
16994 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
16995 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
16996 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
16997 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
16998 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
16999 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
17005 dalpha(k,j,i)=0.0d0
17006 domega(k,j,i)=0.0d0
17012 #if defined(MPI) && defined(PARINTDER)
17013 if (nfgtasks.gt.1) then
17015 !d write (iout,*) "Gather dtheta"
17016 !d call flush(iout)
17017 write (iout,*) "dtheta before gather"
17019 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
17022 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
17023 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
17024 king,FG_COMM,IERROR)
17026 !d write (iout,*) "Gather dphi"
17027 !d call flush(iout)
17028 write (iout,*) "dphi before gather"
17030 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
17033 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
17034 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
17035 king,FG_COMM,IERROR)
17036 !d write (iout,*) "Gather dalpha"
17037 !d call flush(iout)
17039 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
17040 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
17041 king,FG_COMM,IERROR)
17042 !d write (iout,*) "Gather domega"
17043 !d call flush(iout)
17044 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
17045 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
17046 king,FG_COMM,IERROR)
17051 write (iout,*) "dtheta after gather"
17053 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
17055 write (iout,*) "dphi after gather"
17057 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
17059 write (iout,*) "dalpha after gather"
17061 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
17063 write (iout,*) "domega after gather"
17065 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
17069 end subroutine intcartderiv
17070 !-----------------------------------------------------------------------------
17071 subroutine checkintcartgrad
17072 ! implicit real*8 (a-h,o-z)
17073 ! include 'DIMENSIONS'
17077 ! include 'COMMON.CHAIN'
17078 ! include 'COMMON.VAR'
17079 ! include 'COMMON.GEO'
17080 ! include 'COMMON.INTERACT'
17081 ! include 'COMMON.DERIV'
17082 ! include 'COMMON.IOUNITS'
17083 ! include 'COMMON.SETUP'
17084 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
17085 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
17086 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
17087 real(kind=8),dimension(3) :: dc_norm_s
17088 real(kind=8) :: aincr=1.0d-5
17090 real(kind=8) :: dcji
17093 theta_s(i)=theta(i)
17097 ! Check theta gradient
17099 "Analytical (upper) and numerical (lower) gradient of theta"
17104 dc(j,i-2)=dcji+aincr
17105 call chainbuild_cart
17106 call int_from_cart1(.false.)
17107 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
17110 dc(j,i-1)=dc(j,i-1)+aincr
17111 call chainbuild_cart
17112 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
17115 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
17116 !el (dtheta(j,2,i),j=1,3)
17117 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
17118 !el (dthetanum(j,2,i),j=1,3)
17119 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
17120 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
17121 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
17124 ! Check gamma gradient
17126 "Analytical (upper) and numerical (lower) gradient of gamma"
17130 dc(j,i-3)=dcji+aincr
17131 call chainbuild_cart
17132 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
17135 dc(j,i-2)=dcji+aincr
17136 call chainbuild_cart
17137 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
17140 dc(j,i-1)=dc(j,i-1)+aincr
17141 call chainbuild_cart
17142 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
17145 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
17146 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
17147 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
17148 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
17149 !el write (iout,'(5x,3(3f10.5,5x))') &
17150 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
17151 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
17152 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
17155 ! Check alpha gradient
17157 "Analytical (upper) and numerical (lower) gradient of alpha"
17159 if(itype(i,1).ne.10) then
17162 dc(j,i-1)=dcji+aincr
17163 call chainbuild_cart
17164 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
17169 call chainbuild_cart
17170 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
17174 dc(j,i+nres)=dc(j,i+nres)+aincr
17175 call chainbuild_cart
17176 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
17181 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
17182 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
17183 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
17184 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
17185 !el write (iout,'(5x,3(3f10.5,5x))') &
17186 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
17187 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
17188 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
17191 ! Check omega gradient
17193 "Analytical (upper) and numerical (lower) gradient of omega"
17195 if(itype(i,1).ne.10) then
17198 dc(j,i-1)=dcji+aincr
17199 call chainbuild_cart
17200 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
17205 call chainbuild_cart
17206 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
17210 dc(j,i+nres)=dc(j,i+nres)+aincr
17211 call chainbuild_cart
17212 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
17217 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
17218 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
17219 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
17220 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
17221 !el write (iout,'(5x,3(3f10.5,5x))') &
17222 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
17223 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
17224 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
17228 end subroutine checkintcartgrad
17229 !-----------------------------------------------------------------------------
17231 !-----------------------------------------------------------------------------
17232 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
17233 ! implicit real*8 (a-h,o-z)
17234 ! include 'DIMENSIONS'
17235 ! include 'COMMON.IOUNITS'
17236 ! include 'COMMON.CHAIN'
17237 ! include 'COMMON.INTERACT'
17238 ! include 'COMMON.VAR'
17239 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
17240 integer :: kkk,nsep=3
17241 real(kind=8) :: qm !dist,
17242 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
17243 logical :: lprn=.false.
17245 ! real(kind=8) :: sigm,x
17247 !el sigm(x)=0.25d0*x ! local function
17253 do il=seg1+nsep,seg2
17256 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
17257 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
17258 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17260 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
17261 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17264 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17265 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17266 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17267 dijCM=dist(il+nres,jl+nres)
17268 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
17270 qq = qq+qqij+qqijCM
17276 if((seg3-il).lt.3) then
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
17302 if (qqmax.le.qq) qqmax=qq
17304 qwolynes=1.0d0-qqmax
17306 end function qwolynes
17307 !-----------------------------------------------------------------------------
17308 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
17309 ! implicit real*8 (a-h,o-z)
17310 ! include 'DIMENSIONS'
17311 ! include 'COMMON.IOUNITS'
17312 ! include 'COMMON.CHAIN'
17313 ! include 'COMMON.INTERACT'
17314 ! include 'COMMON.VAR'
17315 ! include 'COMMON.MD'
17316 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
17317 integer :: nsep=3, kkk
17318 !el real(kind=8) :: dist
17319 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
17320 logical :: lprn=.false.
17322 real(kind=8) :: sim,dd0,fac,ddqij
17323 !el sigm(x)=0.25d0*x ! local function
17333 do il=seg1+nsep,seg2
17336 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17337 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17338 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17340 sim = 1.0d0/sigm(d0ij)
17343 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
17345 ddqij = (c(k,il)-c(k,jl))*fac
17346 dqwol(k,il)=dqwol(k,il)+ddqij
17347 dqwol(k,jl)=dqwol(k,jl)-ddqij
17350 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17353 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17354 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17355 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17356 dijCM=dist(il+nres,jl+nres)
17357 sim = 1.0d0/sigm(d0ijCM)
17360 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17362 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17363 dxqwol(k,il)=dxqwol(k,il)+ddqij
17364 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17371 if((seg3-il).lt.3) then
17378 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17379 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17380 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17382 sim = 1.0d0/sigm(d0ij)
17385 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
17387 ddqij = (c(k,il)-c(k,jl))*fac
17388 dqwol(k,il)=dqwol(k,il)+ddqij
17389 dqwol(k,jl)=dqwol(k,jl)-ddqij
17391 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17394 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17395 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17396 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17397 dijCM=dist(il+nres,jl+nres)
17398 sim = 1.0d0/sigm(d0ijCM)
17401 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17403 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17404 dxqwol(k,il)=dxqwol(k,il)+ddqij
17405 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17414 dqwol(j,i)=dqwol(j,i)/nl
17415 dxqwol(j,i)=dxqwol(j,i)/nl
17419 end subroutine qwolynes_prim
17420 !-----------------------------------------------------------------------------
17421 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
17422 ! implicit real*8 (a-h,o-z)
17423 ! include 'DIMENSIONS'
17424 ! include 'COMMON.IOUNITS'
17425 ! include 'COMMON.CHAIN'
17426 ! include 'COMMON.INTERACT'
17427 ! include 'COMMON.VAR'
17428 integer :: seg1,seg2,seg3,seg4
17430 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
17431 real(kind=8),dimension(3,0:2*nres) :: cdummy
17432 real(kind=8) :: q1,q2
17433 real(kind=8) :: delta=1.0d-10
17438 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
17440 c(j,i)=c(j,i)+delta
17441 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
17442 qwolan(j,i)=(q2-q1)/delta
17448 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
17449 cdummy(j,i+nres)=c(j,i+nres)
17450 c(j,i+nres)=c(j,i+nres)+delta
17451 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
17452 qwolxan(j,i)=(q2-q1)/delta
17453 c(j,i+nres)=cdummy(j,i+nres)
17456 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
17458 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
17460 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
17462 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
17465 end subroutine qwol_num
17466 !-----------------------------------------------------------------------------
17467 subroutine EconstrQ
17468 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
17469 ! implicit real*8 (a-h,o-z)
17470 ! include 'DIMENSIONS'
17471 ! include 'COMMON.CONTROL'
17472 ! include 'COMMON.VAR'
17473 ! include 'COMMON.MD'
17476 ! include 'COMMON.LANGEVIN'
17478 ! include 'COMMON.LANGEVIN.lang0'
17480 ! include 'COMMON.CHAIN'
17481 ! include 'COMMON.DERIV'
17482 ! include 'COMMON.GEO'
17483 ! include 'COMMON.LOCAL'
17484 ! include 'COMMON.INTERACT'
17485 ! include 'COMMON.IOUNITS'
17486 ! include 'COMMON.NAMES'
17487 ! include 'COMMON.TIME1'
17488 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
17489 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
17491 integer :: kstart,kend,lstart,lend,idummy
17492 real(kind=8) :: delta=1.0d-7
17493 integer :: i,j,k,ii
17497 dudconst(j,i)=0.0d0
17498 duxconst(j,i)=0.0d0
17499 dudxconst(j,i)=0.0d0
17504 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
17506 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
17507 ! Calculating the derivatives of Constraint energy with respect to Q
17508 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
17510 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
17511 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
17512 ! hmnum=(hm2-hm1)/delta
17513 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
17514 ! & qinfrag(i,iset))
17515 ! write(iout,*) "harmonicnum frag", hmnum
17516 ! Calculating the derivatives of Q with respect to cartesian coordinates
17517 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
17519 ! write(iout,*) "dqwol "
17521 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17523 ! write(iout,*) "dxqwol "
17525 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17527 ! Calculating numerical gradients of dU/dQi and dQi/dxi
17528 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
17529 ! & ,idummy,idummy)
17530 ! The gradients of Uconst in Cs
17533 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
17534 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
17539 kstart=ifrag(1,ipair(1,i,iset),iset)
17540 kend=ifrag(2,ipair(1,i,iset),iset)
17541 lstart=ifrag(1,ipair(2,i,iset),iset)
17542 lend=ifrag(2,ipair(2,i,iset),iset)
17543 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
17544 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
17545 ! Calculating dU/dQ
17546 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
17547 ! hm1=harmonic(qpair(i),qinpair(i,iset))
17548 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
17549 ! hmnum=(hm2-hm1)/delta
17550 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
17551 ! & qinpair(i,iset))
17552 ! write(iout,*) "harmonicnum pair ", hmnum
17553 ! Calculating dQ/dXi
17554 call qwolynes_prim(kstart,kend,.false.,&
17556 ! write(iout,*) "dqwol "
17558 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17560 ! write(iout,*) "dxqwol "
17562 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17564 ! Calculating numerical gradients
17565 ! call qwol_num(kstart,kend,.false.
17567 ! The gradients of Uconst in Cs
17570 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
17571 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
17575 ! write(iout,*) "Uconst inside subroutine ", Uconst
17576 ! Transforming the gradients from Cs to dCs for the backbone
17580 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
17584 ! Transforming the gradients from Cs to dCs for the side chains
17587 dudxconst(j,i)=duxconst(j,i)
17590 ! write(iout,*) "dU/ddc backbone "
17592 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
17594 ! write(iout,*) "dU/ddX side chain "
17596 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
17598 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
17599 ! call dEconstrQ_num
17601 end subroutine EconstrQ
17602 !-----------------------------------------------------------------------------
17603 subroutine dEconstrQ_num
17604 ! Calculating numerical dUconst/ddc and dUconst/ddx
17605 ! implicit real*8 (a-h,o-z)
17606 ! include 'DIMENSIONS'
17607 ! include 'COMMON.CONTROL'
17608 ! include 'COMMON.VAR'
17609 ! include 'COMMON.MD'
17612 ! include 'COMMON.LANGEVIN'
17614 ! include 'COMMON.LANGEVIN.lang0'
17616 ! include 'COMMON.CHAIN'
17617 ! include 'COMMON.DERIV'
17618 ! include 'COMMON.GEO'
17619 ! include 'COMMON.LOCAL'
17620 ! include 'COMMON.INTERACT'
17621 ! include 'COMMON.IOUNITS'
17622 ! include 'COMMON.NAMES'
17623 ! include 'COMMON.TIME1'
17624 real(kind=8) :: uzap1,uzap2
17625 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
17626 integer :: kstart,kend,lstart,lend,idummy
17627 real(kind=8) :: delta=1.0d-7
17628 !el local variables
17634 dUcartan(j,i)=0.0d0
17635 cdummy(j,i)=dc(j,i)
17636 dc(j,i)=dc(j,i)+delta
17637 call chainbuild_cart
17640 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17642 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17646 kstart=ifrag(1,ipair(1,ii,iset),iset)
17647 kend=ifrag(2,ipair(1,ii,iset),iset)
17648 lstart=ifrag(1,ipair(2,ii,iset),iset)
17649 lend=ifrag(2,ipair(2,ii,iset),iset)
17650 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17651 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17654 dc(j,i)=cdummy(j,i)
17655 call chainbuild_cart
17658 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17660 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17664 kstart=ifrag(1,ipair(1,ii,iset),iset)
17665 kend=ifrag(2,ipair(1,ii,iset),iset)
17666 lstart=ifrag(1,ipair(2,ii,iset),iset)
17667 lend=ifrag(2,ipair(2,ii,iset),iset)
17668 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17669 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17672 ducartan(j,i)=(uzap2-uzap1)/(delta)
17675 ! Calculating numerical gradients for dU/ddx
17677 duxcartan(j,i)=0.0d0
17679 cdummy(j,i)=dc(j,i+nres)
17680 dc(j,i+nres)=dc(j,i+nres)+delta
17681 call chainbuild_cart
17684 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17686 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17690 kstart=ifrag(1,ipair(1,ii,iset),iset)
17691 kend=ifrag(2,ipair(1,ii,iset),iset)
17692 lstart=ifrag(1,ipair(2,ii,iset),iset)
17693 lend=ifrag(2,ipair(2,ii,iset),iset)
17694 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17695 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17698 dc(j,i+nres)=cdummy(j,i)
17699 call chainbuild_cart
17702 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
17703 ifrag(2,ii,iset),.true.,idummy,idummy)
17704 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17708 kstart=ifrag(1,ipair(1,ii,iset),iset)
17709 kend=ifrag(2,ipair(1,ii,iset),iset)
17710 lstart=ifrag(1,ipair(2,ii,iset),iset)
17711 lend=ifrag(2,ipair(2,ii,iset),iset)
17712 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17713 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17716 duxcartan(j,i)=(uzap2-uzap1)/(delta)
17719 write(iout,*) "Numerical dUconst/ddc backbone "
17721 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
17723 ! write(iout,*) "Numerical dUconst/ddx side-chain "
17725 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
17728 end subroutine dEconstrQ_num
17729 !-----------------------------------------------------------------------------
17731 !-----------------------------------------------------------------------------
17732 subroutine check_energies
17734 ! use random, only: ran_number
17738 ! include 'DIMENSIONS'
17739 ! include 'COMMON.CHAIN'
17740 ! include 'COMMON.VAR'
17741 ! include 'COMMON.IOUNITS'
17742 ! include 'COMMON.SBRIDGE'
17743 ! include 'COMMON.LOCAL'
17744 ! include 'COMMON.GEO'
17746 ! External functions
17747 !EL double precision ran_number
17748 !EL external ran_number
17751 integer :: i,j,k,l,lmax,p,pmax
17752 real(kind=8) :: rmin,rmax
17753 real(kind=8) :: eij
17756 real(kind=8) :: wi,rij,tj,pj
17778 !t wi=ran_number(0.0D0,pi)
17779 ! wi=ran_number(0.0D0,pi/6.0D0)
17781 !t tj=ran_number(0.0D0,pi)
17782 !t pj=ran_number(0.0D0,pi)
17783 ! pj=ran_number(0.0D0,pi/6.0D0)
17787 !t rij=ran_number(rmin,rmax)
17789 c(1,j)=d*sin(pj)*cos(tj)
17790 c(2,j)=d*sin(pj)*sin(tj)
17796 c(3,i)=-rij-d*cos(wi)
17799 dc(k,nres+i)=c(k,nres+i)-c(k,i)
17800 dc_norm(k,nres+i)=dc(k,nres+i)/d
17801 dc(k,nres+j)=c(k,nres+j)-c(k,j)
17802 dc_norm(k,nres+j)=dc(k,nres+j)/d
17805 call dyn_ssbond_ene(i,j,eij)
17810 end subroutine check_energies
17811 !-----------------------------------------------------------------------------
17812 subroutine dyn_ssbond_ene(resi,resj,eij)
17817 ! include 'DIMENSIONS'
17818 ! include 'COMMON.SBRIDGE'
17819 ! include 'COMMON.CHAIN'
17820 ! include 'COMMON.DERIV'
17821 ! include 'COMMON.LOCAL'
17822 ! include 'COMMON.INTERACT'
17823 ! include 'COMMON.VAR'
17824 ! include 'COMMON.IOUNITS'
17825 ! include 'COMMON.CALC'
17829 ! include 'COMMON.MD'
17830 ! use MD, only: totT,t_bath
17833 ! External functions
17834 !EL double precision h_base
17835 !EL external h_base
17838 integer :: resi,resj
17841 real(kind=8) :: eij
17844 logical :: havebond
17845 integer itypi,itypj
17846 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
17847 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
17848 real(kind=8),dimension(3) :: dcosom1,dcosom2
17850 real(kind=8) :: pom1,pom2
17851 real(kind=8) :: ljA,ljB,ljXs
17852 real(kind=8),dimension(1:3) :: d_ljB
17853 real(kind=8) :: ssA,ssB,ssC,ssXs
17854 real(kind=8) :: ssxm,ljxm,ssm,ljm
17855 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
17856 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
17857 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
17858 !-------FIRST METHOD
17860 real(kind=8),dimension(1:3) :: d_xm
17861 !-------END FIRST METHOD
17862 !-------SECOND METHOD
17863 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
17864 !-------END SECOND METHOD
17866 !-------TESTING CODE
17867 !el logical :: checkstop,transgrad
17868 !el common /sschecks/ checkstop,transgrad
17870 integer :: icheck,nicheck,jcheck,njcheck
17871 real(kind=8),dimension(-1:1) :: echeck
17872 real(kind=8) :: deps,ssx0,ljx0
17873 !-------END TESTING CODE
17879 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
17880 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
17883 dxi=dc_norm(1,nres+i)
17884 dyi=dc_norm(2,nres+i)
17885 dzi=dc_norm(3,nres+i)
17886 dsci_inv=vbld_inv(i+nres)
17889 xj=c(1,nres+j)-c(1,nres+i)
17890 yj=c(2,nres+j)-c(2,nres+i)
17891 zj=c(3,nres+j)-c(3,nres+i)
17892 dxj=dc_norm(1,nres+j)
17893 dyj=dc_norm(2,nres+j)
17894 dzj=dc_norm(3,nres+j)
17895 dscj_inv=vbld_inv(j+nres)
17897 chi1=chi(itypi,itypj)
17898 chi2=chi(itypj,itypi)
17905 alf12=0.5D0*(alf1+alf2)
17907 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
17908 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
17909 ! The following are set in sc_angular
17913 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
17914 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
17915 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
17917 rij=1.0D0/rij ! Reset this so it makes sense
17919 sig0ij=sigma(itypi,itypj)
17920 sig=sig0ij*dsqrt(1.0D0/sigsq)
17923 ljA=eps1*eps2rt**2*eps3rt**2
17924 ljB=ljA*bb_aq(itypi,itypj)
17925 ljA=ljA*aa_aq(itypi,itypj)
17926 ljxm=ljXs+(-2.0D0*aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
17931 deltat12=om2-om1+2.0d0
17932 cosphi=om12-om1*om2
17936 +akth*(deltat1*deltat1+deltat2*deltat2) &
17937 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
17938 ssxm=ssXs-0.5D0*ssB/ssA
17940 !-------TESTING CODE
17941 !$$$c Some extra output
17942 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
17943 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
17944 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
17945 !$$$ if (ssx0.gt.0.0d0) then
17946 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
17950 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
17951 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
17952 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
17954 !-------END TESTING CODE
17956 !-------TESTING CODE
17957 ! Stop and plot energy and derivative as a function of distance
17958 if (checkstop) then
17959 ssm=ssC-0.25D0*ssB*ssB/ssA
17960 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
17961 if (ssm.lt.ljm .and. &
17962 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
17970 if (.not.checkstop) then
17975 do icheck=0,nicheck
17976 do jcheck=-1,njcheck
17977 if (checkstop) rij=(ssxm-1.0d0)+ &
17978 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
17979 !-------END TESTING CODE
17981 if (rij.gt.ljxm) then
17984 fac=(1.0D0/ljd)**expon
17985 e1=fac*fac*aa_aq(itypi,itypj)
17986 e2=fac*bb_aq(itypi,itypj)
17987 eij=eps1*eps2rt*eps3rt*(e1+e2)
17990 eij=eij*eps2rt*eps3rt
17993 e1=e1*eps1*eps2rt**2*eps3rt**2
17994 ed=-expon*(e1+eij)/ljd
17996 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
17997 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
17998 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
17999 -2.0D0*alf12*eps3der+sigder*sigsq_om12
18000 else if (rij.lt.ssxm) then
18003 eij=ssA*ssd*ssd+ssB*ssd+ssC
18005 ed=2*akcm*ssd+akct*deltat12
18007 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
18008 eom1=-2*akth*deltat1-pom1-om2*pom2
18009 eom2= 2*akth*deltat2+pom1-om1*pom2
18012 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
18014 d_ssxm(1)=0.5D0*akct/ssA
18015 d_ssxm(2)=-d_ssxm(1)
18018 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
18019 d_ljxm(2)=d_ljxm(1)*sigsq_om2
18020 d_ljxm(3)=d_ljxm(1)*sigsq_om12
18021 d_ljxm(1)=d_ljxm(1)*sigsq_om1
18023 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
18024 xm=0.5d0*(ssxm+ljxm)
18026 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
18028 if (rij.lt.xm) then
18030 ssm=ssC-0.25D0*ssB*ssB/ssA
18031 d_ssm(1)=0.5D0*akct*ssB/ssA
18032 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
18033 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
18035 f1=(rij-xm)/(ssxm-xm)
18036 f2=(rij-ssxm)/(xm-ssxm)
18040 delta_inv=1.0d0/(xm-ssxm)
18041 deltasq_inv=delta_inv*delta_inv
18043 fac1=deltasq_inv*fac*(xm-rij)
18044 fac2=deltasq_inv*fac*(rij-ssxm)
18045 ed=delta_inv*(Ht*hd2-ssm*hd1)
18046 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
18047 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
18048 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
18051 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
18052 d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
18053 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
18054 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
18056 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
18057 f1=(rij-ljxm)/(xm-ljxm)
18058 f2=(rij-xm)/(ljxm-xm)
18062 delta_inv=1.0d0/(ljxm-xm)
18063 deltasq_inv=delta_inv*delta_inv
18065 fac1=deltasq_inv*fac*(ljxm-rij)
18066 fac2=deltasq_inv*fac*(rij-xm)
18067 ed=delta_inv*(ljm*hd2-Ht*hd1)
18068 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
18069 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
18070 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
18072 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
18074 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
18080 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
18081 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
18082 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
18084 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
18085 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
18086 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
18087 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
18088 !$$$ d_ssm(3)=omega
18090 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
18092 !$$$ d_ljm(k)=ljm*d_ljB(k)
18096 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
18097 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
18098 !$$$ d_ss(2)=akct*ssd
18099 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
18100 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
18103 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
18104 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
18105 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
18107 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
18108 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
18110 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
18112 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
18113 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
18114 !$$$ h1=h_base(f1,hd1)
18115 !$$$ h2=h_base(f2,hd2)
18116 !$$$ eij=ss*h1+ljf*h2
18117 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
18118 !$$$ deltasq_inv=delta_inv*delta_inv
18119 !$$$ fac=ljf*hd2-ss*hd1
18120 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
18121 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
18122 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
18123 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
18124 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
18125 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
18126 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
18128 !$$$ havebond=.false.
18129 !$$$ if (ed.gt.0.0d0) havebond=.true.
18130 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
18137 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
18138 ! write(iout,'(a15,f12.2,f8.1,2i5)')
18139 ! & "SSBOND_E_FORM",totT,t_bath,i,j
18143 dyn_ssbond_ij(i,j)=eij
18144 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
18145 dyn_ssbond_ij(i,j)=1.0d300
18148 ! write(iout,'(a15,f12.2,f8.1,2i5)')
18149 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
18154 !-------TESTING CODE
18155 !el if (checkstop) then
18156 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
18157 "CHECKSTOP",rij,eij,ed
18161 if (checkstop) then
18162 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
18165 if (checkstop) then
18169 !-------END TESTING CODE
18172 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
18173 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
18176 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
18179 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
18180 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
18181 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
18182 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
18183 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
18184 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
18188 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
18193 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18194 gvdwc(l,j)=gvdwc(l,j)+gg(l)
18198 end subroutine dyn_ssbond_ene
18199 !--------------------------------------------------------------------------
18200 subroutine triple_ssbond_ene(resi,resj,resk,eij)
18205 ! include 'DIMENSIONS'
18206 ! include 'COMMON.SBRIDGE'
18207 ! include 'COMMON.CHAIN'
18208 ! include 'COMMON.DERIV'
18209 ! include 'COMMON.LOCAL'
18210 ! include 'COMMON.INTERACT'
18211 ! include 'COMMON.VAR'
18212 ! include 'COMMON.IOUNITS'
18213 ! include 'COMMON.CALC'
18217 ! include 'COMMON.MD'
18218 ! use MD, only: totT,t_bath
18221 double precision h_base
18225 integer resi,resj,resk,m,itypi,itypj,itypk
18227 !c Output arguments
18228 double precision eij,eij1,eij2,eij3
18232 !c integer itypi,itypj,k,l
18233 double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi
18234 double precision rrik,rrjk,rik,rjk,xi,xk,yi,yk,zi,zk,xij,yij,zij
18235 double precision xik,yik,zik,xjk,yjk,zjk,dxk,dyk,dzk
18236 double precision sig0ij,ljd,sig,fac,e1,e2
18237 double precision dcosom1(3),dcosom2(3),ed
18238 double precision pom1,pom2
18239 double precision ljA,ljB,ljXs
18240 double precision d_ljB(1:3)
18241 double precision ssA,ssB,ssC,ssXs
18242 double precision ssxm,ljxm,ssm,ljm
18243 double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3)
18245 if (dtriss.eq.0) return
18249 !C write(iout,*) resi,resj,resk
18251 dxi=dc_norm(1,nres+i)
18252 dyi=dc_norm(2,nres+i)
18253 dzi=dc_norm(3,nres+i)
18254 dsci_inv=vbld_inv(i+nres)
18263 dxj=dc_norm(1,nres+j)
18264 dyj=dc_norm(2,nres+j)
18265 dzj=dc_norm(3,nres+j)
18266 dscj_inv=vbld_inv(j+nres)
18272 dxk=dc_norm(1,nres+k)
18273 dyk=dc_norm(2,nres+k)
18274 dzk=dc_norm(3,nres+k)
18275 dscj_inv=vbld_inv(k+nres)
18285 rrij=(xij*xij+yij*yij+zij*zij)
18286 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
18287 rrik=(xik*xik+yik*yik+zik*zik)
18289 rrjk=(xjk*xjk+yjk*yjk+zjk*zjk)
18291 !C there are three combination of distances for each trisulfide bonds
18292 !C The first case the ith atom is the center
18293 !C Energy function is E=d/(a*(x-y)**2+b*(x+y)**2+c) where x is first
18294 !C distance y is second distance the a,b,c,d are parameters derived for
18295 !C this problem d parameter was set as a penalty currenlty set to 1.
18296 if ((iabs(j-i).le.2).or.(iabs(i-k).le.2)) then
18299 eij1=dtriss/(atriss*(rij-rik)**2+btriss*(rij+rik)**6+ctriss)
18301 !C second case jth atom is center
18302 if ((iabs(j-i).le.2).or.(iabs(j-k).le.2)) then
18305 eij2=dtriss/(atriss*(rij-rjk)**2+btriss*(rij+rjk)**6+ctriss)
18307 !C the third case kth atom is the center
18308 if ((iabs(i-k).le.2).or.(iabs(j-k).le.2)) then
18311 eij3=dtriss/(atriss*(rik-rjk)**2+btriss*(rik+rjk)**6+ctriss)
18317 !C write(iout,*)i,j,k,eij
18318 !C The energy penalty calculated now time for the gradient part
18319 !C derivative over rij
18320 fac=-eij1**2/dtriss*(2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
18321 -eij2**2/dtriss*(2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)
18326 gvdwx(m,i)=gvdwx(m,i)-gg(m)
18327 gvdwx(m,j)=gvdwx(m,j)+gg(m)
18331 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18332 gvdwc(l,j)=gvdwc(l,j)+gg(l)
18334 !C now derivative over rik
18335 fac=-eij1**2/dtriss* &
18336 (-2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
18337 -eij3**2/dtriss*(2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
18342 gvdwx(m,i)=gvdwx(m,i)-gg(m)
18343 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18346 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18347 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18349 !C now derivative over rjk
18350 fac=-eij2**2/dtriss* &
18351 (-2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)- &
18352 eij3**2/dtriss*(-2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
18357 gvdwx(m,j)=gvdwx(m,j)-gg(m)
18358 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18361 gvdwc(l,j)=gvdwc(l,j)-gg(l)
18362 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18365 end subroutine triple_ssbond_ene
18369 !-----------------------------------------------------------------------------
18370 real(kind=8) function h_base(x,deriv)
18371 ! A smooth function going 0->1 in range [0,1]
18372 ! It should NOT be called outside range [0,1], it will not work there.
18379 real(kind=8) :: deriv
18382 real(kind=8) :: xsq
18385 ! Two parabolas put together. First derivative zero at extrema
18386 !$$$ if (x.lt.0.5D0) then
18387 !$$$ h_base=2.0D0*x*x
18391 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
18392 !$$$ deriv=4.0D0*deriv
18395 ! Third degree polynomial. First derivative zero at extrema
18396 h_base=x*x*(3.0d0-2.0d0*x)
18397 deriv=6.0d0*x*(1.0d0-x)
18399 ! Fifth degree polynomial. First and second derivatives zero at extrema
18401 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
18403 !$$$ deriv=deriv*deriv
18404 !$$$ deriv=30.0d0*xsq*deriv
18407 end function h_base
18408 !-----------------------------------------------------------------------------
18409 subroutine dyn_set_nss
18410 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
18412 use MD_data, only: totT,t_bath
18414 ! include 'DIMENSIONS'
18418 ! include 'COMMON.SBRIDGE'
18419 ! include 'COMMON.CHAIN'
18420 ! include 'COMMON.IOUNITS'
18421 ! include 'COMMON.SETUP'
18422 ! include 'COMMON.MD'
18424 real(kind=8) :: emin
18425 integer :: i,j,imin,ierr
18426 integer :: diff,allnss,newnss
18427 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
18430 integer,dimension(0:nfgtasks) :: i_newnss
18431 integer,dimension(0:nfgtasks) :: displ
18432 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
18433 integer :: g_newnss
18438 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
18447 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
18451 if (allflag(i).eq.0 .and. &
18452 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
18453 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
18457 if (emin.lt.1.0d300) then
18460 if (allflag(i).eq.0 .and. &
18461 (allihpb(i).eq.allihpb(imin) .or. &
18462 alljhpb(i).eq.allihpb(imin) .or. &
18463 allihpb(i).eq.alljhpb(imin) .or. &
18464 alljhpb(i).eq.alljhpb(imin))) then
18471 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
18475 if (allflag(i).eq.1) then
18477 newihpb(newnss)=allihpb(i)
18478 newjhpb(newnss)=alljhpb(i)
18483 if (nfgtasks.gt.1)then
18485 call MPI_Reduce(newnss,g_newnss,1,&
18486 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
18487 call MPI_Gather(newnss,1,MPI_INTEGER,&
18488 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
18490 do i=1,nfgtasks-1,1
18491 displ(i)=i_newnss(i-1)+displ(i-1)
18493 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
18494 g_newihpb,i_newnss,displ,MPI_INTEGER,&
18496 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
18497 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
18499 if(fg_rank.eq.0) then
18500 ! print *,'g_newnss',g_newnss
18501 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
18502 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
18505 newihpb(i)=g_newihpb(i)
18506 newjhpb(i)=g_newjhpb(i)
18514 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
18515 ! print *,newnss,nss,maxdim
18521 if (idssb(i).eq.newihpb(j) .and. &
18522 jdssb(i).eq.newjhpb(j)) found=.true.
18526 ! write(iout,*) "found",found,i,j
18527 if (.not.found.and.fg_rank.eq.0) &
18528 write(iout,'(a15,f12.2,f8.1,2i5)') &
18529 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
18538 if (newihpb(i).eq.idssb(j) .and. &
18539 newjhpb(i).eq.jdssb(j)) found=.true.
18543 ! write(iout,*) "found",found,i,j
18544 if (.not.found.and.fg_rank.eq.0) &
18545 write(iout,'(a15,f12.2,f8.1,2i5)') &
18546 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
18553 idssb(i)=newihpb(i)
18554 jdssb(i)=newjhpb(i)
18558 end subroutine dyn_set_nss
18559 ! Lipid transfer energy function
18560 subroutine Eliptransfer(eliptran)
18561 !C this is done by Adasko
18562 !C print *,"wchodze"
18563 !C structure of box:
18565 !C--bordliptop-- buffore starts
18566 !C--bufliptop--- here true lipid starts
18568 !C--buflipbot--- lipid ends buffore starts
18569 !C--bordlipbot--buffore ends
18570 real(kind=8) :: fracinbuf,eliptran,sslip,positi,ssgradlip
18573 ! print *, "I am in eliptran"
18574 do i=ilip_start,ilip_end
18576 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))&
18579 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
18580 if (positi.le.0.0) positi=positi+boxzsize
18582 !C first for peptide groups
18583 !c for each residue check if it is in lipid or lipid water border area
18584 if ((positi.gt.bordlipbot) &
18585 .and.(positi.lt.bordliptop)) then
18586 !C the energy transfer exist
18587 if (positi.lt.buflipbot) then
18588 !C what fraction I am in
18590 ((positi-bordlipbot)/lipbufthick)
18591 !C lipbufthick is thickenes of lipid buffore
18592 sslip=sscalelip(fracinbuf)
18593 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
18594 eliptran=eliptran+sslip*pepliptran
18595 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
18596 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
18597 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
18599 !C print *,"doing sccale for lower part"
18600 !C print *,i,sslip,fracinbuf,ssgradlip
18601 elseif (positi.gt.bufliptop) then
18602 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
18603 sslip=sscalelip(fracinbuf)
18604 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
18605 eliptran=eliptran+sslip*pepliptran
18606 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
18607 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
18608 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
18609 !C print *, "doing sscalefor top part"
18610 !C print *,i,sslip,fracinbuf,ssgradlip
18612 eliptran=eliptran+pepliptran
18613 !C print *,"I am in true lipid"
18616 !C eliptran=elpitran+0.0 ! I am in water
18618 if (energy_dec) write(iout,*) i,"eliptran=",eliptran,positi,sslip
18620 ! here starts the side chain transfer
18621 do i=ilip_start,ilip_end
18622 if (itype(i,1).eq.ntyp1) cycle
18623 positi=(mod(c(3,i+nres),boxzsize))
18624 if (positi.le.0) positi=positi+boxzsize
18625 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18626 !c for each residue check if it is in lipid or lipid water border area
18627 !C respos=mod(c(3,i+nres),boxzsize)
18628 !C print *,positi,bordlipbot,buflipbot
18629 if ((positi.gt.bordlipbot) &
18630 .and.(positi.lt.bordliptop)) then
18631 !C the energy transfer exist
18632 if (positi.lt.buflipbot) then
18634 ((positi-bordlipbot)/lipbufthick)
18635 !C lipbufthick is thickenes of lipid buffore
18636 sslip=sscalelip(fracinbuf)
18637 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
18638 eliptran=eliptran+sslip*liptranene(itype(i,1))
18639 gliptranx(3,i)=gliptranx(3,i) &
18640 +ssgradlip*liptranene(itype(i,1))
18641 gliptranc(3,i-1)= gliptranc(3,i-1) &
18642 +ssgradlip*liptranene(itype(i,1))
18643 !C print *,"doing sccale for lower part"
18644 elseif (positi.gt.bufliptop) then
18646 ((bordliptop-positi)/lipbufthick)
18647 sslip=sscalelip(fracinbuf)
18648 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
18649 eliptran=eliptran+sslip*liptranene(itype(i,1))
18650 gliptranx(3,i)=gliptranx(3,i) &
18651 +ssgradlip*liptranene(itype(i,1))
18652 gliptranc(3,i-1)= gliptranc(3,i-1) &
18653 +ssgradlip*liptranene(itype(i,1))
18654 !C print *, "doing sscalefor top part",sslip,fracinbuf
18656 eliptran=eliptran+liptranene(itype(i,1))
18657 !C print *,"I am in true lipid"
18659 endif ! if in lipid or buffor
18661 !C eliptran=elpitran+0.0 ! I am in water
18662 if (energy_dec) write(iout,*) i,"eliptran=",eliptran
18665 end subroutine Eliptransfer
18666 !----------------------------------NANO FUNCTIONS
18667 !C-----------------------------------------------------------------------
18668 !C-----------------------------------------------------------
18669 !C This subroutine is to mimic the histone like structure but as well can be
18670 !C utilizet to nanostructures (infinit) small modification has to be used to
18671 !C make it finite (z gradient at the ends has to be changes as well as the x,y
18672 !C gradient has to be modified at the ends
18673 !C The energy function is Kihara potential
18674 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
18675 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
18676 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
18677 !C simple Kihara potential
18678 subroutine calctube(Etube)
18679 real(kind=8),dimension(3) :: vectube
18680 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18681 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi, &
18682 sc_aa_tube,sc_bb_tube
18685 do i=itube_start,itube_end
18687 enetube(i+nres)=0.0d0
18689 !C first we calculate the distance from tube center
18691 do i=itube_start,itube_end
18692 !C lets ommit dummy atoms for now
18693 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18694 !C now calculate distance from center of tube and direction vectors
18697 ! Find minimum distance in periodic box
18699 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18700 vectube(1)=vectube(1)+boxxsize*j
18701 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18702 vectube(2)=vectube(2)+boxysize*j
18703 xminact=abs(vectube(1)-tubecenter(1))
18704 yminact=abs(vectube(2)-tubecenter(2))
18705 if (xmin.gt.xminact) then
18709 if (ymin.gt.yminact) then
18716 vectube(1)=vectube(1)-tubecenter(1)
18717 vectube(2)=vectube(2)-tubecenter(2)
18719 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18720 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18722 !C as the tube is infinity we do not calculate the Z-vector use of Z
18725 !C now calculte the distance
18726 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18727 !C now normalize vector
18728 vectube(1)=vectube(1)/tub_r
18729 vectube(2)=vectube(2)/tub_r
18730 !C calculte rdiffrence between r and r0
18733 rdiff6=rdiff**6.0d0
18734 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18735 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
18736 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18737 !C print *,rdiff,rdiff6,pep_aa_tube
18738 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18739 !C now we calculate gradient
18740 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18741 6.0d0*pep_bb_tube)/rdiff6/rdiff
18742 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18744 !C now direction of gg_tube vector
18746 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18747 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18750 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18751 !C print *,gg_tube(1,0),"TU"
18754 do i=itube_start,itube_end
18755 !C Lets not jump over memory as we use many times iti
18757 !C lets ommit dummy atoms for now
18758 if ((iti.eq.ntyp1) &
18759 !C in UNRES uncomment the line below as GLY has no side-chain...
18765 vectube(1)=mod((c(1,i+nres)),boxxsize)
18766 vectube(1)=vectube(1)+boxxsize*j
18767 vectube(2)=mod((c(2,i+nres)),boxysize)
18768 vectube(2)=vectube(2)+boxysize*j
18770 xminact=abs(vectube(1)-tubecenter(1))
18771 yminact=abs(vectube(2)-tubecenter(2))
18772 if (xmin.gt.xminact) then
18776 if (ymin.gt.yminact) then
18783 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
18785 vectube(1)=vectube(1)-tubecenter(1)
18786 vectube(2)=vectube(2)-tubecenter(2)
18788 !C as the tube is infinity we do not calculate the Z-vector use of Z
18791 !C now calculte the distance
18792 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18793 !C now normalize vector
18794 vectube(1)=vectube(1)/tub_r
18795 vectube(2)=vectube(2)/tub_r
18797 !C calculte rdiffrence between r and r0
18800 rdiff6=rdiff**6.0d0
18801 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18802 sc_aa_tube=sc_aa_tube_par(iti)
18803 sc_bb_tube=sc_bb_tube_par(iti)
18804 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
18805 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
18806 6.0d0*sc_bb_tube/rdiff6/rdiff
18807 !C now direction of gg_tube vector
18809 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
18810 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
18813 do i=itube_start,itube_end
18814 Etube=Etube+enetube(i)+enetube(i+nres)
18816 !C print *,"ETUBE", etube
18818 end subroutine calctube
18819 !C TO DO 1) add to total energy
18820 !C 2) add to gradient summation
18821 !C 3) add reading parameters (AND of course oppening of PARAM file)
18822 !C 4) add reading the center of tube
18824 !C 6) add to zerograd
18825 !C 7) allocate matrices
18828 !C-----------------------------------------------------------------------
18829 !C-----------------------------------------------------------
18830 !C This subroutine is to mimic the histone like structure but as well can be
18831 !C utilizet to nanostructures (infinit) small modification has to be used to
18832 !C make it finite (z gradient at the ends has to be changes as well as the x,y
18833 !C gradient has to be modified at the ends
18834 !C The energy function is Kihara potential
18835 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
18836 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
18837 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
18838 !C simple Kihara potential
18839 subroutine calctube2(Etube)
18840 real(kind=8),dimension(3) :: vectube
18841 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18842 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi,fracinbuf,&
18843 sstube,ssgradtube,sc_aa_tube,sc_bb_tube
18846 do i=itube_start,itube_end
18848 enetube(i+nres)=0.0d0
18850 !C first we calculate the distance from tube center
18851 !C first sugare-phosphate group for NARES this would be peptide group
18853 do i=itube_start,itube_end
18854 !C lets ommit dummy atoms for now
18856 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18857 !C now calculate distance from center of tube and direction vectors
18858 !C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18859 !C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
18860 !C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18861 !C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
18865 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18866 vectube(1)=vectube(1)+boxxsize*j
18867 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18868 vectube(2)=vectube(2)+boxysize*j
18870 xminact=abs(vectube(1)-tubecenter(1))
18871 yminact=abs(vectube(2)-tubecenter(2))
18872 if (xmin.gt.xminact) then
18876 if (ymin.gt.yminact) then
18883 vectube(1)=vectube(1)-tubecenter(1)
18884 vectube(2)=vectube(2)-tubecenter(2)
18886 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18887 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18889 !C as the tube is infinity we do not calculate the Z-vector use of Z
18892 !C now calculte the distance
18893 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18894 !C now normalize vector
18895 vectube(1)=vectube(1)/tub_r
18896 vectube(2)=vectube(2)/tub_r
18897 !C calculte rdiffrence between r and r0
18900 rdiff6=rdiff**6.0d0
18901 !C THIS FRAGMENT MAKES TUBE FINITE
18902 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
18903 if (positi.le.0) positi=positi+boxzsize
18904 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18905 !c for each residue check if it is in lipid or lipid water border area
18906 !C respos=mod(c(3,i+nres),boxzsize)
18907 !C print *,positi,bordtubebot,buftubebot,bordtubetop
18908 if ((positi.gt.bordtubebot) &
18909 .and.(positi.lt.bordtubetop)) then
18910 !C the energy transfer exist
18911 if (positi.lt.buftubebot) then
18913 ((positi-bordtubebot)/tubebufthick)
18914 !C lipbufthick is thickenes of lipid buffore
18915 sstube=sscalelip(fracinbuf)
18916 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
18917 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
18918 enetube(i)=enetube(i)+sstube*tubetranenepep
18919 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18920 !C &+ssgradtube*tubetranene(itype(i,1))
18921 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18922 !C &+ssgradtube*tubetranene(itype(i,1))
18923 !C print *,"doing sccale for lower part"
18924 elseif (positi.gt.buftubetop) then
18926 ((bordtubetop-positi)/tubebufthick)
18927 sstube=sscalelip(fracinbuf)
18928 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
18929 enetube(i)=enetube(i)+sstube*tubetranenepep
18930 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18931 !C &+ssgradtube*tubetranene(itype(i,1))
18932 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18933 !C &+ssgradtube*tubetranene(itype(i,1))
18934 !C print *, "doing sscalefor top part",sslip,fracinbuf
18938 enetube(i)=enetube(i)+sstube*tubetranenepep
18939 !C print *,"I am in true lipid"
18943 !C ssgradtube=0.0d0
18945 endif ! if in lipid or buffor
18947 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18948 enetube(i)=enetube(i)+sstube* &
18949 (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
18950 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18951 !C print *,rdiff,rdiff6,pep_aa_tube
18952 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18953 !C now we calculate gradient
18954 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18955 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
18956 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18959 !C now direction of gg_tube vector
18961 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18962 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18964 gg_tube(3,i)=gg_tube(3,i) &
18965 +ssgradtube*enetube(i)/sstube/2.0d0
18966 gg_tube(3,i-1)= gg_tube(3,i-1) &
18967 +ssgradtube*enetube(i)/sstube/2.0d0
18970 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18971 !C print *,gg_tube(1,0),"TU"
18972 do i=itube_start,itube_end
18973 !C Lets not jump over memory as we use many times iti
18975 !C lets ommit dummy atoms for now
18976 if ((iti.eq.ntyp1) &
18977 !!C in UNRES uncomment the line below as GLY has no side-chain...
18980 vectube(1)=c(1,i+nres)
18981 vectube(1)=mod(vectube(1),boxxsize)
18982 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
18983 vectube(2)=c(2,i+nres)
18984 vectube(2)=mod(vectube(2),boxysize)
18985 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
18987 vectube(1)=vectube(1)-tubecenter(1)
18988 vectube(2)=vectube(2)-tubecenter(2)
18989 !C THIS FRAGMENT MAKES TUBE FINITE
18990 positi=(mod(c(3,i+nres),boxzsize))
18991 if (positi.le.0) positi=positi+boxzsize
18992 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18993 !c for each residue check if it is in lipid or lipid water border area
18994 !C respos=mod(c(3,i+nres),boxzsize)
18995 !C print *,positi,bordtubebot,buftubebot,bordtubetop
18997 if ((positi.gt.bordtubebot) &
18998 .and.(positi.lt.bordtubetop)) then
18999 !C the energy transfer exist
19000 if (positi.lt.buftubebot) then
19002 ((positi-bordtubebot)/tubebufthick)
19003 !C lipbufthick is thickenes of lipid buffore
19004 sstube=sscalelip(fracinbuf)
19005 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
19006 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
19007 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19008 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19009 !C &+ssgradtube*tubetranene(itype(i,1))
19010 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19011 !C &+ssgradtube*tubetranene(itype(i,1))
19012 !C print *,"doing sccale for lower part"
19013 elseif (positi.gt.buftubetop) then
19015 ((bordtubetop-positi)/tubebufthick)
19017 sstube=sscalelip(fracinbuf)
19018 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
19019 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19020 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19021 !C &+ssgradtube*tubetranene(itype(i,1))
19022 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19023 !C &+ssgradtube*tubetranene(itype(i,1))
19024 !C print *, "doing sscalefor top part",sslip,fracinbuf
19028 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19029 !C print *,"I am in true lipid"
19033 !C ssgradtube=0.0d0
19035 endif ! if in lipid or buffor
19036 !CEND OF FINITE FRAGMENT
19037 !C as the tube is infinity we do not calculate the Z-vector use of Z
19040 !C now calculte the distance
19041 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19042 !C now normalize vector
19043 vectube(1)=vectube(1)/tub_r
19044 vectube(2)=vectube(2)/tub_r
19045 !C calculte rdiffrence between r and r0
19048 rdiff6=rdiff**6.0d0
19049 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19050 sc_aa_tube=sc_aa_tube_par(iti)
19051 sc_bb_tube=sc_bb_tube_par(iti)
19052 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)&
19053 *sstube+enetube(i+nres)
19054 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19055 !C now we calculate gradient
19056 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-&
19057 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
19058 !C now direction of gg_tube vector
19060 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19061 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19063 gg_tube_SC(3,i)=gg_tube_SC(3,i) &
19064 +ssgradtube*enetube(i+nres)/sstube
19065 gg_tube(3,i-1)= gg_tube(3,i-1) &
19066 +ssgradtube*enetube(i+nres)/sstube
19069 do i=itube_start,itube_end
19070 Etube=Etube+enetube(i)+enetube(i+nres)
19072 !C print *,"ETUBE", etube
19074 end subroutine calctube2
19075 !=====================================================================================================================================
19076 subroutine calcnano(Etube)
19077 real(kind=8),dimension(3) :: vectube
19079 real(kind=8) :: Etube,xtemp,xminact,yminact,&
19080 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,denominator,faccav,&
19081 sc_aa_tube,sc_bb_tube,zmin,ztemp,zminact
19082 integer:: i,j,iti,r
19085 ! print *,itube_start,itube_end,"poczatek"
19086 do i=itube_start,itube_end
19088 enetube(i+nres)=0.0d0
19090 !C first we calculate the distance from tube center
19091 !C first sugare-phosphate group for NARES this would be peptide group
19093 do i=itube_start,itube_end
19094 !C lets ommit dummy atoms for now
19095 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
19096 !C now calculate distance from center of tube and direction vectors
19102 vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19103 vectube(1)=vectube(1)+boxxsize*j
19104 vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19105 vectube(2)=vectube(2)+boxysize*j
19106 vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
19107 vectube(3)=vectube(3)+boxzsize*j
19110 xminact=dabs(vectube(1)-tubecenter(1))
19111 yminact=dabs(vectube(2)-tubecenter(2))
19112 zminact=dabs(vectube(3)-tubecenter(3))
19114 if (xmin.gt.xminact) then
19118 if (ymin.gt.yminact) then
19122 if (zmin.gt.zminact) then
19131 vectube(1)=vectube(1)-tubecenter(1)
19132 vectube(2)=vectube(2)-tubecenter(2)
19133 vectube(3)=vectube(3)-tubecenter(3)
19135 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
19136 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
19137 !C as the tube is infinity we do not calculate the Z-vector use of Z
19139 !C vectube(3)=0.0d0
19140 !C now calculte the distance
19141 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19142 !C now normalize vector
19143 vectube(1)=vectube(1)/tub_r
19144 vectube(2)=vectube(2)/tub_r
19145 vectube(3)=vectube(3)/tub_r
19146 !C calculte rdiffrence between r and r0
19149 rdiff6=rdiff**6.0d0
19150 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19151 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
19152 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
19153 !C print *,rdiff,rdiff6,pep_aa_tube
19154 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19155 !C now we calculate gradient
19156 fac=(-12.0d0*pep_aa_tube/rdiff6- &
19157 6.0d0*pep_bb_tube)/rdiff6/rdiff
19158 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
19160 if (acavtubpep.eq.0.0d0) then
19165 denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
19167 (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
19170 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
19171 *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
19172 +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
19173 /denominator**2.0d0
19178 if (energy_dec) write(iout,*),i,rdiff,enetube(i),enecavtube(i)
19180 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
19181 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
19185 do i=itube_start,itube_end
19186 enecavtube(i)=0.0d0
19187 !C Lets not jump over memory as we use many times iti
19189 !C lets ommit dummy atoms for now
19190 if ((iti.eq.ntyp1) &
19191 !C in UNRES uncomment the line below as GLY has no side-chain...
19198 vectube(1)=dmod((c(1,i+nres)),boxxsize)
19199 vectube(1)=vectube(1)+boxxsize*j
19200 vectube(2)=dmod((c(2,i+nres)),boxysize)
19201 vectube(2)=vectube(2)+boxysize*j
19202 vectube(3)=dmod((c(3,i+nres)),boxzsize)
19203 vectube(3)=vectube(3)+boxzsize*j
19206 xminact=dabs(vectube(1)-tubecenter(1))
19207 yminact=dabs(vectube(2)-tubecenter(2))
19208 zminact=dabs(vectube(3)-tubecenter(3))
19210 if (xmin.gt.xminact) then
19214 if (ymin.gt.yminact) then
19218 if (zmin.gt.zminact) then
19227 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
19229 vectube(1)=vectube(1)-tubecenter(1)
19230 vectube(2)=vectube(2)-tubecenter(2)
19231 vectube(3)=vectube(3)-tubecenter(3)
19232 !C now calculte the distance
19233 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19234 !C now normalize vector
19235 vectube(1)=vectube(1)/tub_r
19236 vectube(2)=vectube(2)/tub_r
19237 vectube(3)=vectube(3)/tub_r
19239 !C calculte rdiffrence between r and r0
19242 rdiff6=rdiff**6.0d0
19243 sc_aa_tube=sc_aa_tube_par(iti)
19244 sc_bb_tube=sc_bb_tube_par(iti)
19245 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19246 !C enetube(i+nres)=0.0d0
19247 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19248 !C now we calculate gradient
19249 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
19250 6.0d0*sc_bb_tube/rdiff6/rdiff
19252 !C now direction of gg_tube vector
19253 !C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
19254 if (acavtub(iti).eq.0.0d0) then
19256 enecavtube(i+nres)=0.0d0
19259 denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
19260 enecavtube(i+nres)= &
19261 (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
19263 !C enecavtube(i)=0.0
19264 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
19265 *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
19266 +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
19267 /denominator**2.0d0
19272 !C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
19273 !C & enecavtube(i),faccav
19274 !C print *,"licz=",
19275 !C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
19276 !C print *,"finene=",enetube(i+nres)+enecavtube(i)
19278 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19279 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19281 if (energy_dec) write(iout,*),i,rdiff,enetube(i+nres),enecavtube(i+nres)
19286 do i=itube_start,itube_end
19287 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) &
19288 +enecavtube(i+nres)
19291 ! print *,"begin", i,"a"
19294 ! rdiff6=rdiff**6.0d0
19295 ! sc_aa_tube=sc_aa_tube_par(i)
19296 ! sc_bb_tube=sc_bb_tube_par(i)
19297 ! enetube(i)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19298 ! denominator=(1.0d0+dcavtub(i)*rdiff6*rdiff6)
19300 ! (bcavtub(i)*rdiff+acavtub(i)*dsqrt(rdiff)+ccavtub(i)) &
19303 ! print '(5(f10.3,1x))',rdiff,enetube(i),enecavtube(i),enecavtube(i)+enetube(i)
19305 ! print *,"end",i,"a"
19307 !C print *,"ETUBE", etube
19309 end subroutine calcnano
19311 !===============================================
19312 !--------------------------------------------------------------------------------
19313 !C first for shielding is setting of function of side-chains
19315 subroutine set_shield_fac2
19316 real(kind=8) :: div77_81=0.974996043d0, &
19317 div4_81=0.2222222222d0
19318 real (kind=8) :: dist_pep_side,dist_side_calf,dist_pept_group, &
19319 scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
19320 short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
19321 sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
19322 !C the vector between center of side_chain and peptide group
19323 real(kind=8),dimension(3) :: pep_side_long,side_calf, &
19324 pept_group,costhet_grad,cosphi_grad_long, &
19325 cosphi_grad_loc,pep_side_norm,side_calf_norm, &
19326 sh_frac_dist_grad,pep_side
19328 !C write(2,*) "ivec",ivec_start,ivec_end
19330 fac_shield(i)=0.0d0
19332 grad_shield(j,i)=0.0d0
19335 do i=ivec_start,ivec_end
19337 !C if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
19339 if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
19340 !Cif there two consequtive dummy atoms there is no peptide group between them
19341 !C the line below has to be changed for FGPROC>1
19344 if ((itype(k,1).eq.ntyp1).or.(itype(k,1).eq.10)) cycle
19348 !C first lets set vector conecting the ithe side-chain with kth side-chain
19349 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
19350 !C pep_side(j)=2.0d0
19351 !C and vector conecting the side-chain with its proper calfa
19352 side_calf(j)=c(j,k+nres)-c(j,k)
19353 !C side_calf(j)=2.0d0
19354 pept_group(j)=c(j,i)-c(j,i+1)
19355 !C lets have their lenght
19356 dist_pep_side=pep_side(j)**2+dist_pep_side
19357 dist_side_calf=dist_side_calf+side_calf(j)**2
19358 dist_pept_group=dist_pept_group+pept_group(j)**2
19360 dist_pep_side=sqrt(dist_pep_side)
19361 dist_pept_group=sqrt(dist_pept_group)
19362 dist_side_calf=sqrt(dist_side_calf)
19364 pep_side_norm(j)=pep_side(j)/dist_pep_side
19365 side_calf_norm(j)=dist_side_calf
19367 !C now sscale fraction
19368 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
19369 !C print *,buff_shield,"buff"
19371 if (sh_frac_dist.le.0.0) cycle
19372 !C print *,ishield_list(i),i
19373 !C If we reach here it means that this side chain reaches the shielding sphere
19374 !C Lets add him to the list for gradient
19375 ishield_list(i)=ishield_list(i)+1
19376 !C ishield_list is a list of non 0 side-chain that contribute to factor gradient
19377 !C this list is essential otherwise problem would be O3
19378 shield_list(ishield_list(i),i)=k
19379 !C Lets have the sscale value
19380 if (sh_frac_dist.gt.1.0) then
19381 scale_fac_dist=1.0d0
19383 sh_frac_dist_grad(j)=0.0d0
19386 scale_fac_dist=-sh_frac_dist*sh_frac_dist &
19387 *(2.0d0*sh_frac_dist-3.0d0)
19388 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
19389 /dist_pep_side/buff_shield*0.5d0
19391 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
19392 !C sh_frac_dist_grad(j)=0.0d0
19393 !C scale_fac_dist=1.0d0
19394 !C print *,"jestem",scale_fac_dist,fac_help_scale,
19395 !C & sh_frac_dist_grad(j)
19398 !C this is what is now we have the distance scaling now volume...
19399 short=short_r_sidechain(itype(k,1))
19400 long=long_r_sidechain(itype(k,1))
19401 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
19402 sinthet=short/dist_pep_side*costhet
19403 !C now costhet_grad
19406 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
19407 !C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
19408 !C & -short/dist_pep_side**2/costhet)
19409 !C costhet_fac=0.0d0
19411 costhet_grad(j)=costhet_fac*pep_side(j)
19413 !C remember for the final gradient multiply costhet_grad(j)
19414 !C for side_chain by factor -2 !
19415 !C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
19416 !C pep_side0pept_group is vector multiplication
19417 pep_side0pept_group=0.0d0
19419 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
19421 cosalfa=(pep_side0pept_group/ &
19422 (dist_pep_side*dist_side_calf))
19423 fac_alfa_sin=1.0d0-cosalfa**2
19424 fac_alfa_sin=dsqrt(fac_alfa_sin)
19425 rkprim=fac_alfa_sin*(long-short)+short
19428 !C now costhet_grad
19429 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
19431 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
19432 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ &
19436 cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
19437 +cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
19438 *(long-short)/fac_alfa_sin*cosalfa/ &
19439 ((dist_pep_side*dist_side_calf))* &
19440 ((side_calf(j))-cosalfa* &
19441 ((pep_side(j)/dist_pep_side)*dist_side_calf))
19442 !C cosphi_grad_long(j)=0.0d0
19443 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
19444 *(long-short)/fac_alfa_sin*cosalfa &
19445 /((dist_pep_side*dist_side_calf))* &
19447 cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
19448 !C cosphi_grad_loc(j)=0.0d0
19450 !C print *,sinphi,sinthet
19451 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) &
19454 !C now the gradient...
19456 grad_shield(j,i)=grad_shield(j,i) &
19457 !C gradient po skalowaniu
19458 +(sh_frac_dist_grad(j)*VofOverlap &
19459 !C gradient po costhet
19460 +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
19461 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
19462 sinphi/sinthet*costhet*costhet_grad(j) &
19463 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
19465 !C grad_shield_side is Cbeta sidechain gradient
19466 grad_shield_side(j,ishield_list(i),i)=&
19467 (sh_frac_dist_grad(j)*-2.0d0&
19469 -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
19470 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(&
19471 sinphi/sinthet*costhet*costhet_grad(j)&
19472 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
19475 grad_shield_loc(j,ishield_list(i),i)= &
19476 scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
19477 (1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(&
19478 sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
19482 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
19484 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
19486 !C write(2,*) "TOTAL VOLUME",i,itype(i,1),fac_shield(i)
19489 end subroutine set_shield_fac2
19490 !----------------------------------------------------------------------------
19491 ! SOUBROUTINE FOR AFM
19492 subroutine AFMvel(Eafmforce)
19493 use MD_data, only:totTafm
19494 real(kind=8),dimension(3) :: diffafm
19495 real(kind=8) :: afmdist,Eafmforce
19497 !C Only for check grad COMMENT if not used for checkgrad
19499 !C--------------------------------------------------------
19500 !C print *,"wchodze"
19504 diffafm(i)=c(i,afmend)-c(i,afmbeg)
19505 afmdist=afmdist+diffafm(i)**2
19507 afmdist=dsqrt(afmdist)
19509 Eafmforce=0.5d0*forceAFMconst &
19510 *(distafminit+totTafm*velAFMconst-afmdist)**2
19511 !C Eafmforce=-forceAFMconst*(dist-distafminit)
19513 gradafm(i,afmend-1)=-forceAFMconst* &
19514 (distafminit+totTafm*velAFMconst-afmdist) &
19515 *diffafm(i)/afmdist
19516 gradafm(i,afmbeg-1)=forceAFMconst* &
19517 (distafminit+totTafm*velAFMconst-afmdist) &
19518 *diffafm(i)/afmdist
19520 ! print *,'AFM',Eafmforce,totTafm*velAFMconst,afmdist
19522 end subroutine AFMvel
19523 !---------------------------------------------------------
19524 subroutine AFMforce(Eafmforce)
19526 real(kind=8),dimension(3) :: diffafm
19527 ! real(kind=8) ::afmdist
19528 real(kind=8) :: afmdist,Eafmforce
19533 diffafm(i)=c(i,afmend)-c(i,afmbeg)
19534 afmdist=afmdist+diffafm(i)**2
19536 afmdist=dsqrt(afmdist)
19537 ! print *,afmdist,distafminit
19538 Eafmforce=-forceAFMconst*(afmdist-distafminit)
19540 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/afmdist
19541 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/afmdist
19543 !C print *,'AFM',Eafmforce
19545 end subroutine AFMforce
19547 !-----------------------------------------------------------------------------
19549 subroutine read_ssHist
19552 ! include 'DIMENSIONS'
19553 ! include "DIMENSIONS.FREE"
19554 ! include 'COMMON.FREE'
19557 character(len=80) :: controlcard
19560 call card_concat(controlcard,.true.)
19561 read(controlcard,*) &
19562 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
19566 end subroutine read_ssHist
19568 !-----------------------------------------------------------------------------
19569 integer function indmat(i,j)
19571 ! get the position of the jth ijth fragment of the chain coordinate system
19572 ! in the fromto array.
19575 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
19577 end function indmat
19578 !-----------------------------------------------------------------------------
19579 real(kind=8) function sigm(x)
19585 !-----------------------------------------------------------------------------
19586 !-----------------------------------------------------------------------------
19587 subroutine alloc_ener_arrays
19588 !EL Allocation of arrays used by module energy
19589 use MD_data, only: mset
19590 !el local variables
19593 if(nres.lt.100) then
19595 elseif(nres.lt.200) then
19596 maxconts=0.8*nres ! Max. number of contacts per residue
19598 maxconts=0.6*nres ! (maxconts=maxres/4)
19600 maxcont=12*nres ! Max. number of SC contacts
19601 maxvar=6*nres ! Max. number of variables
19602 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
19603 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
19604 !----------------------
19605 ! arrays in subroutine init_int_table
19607 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
19608 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
19610 allocate(nint_gr(nres))
19611 allocate(nscp_gr(nres))
19612 allocate(ielstart(nres))
19613 allocate(ielend(nres))
19615 allocate(istart(nres,maxint_gr))
19616 allocate(iend(nres,maxint_gr))
19617 !(maxres,maxint_gr)
19618 allocate(iscpstart(nres,maxint_gr))
19619 allocate(iscpend(nres,maxint_gr))
19620 !(maxres,maxint_gr)
19621 allocate(ielstart_vdw(nres))
19622 allocate(ielend_vdw(nres))
19624 allocate(nint_gr_nucl(nres))
19625 allocate(nscp_gr_nucl(nres))
19626 allocate(ielstart_nucl(nres))
19627 allocate(ielend_nucl(nres))
19629 allocate(istart_nucl(nres,maxint_gr))
19630 allocate(iend_nucl(nres,maxint_gr))
19631 !(maxres,maxint_gr)
19632 allocate(iscpstart_nucl(nres,maxint_gr))
19633 allocate(iscpend_nucl(nres,maxint_gr))
19634 !(maxres,maxint_gr)
19635 allocate(ielstart_vdw_nucl(nres))
19636 allocate(ielend_vdw_nucl(nres))
19638 allocate(lentyp(0:nfgtasks-1))
19640 !----------------------
19642 ! common /contacts/
19643 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
19644 allocate(icont(2,maxcont))
19646 ! common /contacts1/
19647 allocate(num_cont(0:nres+4))
19649 allocate(jcont(maxconts,nres))
19651 allocate(facont(maxconts,nres))
19653 allocate(gacont(3,maxconts,nres))
19654 !(3,maxconts,maxres)
19655 ! common /contacts_hb/
19656 allocate(gacontp_hb1(3,maxconts,nres))
19657 allocate(gacontp_hb2(3,maxconts,nres))
19658 allocate(gacontp_hb3(3,maxconts,nres))
19659 allocate(gacontm_hb1(3,maxconts,nres))
19660 allocate(gacontm_hb2(3,maxconts,nres))
19661 allocate(gacontm_hb3(3,maxconts,nres))
19662 allocate(gacont_hbr(3,maxconts,nres))
19663 allocate(grij_hb_cont(3,maxconts,nres))
19664 !(3,maxconts,maxres)
19665 allocate(facont_hb(maxconts,nres))
19667 allocate(ees0p(maxconts,nres))
19668 allocate(ees0m(maxconts,nres))
19669 allocate(d_cont(maxconts,nres))
19670 allocate(ees0plist(maxconts,nres))
19673 allocate(num_cont_hb(nres))
19675 allocate(jcont_hb(maxconts,nres))
19678 allocate(Ug(2,2,nres))
19679 allocate(Ugder(2,2,nres))
19680 allocate(Ug2(2,2,nres))
19681 allocate(Ug2der(2,2,nres))
19683 allocate(obrot(2,nres))
19684 allocate(obrot2(2,nres))
19685 allocate(obrot_der(2,nres))
19686 allocate(obrot2_der(2,nres))
19688 ! common /precomp1/
19689 allocate(mu(2,nres))
19690 allocate(muder(2,nres))
19691 allocate(Ub2(2,nres))
19694 allocate(Ub2der(2,nres))
19695 allocate(Ctobr(2,nres))
19696 allocate(Ctobrder(2,nres))
19697 allocate(Dtobr2(2,nres))
19698 allocate(Dtobr2der(2,nres))
19700 allocate(EUg(2,2,nres))
19701 allocate(EUgder(2,2,nres))
19702 allocate(CUg(2,2,nres))
19703 allocate(CUgder(2,2,nres))
19704 allocate(DUg(2,2,nres))
19705 allocate(Dugder(2,2,nres))
19706 allocate(DtUg2(2,2,nres))
19707 allocate(DtUg2der(2,2,nres))
19709 ! common /precomp2/
19710 allocate(Ug2Db1t(2,nres))
19711 allocate(Ug2Db1tder(2,nres))
19712 allocate(CUgb2(2,nres))
19713 allocate(CUgb2der(2,nres))
19715 allocate(EUgC(2,2,nres))
19716 allocate(EUgCder(2,2,nres))
19717 allocate(EUgD(2,2,nres))
19718 allocate(EUgDder(2,2,nres))
19719 allocate(DtUg2EUg(2,2,nres))
19720 allocate(Ug2DtEUg(2,2,nres))
19722 allocate(Ug2DtEUgder(2,2,2,nres))
19723 allocate(DtUg2EUgder(2,2,2,nres))
19725 ! common /rotat_old/
19726 allocate(costab(nres))
19727 allocate(sintab(nres))
19728 allocate(costab2(nres))
19729 allocate(sintab2(nres))
19732 allocate(a_chuj(2,2,maxconts,nres))
19733 !(2,2,maxconts,maxres)(maxconts=maxres/4)
19734 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
19735 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
19736 ! common /contdistrib/
19737 allocate(ncont_sent(nres))
19738 allocate(ncont_recv(nres))
19740 allocate(iat_sent(nres))
19742 allocate(iint_sent(4,nres,nres))
19743 allocate(iint_sent_local(4,nres,nres))
19745 allocate(iturn3_sent(4,0:nres+4))
19746 allocate(iturn4_sent(4,0:nres+4))
19747 allocate(iturn3_sent_local(4,nres))
19748 allocate(iturn4_sent_local(4,nres))
19750 allocate(itask_cont_from(0:nfgtasks-1))
19751 allocate(itask_cont_to(0:nfgtasks-1))
19752 !(0:max_fg_procs-1)
19756 !----------------------
19759 allocate(dcdv(6,maxdim))
19760 allocate(dxdv(6,maxdim))
19762 allocate(dxds(6,nres))
19764 allocate(gradx(3,-1:nres,0:2))
19765 allocate(gradc(3,-1:nres,0:2))
19767 allocate(gvdwx(3,-1:nres))
19768 allocate(gvdwc(3,-1:nres))
19769 allocate(gelc(3,-1:nres))
19770 allocate(gelc_long(3,-1:nres))
19771 allocate(gvdwpp(3,-1:nres))
19772 allocate(gvdwc_scpp(3,-1:nres))
19773 allocate(gradx_scp(3,-1:nres))
19774 allocate(gvdwc_scp(3,-1:nres))
19775 allocate(ghpbx(3,-1:nres))
19776 allocate(ghpbc(3,-1:nres))
19777 allocate(gradcorr(3,-1:nres))
19778 allocate(gradcorr_long(3,-1:nres))
19779 allocate(gradcorr5_long(3,-1:nres))
19780 allocate(gradcorr6_long(3,-1:nres))
19781 allocate(gcorr6_turn_long(3,-1:nres))
19782 allocate(gradxorr(3,-1:nres))
19783 allocate(gradcorr5(3,-1:nres))
19784 allocate(gradcorr6(3,-1:nres))
19785 allocate(gliptran(3,-1:nres))
19786 allocate(gliptranc(3,-1:nres))
19787 allocate(gliptranx(3,-1:nres))
19788 allocate(gshieldx(3,-1:nres))
19789 allocate(gshieldc(3,-1:nres))
19790 allocate(gshieldc_loc(3,-1:nres))
19791 allocate(gshieldx_ec(3,-1:nres))
19792 allocate(gshieldc_ec(3,-1:nres))
19793 allocate(gshieldc_loc_ec(3,-1:nres))
19794 allocate(gshieldx_t3(3,-1:nres))
19795 allocate(gshieldc_t3(3,-1:nres))
19796 allocate(gshieldc_loc_t3(3,-1:nres))
19797 allocate(gshieldx_t4(3,-1:nres))
19798 allocate(gshieldc_t4(3,-1:nres))
19799 allocate(gshieldc_loc_t4(3,-1:nres))
19800 allocate(gshieldx_ll(3,-1:nres))
19801 allocate(gshieldc_ll(3,-1:nres))
19802 allocate(gshieldc_loc_ll(3,-1:nres))
19803 allocate(grad_shield(3,-1:nres))
19804 allocate(gg_tube_sc(3,-1:nres))
19805 allocate(gg_tube(3,-1:nres))
19806 allocate(gradafm(3,-1:nres))
19807 allocate(gradb_nucl(3,-1:nres))
19808 allocate(gradbx_nucl(3,-1:nres))
19809 allocate(gvdwpsb1(3,-1:nres))
19810 allocate(gelpp(3,-1:nres))
19811 allocate(gvdwpsb(3,-1:nres))
19812 allocate(gelsbc(3,-1:nres))
19813 allocate(gelsbx(3,-1:nres))
19814 allocate(gvdwsbx(3,-1:nres))
19815 allocate(gvdwsbc(3,-1:nres))
19816 allocate(gsbloc(3,-1:nres))
19817 allocate(gsblocx(3,-1:nres))
19818 allocate(gradcorr_nucl(3,-1:nres))
19819 allocate(gradxorr_nucl(3,-1:nres))
19820 allocate(gradcorr3_nucl(3,-1:nres))
19821 allocate(gradxorr3_nucl(3,-1:nres))
19822 allocate(gvdwpp_nucl(3,-1:nres))
19823 allocate(gradpepcat(3,-1:nres))
19824 allocate(gradpepcatx(3,-1:nres))
19825 allocate(gradcatcat(3,-1:nres))
19827 allocate(grad_shield_side(3,50,nres))
19828 allocate(grad_shield_loc(3,50,nres))
19829 ! grad for shielding surroing
19830 allocate(gloc(0:maxvar,0:2))
19831 allocate(gloc_x(0:maxvar,2))
19833 allocate(gel_loc(3,-1:nres))
19834 allocate(gel_loc_long(3,-1:nres))
19835 allocate(gcorr3_turn(3,-1:nres))
19836 allocate(gcorr4_turn(3,-1:nres))
19837 allocate(gcorr6_turn(3,-1:nres))
19838 allocate(gradb(3,-1:nres))
19839 allocate(gradbx(3,-1:nres))
19841 allocate(gel_loc_loc(maxvar))
19842 allocate(gel_loc_turn3(maxvar))
19843 allocate(gel_loc_turn4(maxvar))
19844 allocate(gel_loc_turn6(maxvar))
19845 allocate(gcorr_loc(maxvar))
19846 allocate(g_corr5_loc(maxvar))
19847 allocate(g_corr6_loc(maxvar))
19849 allocate(gsccorc(3,-1:nres))
19850 allocate(gsccorx(3,-1:nres))
19852 allocate(gsccor_loc(-1:nres))
19854 allocate(gvdwx_scbase(3,-1:nres))
19855 allocate(gvdwc_scbase(3,-1:nres))
19856 allocate(gvdwx_pepbase(3,-1:nres))
19857 allocate(gvdwc_pepbase(3,-1:nres))
19858 allocate(gvdwx_scpho(3,-1:nres))
19859 allocate(gvdwc_scpho(3,-1:nres))
19860 allocate(gvdwc_peppho(3,-1:nres))
19862 allocate(dtheta(3,2,-1:nres))
19864 allocate(gscloc(3,-1:nres))
19865 allocate(gsclocx(3,-1:nres))
19867 allocate(dphi(3,3,-1:nres))
19868 allocate(dalpha(3,3,-1:nres))
19869 allocate(domega(3,3,-1:nres))
19871 ! common /deriv_scloc/
19872 allocate(dXX_C1tab(3,nres))
19873 allocate(dYY_C1tab(3,nres))
19874 allocate(dZZ_C1tab(3,nres))
19875 allocate(dXX_Ctab(3,nres))
19876 allocate(dYY_Ctab(3,nres))
19877 allocate(dZZ_Ctab(3,nres))
19878 allocate(dXX_XYZtab(3,nres))
19879 allocate(dYY_XYZtab(3,nres))
19880 allocate(dZZ_XYZtab(3,nres))
19883 allocate(jgrad_start(nres))
19884 allocate(jgrad_end(nres))
19886 !----------------------
19889 allocate(ibond_displ(0:nfgtasks-1))
19890 allocate(ibond_count(0:nfgtasks-1))
19891 allocate(ithet_displ(0:nfgtasks-1))
19892 allocate(ithet_count(0:nfgtasks-1))
19893 allocate(iphi_displ(0:nfgtasks-1))
19894 allocate(iphi_count(0:nfgtasks-1))
19895 allocate(iphi1_displ(0:nfgtasks-1))
19896 allocate(iphi1_count(0:nfgtasks-1))
19897 allocate(ivec_displ(0:nfgtasks-1))
19898 allocate(ivec_count(0:nfgtasks-1))
19899 allocate(iset_displ(0:nfgtasks-1))
19900 allocate(iset_count(0:nfgtasks-1))
19901 allocate(iint_count(0:nfgtasks-1))
19902 allocate(iint_displ(0:nfgtasks-1))
19903 !(0:max_fg_procs-1)
19904 !----------------------
19907 allocate(gcart(3,-1:nres))
19908 allocate(gxcart(3,-1:nres))
19910 allocate(gradcag(3,-1:nres))
19911 allocate(gradxag(3,-1:nres))
19913 ! common /back_constr/
19914 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
19915 allocate(dutheta(nres))
19916 allocate(dugamma(nres))
19918 allocate(duscdiff(3,nres))
19919 allocate(duscdiffx(3,nres))
19921 !el i io:read_fragments
19922 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
19923 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
19925 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
19926 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
19927 allocate(mset(0:nprocs)) !(maxprocs/20)
19929 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
19930 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
19931 allocate(dUdconst(3,0:nres))
19932 allocate(dUdxconst(3,0:nres))
19933 allocate(dqwol(3,0:nres))
19934 allocate(dxqwol(3,0:nres))
19936 !----------------------
19938 ! common /sbridge/ in io_common: read_bridge
19939 !el allocate((:),allocatable :: iss !(maxss)
19940 ! common /links/ in io_common: read_bridge
19941 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
19942 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
19943 ! common /dyn_ssbond/
19944 ! and side-chain vectors in theta or phi.
19945 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
19949 dyn_ssbond_ij(:,:)=1.0d300
19953 ! if (nss.gt.0) then
19954 allocate(idssb(maxdim),jdssb(maxdim))
19955 ! allocate(newihpb(nss),newjhpb(nss))
19958 allocate(ishield_list(nres))
19959 allocate(shield_list(50,nres))
19960 allocate(dyn_ss_mask(nres))
19961 allocate(fac_shield(nres))
19962 allocate(enetube(nres*2))
19963 allocate(enecavtube(nres*2))
19966 dyn_ss_mask(:)=.false.
19967 !----------------------
19969 ! Parameters of the SCCOR term
19971 !el in io_conf: parmread
19972 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
19973 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
19974 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
19975 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
19976 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
19977 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
19978 ! allocate(vlor1sccor(maxterm_sccor,20,20))
19979 ! allocate(vlor2sccor(maxterm_sccor,20,20))
19980 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
19982 allocate(gloc_sc(3,0:2*nres,0:10))
19983 !(3,0:maxres2,10)maxres2=2*maxres
19984 allocate(dcostau(3,3,3,2*nres))
19985 allocate(dsintau(3,3,3,2*nres))
19986 allocate(dtauangle(3,3,3,2*nres))
19987 allocate(dcosomicron(3,3,3,2*nres))
19988 allocate(domicron(3,3,3,2*nres))
19989 !(3,3,3,maxres2)maxres2=2*maxres
19990 !----------------------
19993 allocate(varall(maxvar))
19994 !(maxvar)(maxvar=6*maxres)
19995 allocate(mask_theta(nres))
19996 allocate(mask_phi(nres))
19997 allocate(mask_side(nres))
19999 !----------------------
20002 allocate(uy(3,nres))
20003 allocate(uz(3,nres))
20005 allocate(uygrad(3,3,2,nres))
20006 allocate(uzgrad(3,3,2,nres))
20010 end subroutine alloc_ener_arrays
20011 !-----------------------------------------------------------------
20012 subroutine ebond_nucl(estr_nucl)
20014 !c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
20017 real(kind=8),dimension(3) :: u,ud
20018 real(kind=8) :: usum,uprod,uprod1,uprod2,usumsqder
20019 real(kind=8) :: estr_nucl,diff
20020 integer :: iti,i,j,k,nbi
20022 !C print *,"I enter ebond"
20024 write (iout,*) "ibondp_start,ibondp_end",&
20025 ibondp_nucl_start,ibondp_nucl_end
20026 do i=ibondp_nucl_start,ibondp_nucl_end
20027 if (itype(i-1,2).eq.ntyp1_molec(2) .or. &
20028 itype(i,2).eq.ntyp1_molec(2)) cycle
20029 ! estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
20031 ! gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
20032 ! & *dc(j,i-1)/vbld(i)
20034 ! if (energy_dec) write(iout,*)
20035 ! & "estr1",i,vbld(i),distchainmax,
20036 ! & gnmr1(vbld(i),-1.0d0,distchainmax)
20038 diff = vbld(i)-vbldp0_nucl
20039 if(energy_dec)write(iout,*) "estr_nucl_bb" , i,vbld(i),&
20040 vbldp0_nucl,diff,AKP_nucl*diff*diff
20041 estr_nucl=estr_nucl+diff*diff
20042 ! print *,estr_nucl
20044 gradb_nucl(j,i-1)=AKP_nucl*diff*dc(j,i-1)/vbld(i)
20046 !c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
20048 estr_nucl=0.5d0*AKP_nucl*estr_nucl
20049 ! print *,"partial sum", estr_nucl,AKP_nucl
20052 write (iout,*) "ibondp_start,ibondp_end",&
20053 ibond_nucl_start,ibond_nucl_end
20055 do i=ibond_nucl_start,ibond_nucl_end
20056 !C print *, "I am stuck",i
20058 if (iti.eq.ntyp1_molec(2)) cycle
20059 nbi=nbondterm_nucl(iti)
20062 diff=vbld(i+nres)-vbldsc0_nucl(1,iti)
20065 write (iout,*) "estr_nucl_sc", i,iti,vbld(i+nres),vbldsc0_nucl(1,iti),diff, &
20066 AKSC_nucl(1,iti),AKSC_nucl(1,iti)*diff*diff
20067 estr_nucl=estr_nucl+0.5d0*AKSC_nucl(1,iti)*diff*diff
20068 ! print *,estr_nucl
20070 gradbx_nucl(j,i)=AKSC_nucl(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
20074 diff=vbld(i+nres)-vbldsc0_nucl(j,iti)
20075 ud(j)=aksc_nucl(j,iti)*diff
20076 u(j)=abond0_nucl(j,iti)+0.5d0*ud(j)*diff
20090 uprod2=uprod2*u(k)*u(k)
20094 usumsqder=usumsqder+ud(j)*uprod2
20096 estr_nucl=estr_nucl+uprod/usum
20098 gradbx_nucl(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
20102 !C print *,"I am about to leave ebond"
20104 end subroutine ebond_nucl
20106 !-----------------------------------------------------------------------------
20107 subroutine ebend_nucl(etheta_nucl)
20108 real(kind=8),dimension(nntheterm_nucl+1) :: coskt,sinkt !mmaxtheterm
20109 real(kind=8),dimension(nsingle_nucl+1) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
20110 real(kind=8),dimension(ndouble_nucl+1,ndouble_nucl+1) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
20111 logical :: lprn=.false., lprn1=.false.
20112 !el local variables
20113 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
20114 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
20115 real(kind=8) :: aux,etheta_nucl,ccl,ssl,scl,csl,ethetacnstr
20116 ! local variables for constrains
20117 real(kind=8) :: difi,thetiii
20120 ! print *,"ithet_start",ithet_nucl_start," ithet_end",ithet_nucl_end,nres
20121 do i=ithet_nucl_start,ithet_nucl_end
20122 if ((itype(i-1,2).eq.ntyp1_molec(2)).or.&
20123 (itype(i-2,2).eq.ntyp1_molec(2)).or. &
20124 (itype(i,2).eq.ntyp1_molec(2))) cycle
20128 theti2=0.5d0*theta(i)
20129 ityp2=ithetyp_nucl(itype(i-1,2))
20130 do k=1,nntheterm_nucl
20131 coskt(k)=dcos(k*theti2)
20132 sinkt(k)=dsin(k*theti2)
20134 if (i.gt.3 .and. itype(i-2,2).ne.ntyp1_molec(2)) then
20137 if (phii.ne.phii) phii=150.0
20141 ityp1=ithetyp_nucl(itype(i-2,2))
20142 do k=1,nsingle_nucl
20143 cosph1(k)=dcos(k*phii)
20144 sinph1(k)=dsin(k*phii)
20148 ityp1=nthetyp_nucl+1
20149 do k=1,nsingle_nucl
20155 if (i.lt.nres .and. itype(i,2).ne.ntyp1_molec(2)) then
20158 if (phii1.ne.phii1) phii1=150.0
20159 phii1=pinorm(phii1)
20163 ityp3=ithetyp_nucl(itype(i,2))
20164 do k=1,nsingle_nucl
20165 cosph2(k)=dcos(k*phii1)
20166 sinph2(k)=dsin(k*phii1)
20170 ityp3=nthetyp_nucl+1
20171 do k=1,nsingle_nucl
20176 ethetai=aa0thet_nucl(ityp1,ityp2,ityp3)
20177 do k=1,ndouble_nucl
20179 ccl=cosph1(l)*cosph2(k-l)
20180 ssl=sinph1(l)*sinph2(k-l)
20181 scl=sinph1(l)*cosph2(k-l)
20182 csl=cosph1(l)*sinph2(k-l)
20183 cosph1ph2(l,k)=ccl-ssl
20184 cosph1ph2(k,l)=ccl+ssl
20185 sinph1ph2(l,k)=scl+csl
20186 sinph1ph2(k,l)=scl-csl
20190 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
20191 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
20192 write (iout,*) "coskt and sinkt",nntheterm_nucl
20193 do k=1,nntheterm_nucl
20194 write (iout,*) k,coskt(k),sinkt(k)
20197 do k=1,ntheterm_nucl
20198 ethetai=ethetai+aathet_nucl(k,ityp1,ityp2,ityp3)*sinkt(k)
20199 dethetai=dethetai+0.5d0*k*aathet_nucl(k,ityp1,ityp2,ityp3)&
20202 write (iout,*) "k",k," aathet",aathet_nucl(k,ityp1,ityp2,ityp3),&
20206 write (iout,*) "cosph and sinph"
20207 do k=1,nsingle_nucl
20208 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
20210 write (iout,*) "cosph1ph2 and sinph2ph2"
20211 do k=2,ndouble_nucl
20213 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
20214 sinph1ph2(l,k),sinph1ph2(k,l)
20217 write(iout,*) "ethetai",ethetai
20219 do m=1,ntheterm2_nucl
20220 do k=1,nsingle_nucl
20221 aux=bbthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)&
20222 +ccthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k)&
20223 +ddthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)&
20224 +eethet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k)
20225 ethetai=ethetai+sinkt(m)*aux
20226 dethetai=dethetai+0.5d0*m*aux*coskt(m)
20227 dephii=dephii+k*sinkt(m)*(&
20228 ccthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)-&
20229 bbthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k))
20230 dephii1=dephii1+k*sinkt(m)*(&
20231 eethet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)-&
20232 ddthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k))
20234 write (iout,*) "m",m," k",k," bbthet",&
20235 bbthet_nucl(k,m,ityp1,ityp2,ityp3)," ccthet",&
20236 ccthet_nucl(k,m,ityp1,ityp2,ityp3)," ddthet",&
20237 ddthet_nucl(k,m,ityp1,ityp2,ityp3)," eethet",&
20238 eethet_nucl(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
20242 write(iout,*) "ethetai",ethetai
20243 do m=1,ntheterm3_nucl
20244 do k=2,ndouble_nucl
20246 aux=ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
20247 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+&
20248 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
20249 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
20250 ethetai=ethetai+sinkt(m)*aux
20251 dethetai=dethetai+0.5d0*m*coskt(m)*aux
20252 dephii=dephii+l*sinkt(m)*(&
20253 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-&
20254 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
20255 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
20256 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
20257 dephii1=dephii1+(k-l)*sinkt(m)*( &
20258 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
20259 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
20260 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-&
20261 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
20263 write (iout,*) "m",m," k",k," l",l," ffthet", &
20264 ffthet_nucl(l,k,m,ityp1,ityp2,ityp3), &
20265 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ggthet",&
20266 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3),&
20267 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
20268 write (iout,*) cosph1ph2(l,k)*sinkt(m), &
20269 cosph1ph2(k,l)*sinkt(m),&
20270 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
20276 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
20277 i,theta(i)*rad2deg,phii*rad2deg, &
20278 phii1*rad2deg,ethetai
20279 etheta_nucl=etheta_nucl+ethetai
20280 ! print *,i,"partial sum",etheta_nucl
20281 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang_nucl*dephii
20282 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang_nucl*dephii1
20283 gloc(nphi+i-2,icg)=wang_nucl*dethetai
20286 end subroutine ebend_nucl
20287 !----------------------------------------------------
20288 subroutine etor_nucl(etors_nucl)
20289 ! implicit real*8 (a-h,o-z)
20290 ! include 'DIMENSIONS'
20291 ! include 'COMMON.VAR'
20292 ! include 'COMMON.GEO'
20293 ! include 'COMMON.LOCAL'
20294 ! include 'COMMON.TORSION'
20295 ! include 'COMMON.INTERACT'
20296 ! include 'COMMON.DERIV'
20297 ! include 'COMMON.CHAIN'
20298 ! include 'COMMON.NAMES'
20299 ! include 'COMMON.IOUNITS'
20300 ! include 'COMMON.FFIELD'
20301 ! include 'COMMON.TORCNSTR'
20302 ! include 'COMMON.CONTROL'
20303 real(kind=8) :: etors_nucl,edihcnstr
20305 !el local variables
20306 integer :: i,j,iblock,itori,itori1
20307 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
20308 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
20309 ! Set lprn=.true. for debugging
20313 ! print *,"iphi_nucl_start/end", iphi_nucl_start,iphi_nucl_end
20314 do i=iphi_nucl_start,iphi_nucl_end
20315 if (itype(i-2,2).eq.ntyp1_molec(2) .or. itype(i-1,2).eq.ntyp1_molec(2) &
20316 .or. itype(i-3,2).eq.ntyp1_molec(2) &
20317 .or. itype(i,2).eq.ntyp1_molec(2)) cycle
20319 itori=itortyp_nucl(itype(i-2,2))
20320 itori1=itortyp_nucl(itype(i-1,2))
20322 ! print *,i,itori,itori1
20324 !C Regular cosine and sine terms
20325 do j=1,nterm_nucl(itori,itori1)
20326 v1ij=v1_nucl(j,itori,itori1)
20327 v2ij=v2_nucl(j,itori,itori1)
20328 cosphi=dcos(j*phii)
20329 sinphi=dsin(j*phii)
20330 etors_nucl=etors_nucl+v1ij*cosphi+v2ij*sinphi
20331 if (energy_dec) etors_ii=etors_ii+&
20332 v1ij*cosphi+v2ij*sinphi
20333 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
20337 !C E = SUM ----------------------------------- - v1
20338 !C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
20340 cosphi=dcos(0.5d0*phii)
20341 sinphi=dsin(0.5d0*phii)
20342 do j=1,nlor_nucl(itori,itori1)
20343 vl1ij=vlor1_nucl(j,itori,itori1)
20344 vl2ij=vlor2_nucl(j,itori,itori1)
20345 vl3ij=vlor3_nucl(j,itori,itori1)
20346 pom=vl2ij*cosphi+vl3ij*sinphi
20347 pom1=1.0d0/(pom*pom+1.0d0)
20348 etors_nucl=etors_nucl+vl1ij*pom1
20349 if (energy_dec) etors_ii=etors_ii+ &
20352 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
20354 !C Subtract the constant term
20355 etors_nucl=etors_nucl-v0_nucl(itori,itori1)
20356 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
20357 'etor',i,etors_ii-v0_nucl(itori,itori1)
20359 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
20360 restyp(itype(i-2,2),2),i-2,restyp(itype(i-1,2),2),i-1,itori,itori1, &
20361 (v1_nucl(j,itori,itori1),j=1,6),(v2_nucl(j,itori,itori1),j=1,6)
20362 gloc(i-3,icg)=gloc(i-3,icg)+wtor_nucl*gloci
20363 !c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
20366 end subroutine etor_nucl
20367 !------------------------------------------------------------
20368 subroutine epp_nucl_sub(evdw1,ees)
20370 !C This subroutine calculates the average interaction energy and its gradient
20371 !C in the virtual-bond vectors between non-adjacent peptide groups, based on
20372 !C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
20373 !C The potential depends both on the distance of peptide-group centers and on
20374 !C the orientation of the CA-CA virtual bonds.
20376 integer :: i,j,k,iteli,itelj,num_conti,isubchap,ind
20377 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
20378 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
20379 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
20380 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
20381 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20382 dist_temp, dist_init,sss_grad,fac,evdw1ij
20383 integer xshift,yshift,zshift
20384 real(kind=8),dimension(3):: ggg,gggp,gggm,erij
20385 real(kind=8) :: ees,eesij
20386 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
20387 real(kind=8) scal_el /0.5d0/
20393 !c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
20395 ! print *,"iatel_s_nucl,iatel_e_nucl",iatel_s_nucl,iatel_e_nucl
20396 do i=iatel_s_nucl,iatel_e_nucl
20397 if (itype(i,2).eq.ntyp1_molec(2) .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
20401 dx_normi=dc_norm(1,i)
20402 dy_normi=dc_norm(2,i)
20403 dz_normi=dc_norm(3,i)
20404 xmedi=c(1,i)+0.5d0*dxi
20405 ymedi=c(2,i)+0.5d0*dyi
20406 zmedi=c(3,i)+0.5d0*dzi
20407 xmedi=dmod(xmedi,boxxsize)
20408 if (xmedi.lt.0) xmedi=xmedi+boxxsize
20409 ymedi=dmod(ymedi,boxysize)
20410 if (ymedi.lt.0) ymedi=ymedi+boxysize
20411 zmedi=dmod(zmedi,boxzsize)
20412 if (zmedi.lt.0) zmedi=zmedi+boxzsize
20414 do j=ielstart_nucl(i),ielend_nucl(i)
20415 if (itype(j,2).eq.ntyp1_molec(2) .or. itype(j+1,2).eq.ntyp1_molec(2)) cycle
20420 ! xj=c(1,j)+0.5D0*dxj-xmedi
20421 ! yj=c(2,j)+0.5D0*dyj-ymedi
20422 ! zj=c(3,j)+0.5D0*dzj-zmedi
20423 xj=c(1,j)+0.5D0*dxj
20424 yj=c(2,j)+0.5D0*dyj
20425 zj=c(3,j)+0.5D0*dzj
20426 xj=mod(xj,boxxsize)
20427 if (xj.lt.0) xj=xj+boxxsize
20428 yj=mod(yj,boxysize)
20429 if (yj.lt.0) yj=yj+boxysize
20430 zj=mod(zj,boxzsize)
20431 if (zj.lt.0) zj=zj+boxzsize
20433 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
20440 xj=xj_safe+xshift*boxxsize
20441 yj=yj_safe+yshift*boxysize
20442 zj=zj_safe+zshift*boxzsize
20443 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
20444 if(dist_temp.lt.dist_init) then
20445 dist_init=dist_temp
20454 if (isubchap.eq.1) then
20465 rij=xj*xj+yj*yj+zj*zj
20466 !c write (2,*)"ij",i,j," r0pp",r0pp," rij",rij," epspp",epspp
20467 fac=(r0pp**2/rij)**3
20471 fac=(-ev1-evdw1ij)/rij
20472 ! write (2,*)"fac",fac," ev1",ev1," ev2",ev2," evdw1ij",evdw1ij
20473 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"evdw1ij",evdw1ij
20474 evdw1=evdw1+evdw1ij
20476 !C Calculate contributions to the Cartesian gradient.
20482 gvdwpp_nucl(k,i)=gvdwpp_nucl(k,i)-ggg(k)
20483 gvdwpp_nucl(k,j)=gvdwpp_nucl(k,j)+ggg(k)
20485 !c phoshate-phosphate electrostatic interactions
20488 eesij=dexp(-BEES*rij)*fac
20489 ! write (2,*)"fac",fac," eesijpp",eesij
20490 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"eesijpp",eesij
20493 fac=-(fac+BEES)*eesij*fac
20497 !c write(2,*) "ggg",i,j,ggg(1),ggg(2),ggg(3)
20498 !c write(2,*) "gelpp",i,(gelpp(k,i),k=1,3)
20499 !c write(2,*) "gelpp",j,(gelpp(k,j),k=1,3)
20501 gelpp(k,i)=gelpp(k,i)-ggg(k)
20502 gelpp(k,j)=gelpp(k,j)+ggg(k)
20509 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
20511 gvdwpp_nucl(k,i)=6*gvdwpp_nucl(k,i)
20512 !c gelpp(k,i)=332.0d0*gelpp(k,i)
20513 gelpp(k,i)=AEES*gelpp(k,i)
20515 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
20517 !c write (2,*) "total EES",ees
20519 end subroutine epp_nucl_sub
20520 !---------------------------------------------------------------------
20521 subroutine epsb(evdwpsb,eelpsb)
20524 !C This subroutine calculates the excluded-volume interaction energy between
20525 !C peptide-group centers and side chains and its gradient in virtual-bond and
20526 !C side-chain vectors.
20528 real(kind=8),dimension(3):: ggg
20529 integer :: i,iint,j,k,iteli,itypj,subchap
20530 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
20531 e1,e2,evdwij,rij,evdwpsb,eelpsb
20532 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20533 dist_temp, dist_init
20534 integer xshift,yshift,zshift
20536 !cd print '(a)','Enter ESCP'
20537 !cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
20540 ! print *,"iatscp_s_nucl,iatscp_e_nucl",iatscp_s_nucl,iatscp_e_nucl
20541 do i=iatscp_s_nucl,iatscp_e_nucl
20542 if (itype(i,2).eq.ntyp1_molec(2) &
20543 .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
20544 xi=0.5D0*(c(1,i)+c(1,i+1))
20545 yi=0.5D0*(c(2,i)+c(2,i+1))
20546 zi=0.5D0*(c(3,i)+c(3,i+1))
20547 xi=mod(xi,boxxsize)
20548 if (xi.lt.0) xi=xi+boxxsize
20549 yi=mod(yi,boxysize)
20550 if (yi.lt.0) yi=yi+boxysize
20551 zi=mod(zi,boxzsize)
20552 if (zi.lt.0) zi=zi+boxzsize
20554 do iint=1,nscp_gr_nucl(i)
20556 do j=iscpstart_nucl(i,iint),iscpend_nucl(i,iint)
20558 if (itypj.eq.ntyp1_molec(2)) cycle
20559 !C Uncomment following three lines for SC-p interactions
20560 !c xj=c(1,nres+j)-xi
20561 !c yj=c(2,nres+j)-yi
20562 !c zj=c(3,nres+j)-zi
20563 !C Uncomment following three lines for Ca-p interactions
20570 xj=mod(xj,boxxsize)
20571 if (xj.lt.0) xj=xj+boxxsize
20572 yj=mod(yj,boxysize)
20573 if (yj.lt.0) yj=yj+boxysize
20574 zj=mod(zj,boxzsize)
20575 if (zj.lt.0) zj=zj+boxzsize
20576 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20584 xj=xj_safe+xshift*boxxsize
20585 yj=yj_safe+yshift*boxysize
20586 zj=zj_safe+zshift*boxzsize
20587 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20588 if(dist_temp.lt.dist_init) then
20589 dist_init=dist_temp
20598 if (subchap.eq.1) then
20608 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
20610 e1=fac*fac*aad_nucl(itypj)
20611 e2=fac*bad_nucl(itypj)
20612 if (iabs(j-i) .le. 2) then
20617 evdwpsb=evdwpsb+evdwij
20618 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a4)') &
20619 'evdw2',i,j,evdwij,"tu4"
20621 !C Calculate contributions to the gradient in the virtual-bond and SC vectors.
20623 fac=-(evdwij+e1)*rrij
20628 gvdwpsb1(k,i)=gvdwpsb1(k,i)-ggg(k)
20629 gvdwpsb(k,j)=gvdwpsb(k,j)+ggg(k)
20637 gvdwpsb(j,i)=expon*gvdwpsb(j,i)
20638 gvdwpsb1(j,i)=expon*gvdwpsb1(j,i)
20642 end subroutine epsb
20644 !------------------------------------------------------
20645 subroutine esb_gb(evdwsb,eelsb)
20648 integer :: iint,itypi,itypi1,itypj,subchap,num_conti2
20649 real(kind=8) :: xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
20650 real(kind=8) :: evdw,sig0iji,evdwsb,eelsb,ecorr,eelij
20651 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20652 dist_temp, dist_init,aa,bb,faclip,sig0ij
20661 ! print *,"iastsc_nucl",iatsc_s_nucl,iatsc_e_nucl
20662 do i=iatsc_s_nucl,iatsc_e_nucl
20666 ! PRINT *,"I=",i,itypi
20667 if (itypi.eq.ntyp1_molec(2)) cycle
20668 itypi1=itype(i+1,2)
20672 xi=dmod(xi,boxxsize)
20673 if (xi.lt.0) xi=xi+boxxsize
20674 yi=dmod(yi,boxysize)
20675 if (yi.lt.0) yi=yi+boxysize
20676 zi=dmod(zi,boxzsize)
20677 if (zi.lt.0) zi=zi+boxzsize
20679 dxi=dc_norm(1,nres+i)
20680 dyi=dc_norm(2,nres+i)
20681 dzi=dc_norm(3,nres+i)
20682 dsci_inv=vbld_inv(i+nres)
20684 !C Calculate SC interaction energy.
20686 do iint=1,nint_gr_nucl(i)
20687 ! print *,"tu?",i,istart_nucl(i,iint),iend_nucl(i,iint)
20688 do j=istart_nucl(i,iint),iend_nucl(i,iint)
20692 if (itypj.eq.ntyp1_molec(2)) cycle
20693 dscj_inv=vbld_inv(j+nres)
20694 sig0ij=sigma_nucl(itypi,itypj)
20695 chi1=chi_nucl(itypi,itypj)
20696 chi2=chi_nucl(itypj,itypi)
20698 chip1=chip_nucl(itypi,itypj)
20699 chip2=chip_nucl(itypj,itypi)
20701 ! xj=c(1,nres+j)-xi
20702 ! yj=c(2,nres+j)-yi
20703 ! zj=c(3,nres+j)-zi
20707 xj=dmod(xj,boxxsize)
20708 if (xj.lt.0) xj=xj+boxxsize
20709 yj=dmod(yj,boxysize)
20710 if (yj.lt.0) yj=yj+boxysize
20711 zj=dmod(zj,boxzsize)
20712 if (zj.lt.0) zj=zj+boxzsize
20713 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20721 xj=xj_safe+xshift*boxxsize
20722 yj=yj_safe+yshift*boxysize
20723 zj=zj_safe+zshift*boxzsize
20724 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20725 if(dist_temp.lt.dist_init) then
20726 dist_init=dist_temp
20735 if (subchap.eq.1) then
20745 dxj=dc_norm(1,nres+j)
20746 dyj=dc_norm(2,nres+j)
20747 dzj=dc_norm(3,nres+j)
20748 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
20750 !C Calculate angle-dependent terms of energy and contributions to their
20755 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
20756 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
20757 om12=dxi*dxj+dyi*dyj+dzi*dzj
20758 call sc_angular_nucl
20760 sig=sig0ij*dsqrt(sigsq)
20761 rij_shift=1.0D0/rij-sig+sig0ij
20762 ! print *,rij_shift,"rij_shift"
20763 !c write (2,*) " rij",1.0D0/rij," sig",sig," sig0ij",sig0ij,
20764 !c & " rij_shift",rij_shift
20765 if (rij_shift.le.0.0D0) then
20770 !c---------------------------------------------------------------
20771 rij_shift=1.0D0/rij_shift
20772 fac=rij_shift**expon
20773 e1=fac*fac*aa_nucl(itypi,itypj)
20774 e2=fac*bb_nucl(itypi,itypj)
20775 evdwij=eps1*eps2rt*(e1+e2)
20776 !c write (2,*) "eps1",eps1," eps2rt",eps2rt,
20777 !c & " e1",e1," e2",e2," evdwij",evdwij
20779 evdwij=evdwij*eps2rt
20780 evdwsb=evdwsb+evdwij
20782 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
20783 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
20784 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
20785 restyp(itypi,2),i,restyp(itypj,2),j, &
20786 epsi,sigm,chi1,chi2,chip1,chip2, &
20787 eps1,eps2rt**2,sig,sig0ij, &
20788 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
20790 write (iout,*) "aa",aa_nucl(itypi,itypj)," bb",bb_nucl(itypi,itypj)
20793 if (energy_dec) write (iout,'(a6,2i5,e15.3,a4)') &
20794 'evdw',i,j,evdwij,"tu3"
20797 !C Calculate gradient components.
20798 e1=e1*eps1*eps2rt**2
20799 fac=-expon*(e1+evdwij)*rij_shift
20803 !C Calculate the radial part of the gradient
20807 !C Calculate angular part of the gradient.
20809 call eelsbij(eelij,num_conti2)
20810 if (energy_dec .and. &
20811 (j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2)) &
20812 write (istat,'(e14.5)') evdwij
20816 num_cont_hb(i)=num_conti2
20818 !c write (iout,*) "Number of loop steps in EGB:",ind
20819 !cccc energy_dec=.false.
20821 end subroutine esb_gb
20822 !-------------------------------------------------------------------------------
20823 subroutine eelsbij(eesij,num_conti2)
20826 real(kind=8),dimension(3) :: ggg,gggp,gggm,dcosb,dcosg
20827 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
20828 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20829 dist_temp, dist_init,rlocshield,fracinbuf
20830 integer xshift,yshift,zshift,ilist,iresshield,num_conti2
20832 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
20833 real(kind=8) scal_el /0.5d0/
20834 integer :: iteli,itelj,kkk,kkll,m,isubchap
20835 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp,facfac
20836 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i,ael63i,ael32i
20837 real(kind=8) :: dx_normj,dy_normj,dz_normj,&
20838 r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,fac5,fac6,&
20839 el1,el2,el3,el4,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
20840 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
20841 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
20842 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
20843 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
20844 ecosgp,ecosam,ecosbm,ecosgm,ghalf,itypi,itypj
20848 ! print *,i,j,itypi,itypj,istype(i),istype(j),"????"
20849 ael6i=ael6_nucl(itypi,itypj)
20850 ael3i=ael3_nucl(itypi,itypj)
20851 ael63i=ael63_nucl(itypi,itypj)
20852 ael32i=ael32_nucl(itypi,itypj)
20853 !c write (iout,*) "eelecij",i,j,itype(i),itype(j),
20854 !c & ael6i,ael3i,ael63i,al32i,rij,rrij
20858 dx_normi=dc_norm(1,i+nres)
20859 dy_normi=dc_norm(2,i+nres)
20860 dz_normi=dc_norm(3,i+nres)
20861 dx_normj=dc_norm(1,j+nres)
20862 dy_normj=dc_norm(2,j+nres)
20863 dz_normj=dc_norm(3,j+nres)
20864 !c xj=c(1,j)+0.5D0*dxj-xmedi
20865 !c yj=c(2,j)+0.5D0*dyj-ymedi
20866 !c zj=c(3,j)+0.5D0*dzj-zmedi
20867 if (ipot_nucl.ne.2) then
20868 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
20869 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
20870 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
20878 fac=cosa-3.0D0*cosb*cosg
20880 fac1=3.0d0*(cosb*cosb+cosg*cosg)
20885 !c write (iout,*) "r3ij",r3ij," r6ij",r6ij," fac",fac," fac1",fac1,
20886 !c & " fac2",fac2," fac3",fac3," fac4",fac4," fac5",fac5," fac6",fac6
20887 el1=fac3*(4.0D0+facfac-fac1)
20889 el3=fac5*(2.0d0-2.0d0*facfac+fac1)
20891 eesij=el1+el2+el3+el4
20892 !C 12/26/95 - for the evaluation of multi-body H-bonding interactions
20893 ees0ij=4.0D0+facfac-fac1
20895 if (energy_dec) then
20896 if(j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2) &
20897 write (istat,'(2a1,i4,1x,2a1,i4,4f10.5,3e12.5,$)') &
20898 sugartyp(istype(i)),restyp(itypi,2),i,sugartyp(istype(j)),&
20899 restyp(itypj,2),j,1.0d0/rij,cosa,cosb,cosg,fac*r3ij, &
20900 (4.0D0+facfac-fac1)*r6ij,(2.0d0-2.0d0*facfac+fac1)*r6ij
20901 write (iout,'(a6,2i5,e15.3)') 'ees',i,j,eesij
20905 !C Calculate contributions to the Cartesian gradient.
20907 facel=-3.0d0*rrij*(eesij+el1+el3+el4)
20913 !* Radial derivatives. First process both termini of the fragment (i,j)
20919 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
20920 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
20921 gelsbx(k,j)=gelsbx(k,j)+ggg(k)
20922 gelsbx(k,i)=gelsbx(k,i)-ggg(k)
20927 ecosa=2.0D0*fac3*fac1+fac4+(-4.0d0*fac5+2.0d0*fac6)*fac1
20932 ecosb=fac3*(fac1*cosg+cosb)+cosg*fac4+(cosb+2*fac1*cosg)*fac5+&
20934 ecosg=fac3*(fac1*cosb+cosg)+cosb*fac4+(cosg+2*fac1*cosb)*fac5+&
20937 dcosb(k)=rij*(dc_norm(k,i+nres)-erij(k)*cosb)
20938 dcosg(k)=rij*(dc_norm(k,j+nres)-erij(k)*cosg)
20941 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
20944 gelsbx(k,i)=gelsbx(k,i)-ggg(k) &
20945 +(ecosa*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres))&
20946 + ecosb*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
20947 gelsbx(k,j)=gelsbx(k,j)+ggg(k) &
20948 +(ecosa*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
20949 + ecosg*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
20950 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
20951 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
20953 ! IF ( (wcorr_nucl.gt.0.0d0.or.wcorr3_nucl.gt.0.0d0) .and.
20954 IF ( j.gt.i+1 .and.&
20955 num_conti.le.maxconts) THEN
20957 !C Calculate the contact function. The ith column of the array JCONT will
20958 !C contain the numbers of atoms that make contacts with the atom I (of numbers
20959 !C greater than I). The arrays FACONT and GACONT will contain the values of
20960 !C the contact function and its derivative.
20961 r0ij=2.20D0*sigma(itypi,itypj)
20962 !c write (2,*) "ij",i,j," rij",1.0d0/rij," r0ij",r0ij
20963 call gcont(rij,r0ij,1.0D0,0.2d0/r0ij,fcont,fprimcont)
20964 !c write (2,*) "fcont",fcont
20965 if (fcont.gt.0.0D0) then
20966 num_conti=num_conti+1
20967 num_conti2=num_conti2+1
20969 if (num_conti.gt.maxconts) then
20970 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
20971 ' will skip next contacts for this conf.'
20973 jcont_hb(num_conti,i)=j
20974 !c write (iout,*) "num_conti",num_conti,
20975 !c & " jcont_hb",jcont_hb(num_conti,i)
20976 !C Calculate contact energies
20978 wij=cosa-3.0D0*cosb*cosg
20981 fac3=dsqrt(-ael6i)*r3ij
20982 !c write (2,*) "ael6i",ael6i," r3ij",r3ij," fac3",fac3
20983 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
20984 if (ees0tmp.gt.0) then
20985 ees0pij=dsqrt(ees0tmp)
20989 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
20990 if (ees0tmp.gt.0) then
20991 ees0mij=dsqrt(ees0tmp)
20995 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
20996 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
20997 !c write (iout,*) "i",i," j",j,
20998 !c & " ees0m",ees0m(num_conti,i)," ees0p",ees0p(num_conti,i)
20999 ees0pij1=fac3/ees0pij
21000 ees0mij1=fac3/ees0mij
21001 fac3p=-3.0D0*fac3*rrij
21002 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
21003 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
21004 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
21005 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
21006 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
21007 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
21008 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
21009 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
21010 ecosap=ecosa1+ecosa2
21011 ecosbp=ecosb1+ecosb2
21012 ecosgp=ecosg1+ecosg2
21013 ecosam=ecosa1-ecosa2
21014 ecosbm=ecosb1-ecosb2
21015 ecosgm=ecosg1-ecosg2
21017 facont_hb(num_conti,i)=fcont
21018 fprimcont=fprimcont/rij
21020 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
21021 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
21023 gggp(1)=gggp(1)+ees0pijp*xj
21024 gggp(2)=gggp(2)+ees0pijp*yj
21025 gggp(3)=gggp(3)+ees0pijp*zj
21026 gggm(1)=gggm(1)+ees0mijp*xj
21027 gggm(2)=gggm(2)+ees0mijp*yj
21028 gggm(3)=gggm(3)+ees0mijp*zj
21029 !C Derivatives due to the contact function
21030 gacont_hbr(1,num_conti,i)=fprimcont*xj
21031 gacont_hbr(2,num_conti,i)=fprimcont*yj
21032 gacont_hbr(3,num_conti,i)=fprimcont*zj
21035 !c Gradient of the correlation terms
21037 gacontp_hb1(k,num_conti,i)= &
21038 (ecosap*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
21039 + ecosbp*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21040 gacontp_hb2(k,num_conti,i)= &
21041 (ecosap*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres)) &
21042 + ecosgp*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21043 gacontp_hb3(k,num_conti,i)=gggp(k)
21044 gacontm_hb1(k,num_conti,i)= &
21045 (ecosam*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
21046 + ecosbm*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21047 gacontm_hb2(k,num_conti,i)= &
21048 (ecosam*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
21049 + ecosgm*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21050 gacontm_hb3(k,num_conti,i)=gggm(k)
21056 end subroutine eelsbij
21057 !------------------------------------------------------------------
21058 subroutine sc_grad_nucl
21061 real(kind=8),dimension(3) :: dcosom1,dcosom2
21062 eom1=eps2der*eps2rt_om1+sigder*sigsq_om1
21063 eom2=eps2der*eps2rt_om2+sigder*sigsq_om2
21064 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12+sigder*sigsq_om12
21066 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
21067 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
21070 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
21073 gvdwsbx(k,i)=gvdwsbx(k,i)-gg(k) &
21074 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
21075 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
21076 gvdwsbx(k,j)=gvdwsbx(k,j)+gg(k) &
21077 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
21078 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
21081 !C Calculate the components of the gradient in DC and X
21084 gvdwsbc(l,i)=gvdwsbc(l,i)-gg(l)
21085 gvdwsbc(l,j)=gvdwsbc(l,j)+gg(l)
21088 end subroutine sc_grad_nucl
21089 !-----------------------------------------------------------------------
21090 subroutine esb(esbloc)
21091 !C Calculate the local energy of a side chain and its derivatives in the
21092 !C corresponding virtual-bond valence angles THETA and the spherical angles
21093 !C ALPHA and OMEGA derived from AM1 all-atom calculations.
21094 !C added by Urszula Kozlowska. 07/11/2007
21096 real(kind=8),dimension(3):: x_prime,y_prime,z_prime
21097 real(kind=8),dimension(9):: x
21098 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1, &
21099 sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,&
21100 de_dxx,de_dyy,de_dzz,de_dt,s1_t,s1_6_t,s2_t,s2_6_t
21101 real(kind=8),dimension(3):: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,&
21102 dYY_Ci,dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
21103 real(kind=8) :: esbloc,delta,cosfac2,cosfac,sinfac2,sinfac,de_dtt,&
21104 cossc,cossc1,cosfac2xx,sinfac2yy,pom1,pom
21105 integer::it,nlobit,i,j,k
21106 ! common /sccalc/ time11,time12,time112,theti,it,nlobit
21109 do i=loc_start_nucl,loc_end_nucl
21110 if (itype(i,2).eq.ntyp1_molec(2)) cycle
21111 costtab(i+1) =dcos(theta(i+1))
21112 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
21113 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
21114 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
21115 cosfac2=0.5d0/(1.0d0+costtab(i+1))
21116 cosfac=dsqrt(cosfac2)
21117 sinfac2=0.5d0/(1.0d0-costtab(i+1))
21118 sinfac=dsqrt(sinfac2)
21120 if (it.eq.10) goto 1
21123 !C Compute the axes of tghe local cartesian coordinates system; store in
21124 !c x_prime, y_prime and z_prime
21131 !C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
21132 !C & dc_norm(3,i+nres)
21134 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
21135 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
21138 z_prime(j) = -uz(j,i-1)
21146 xx = xx + x_prime(j)*dc_norm(j,i+nres)
21147 yy = yy + y_prime(j)*dc_norm(j,i+nres)
21148 zz = zz + z_prime(j)*dc_norm(j,i+nres)
21156 x(j) = sc_parmin_nucl(j,it)
21159 !Cc diagnostics - remove later
21160 xx1 = dcos(alph(2))
21161 yy1 = dsin(alph(2))*dcos(omeg(2))
21162 zz1 = -dsin(alph(2))*dsin(omeg(2))
21163 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
21164 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
21166 !C," --- ", xx_w,yy_w,zz_w
21169 sumene = enesc_nucl(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21170 esbloc = esbloc + sumene
21171 sumene2= enesc_nucl(x,xx,yy,0.0d0,cost2tab(i+1),sint2tab(i+1))
21172 ! print *,"enecomp",sumene,sumene2
21173 ! if (energy_dec) write(iout,*) "i",i," esbloc",sumene,esbloc,xx,yy,zz
21174 ! if (energy_dec) write(iout,*) "x",(x(k),k=1,9)
21176 write (2,*) "x",(x(k),k=1,9)
21178 !C This section to check the numerical derivatives of the energy of ith side
21179 !C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
21180 !C #define DEBUG in the code to turn it on.
21182 write (2,*) "sumene =",sumene
21186 write (2,*) xx,yy,zz
21187 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21188 de_dxx_num=(sumenep-sumene)/aincr
21190 write (2,*) "xx+ sumene from enesc=",sumenep,sumene
21193 write (2,*) xx,yy,zz
21194 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21195 de_dyy_num=(sumenep-sumene)/aincr
21197 write (2,*) "yy+ sumene from enesc=",sumenep,sumene
21200 write (2,*) xx,yy,zz
21201 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21202 de_dzz_num=(sumenep-sumene)/aincr
21204 write (2,*) "zz+ sumene from enesc=",sumenep,sumene
21205 costsave=cost2tab(i+1)
21206 sintsave=sint2tab(i+1)
21207 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
21208 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
21209 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21210 de_dt_num=(sumenep-sumene)/aincr
21211 write (2,*) " t+ sumene from enesc=",sumenep,sumene
21212 cost2tab(i+1)=costsave
21213 sint2tab(i+1)=sintsave
21214 !C End of diagnostics section.
21217 !C Compute the gradient of esc
21219 de_dxx=x(1)+2*x(4)*xx+x(7)*zz+x(8)*yy
21220 de_dyy=x(2)+2*x(5)*yy+x(8)*xx+x(9)*zz
21221 de_dzz=x(3)+2*x(6)*zz+x(7)*xx+x(9)*yy
21224 write (2,*) "x",(x(k),k=1,9)
21225 write (2,*) "xx",xx," yy",yy," zz",zz
21226 write (2,*) "de_xx ",de_xx," de_yy ",de_yy,&
21227 " de_zz ",de_zz," de_tt ",de_tt
21228 write (2,*) "de_xx_num",de_dxx_num," de_yy_num",de_dyy_num,&
21229 " de_zz_num",de_dzz_num," de_dt_num",de_dt_num
21232 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
21233 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
21234 cosfac2xx=cosfac2*xx
21235 sinfac2yy=sinfac2*yy
21237 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*&
21239 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*&
21241 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
21242 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
21243 !c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
21244 !c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
21245 !c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
21246 !c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
21247 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
21248 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
21249 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
21250 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
21254 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
21255 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
21258 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
21259 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
21260 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
21262 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
21263 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
21267 dXX_Ctab(k,i)=dXX_Ci(k)
21268 dXX_C1tab(k,i)=dXX_Ci1(k)
21269 dYY_Ctab(k,i)=dYY_Ci(k)
21270 dYY_C1tab(k,i)=dYY_Ci1(k)
21271 dZZ_Ctab(k,i)=dZZ_Ci(k)
21272 dZZ_C1tab(k,i)=dZZ_Ci1(k)
21273 dXX_XYZtab(k,i)=dXX_XYZ(k)
21274 dYY_XYZtab(k,i)=dYY_XYZ(k)
21275 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
21278 !c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
21279 !c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
21280 !c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
21281 !c & dyy_ci(k)," dzz_ci",dzz_ci(k)
21282 !c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
21284 !c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
21285 !c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
21286 gsbloc(k,i-1)=gsbloc(k,i-1)+(de_dxx*dxx_ci1(k) &
21287 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k))
21288 gsbloc(k,i)=gsbloc(k,i)+(de_dxx*dxx_Ci(k) &
21289 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k))
21290 gsblocx(k,i)= de_dxx*dxx_XYZ(k)&
21291 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
21292 ! print *,i,de_dxx*dxx_ci1(k)+de_dyy*dyy_ci1(k),de_dzz*dzz_ci1(k)*2
21294 !c write(iout,*) "ENERGY GRAD = ", (gsbloc(k,i-1),k=1,3),
21295 !c & (gsbloc(k,i),k=1,3),(gsblocx(k,i),k=1,3)
21297 !C to check gradient call subroutine check_grad
21303 !=-------------------------------------------------------
21304 real(kind=8) function enesc_nucl(x,xx,yy,zz,cost2,sint2)
21306 real(kind=8),dimension(9):: x(9)
21307 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2, &
21308 sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
21310 !c write (2,*) "enesc"
21311 !c write (2,*) "x",(x(i),i=1,9)
21312 !c write(2,*)"xx",xx," yy",yy," zz",zz," cost2",cost2," sint2",sint2
21313 sumene=x(1)*xx+x(2)*yy+x(3)*zz+x(4)*xx**2 &
21314 + x(5)*yy**2+x(6)*zz**2+x(7)*xx*zz+x(8)*xx*yy &
21318 end function enesc_nucl
21319 !-----------------------------------------------------------------------------
21320 subroutine multibody_hb_nucl(ecorr,ecorr3,n_corr,n_corr1)
21323 integer,parameter :: max_cont=2000
21324 integer,parameter:: max_dim=2*(8*3+6)
21325 integer, parameter :: msglen1=max_cont*max_dim
21326 integer,parameter :: msglen2=2*msglen1
21327 integer source,CorrelType,CorrelID,Error
21328 real(kind=8) :: buffer(max_cont,max_dim)
21329 integer status(MPI_STATUS_SIZE)
21330 integer :: ierror,nbytes
21332 real(kind=8),dimension(3):: gx(3),gx1(3)
21333 real(kind=8) :: time00
21335 integer i,j,i1,j1,jj,kk,num_conti,num_conti1,nn
21336 real(kind=8) ecorr,ecorr3
21337 integer :: n_corr,n_corr1,mm,msglen
21338 !C Set lprn=.true. for debugging
21343 if(.not.allocated(zapas2)) allocate(zapas2(3,maxconts,nres,8))
21345 if (nfgtasks.le.1) goto 30
21347 write (iout,'(a)') 'Contact function values:'
21349 write (iout,'(2i3,50(1x,i2,f5.2))') &
21350 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
21351 j=1,num_cont_hb(i))
21354 !C Caution! Following code assumes that electrostatic interactions concerning
21355 !C a given atom are split among at most two processors!
21365 !c write (*,*) 'MyRank',MyRank,' mm',mm
21368 !c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
21369 if (fg_rank.gt.0) then
21370 !C Send correlation contributions to the preceding processor
21372 nn=num_cont_hb(iatel_s_nucl)
21373 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
21374 !c write (*,*) 'The BUFFER array:'
21376 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
21378 if (ielstart_nucl(iatel_s_nucl).gt.iatel_s_nucl+ispp) then
21380 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
21381 !C Clear the contacts of the atom passed to the neighboring processor
21382 nn=num_cont_hb(iatel_s_nucl+1)
21384 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
21386 num_cont_hb(iatel_s_nucl)=0
21388 !cd write (iout,*) 'Processor ',fg_rank,MyRank,
21389 !cd & ' is sending correlation contribution to processor',fg_rank-1,
21390 !cd & ' msglen=',msglen
21391 !c write (*,*) 'Processor ',fg_rank,MyRank,
21392 !c & ' is sending correlation contribution to processor',fg_rank-1,
21393 !c & ' msglen=',msglen,' CorrelType=',CorrelType
21395 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, &
21396 CorrelType,FG_COMM,IERROR)
21397 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
21398 !cd write (iout,*) 'Processor ',fg_rank,
21399 !cd & ' has sent correlation contribution to processor',fg_rank-1,
21400 !cd & ' msglen=',msglen,' CorrelID=',CorrelID
21401 !c write (*,*) 'Processor ',fg_rank,
21402 !c & ' has sent correlation contribution to processor',fg_rank-1,
21403 !c & ' msglen=',msglen,' CorrelID=',CorrelID
21405 endif ! (fg_rank.gt.0)
21409 !c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
21410 if (fg_rank.lt.nfgtasks-1) then
21411 !C Receive correlation contributions from the next processor
21413 if (ielend_nucl(iatel_e_nucl).lt.nct_molec(2)-1) msglen=msglen2
21414 !cd write (iout,*) 'Processor',fg_rank,
21415 !cd & ' is receiving correlation contribution from processor',fg_rank+1,
21416 !cd & ' msglen=',msglen,' CorrelType=',CorrelType
21417 !c write (*,*) 'Processor',fg_rank,
21418 !c &' is receiving correlation contribution from processor',fg_rank+1,
21419 !c & ' msglen=',msglen,' CorrelType=',CorrelType
21422 do while (nbytes.le.0)
21423 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
21424 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
21426 !c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
21427 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, &
21428 fg_rank+1,CorrelType,FG_COMM,status,IERROR)
21429 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
21430 !c write (*,*) 'Processor',fg_rank,
21431 !c &' has received correlation contribution from processor',fg_rank+1,
21432 !c & ' msglen=',msglen,' nbytes=',nbytes
21433 !c write (*,*) 'The received BUFFER array:'
21435 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
21437 if (msglen.eq.msglen1) then
21438 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,0,buffer)
21439 else if (msglen.eq.msglen2) then
21440 call unpack_buffer(max_cont,max_dim,iatel_e_nucl,0,buffer)
21441 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,30,buffer)
21444 'ERROR!!!! message length changed while processing correlations.'
21446 'ERROR!!!! message length changed while processing correlations.'
21447 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
21448 endif ! msglen.eq.msglen1
21449 endif ! fg_rank.lt.nfgtasks-1
21456 write (iout,'(a)') 'Contact function values:'
21457 do i=nnt_molec(2),nct_molec(2)-1
21458 write (iout,'(2i3,50(1x,i2,f5.2))') &
21459 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
21460 j=1,num_cont_hb(i))
21465 !C Remove the loop below after debugging !!!
21466 ! do i=nnt_molec(2),nct_molec(2)
21468 ! gradcorr_nucl(j,i)=0.0D0
21469 ! gradxorr_nucl(j,i)=0.0D0
21470 ! gradcorr3_nucl(j,i)=0.0D0
21471 ! gradxorr3_nucl(j,i)=0.0D0
21474 ! print *,"iatsc_s_nucl,iatsc_e_nucl",iatsc_s_nucl,iatsc_e_nucl
21475 !C Calculate the local-electrostatic correlation terms
21476 do i=iatsc_s_nucl,iatsc_e_nucl
21478 num_conti=num_cont_hb(i)
21479 num_conti1=num_cont_hb(i+1)
21480 ! print *,i,num_conti,num_conti1
21485 !c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
21486 !c & ' jj=',jj,' kk=',kk
21487 if (j1.eq.j+1 .or. j1.eq.j-1) then
21489 !C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
21490 !C The system gains extra energy.
21491 !C Tentative expression & coefficients; assumed d(stacking)=4.5 A,
21492 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
21493 !C Need to implement full formulas 34 and 35 from Liwo et al., 1998.
21495 ecorr=ecorr+ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
21496 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
21497 'ecorrh',i,j,ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
21499 else if (j1.eq.j) then
21501 !C Contacts I-J and I-(J+1) occur simultaneously.
21502 !C The system loses extra energy.
21503 !C Tentative expression & c?oefficients; assumed d(stacking)=4.5 A,
21504 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
21505 !C Need to implement full formulas 32 from Liwo et al., 1998.
21507 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
21508 !c & ' jj=',jj,' kk=',kk
21509 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i+1,j,jj,kk,0.310D0,-0.155D0)
21514 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
21515 !c & ' jj=',jj,' kk=',kk
21516 if (j1.eq.j+1) then
21517 !C Contacts I-J and (I+1)-J occur simultaneously.
21518 !C The system loses extra energy.
21519 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i,j+1,jj,kk,0.310D0,-0.155D0)
21525 end subroutine multibody_hb_nucl
21526 !-----------------------------------------------------------
21527 real(kind=8) function ehbcorr_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
21528 ! implicit real*8 (a-h,o-z)
21529 ! include 'DIMENSIONS'
21530 ! include 'COMMON.IOUNITS'
21531 ! include 'COMMON.DERIV'
21532 ! include 'COMMON.INTERACT'
21533 ! include 'COMMON.CONTACTS'
21534 real(kind=8),dimension(3) :: gx,gx1
21536 !el local variables
21537 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
21538 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
21539 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
21540 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
21544 eij=facont_hb(jj,i)
21545 ekl=facont_hb(kk,k)
21546 ees0pij=ees0p(jj,i)
21547 ees0pkl=ees0p(kk,k)
21548 ees0mij=ees0m(jj,i)
21549 ees0mkl=ees0m(kk,k)
21551 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
21552 ! print *,"ehbcorr_nucl",ekont,ees
21553 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
21554 !C Following 4 lines for diagnostics.
21559 !cd write (iout,*)'Contacts have occurred for nucleic bases',
21560 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
21561 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
21562 !C Calculate the multi-body contribution to energy.
21563 ! ecorr_nucl=ecorr_nucl+ekont*ees
21564 !C Calculate multi-body contributions to the gradient.
21565 coeffpees0pij=coeffp*ees0pij
21566 coeffmees0mij=coeffm*ees0mij
21567 coeffpees0pkl=coeffp*ees0pkl
21568 coeffmees0mkl=coeffm*ees0mkl
21570 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i) &
21571 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
21572 coeffmees0mkl*gacontm_hb1(ll,jj,i))
21573 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j) &
21574 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+&
21575 coeffmees0mkl*gacontm_hb2(ll,jj,i))
21576 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k) &
21577 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
21578 coeffmees0mij*gacontm_hb1(ll,kk,k))
21579 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l) &
21580 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
21581 coeffmees0mij*gacontm_hb2(ll,kk,k))
21582 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
21583 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
21584 coeffmees0mkl*gacontm_hb3(ll,jj,i))
21585 gradcorr_nucl(ll,j)=gradcorr_nucl(ll,j)+gradlongij
21586 gradcorr_nucl(ll,i)=gradcorr_nucl(ll,i)-gradlongij
21587 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
21588 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
21589 coeffmees0mij*gacontm_hb3(ll,kk,k))
21590 gradcorr_nucl(ll,l)=gradcorr_nucl(ll,l)+gradlongkl
21591 gradcorr_nucl(ll,k)=gradcorr_nucl(ll,k)-gradlongkl
21592 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i)-gradlongij
21593 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j)+gradlongij
21594 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k)-gradlongkl
21595 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l)+gradlongkl
21597 ehbcorr_nucl=ekont*ees
21599 end function ehbcorr_nucl
21600 !-------------------------------------------------------------------------
21602 real(kind=8) function ehbcorr3_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
21603 ! implicit real*8 (a-h,o-z)
21604 ! include 'DIMENSIONS'
21605 ! include 'COMMON.IOUNITS'
21606 ! include 'COMMON.DERIV'
21607 ! include 'COMMON.INTERACT'
21608 ! include 'COMMON.CONTACTS'
21609 real(kind=8),dimension(3) :: gx,gx1
21611 !el local variables
21612 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
21613 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
21614 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
21615 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
21619 eij=facont_hb(jj,i)
21620 ekl=facont_hb(kk,k)
21621 ees0pij=ees0p(jj,i)
21622 ees0pkl=ees0p(kk,k)
21623 ees0mij=ees0m(jj,i)
21624 ees0mkl=ees0m(kk,k)
21626 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
21627 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
21628 !C Following 4 lines for diagnostics.
21633 !cd write (iout,*)'Contacts have occurred for nucleic bases',
21634 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
21635 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
21636 !C Calculate the multi-body contribution to energy.
21637 ! ecorr=ecorr+ekont*ees
21638 !C Calculate multi-body contributions to the gradient.
21639 coeffpees0pij=coeffp*ees0pij
21640 coeffmees0mij=coeffm*ees0mij
21641 coeffpees0pkl=coeffp*ees0pkl
21642 coeffmees0mkl=coeffm*ees0mkl
21644 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i) &
21645 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
21646 coeffmees0mkl*gacontm_hb1(ll,jj,i))
21647 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j) &
21648 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
21649 coeffmees0mkl*gacontm_hb2(ll,jj,i))
21650 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k) &
21651 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ &
21652 coeffmees0mij*gacontm_hb1(ll,kk,k))
21653 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l) &
21654 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
21655 coeffmees0mij*gacontm_hb2(ll,kk,k))
21656 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
21657 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
21658 coeffmees0mkl*gacontm_hb3(ll,jj,i))
21659 gradcorr3_nucl(ll,j)=gradcorr3_nucl(ll,j)+gradlongij
21660 gradcorr3_nucl(ll,i)=gradcorr3_nucl(ll,i)-gradlongij
21661 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
21662 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
21663 coeffmees0mij*gacontm_hb3(ll,kk,k))
21664 gradcorr3_nucl(ll,l)=gradcorr3_nucl(ll,l)+gradlongkl
21665 gradcorr3_nucl(ll,k)=gradcorr3_nucl(ll,k)-gradlongkl
21666 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i)-gradlongij
21667 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j)+gradlongij
21668 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k)-gradlongkl
21669 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l)+gradlongkl
21671 ehbcorr3_nucl=ekont*ees
21673 end function ehbcorr3_nucl
21675 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
21676 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
21677 real(kind=8):: buffer(dimen1,dimen2)
21678 num_kont=num_cont_hb(atom)
21682 buffer(i,indx+(k-1)*3+j)=zapas2(j,i,atom,k)
21685 buffer(i,indx+25)=facont_hb(i,atom)
21686 buffer(i,indx+26)=ees0p(i,atom)
21687 buffer(i,indx+27)=ees0m(i,atom)
21688 buffer(i,indx+28)=d_cont(i,atom)
21689 buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
21691 buffer(1,indx+30)=dfloat(num_kont)
21693 end subroutine pack_buffer
21694 !c------------------------------------------------------------------------------
21695 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
21696 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
21697 real(kind=8):: buffer(dimen1,dimen2)
21698 ! double precision zapas
21699 ! common /contacts_hb/ zapas(3,maxconts,maxres,8),
21700 ! & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
21701 ! & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
21702 ! & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
21703 num_kont=buffer(1,indx+30)
21704 num_kont_old=num_cont_hb(atom)
21705 num_cont_hb(atom)=num_kont+num_kont_old
21710 zapas2(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
21713 facont_hb(ii,atom)=buffer(i,indx+25)
21714 ees0p(ii,atom)=buffer(i,indx+26)
21715 ees0m(ii,atom)=buffer(i,indx+27)
21716 d_cont(i,atom)=buffer(i,indx+28)
21717 jcont_hb(ii,atom)=buffer(i,indx+29)
21720 end subroutine unpack_buffer
21721 !c------------------------------------------------------------------------------
21723 subroutine ecatcat(ecationcation)
21724 integer :: i,j,itmp,xshift,yshift,zshift,subchap,k
21725 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
21726 r7,r4,ecationcation,k0,rcal
21727 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
21728 dist_init,dist_temp,Evan1cat,Evan2cat,Eeleccat
21729 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
21732 ecationcation=0.0d0
21733 if (nres_molec(5).eq.0) return
21738 k0 = 332.0*(2.0*2.0)/80.0
21741 itmp=itmp+nres_molec(i)
21743 do i=itmp+1,itmp+nres_molec(i)-1
21748 xi=mod(xi,boxxsize)
21749 if (xi.lt.0) xi=xi+boxxsize
21750 yi=mod(yi,boxysize)
21751 if (yi.lt.0) yi=yi+boxysize
21752 zi=mod(zi,boxzsize)
21753 if (zi.lt.0) zi=zi+boxzsize
21755 do j=i+1,itmp+nres_molec(5)
21756 ! print *,i,j,'catcat'
21760 xj=dmod(xj,boxxsize)
21761 if (xj.lt.0) xj=xj+boxxsize
21762 yj=dmod(yj,boxysize)
21763 if (yj.lt.0) yj=yj+boxysize
21764 zj=dmod(zj,boxzsize)
21765 if (zj.lt.0) zj=zj+boxzsize
21766 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21774 xj=xj_safe+xshift*boxxsize
21775 yj=yj_safe+yshift*boxysize
21776 zj=zj_safe+zshift*boxzsize
21777 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21778 if(dist_temp.lt.dist_init) then
21779 dist_init=dist_temp
21788 if (subchap.eq.1) then
21797 rcal =xj**2+yj**2+zj**2
21803 ! k0 = 332*(2*2)/80
21804 Evan1cat=epscalc*(r012/rcal**6)
21805 Evan2cat=epscalc*2*(r06/rcal**3)
21813 dEvan1Cmcat(k)=-12*r(k)*epscalc*r012/r7
21814 dEvan2Cmcat(k)=-12*r(k)*epscalc*r06/r4
21815 dEeleccat(k)=-k0*r(k)/ract**3
21818 gg(k) = dEvan1Cmcat(k)+dEvan2Cmcat(k)+dEeleccat(k)
21819 gradcatcat(k,i)=gradcatcat(k,i)-gg(k)
21820 gradcatcat(k,j)=gradcatcat(k,j)+gg(k)
21823 ecationcation=ecationcation+Evan1cat+Evan2cat+Eeleccat
21827 end subroutine ecatcat
21828 !---------------------------------------------------------------------------
21829 subroutine ecat_prot(ecation_prot)
21830 integer i,j,k,subchap,itmp,inum
21831 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
21832 r7,r4,ecationcation
21833 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
21834 dist_init,dist_temp,ecation_prot,rcal,rocal, &
21835 Evan1,Evan2,EC,cm1mag,DASGL,delta,r0p,Epepcat, &
21836 catl,cml,calpl, Etotal_p, Etotal_m,rtab,wdip,wmodquad,wquad1, &
21837 wquad2,wvan1,E1,E2,wconst,wvan2,rcpm,dcmag,sin2thet,sinthet, &
21838 costhet,v1m,v2m,wh2o,wc,rsecp,Ir,Irsecp,Irthrp,Irfourp,Irfiftp,&
21839 Irsistp,Irseven,Irtwelv,Irthir,dE1dr,dE2dr,dEdcos,wquad2p,opt, &
21840 rs,rthrp,rfourp,rsixp,reight,Irsixp,Ireight,Irtw,Irfourt, &
21841 opt1,opt2,opt3,opt4,opt5,opt6,opt7,opt8,opt9,opt10,opt11,opt12,&
21842 opt13,opt14,opt15,opt16,opt17,opt18,opt19, &
21843 Equad1,Equad2,dscmag,v1dpv2,dscmag3,constA,constB,Edip
21844 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
21845 gg,r,EtotalCat,dEtotalCm,dEtotalCalp,dEvan1Cm,dEvan2Cm, &
21846 dEtotalpep,dEtotalcat_num,dEddci,dEtotalcm_num,dEtotalcalp_num, &
21847 tab1,tab2,tab3,diff,cm1,sc,p,tcat,talp,cm,drcp,drcp_norm,vcat, &
21848 v1,v2,v3,myd_norm,dx,vcm,valpha,drdpep,dcosdpep,dcosddci,dEdpep,&
21849 dEcCat,dEdipCm,dEdipCalp,dEquad1Cat,dEquad1Cm,dEquad1Calp, &
21850 dEquad2Cat,dEquad2Cm,dEquad2Calpd,Evan1Cat,dEvan1Calp,dEvan2Cat,&
21851 dEvan2Calp,dEtotalCat,dscvec,dEcCm,dEcCalp,dEdipCat,dEquad2Calp,&
21853 real(kind=8),dimension(6) :: vcatprm
21855 ! first lets calculate interaction with peptide groups
21856 if (nres_molec(5).eq.0) return
21858 wdip =1.092777950857032D2
21860 wmodquad=-2.174122713004870D4
21861 wmodquad=wmodquad/wconst
21862 wquad1 = 3.901232068562804D1
21863 wquad1=wquad1/wconst
21865 wquad2=wquad2/wconst
21870 itmp=itmp+nres_molec(i)
21872 do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
21874 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle ! leave dummy atoms
21875 xi=0.5d0*(c(1,i)+c(1,i+1))
21876 yi=0.5d0*(c(2,i)+c(2,i+1))
21877 zi=0.5d0*(c(3,i)+c(3,i+1))
21878 xi=mod(xi,boxxsize)
21879 if (xi.lt.0) xi=xi+boxxsize
21880 yi=mod(yi,boxysize)
21881 if (yi.lt.0) yi=yi+boxysize
21882 zi=mod(zi,boxzsize)
21883 if (zi.lt.0) zi=zi+boxzsize
21885 do j=itmp+1,itmp+nres_molec(5)
21889 xj=dmod(xj,boxxsize)
21890 if (xj.lt.0) xj=xj+boxxsize
21891 yj=dmod(yj,boxysize)
21892 if (yj.lt.0) yj=yj+boxysize
21893 zj=dmod(zj,boxzsize)
21894 if (zj.lt.0) zj=zj+boxzsize
21895 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21903 xj=xj_safe+xshift*boxxsize
21904 yj=yj_safe+yshift*boxysize
21905 zj=zj_safe+zshift*boxzsize
21906 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21907 if(dist_temp.lt.dist_init) then
21908 dist_init=dist_temp
21917 if (subchap.eq.1) then
21928 rcpm = sqrt(xj**2+yj**2+zj**2)
21929 drcp_norm(1)=xj/rcpm
21930 drcp_norm(2)=yj/rcpm
21931 drcp_norm(3)=zj/rcpm
21934 dcmag=dcmag+dc(k,i)**2
21938 myd_norm(k)=dc(k,i)/dcmag
21940 costhet=drcp_norm(1)*myd_norm(1)+drcp_norm(2)*myd_norm(2)+&
21941 drcp_norm(3)*myd_norm(3)
21944 Irsecp = 1.0d0/rsecp
21945 Irthrp = Irsecp/rcpm
21946 Irfourp = Irthrp/rcpm
21947 Irfiftp = Irfourp/rcpm
21948 Irsistp=Irfiftp/rcpm
21949 Irseven=Irsistp/rcpm
21950 Irtwelv=Irsistp*Irsistp
21951 Irthir=Irtwelv/rcpm
21952 sin2thet = (1-costhet*costhet)
21953 sinthet=sqrt(sin2thet)
21954 E1 = wdip*Irsecp*costhet+(wmodquad*Irfourp+wquad1*Irthrp)&
21956 E2 = -wquad1*Irthrp*wquad2+wvan1*(wvan2**12*Irtwelv-&
21957 2*wvan2**6*Irsistp)
21958 ecation_prot = ecation_prot+E1+E2
21959 dE1dr = -2*costhet*wdip*Irthrp-&
21960 (4*wmodquad*Irfiftp+3*wquad1*Irfourp)*sin2thet
21961 dE2dr = 3*wquad1*wquad2*Irfourp- &
21962 12*wvan1*wvan2**6*(wvan2**6*Irthir-Irseven)
21963 dEdcos = wdip*Irsecp-2*(wmodquad*Irfourp+wquad1*Irthrp)*costhet
21965 drdpep(k) = -drcp_norm(k)
21966 dcosdpep(k) = Ir*(costhet*drcp_norm(k)-myd_norm(k))
21967 dcosddci(k) = drcp_norm(k)/dcmag-costhet*myd_norm(k)/dcmag
21968 dEdpep(k) = (dE1dr+dE2dr)*drdpep(k)+dEdcos*dcosdpep(k)
21969 dEddci(k) = dEdcos*dcosddci(k)
21972 gradpepcat(k,i)=gradpepcat(k,i)+0.5D0*dEdpep(k)-dEddci(k)
21973 gradpepcat(k,i+1)=gradpepcat(k,i+1)+0.5D0*dEdpep(k)+dEddci(k)
21974 gradpepcat(k,j)=gradpepcat(k,j)-dEdpep(k)
21978 !------------------------------------------sidechains
21979 do i=1,nres_molec(1)
21980 if ((itype(i,1).eq.ntyp1)) cycle ! leave dummy atoms
21982 ! print *,i,ecation_prot
21986 xi=mod(xi,boxxsize)
21987 if (xi.lt.0) xi=xi+boxxsize
21988 yi=mod(yi,boxysize)
21989 if (yi.lt.0) yi=yi+boxysize
21990 zi=mod(zi,boxzsize)
21991 if (zi.lt.0) zi=zi+boxzsize
21993 cm1(k)=dc(k,i+nres)
21995 cm1mag=sqrt(cm1(1)**2+cm1(2)**2+cm1(3)**2)
21996 do j=itmp+1,itmp+nres_molec(5)
22000 xj=dmod(xj,boxxsize)
22001 if (xj.lt.0) xj=xj+boxxsize
22002 yj=dmod(yj,boxysize)
22003 if (yj.lt.0) yj=yj+boxysize
22004 zj=dmod(zj,boxzsize)
22005 if (zj.lt.0) zj=zj+boxzsize
22006 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22014 xj=xj_safe+xshift*boxxsize
22015 yj=yj_safe+yshift*boxysize
22016 zj=zj_safe+zshift*boxzsize
22017 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22018 if(dist_temp.lt.dist_init) then
22019 dist_init=dist_temp
22028 if (subchap.eq.1) then
22039 if(itype(i,1).eq.15.or.itype(i,1).eq.16) then
22040 if(itype(i,1).eq.16) then
22046 vcatprm(k)=catprm(k,inum)
22048 dASGL=catprm(7,inum)
22050 vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
22055 dx(k) = vcat(k)-vcm(k)
22058 v1(k)=(vcm(k)-valpha(k))
22059 v2(k)=(vcat(k)-valpha(k))
22061 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
22062 v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
22063 v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
22065 ! The weights of the energy function calculated from
22066 !The quantum mechanical GAMESS simulations of calcium with ASP/GLU
22074 wquad2 = vcatprm(4)
22079 opt = dx(1)**2+dx(2)**2
22080 rsecp = opt+dx(3)**2
22084 rsixp = rfourp*rsecp
22089 Irfourp = Irthrp/rs
22095 opt1 = (4*rs*dx(3)*wdip)
22096 opt2 = 6*rsecp*wquad1*opt
22097 opt3 = wquad1*wquad2p*Irsixp
22098 opt4 = (wvan1*wvan2**12)
22099 opt5 = opt4*12*Irfourt
22100 opt6 = 2*wvan1*wvan2**6
22101 opt7 = 6*opt6*Ireight
22104 opt11 = (rsecp*v2m)**2
22105 opt12 = (rsecp*v1m)**2
22106 opt14 = (v1m*v2m*rsecp)**2
22107 opt15 = -wquad1/v2m**2
22108 opt16 = (rthrp*(v1m*v2m)**2)**2
22109 opt17 = (v1m**2*rthrp)**2
22110 opt18 = -wquad1/rthrp
22111 opt19 = (v1m**2*v2m**2)**2
22114 dEcCat(k) = -(dx(k)*wc)*Irthrp
22115 dEcCm(k)=(dx(k)*wc)*Irthrp
22118 Edip=opt8*(v1dpv2)/(rsecp*v2m)
22120 dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m &
22121 *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
22122 dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m &
22123 *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
22124 dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m &
22125 *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp) &
22128 Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
22130 dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp* &
22131 (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2* &
22132 v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
22133 dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp* &
22134 (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2* &
22135 v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
22136 dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
22137 v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)* &
22140 Equad2=wquad1*wquad2p*Irthrp
22142 dEquad2Cat(k)=-3*dx(k)*rs*opt3
22143 dEquad2Cm(k)=3*dx(k)*rs*opt3
22144 dEquad2Calp(k)=0.0d0
22148 dEvan1Cat(k)=-dx(k)*opt5
22149 dEvan1Cm(k)=dx(k)*opt5
22150 dEvan1Calp(k)=0.0d0
22154 dEvan2Cat(k)=dx(k)*opt7
22155 dEvan2Cm(k)=-dx(k)*opt7
22156 dEvan2Calp(k)=0.0d0
22158 ecation_prot=ecation_prot+Ec+Edip+Equad1+Equad2+Evan1+Evan2
22159 ! print *,ecation_prot,Ec+Edip+Equad1+Equad2+Evan1+Evan2
22162 dEtotalCat(k)=dEcCat(k)+dEdipCat(k)+dEquad1Cat(k)+ &
22163 dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
22164 !c write(*,*) 'dEtotalCat inside', (dEtotalCat(l),l=1,3)
22165 dEtotalCm(k)=dEcCm(k)+dEdipCm(k)+dEquad1Cm(k)+ &
22166 dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
22167 dEtotalCalp(k)=dEcCalp(k)+dEdipCalp(k)+dEquad1Calp(k) &
22168 +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
22172 dscvec(k) = dc(k,i+nres)
22173 dscmag = dscmag+dscvec(k)*dscvec(k)
22176 dscmag = sqrt(dscmag)
22177 dscmag3 = dscmag3*dscmag
22178 constA = 1.0d0+dASGL/dscmag
22181 constB = constB+dscvec(k)*dEtotalCm(k)
22183 constB = constB*dASGL/dscmag3
22185 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
22186 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
22187 constA*dEtotalCm(k)-constB*dscvec(k)
22188 ! print *,j,constA,dEtotalCm(k),constB,dscvec(k)
22189 gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
22190 gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
22192 else if (itype(i,1).eq.13.or.itype(i,1).eq.14) then
22193 if(itype(i,1).eq.14) then
22199 vcatprm(k)=catprm(k,inum)
22201 dASGL=catprm(7,inum)
22203 vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
22209 dx(k) = vcat(k)-vcm(k)
22212 v1(k)=(vcm(k)-valpha(k))
22213 v2(k)=(vcat(k)-valpha(k))
22215 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
22216 v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
22217 v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
22218 ! The weights of the energy function calculated from
22219 !The quantum mechanical GAMESS simulations of ASN/GLN with calcium
22225 wquad2 = vcatprm(4)
22230 opt = dx(1)**2+dx(2)**2
22231 rsecp = opt+dx(3)**2
22235 rsixp = rfourp*rsecp
22240 Irfourp = Irthrp/rs
22246 opt1 = (4*rs*dx(3)*wdip)
22247 opt2 = 6*rsecp*wquad1*opt
22248 opt3 = wquad1*wquad2p*Irsixp
22249 opt4 = (wvan1*wvan2**12)
22250 opt5 = opt4*12*Irfourt
22251 opt6 = 2*wvan1*wvan2**6
22252 opt7 = 6*opt6*Ireight
22255 opt11 = (rsecp*v2m)**2
22256 opt12 = (rsecp*v1m)**2
22257 opt14 = (v1m*v2m*rsecp)**2
22258 opt15 = -wquad1/v2m**2
22259 opt16 = (rthrp*(v1m*v2m)**2)**2
22260 opt17 = (v1m**2*rthrp)**2
22261 opt18 = -wquad1/rthrp
22262 opt19 = (v1m**2*v2m**2)**2
22263 Edip=opt8*(v1dpv2)/(rsecp*v2m)
22265 dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m&
22266 *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
22267 dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m&
22268 *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
22269 dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m&
22270 *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp)&
22273 Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
22275 dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp*&
22276 (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2*&
22277 v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
22278 dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp*&
22279 (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2*&
22280 v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
22281 dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
22282 v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)*&
22285 Equad2=wquad1*wquad2p*Irthrp
22287 dEquad2Cat(k)=-3*dx(k)*rs*opt3
22288 dEquad2Cm(k)=3*dx(k)*rs*opt3
22289 dEquad2Calp(k)=0.0d0
22293 dEvan1Cat(k)=-dx(k)*opt5
22294 dEvan1Cm(k)=dx(k)*opt5
22295 dEvan1Calp(k)=0.0d0
22299 dEvan2Cat(k)=dx(k)*opt7
22300 dEvan2Cm(k)=-dx(k)*opt7
22301 dEvan2Calp(k)=0.0d0
22303 ecation_prot = ecation_prot+Edip+Equad1+Equad2+Evan1+Evan2
22305 dEtotalCat(k)=dEdipCat(k)+dEquad1Cat(k)+ &
22306 dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
22307 dEtotalCm(k)=dEdipCm(k)+dEquad1Cm(k)+ &
22308 dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
22309 dEtotalCalp(k)=dEdipCalp(k)+dEquad1Calp(k) &
22310 +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
22314 dscvec(k) = c(k,i+nres)-c(k,i)
22315 dscmag = dscmag+dscvec(k)*dscvec(k)
22318 dscmag = sqrt(dscmag)
22319 dscmag3 = dscmag3*dscmag
22320 constA = 1+dASGL/dscmag
22323 constB = constB+dscvec(k)*dEtotalCm(k)
22325 constB = constB*dASGL/dscmag3
22327 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
22328 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
22329 constA*dEtotalCm(k)-constB*dscvec(k)
22330 gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
22331 gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
22336 r(k) = c(k,j)-c(k,i+nres)
22337 rcal = rcal+r(k)*r(k)
22342 r0p=0.5*(rocal+sig0(itype(i,1)))
22345 Evan1=epscalc*(r012/rcal**6)
22346 Evan2=epscalc*2*(r06/rcal**3)
22350 dEvan1Cm(k) = 12*r(k)*epscalc*r012/r7
22351 dEvan2Cm(k) = 12*r(k)*epscalc*r06/r4
22354 dEtotalCm(k)=dEvan1Cm(k)+dEvan2Cm(k)
22356 ecation_prot = ecation_prot+ Evan1+Evan2
22358 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
22360 gradpepcat(k,i)=gradpepcat(k,i)+dEtotalCm(k)
22361 gradpepcat(k,j)=gradpepcat(k,j)-dEtotalCm(k)
22363 endif ! 13-16 residues
22367 end subroutine ecat_prot
22369 !----------------------------------------------------------------------------
22370 !-----------------------------------------------------------------------------
22371 !-----------------------------------------------------------------------------
22372 subroutine eprot_sc_base(escbase)
22374 ! implicit real*8 (a-h,o-z)
22375 ! include 'DIMENSIONS'
22376 ! include 'COMMON.GEO'
22377 ! include 'COMMON.VAR'
22378 ! include 'COMMON.LOCAL'
22379 ! include 'COMMON.CHAIN'
22380 ! include 'COMMON.DERIV'
22381 ! include 'COMMON.NAMES'
22382 ! include 'COMMON.INTERACT'
22383 ! include 'COMMON.IOUNITS'
22384 ! include 'COMMON.CALC'
22385 ! include 'COMMON.CONTROL'
22386 ! include 'COMMON.SBRIDGE'
22388 !el local variables
22389 integer :: iint,itypi,itypi1,itypj,subchap
22390 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
22391 real(kind=8) :: evdw,sig0ij
22392 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
22393 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
22394 sslipi,sslipj,faclip
22396 real(kind=8) :: fracinbuf
22397 real (kind=8) :: escbase
22398 real (kind=8),dimension(4):: ener
22399 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
22400 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
22401 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
22402 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
22403 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
22404 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
22405 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
22406 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
22407 real(kind=8),dimension(3,2)::chead,erhead_tail
22408 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
22412 do i=1,nres_molec(1)
22413 if (itype(i,1).eq.ntyp1_molec(1)) cycle
22415 dxi = dc_norm(1,nres+i)
22416 dyi = dc_norm(2,nres+i)
22417 dzi = dc_norm(3,nres+i)
22418 dsci_inv = vbld_inv(i+nres)
22422 xi=mod(xi,boxxsize)
22423 if (xi.lt.0) xi=xi+boxxsize
22424 yi=mod(yi,boxysize)
22425 if (yi.lt.0) yi=yi+boxysize
22426 zi=mod(zi,boxzsize)
22427 if (zi.lt.0) zi=zi+boxzsize
22428 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
22430 if (itype(j,2).eq.ntyp1_molec(2))cycle
22434 xj=dmod(xj,boxxsize)
22435 if (xj.lt.0) xj=xj+boxxsize
22436 yj=dmod(yj,boxysize)
22437 if (yj.lt.0) yj=yj+boxysize
22438 zj=dmod(zj,boxzsize)
22439 if (zj.lt.0) zj=zj+boxzsize
22440 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22449 xj=xj_safe+xshift*boxxsize
22450 yj=yj_safe+yshift*boxysize
22451 zj=zj_safe+zshift*boxzsize
22452 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22453 if(dist_temp.lt.dist_init) then
22454 dist_init=dist_temp
22463 if (subchap.eq.1) then
22472 dxj = dc_norm( 1, nres+j )
22473 dyj = dc_norm( 2, nres+j )
22474 dzj = dc_norm( 3, nres+j )
22475 ! print *,i,j,itypi,itypj
22476 d1i = dhead_scbasei(itypi,itypj) !this is shift of dipole/charge
22477 d1j = dhead_scbasej(itypi,itypj) !this is shift of dipole/charge
22480 ! BetaT = 1.0d0 / (298.0d0 * Rb)
22482 sig0ij = sigma_scbase( itypi,itypj )
22483 chi1 = chi_scbase( itypi, itypj,1 )
22484 chi2 = chi_scbase( itypi, itypj,2 )
22487 chi12 = chi1 * chi2
22488 chip1 = chipp_scbase( itypi, itypj,1 )
22489 chip2 = chipp_scbase( itypi, itypj,2 )
22492 chip12 = chip1 * chip2
22493 ! not used by momo potential, but needed by sc_angular which is shared
22494 ! by all energy_potential subroutines
22498 a12sq = rborn_scbasei(itypi,itypj) * rborn_scbasej(itypi,itypj)
22499 ! a12sq = a12sq * a12sq
22500 ! charge of amino acid itypi is...
22501 chis1 = chis_scbase(itypi,itypj,1)
22502 chis2 = chis_scbase(itypi,itypj,2)
22503 chis12 = chis1 * chis2
22504 sig1 = sigmap1_scbase(itypi,itypj)
22505 sig2 = sigmap2_scbase(itypi,itypj)
22506 ! write (*,*) "sig1 = ", sig1
22507 ! write (*,*) "sig2 = ", sig2
22508 ! alpha factors from Fcav/Gcav
22509 b1 = alphasur_scbase(1,itypi,itypj)
22511 b2 = alphasur_scbase(2,itypi,itypj)
22512 b3 = alphasur_scbase(3,itypi,itypj)
22513 b4 = alphasur_scbase(4,itypi,itypj)
22514 ! used to determine whether we want to do quadrupole calculations
22516 eps_in = epsintab_scbase(itypi,itypj)
22517 if (eps_in.eq.0.0) eps_in=1.0
22518 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
22519 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
22520 !-------------------------------------------------------------------
22521 ! tail location and distance calculations
22523 ! location of polar head is computed by taking hydrophobic centre
22524 ! and moving by a d1 * dc_norm vector
22525 ! see unres publications for very informative images
22526 chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
22527 chead(k,2) = c(k, j+nres) + d1j * dc_norm(k, j+nres)
22529 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
22530 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
22531 Rhead_distance(k) = chead(k,2) - chead(k,1)
22533 ! pitagoras (root of sum of squares)
22535 (Rhead_distance(1)*Rhead_distance(1)) &
22536 + (Rhead_distance(2)*Rhead_distance(2)) &
22537 + (Rhead_distance(3)*Rhead_distance(3)))
22538 !-------------------------------------------------------------------
22539 ! zero everything that should be zero'ed
22557 dscj_inv = vbld_inv(j+nres)
22558 ! print *,i,j,dscj_inv,dsci_inv
22559 ! rij holds 1/(distance of Calpha atoms)
22560 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
22562 !----------------------------
22564 ! this should be in elgrad_init but om's are calculated by sc_angular
22565 ! which in turn is used by older potentials
22566 ! om = omega, sqom = om^2
22569 sqom12 = om12 * om12
22571 ! now we calculate EGB - Gey-Berne
22572 ! It will be summed up in evdwij and saved in evdw
22573 sigsq = 1.0D0 / sigsq
22574 sig = sig0ij * dsqrt(sigsq)
22575 ! rij_shift = 1.0D0 / rij - sig + sig0ij
22576 rij_shift = 1.0/rij - sig + sig0ij
22577 IF (rij_shift.le.0.0D0) THEN
22581 sigder = -sig * sigsq
22582 rij_shift = 1.0D0 / rij_shift
22583 fac = rij_shift**expon
22584 c1 = fac * fac * aa_scbase(itypi,itypj)
22586 c2 = fac * bb_scbase(itypi,itypj)
22588 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
22589 eps2der = eps3rt * evdwij
22590 eps3der = eps2rt * evdwij
22591 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
22592 evdwij = eps2rt * eps3rt * evdwij
22593 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
22594 fac = -expon * (c1 + evdwij) * rij_shift
22595 sigder = fac * sigder
22597 ! Calculate distance derivative
22601 ! if (b2.gt.0.0) then
22602 fac = chis1 * sqom1 + chis2 * sqom2 &
22603 - 2.0d0 * chis12 * om1 * om2 * om12
22604 ! we will use pom later in Gcav, so dont mess with it!
22605 pom = 1.0d0 - chis1 * chis2 * sqom12
22606 Lambf = (1.0d0 - (fac / pom))
22607 Lambf = dsqrt(Lambf)
22608 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
22609 ! write (*,*) "sparrow = ", sparrow
22610 Chif = 1.0d0/rij * sparrow
22611 ChiLambf = Chif * Lambf
22612 eagle = dsqrt(ChiLambf)
22613 bat = ChiLambf ** 11.0d0
22614 top = b1 * ( eagle + b2 * ChiLambf - b3 )
22615 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
22619 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
22620 dbot = 12.0d0 * b4 * bat * Lambf
22621 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
22623 ! write (*,*) "dFcav/dR = ", dFdR
22624 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
22625 dbot = 12.0d0 * b4 * bat * Chif
22626 eagle = Lambf * pom
22627 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
22628 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
22629 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
22630 * (chis2 * om2 * om12 - om1) / (eagle * pom)
22632 dFdL = ((dtop * bot - top * dbot) / botsq)
22634 dCAVdOM1 = dFdL * ( dFdOM1 )
22635 dCAVdOM2 = dFdL * ( dFdOM2 )
22636 dCAVdOM12 = dFdL * ( dFdOM12 )
22641 ! eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
22642 ! eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
22643 ! eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
22644 ! -2.0D0*alf12*eps3der+sigder*sigsq_om12
22645 ! print *,"EOMY",eom1,eom2,eom12
22646 ! erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
22647 ! erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
22649 ! facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
22650 ! facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
22652 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
22653 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
22655 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
22656 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
22657 - (( dFdR + gg(k) ) * pom)
22658 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
22659 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
22660 ! & - ( dFdR * pom )
22662 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
22663 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
22664 + (( dFdR + gg(k) ) * pom)
22665 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
22666 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
22667 !c! & + ( dFdR * pom )
22669 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
22670 - (( dFdR + gg(k) ) * ertail(k))
22671 !c! & - ( dFdR * ertail(k))
22673 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
22674 + (( dFdR + gg(k) ) * ertail(k))
22675 !c! & + ( dFdR * ertail(k))
22678 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
22679 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
22686 if (wdipdip_scbase(2,itypi,itypj).gt.0.0d0) then
22687 w1 = wdipdip_scbase(1,itypi,itypj)
22688 w2 = wdipdip_scbase(3,itypi,itypj)*2.0
22689 !c!-------------------------------------------------------------------
22691 fac = (om12 - 3.0d0 * om1 * om2)
22692 c1 = (w1 / (Rhead**3.0d0)) * fac
22693 c2 = (w2 / Rhead ** 6.0d0) &
22694 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
22696 !c! write (*,*) "w1 = ", w1
22697 !c! write (*,*) "w2 = ", w2
22698 !c! write (*,*) "om1 = ", om1
22699 !c! write (*,*) "om2 = ", om2
22700 !c! write (*,*) "om12 = ", om12
22701 !c! write (*,*) "fac = ", fac
22702 !c! write (*,*) "c1 = ", c1
22703 !c! write (*,*) "c2 = ", c2
22704 !c! write (*,*) "Ecl = ", Ecl
22705 !c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
22706 !c! write (*,*) "c2_2 = ",
22707 !c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
22708 !c!-------------------------------------------------------------------
22709 !c! dervative of ECL is GCL...
22711 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
22712 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
22713 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
22716 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
22717 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
22718 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
22721 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
22722 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
22723 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
22726 c1 = w1 / (Rhead ** 3.0d0)
22727 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
22728 dGCLdOM12 = c1 - c2
22730 erhead(k) = Rhead_distance(k)/Rhead
22732 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
22733 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
22734 facd1 = d1i * vbld_inv(i+nres)
22735 facd2 = d1j * vbld_inv(j+nres)
22738 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
22739 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
22741 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
22742 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
22745 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
22746 - dGCLdR * erhead(k)
22747 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
22748 + dGCLdR * erhead(k)
22751 !now charge with dipole eg. ARG-dG
22752 if (wqdip_scbase(2,itypi,itypj).gt.0.0d0) then
22753 alphapol1 = alphapol_scbase(itypi,itypj)
22754 w1 = wqdip_scbase(1,itypi,itypj)
22755 w2 = wqdip_scbase(2,itypi,itypj)
22758 ! pis = sig0head_scbase(itypi,itypj)
22759 ! eps_head = epshead_scbase(itypi,itypj)
22760 !c!-------------------------------------------------------------------
22761 !c! R1 - distance between head of ith side chain and tail of jth sidechain
22764 !c! Calculate head-to-tail distances tail is center of side-chain
22765 R1=R1+(c(k,j+nres)-chead(k,1))**2
22770 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
22771 !c! & +dhead(1,1,itypi,itypj))**2))
22772 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
22773 !c! & +dhead(2,1,itypi,itypj))**2))
22775 !c!-------------------------------------------------------------------
22778 hawk = w2 * (1.0d0 - sqom2)
22779 Ecl = sparrow / Rhead**2.0d0 &
22780 - hawk / Rhead**4.0d0
22781 !c!-------------------------------------------------------------------
22782 !c! derivative of ecl is Gcl
22784 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
22785 + 4.0d0 * hawk / Rhead**5.0d0
22787 dGCLdOM1 = (w1) / (Rhead**2.0d0)
22789 dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
22790 !c--------------------------------------------------------------------
22791 !c Polarization energy
22793 MomoFac1 = (1.0d0 - chi1 * sqom2)
22794 RR1 = R1 * R1 / MomoFac1
22795 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
22796 fgb1 = sqrt( RR1 + a12sq * ee1)
22797 ! eps_inout_fac=0.0d0
22798 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
22799 ! derivative of Epol is Gpol...
22800 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
22802 dFGBdR1 = ( (R1 / MomoFac1) &
22803 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
22805 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
22806 * (2.0d0 - 0.5d0 * ee1) ) &
22808 dPOLdR1 = dPOLdFGB1 * dFGBdR1
22811 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
22813 erhead(k) = Rhead_distance(k)/Rhead
22814 erhead_tail(k,1) = ((c(k,j+nres)-chead(k,1))/R1)
22817 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
22818 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
22819 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
22821 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
22822 facd1 = d1i * vbld_inv(i+nres)
22823 facd2 = d1j * vbld_inv(j+nres)
22824 ! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
22827 hawk = (erhead_tail(k,1) + &
22828 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
22831 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
22832 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
22834 - dPOLdR1 * (erhead_tail(k,1))
22837 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
22838 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
22840 + dPOLdR1 * (erhead_tail(k,1))
22844 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
22845 - dGCLdR * erhead(k) &
22846 - dPOLdR1 * erhead_tail(k,1)
22847 ! & - dGLJdR * erhead(k)
22849 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
22850 + dGCLdR * erhead(k) &
22851 + dPOLdR1 * erhead_tail(k,1)
22852 ! & + dGLJdR * erhead(k)
22856 ! print *,i,j,evdwij,epol,Fcav,ECL
22857 escbase=escbase+evdwij+epol+Fcav+ECL
22858 call sc_grad_scbase
22863 end subroutine eprot_sc_base
22864 SUBROUTINE sc_grad_scbase
22867 real (kind=8) :: dcosom1(3),dcosom2(3)
22869 eps2der * eps2rt_om1 &
22870 - 2.0D0 * alf1 * eps3der &
22871 + sigder * sigsq_om1 &
22877 eps2der * eps2rt_om2 &
22878 + 2.0D0 * alf2 * eps3der &
22879 + sigder * sigsq_om2 &
22885 evdwij * eps1_om12 &
22886 + eps2der * eps2rt_om12 &
22887 - 2.0D0 * alf12 * eps3der &
22888 + sigder *sigsq_om12 &
22892 ! print *,eom1,eom2,eom12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
22893 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
22894 ! gg(1),gg(2),"rozne"
22896 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
22897 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
22898 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
22899 gvdwx_scbase(k,i)= gvdwx_scbase(k,i) - gg(k) &
22900 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
22901 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
22902 gvdwx_scbase(k,j)= gvdwx_scbase(k,j) + gg(k) &
22903 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
22904 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
22905 gvdwc_scbase(k,i)=gvdwc_scbase(k,i)-gg(k)
22906 gvdwc_scbase(k,j)=gvdwc_scbase(k,j)+gg(k)
22909 END SUBROUTINE sc_grad_scbase
22912 subroutine epep_sc_base(epepbase)
22915 !el local variables
22916 integer :: iint,itypi,itypi1,itypj,subchap
22917 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
22918 real(kind=8) :: evdw,sig0ij
22919 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
22920 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
22921 sslipi,sslipj,faclip
22923 real(kind=8) :: fracinbuf
22924 real (kind=8) :: epepbase
22925 real (kind=8),dimension(4):: ener
22926 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
22927 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
22928 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
22929 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
22930 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
22931 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
22932 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
22933 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
22934 real(kind=8),dimension(3,2)::chead,erhead_tail
22935 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
22939 do i=1,nres_molec(1)-1
22940 if (itype(i,1).eq.ntyp1_molec(1).or.itype(i+1,1).eq.ntyp1_molec(1)) cycle
22941 !C itypi = itype(i,1)
22945 ! print *,dxi,(-c(1,i)+c(1,i+1))*vbld_inv(i+1)
22946 dsci_inv = vbld_inv(i+1)/2.0
22947 xi=(c(1,i)+c(1,i+1))/2.0
22948 yi=(c(2,i)+c(2,i+1))/2.0
22949 zi=(c(3,i)+c(3,i+1))/2.0
22950 xi=mod(xi,boxxsize)
22951 if (xi.lt.0) xi=xi+boxxsize
22952 yi=mod(yi,boxysize)
22953 if (yi.lt.0) yi=yi+boxysize
22954 zi=mod(zi,boxzsize)
22955 if (zi.lt.0) zi=zi+boxzsize
22956 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
22958 if (itype(j,2).eq.ntyp1_molec(2))cycle
22962 xj=dmod(xj,boxxsize)
22963 if (xj.lt.0) xj=xj+boxxsize
22964 yj=dmod(yj,boxysize)
22965 if (yj.lt.0) yj=yj+boxysize
22966 zj=dmod(zj,boxzsize)
22967 if (zj.lt.0) zj=zj+boxzsize
22968 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22977 xj=xj_safe+xshift*boxxsize
22978 yj=yj_safe+yshift*boxysize
22979 zj=zj_safe+zshift*boxzsize
22980 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22981 if(dist_temp.lt.dist_init) then
22982 dist_init=dist_temp
22991 if (subchap.eq.1) then
23000 dxj = dc_norm( 1, nres+j )
23001 dyj = dc_norm( 2, nres+j )
23002 dzj = dc_norm( 3, nres+j )
23003 ! d1i = dhead_scbasei(itypi) !this is shift of dipole/charge
23004 ! d1j = dhead_scbasej(itypi) !this is shift of dipole/charge
23007 sig0ij = sigma_pepbase(itypj )
23008 chi1 = chi_pepbase(itypj,1 )
23009 chi2 = chi_pepbase(itypj,2 )
23012 chi12 = chi1 * chi2
23013 chip1 = chipp_pepbase(itypj,1 )
23014 chip2 = chipp_pepbase(itypj,2 )
23017 chip12 = chip1 * chip2
23018 chis1 = chis_pepbase(itypj,1)
23019 chis2 = chis_pepbase(itypj,2)
23020 chis12 = chis1 * chis2
23021 sig1 = sigmap1_pepbase(itypj)
23022 sig2 = sigmap2_pepbase(itypj)
23023 ! write (*,*) "sig1 = ", sig1
23024 ! write (*,*) "sig2 = ", sig2
23026 ! location of polar head is computed by taking hydrophobic centre
23027 ! and moving by a d1 * dc_norm vector
23028 ! see unres publications for very informative images
23029 chead(k,1) = (c(k,i)+c(k,i+1))/2.0
23030 ! + d1i * dc_norm(k, i+nres)
23031 chead(k,2) = c(k, j+nres)
23032 ! + d1j * dc_norm(k, j+nres)
23034 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
23035 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
23036 Rhead_distance(k) = chead(k,2) - chead(k,1)
23037 ! print *,gvdwc_pepbase(k,i)
23041 (Rhead_distance(1)*Rhead_distance(1)) &
23042 + (Rhead_distance(2)*Rhead_distance(2)) &
23043 + (Rhead_distance(3)*Rhead_distance(3)))
23045 ! alpha factors from Fcav/Gcav
23046 b1 = alphasur_pepbase(1,itypj)
23048 b2 = alphasur_pepbase(2,itypj)
23049 b3 = alphasur_pepbase(3,itypj)
23050 b4 = alphasur_pepbase(4,itypj)
23054 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23057 !----------------------------
23075 dscj_inv = vbld_inv(j+nres)
23077 ! this should be in elgrad_init but om's are calculated by sc_angular
23078 ! which in turn is used by older potentials
23079 ! om = omega, sqom = om^2
23082 sqom12 = om12 * om12
23084 ! now we calculate EGB - Gey-Berne
23085 ! It will be summed up in evdwij and saved in evdw
23086 sigsq = 1.0D0 / sigsq
23087 sig = sig0ij * dsqrt(sigsq)
23088 rij_shift = 1.0/rij - sig + sig0ij
23089 IF (rij_shift.le.0.0D0) THEN
23093 sigder = -sig * sigsq
23094 rij_shift = 1.0D0 / rij_shift
23095 fac = rij_shift**expon
23096 c1 = fac * fac * aa_pepbase(itypj)
23098 c2 = fac * bb_pepbase(itypj)
23100 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
23101 eps2der = eps3rt * evdwij
23102 eps3der = eps2rt * evdwij
23103 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
23104 evdwij = eps2rt * eps3rt * evdwij
23105 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
23106 fac = -expon * (c1 + evdwij) * rij_shift
23107 sigder = fac * sigder
23109 ! Calculate distance derivative
23113 fac = chis1 * sqom1 + chis2 * sqom2 &
23114 - 2.0d0 * chis12 * om1 * om2 * om12
23115 ! we will use pom later in Gcav, so dont mess with it!
23116 pom = 1.0d0 - chis1 * chis2 * sqom12
23117 Lambf = (1.0d0 - (fac / pom))
23118 Lambf = dsqrt(Lambf)
23119 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
23120 ! write (*,*) "sparrow = ", sparrow
23121 Chif = 1.0d0/rij * sparrow
23122 ChiLambf = Chif * Lambf
23123 eagle = dsqrt(ChiLambf)
23124 bat = ChiLambf ** 11.0d0
23125 top = b1 * ( eagle + b2 * ChiLambf - b3 )
23126 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
23130 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
23131 dbot = 12.0d0 * b4 * bat * Lambf
23132 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
23134 ! write (*,*) "dFcav/dR = ", dFdR
23135 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
23136 dbot = 12.0d0 * b4 * bat * Chif
23137 eagle = Lambf * pom
23138 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
23139 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
23140 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
23141 * (chis2 * om2 * om12 - om1) / (eagle * pom)
23143 dFdL = ((dtop * bot - top * dbot) / botsq)
23145 dCAVdOM1 = dFdL * ( dFdOM1 )
23146 dCAVdOM2 = dFdL * ( dFdOM2 )
23147 dCAVdOM12 = dFdL * ( dFdOM12 )
23153 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23154 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23156 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
23157 gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
23158 - (( dFdR + gg(k) ) * pom)/2.0
23159 ! print *,gvdwc_pepbase(k,i),i,(( dFdR + gg(k) ) * pom)/2.0
23160 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
23161 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
23162 ! & - ( dFdR * pom )
23164 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
23165 gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
23166 + (( dFdR + gg(k) ) * pom)
23167 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
23168 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23169 !c! & + ( dFdR * pom )
23171 gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
23172 - (( dFdR + gg(k) ) * ertail(k))/2.0
23173 ! print *,gvdwc_pepbase(k,i+1),i+1,(( dFdR + gg(k) ) * pom)/2.0
23175 !c! & - ( dFdR * ertail(k))
23177 gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
23178 + (( dFdR + gg(k) ) * ertail(k))
23179 !c! & + ( dFdR * ertail(k))
23182 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23183 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23187 w1 = wdipdip_pepbase(1,itypj)
23188 w2 = wdipdip_pepbase(3,itypj)*2.0
23191 !c!-------------------------------------------------------------------
23193 fac = (om12 - 3.0d0 * om1 * om2)
23194 c1 = (w1 / (Rhead**3.0d0)) * fac
23195 c2 = (w2 / Rhead ** 6.0d0) &
23196 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
23198 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
23199 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
23200 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
23203 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
23204 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
23205 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
23208 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
23209 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
23210 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
23213 c1 = w1 / (Rhead ** 3.0d0)
23214 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
23215 dGCLdOM12 = c1 - c2
23217 erhead(k) = Rhead_distance(k)/Rhead
23219 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
23220 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
23221 ! facd1 = d1 * vbld_inv(i+nres)
23222 ! facd2 = d2 * vbld_inv(j+nres)
23226 !+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
23227 ! gvdwx_pepbase(k,i) = gvdwx_scbase(k,i) &
23230 !+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
23231 gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
23234 gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
23235 - dGCLdR * erhead(k)/2.0d0
23236 ! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
23237 gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
23238 - dGCLdR * erhead(k)/2.0d0
23239 ! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
23240 gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
23241 + dGCLdR * erhead(k)
23243 ! print *,i,j,evdwij,Fcav,ECL,"vdw,cav,ecl"
23244 epepbase=epepbase+evdwij+Fcav+ECL
23245 call sc_grad_pepbase
23248 END SUBROUTINE epep_sc_base
23249 SUBROUTINE sc_grad_pepbase
23252 real (kind=8) :: dcosom1(3),dcosom2(3)
23254 eps2der * eps2rt_om1 &
23255 - 2.0D0 * alf1 * eps3der &
23256 + sigder * sigsq_om1 &
23262 eps2der * eps2rt_om2 &
23263 + 2.0D0 * alf2 * eps3der &
23264 + sigder * sigsq_om2 &
23270 evdwij * eps1_om12 &
23271 + eps2der * eps2rt_om12 &
23272 - 2.0D0 * alf12 * eps3der &
23273 + sigder *sigsq_om12 &
23278 ! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
23279 ! if (i.eq.30) print *,gvdwc_pepbase(k,i),- gg(k),&
23280 ! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
23282 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
23283 ! gg(1),gg(2),"rozne"
23285 dcosom1(k) = rij * (dc_norm(k,i) - om1 * erij(k))
23286 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
23287 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
23288 gvdwc_pepbase(k,i)= gvdwc_pepbase(k,i) +0.5*(- gg(k)) &
23289 + (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
23291 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
23292 gvdwc_pepbase(k,i+1)= gvdwc_pepbase(k,i+1) +0.5*(- gg(k)) &
23293 - (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i))) &
23295 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
23296 ! print *,eom12,eom2,om12,om2
23297 !eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
23298 ! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
23299 gvdwx_pepbase(k,j)= gvdwx_pepbase(k,j) + gg(k) &
23300 + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
23301 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23302 gvdwc_pepbase(k,j)=gvdwc_pepbase(k,j)+gg(k)
23305 END SUBROUTINE sc_grad_pepbase
23306 subroutine eprot_sc_phosphate(escpho)
23308 ! implicit real*8 (a-h,o-z)
23309 ! include 'DIMENSIONS'
23310 ! include 'COMMON.GEO'
23311 ! include 'COMMON.VAR'
23312 ! include 'COMMON.LOCAL'
23313 ! include 'COMMON.CHAIN'
23314 ! include 'COMMON.DERIV'
23315 ! include 'COMMON.NAMES'
23316 ! include 'COMMON.INTERACT'
23317 ! include 'COMMON.IOUNITS'
23318 ! include 'COMMON.CALC'
23319 ! include 'COMMON.CONTROL'
23320 ! include 'COMMON.SBRIDGE'
23322 !el local variables
23323 integer :: iint,itypi,itypi1,itypj,subchap
23324 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
23325 real(kind=8) :: evdw,sig0ij
23326 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
23327 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
23328 sslipi,sslipj,faclip
23330 real(kind=8) :: fracinbuf
23331 real (kind=8) :: escpho
23332 real (kind=8),dimension(4):: ener
23333 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
23334 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
23335 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
23336 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
23337 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
23338 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
23339 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
23340 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
23341 real(kind=8),dimension(3,2)::chead,erhead_tail
23342 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
23346 do i=1,nres_molec(1)
23347 if (itype(i,1).eq.ntyp1_molec(1)) cycle
23349 dxi = dc_norm(1,nres+i)
23350 dyi = dc_norm(2,nres+i)
23351 dzi = dc_norm(3,nres+i)
23352 dsci_inv = vbld_inv(i+nres)
23356 xi=mod(xi,boxxsize)
23357 if (xi.lt.0) xi=xi+boxxsize
23358 yi=mod(yi,boxysize)
23359 if (yi.lt.0) yi=yi+boxysize
23360 zi=mod(zi,boxzsize)
23361 if (zi.lt.0) zi=zi+boxzsize
23362 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
23364 if ((itype(j,2).eq.ntyp1_molec(2)).or.&
23365 (itype(j+1,2).eq.ntyp1_molec(2))) cycle
23366 xj=(c(1,j)+c(1,j+1))/2.0
23367 yj=(c(2,j)+c(2,j+1))/2.0
23368 zj=(c(3,j)+c(3,j+1))/2.0
23369 xj=dmod(xj,boxxsize)
23370 if (xj.lt.0) xj=xj+boxxsize
23371 yj=dmod(yj,boxysize)
23372 if (yj.lt.0) yj=yj+boxysize
23373 zj=dmod(zj,boxzsize)
23374 if (zj.lt.0) zj=zj+boxzsize
23375 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23383 yj=yj_safe+yshift*boxysize
23384 zj=zj_safe+zshift*boxzsize
23385 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23386 if(dist_temp.lt.dist_init) then
23387 dist_init=dist_temp
23396 if (subchap.eq.1) then
23405 dxj = dc_norm( 1,j )
23406 dyj = dc_norm( 2,j )
23407 dzj = dc_norm( 3,j )
23408 dscj_inv = vbld_inv(j+1)
23411 sig0ij = sigma_scpho(itypi )
23412 chi1 = chi_scpho(itypi,1 )
23413 chi2 = chi_scpho(itypi,2 )
23416 chi12 = chi1 * chi2
23417 chip1 = chipp_scpho(itypi,1 )
23418 chip2 = chipp_scpho(itypi,2 )
23421 chip12 = chip1 * chip2
23422 chis1 = chis_scpho(itypi,1)
23423 chis2 = chis_scpho(itypi,2)
23424 chis12 = chis1 * chis2
23425 sig1 = sigmap1_scpho(itypi)
23426 sig2 = sigmap2_scpho(itypi)
23427 ! write (*,*) "sig1 = ", sig1
23428 ! write (*,*) "sig1 = ", sig1
23429 ! write (*,*) "sig2 = ", sig2
23430 ! alpha factors from Fcav/Gcav
23434 a12sq = rborn_scphoi(itypi) * rborn_scphoj(itypi)
23436 b1 = alphasur_scpho(1,itypi)
23438 b2 = alphasur_scpho(2,itypi)
23439 b3 = alphasur_scpho(3,itypi)
23440 b4 = alphasur_scpho(4,itypi)
23441 ! used to determine whether we want to do quadrupole calculations
23443 eps_in = epsintab_scpho(itypi)
23444 if (eps_in.eq.0.0) eps_in=1.0
23445 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
23446 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
23447 !-------------------------------------------------------------------
23448 ! tail location and distance calculations
23449 d1i = dhead_scphoi(itypi) !this is shift of dipole/charge
23452 ! location of polar head is computed by taking hydrophobic centre
23453 ! and moving by a d1 * dc_norm vector
23454 ! see unres publications for very informative images
23455 chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
23456 chead(k,2) = (c(k, j) + c(k, j+1))/2.0
23458 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
23459 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
23460 Rhead_distance(k) = chead(k,2) - chead(k,1)
23462 ! pitagoras (root of sum of squares)
23464 (Rhead_distance(1)*Rhead_distance(1)) &
23465 + (Rhead_distance(2)*Rhead_distance(2)) &
23466 + (Rhead_distance(3)*Rhead_distance(3)))
23467 Rhead_sq=Rhead**2.0
23468 !-------------------------------------------------------------------
23469 ! zero everything that should be zero'ed
23488 dscj_inv = vbld_inv(j+1)/2.0
23489 !dhead_scbasej(itypi,itypj)
23490 ! print *,i,j,dscj_inv,dsci_inv
23491 ! rij holds 1/(distance of Calpha atoms)
23492 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23494 !----------------------------
23496 ! this should be in elgrad_init but om's are calculated by sc_angular
23497 ! which in turn is used by older potentials
23498 ! om = omega, sqom = om^2
23501 sqom12 = om12 * om12
23503 ! now we calculate EGB - Gey-Berne
23504 ! It will be summed up in evdwij and saved in evdw
23505 sigsq = 1.0D0 / sigsq
23506 sig = sig0ij * dsqrt(sigsq)
23507 ! rij_shift = 1.0D0 / rij - sig + sig0ij
23508 rij_shift = 1.0/rij - sig + sig0ij
23509 IF (rij_shift.le.0.0D0) THEN
23513 sigder = -sig * sigsq
23514 rij_shift = 1.0D0 / rij_shift
23515 fac = rij_shift**expon
23516 c1 = fac * fac * aa_scpho(itypi)
23518 c2 = fac * bb_scpho(itypi)
23520 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
23521 eps2der = eps3rt * evdwij
23522 eps3der = eps2rt * evdwij
23523 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
23524 evdwij = eps2rt * eps3rt * evdwij
23525 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
23526 fac = -expon * (c1 + evdwij) * rij_shift
23527 sigder = fac * sigder
23529 ! Calculate distance derivative
23533 fac = chis1 * sqom1 + chis2 * sqom2 &
23534 - 2.0d0 * chis12 * om1 * om2 * om12
23535 ! we will use pom later in Gcav, so dont mess with it!
23536 pom = 1.0d0 - chis1 * chis2 * sqom12
23537 Lambf = (1.0d0 - (fac / pom))
23538 Lambf = dsqrt(Lambf)
23539 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
23540 ! write (*,*) "sparrow = ", sparrow
23541 Chif = 1.0d0/rij * sparrow
23542 ChiLambf = Chif * Lambf
23543 eagle = dsqrt(ChiLambf)
23544 bat = ChiLambf ** 11.0d0
23545 top = b1 * ( eagle + b2 * ChiLambf - b3 )
23546 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
23549 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
23550 dbot = 12.0d0 * b4 * bat * Lambf
23551 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
23553 ! write (*,*) "dFcav/dR = ", dFdR
23554 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
23555 dbot = 12.0d0 * b4 * bat * Chif
23556 eagle = Lambf * pom
23557 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
23558 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
23559 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
23560 * (chis2 * om2 * om12 - om1) / (eagle * pom)
23562 dFdL = ((dtop * bot - top * dbot) / botsq)
23564 dCAVdOM1 = dFdL * ( dFdOM1 )
23565 dCAVdOM2 = dFdL * ( dFdOM2 )
23566 dCAVdOM12 = dFdL * ( dFdOM12 )
23572 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23573 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23574 ! if (i.eq.3) print *,'decl0',gvdwx_scpho(k,i),i
23577 ! print *,pom,gg(k),dFdR
23578 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
23579 gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
23580 - (( dFdR + gg(k) ) * pom)
23581 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
23582 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
23583 ! & - ( dFdR * pom )
23585 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
23586 ! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
23587 ! + (( dFdR + gg(k) ) * pom)
23588 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
23589 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23590 !c! & + ( dFdR * pom )
23592 gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
23593 - (( dFdR + gg(k) ) * ertail(k))
23594 !c! & - ( dFdR * ertail(k))
23596 gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
23597 + (( dFdR + gg(k) ) * ertail(k))/2.0
23599 gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
23600 + (( dFdR + gg(k) ) * ertail(k))/2.0
23602 !c! & + ( dFdR * ertail(k))
23606 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23607 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23608 ! alphapol1 = alphapol_scpho(itypi)
23609 if (wqq_scpho(itypi).gt.0.0) then
23610 Qij=wqq_scpho(itypi)/eps_in
23612 Ecl = (332.0d0 * Qij) / Rhead
23613 !c! derivative of Ecl is Gcl...
23614 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
23615 else if (wqdip_scpho(2,itypi).gt.0.0d0) then
23616 w1 = wqdip_scpho(1,itypi)
23617 w2 = wqdip_scpho(2,itypi)
23620 ! pis = sig0head_scbase(itypi,itypj)
23621 ! eps_head = epshead_scbase(itypi,itypj)
23622 !c!-------------------------------------------------------------------
23624 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
23625 !c! & +dhead(1,1,itypi,itypj))**2))
23626 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
23627 !c! & +dhead(2,1,itypi,itypj))**2))
23629 !c!-------------------------------------------------------------------
23632 hawk = w2 * (1.0d0 - sqom2)
23633 Ecl = sparrow / Rhead**2.0d0 &
23634 - hawk / Rhead**4.0d0
23635 !c!-------------------------------------------------------------------
23636 !c! derivative of ecl is Gcl
23638 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
23639 + 4.0d0 * hawk / Rhead**5.0d0
23641 dGCLdOM1 = (w1) / (Rhead**2.0d0)
23643 dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
23646 !c--------------------------------------------------------------------
23647 !c Polarization energy
23651 !c! Calculate head-to-tail distances tail is center of side-chain
23652 R1=R1+((c(k,j)+c(k,j+1))/2.0-chead(k,1))**2
23657 alphapol1 = alphapol_scpho(itypi)
23659 MomoFac1 = (1.0d0 - chi2 * sqom1)
23660 RR1 = R1 * R1 / MomoFac1
23661 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
23662 ! print *,"ee1",ee1,a12sq,alphapol1,eps_inout_fac
23663 fgb1 = sqrt( RR1 + a12sq * ee1)
23664 ! eps_inout_fac=0.0d0
23665 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
23666 ! derivative of Epol is Gpol...
23667 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
23669 dFGBdR1 = ( (R1 / MomoFac1) &
23670 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
23672 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
23673 * (2.0d0 - 0.5d0 * ee1) ) &
23675 dPOLdR1 = dPOLdFGB1 * dFGBdR1
23678 dFGBdOM1 = (((R1 * R1 * chi2 * om1) / (MomoFac1 * MomoFac1)) &
23679 * (2.0d0 - 0.5d0 * ee1) ) &
23682 dPOLdOM1 = dPOLdFGB1 * dFGBdOM1
23685 erhead(k) = Rhead_distance(k)/Rhead
23686 erhead_tail(k,1) = (((c(k,j)+c(k,j+1))/2.0-chead(k,1))/R1)
23689 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
23690 erdxj = scalar( erhead(1), dC_norm(1,j) )
23691 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
23693 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j))
23694 facd1 = d1i * vbld_inv(i+nres)
23695 facd2 = d1j * vbld_inv(j)
23696 ! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
23699 hawk = (erhead_tail(k,1) + &
23700 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
23703 ! if (i.eq.3) print *,'decl1',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i,&
23704 ! pom,(erhead_tail(k,1))
23706 ! print *,'decl',dGCLdR,dPOLdR1,gvdwc_scpho(k,i)
23707 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
23708 gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
23710 - dPOLdR1 * (erhead_tail(k,1))
23713 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
23714 ! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
23716 ! + dPOLdR1 * (erhead_tail(k,1))
23720 gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
23721 - dGCLdR * erhead(k) &
23722 - dPOLdR1 * erhead_tail(k,1)
23723 ! & - dGLJdR * erhead(k)
23725 gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
23726 + (dGCLdR * erhead(k) &
23727 + dPOLdR1 * erhead_tail(k,1))/2.0
23728 gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
23729 + (dGCLdR * erhead(k) &
23730 + dPOLdR1 * erhead_tail(k,1))/2.0
23732 ! & + dGLJdR * erhead(k)
23733 ! if (i.eq.3) print *,'decl2',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i
23736 ! if (i.eq.3) print *,i,j,evdwij,epol,Fcav,ECL
23737 escpho=escpho+evdwij+epol+Fcav+ECL
23744 end subroutine eprot_sc_phosphate
23745 SUBROUTINE sc_grad_scpho
23748 real (kind=8) :: dcosom1(3),dcosom2(3)
23750 eps2der * eps2rt_om1 &
23751 - 2.0D0 * alf1 * eps3der &
23752 + sigder * sigsq_om1 &
23758 eps2der * eps2rt_om2 &
23759 + 2.0D0 * alf2 * eps3der &
23760 + sigder * sigsq_om2 &
23766 evdwij * eps1_om12 &
23767 + eps2der * eps2rt_om12 &
23768 - 2.0D0 * alf12 * eps3der &
23769 + sigder *sigsq_om12 &
23774 ! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
23775 ! if (i.eq.30) print *,gvdwc_scpho(k,i),- gg(k),&
23776 ! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
23778 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
23779 ! gg(1),gg(2),"rozne"
23781 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
23782 dcosom2(k) = rij * (dc_norm(k,j) - om2 * erij(k))
23783 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
23784 gvdwc_scpho(k,j)= gvdwc_scpho(k,j) +0.5*( gg(k)) &
23785 + (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)))&
23787 - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
23788 gvdwc_scpho(k,j+1)= gvdwc_scpho(k,j+1) +0.5*( gg(k)) &
23789 - (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j))) &
23791 + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
23792 gvdwx_scpho(k,i)= gvdwx_scpho(k,i) - gg(k) &
23793 + (eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
23794 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
23796 ! print *,eom12,eom2,om12,om2
23797 !eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
23798 ! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
23799 ! gvdwx_scpho(k,j)= gvdwx_scpho(k,j) + gg(k) &
23800 ! + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
23801 ! + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23802 gvdwc_scpho(k,i)=gvdwc_scpho(k,i)-gg(k)
23805 END SUBROUTINE sc_grad_scpho
23806 subroutine eprot_pep_phosphate(epeppho)
23808 ! implicit real*8 (a-h,o-z)
23809 ! include 'DIMENSIONS'
23810 ! include 'COMMON.GEO'
23811 ! include 'COMMON.VAR'
23812 ! include 'COMMON.LOCAL'
23813 ! include 'COMMON.CHAIN'
23814 ! include 'COMMON.DERIV'
23815 ! include 'COMMON.NAMES'
23816 ! include 'COMMON.INTERACT'
23817 ! include 'COMMON.IOUNITS'
23818 ! include 'COMMON.CALC'
23819 ! include 'COMMON.CONTROL'
23820 ! include 'COMMON.SBRIDGE'
23822 !el local variables
23823 integer :: iint,itypi,itypi1,itypj,subchap
23824 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
23825 real(kind=8) :: evdw,sig0ij
23826 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
23827 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
23828 sslipi,sslipj,faclip
23830 real(kind=8) :: fracinbuf
23831 real (kind=8) :: epeppho
23832 real (kind=8),dimension(4):: ener
23833 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
23834 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
23835 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
23836 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
23837 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
23838 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
23839 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
23840 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
23841 real(kind=8),dimension(3,2)::chead,erhead_tail
23842 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
23844 real (kind=8) :: dcosom1(3),dcosom2(3)
23846 do i=1,nres_molec(1)
23847 if (itype(i,1).eq.ntyp1_molec(1)) cycle
23849 dsci_inv = vbld_inv(i+1)/2.0
23853 xi=(c(1,i)+c(1,i+1))/2.0
23854 yi=(c(2,i)+c(2,i+1))/2.0
23855 zi=(c(3,i)+c(3,i+1))/2.0
23856 xi=mod(xi,boxxsize)
23857 if (xi.lt.0) xi=xi+boxxsize
23858 yi=mod(yi,boxysize)
23859 if (yi.lt.0) yi=yi+boxysize
23860 zi=mod(zi,boxzsize)
23861 if (zi.lt.0) zi=zi+boxzsize
23862 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
23864 if ((itype(j,2).eq.ntyp1_molec(2)).or.&
23865 (itype(j+1,2).eq.ntyp1_molec(2))) cycle
23866 xj=(c(1,j)+c(1,j+1))/2.0
23867 yj=(c(2,j)+c(2,j+1))/2.0
23868 zj=(c(3,j)+c(3,j+1))/2.0
23869 xj=dmod(xj,boxxsize)
23870 if (xj.lt.0) xj=xj+boxxsize
23871 yj=dmod(yj,boxysize)
23872 if (yj.lt.0) yj=yj+boxysize
23873 zj=dmod(zj,boxzsize)
23874 if (zj.lt.0) zj=zj+boxzsize
23875 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23883 yj=yj_safe+yshift*boxysize
23884 zj=zj_safe+zshift*boxzsize
23885 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23886 if(dist_temp.lt.dist_init) then
23887 dist_init=dist_temp
23896 if (subchap.eq.1) then
23905 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23907 dxj = dc_norm( 1,j )
23908 dyj = dc_norm( 2,j )
23909 dzj = dc_norm( 3,j )
23910 dscj_inv = vbld_inv(j+1)/2.0
23912 sig0ij = sigma_peppho
23915 chi12 = chi1 * chi2
23918 chip12 = chip1 * chip2
23921 chis12 = chis1 * chis2
23922 sig1 = sigmap1_peppho
23923 sig2 = sigmap2_peppho
23924 ! write (*,*) "sig1 = ", sig1
23925 ! write (*,*) "sig1 = ", sig1
23926 ! write (*,*) "sig2 = ", sig2
23927 ! alpha factors from Fcav/Gcav
23931 b1 = alphasur_peppho(1)
23933 b2 = alphasur_peppho(2)
23934 b3 = alphasur_peppho(3)
23935 b4 = alphasur_peppho(4)
23957 fac = rij_shift**expon
23958 c1 = fac * fac * aa_peppho
23960 c2 = fac * bb_peppho
23963 ! Now cavity....................
23964 eagle = dsqrt(1.0/rij_shift)
23965 top = b1 * ( eagle + b2 * 1.0/rij_shift - b3 )
23966 bot = 1.0d0 + b4 * (1.0/rij_shift ** 12.0d0)
23969 dtop = b1 * ((1.0/ (2.0d0 * eagle)) + (b2))
23970 dbot = 12.0d0 * b4 * (1.0/rij_shift) ** 11.0d0
23971 dFdR = ((dtop * bot - top * dbot) / botsq)
23972 w1 = wqdip_peppho(1)
23973 w2 = wqdip_peppho(2)
23976 ! pis = sig0head_scbase(itypi,itypj)
23977 ! eps_head = epshead_scbase(itypi,itypj)
23978 !c!-------------------------------------------------------------------
23980 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
23981 !c! & +dhead(1,1,itypi,itypj))**2))
23982 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
23983 !c! & +dhead(2,1,itypi,itypj))**2))
23985 !c!-------------------------------------------------------------------
23988 hawk = w2 * (1.0d0 - sqom1)
23989 Ecl = sparrow * rij_shift**2.0d0 &
23990 - hawk * rij_shift**4.0d0
23991 !c!-------------------------------------------------------------------
23992 !c! derivative of ecl is Gcl
23995 dGCLdR = - 2.0d0 * sparrow * rij_shift**3.0d0 &
23996 + 4.0d0 * hawk * rij_shift**5.0d0
23998 dGCLdOM1 = (w1) * (rij_shift**2.0d0)
24000 dGCLdOM2 = (2.0d0 * w2 * om1) * (rij_shift ** 4.0d0)
24001 eom1 = dGCLdOM1+dGCLdOM2
24004 fac = -expon * (c1 + evdwij) * rij_shift+dFdR+dGCLdR
24010 gvdwc_peppho(k,j) = gvdwc_peppho(k,j) +gg(k)/2.0
24011 gvdwc_peppho(k,j+1) = gvdwc_peppho(k,j+1) +gg(k)/2.0
24012 gvdwc_peppho(k,i) = gvdwc_peppho(k,i) -gg(k)/2.0
24013 gvdwc_peppho(k,i+1) = gvdwc_peppho(k,i+1) -gg(k)/2.0
24018 dcosom1(k) = rij* (dc_norm(k,i) - om1 * erij(k))
24019 dcosom2(k) = rij* (dc_norm(k,j) - om2 * erij(k))
24020 gg(k) = gg(k) + eom1 * dcosom1(k)! + eom2 * dcosom2(k)
24021 gvdwc_peppho(k,j)= gvdwc_peppho(k,j) +0.5*( gg(k)) !&
24022 ! - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
24023 gvdwc_peppho(k,j+1)= gvdwc_peppho(k,j+1) +0.5*( gg(k)) !&
24024 ! + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
24025 gvdwc_peppho(k,i)= gvdwc_peppho(k,i) -0.5*( gg(k)) &
24026 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
24027 gvdwc_peppho(k,i+1)= gvdwc_peppho(k,i+1) - 0.5*( gg(k)) &
24028 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
24030 epeppho=epeppho+evdwij+Fcav+ECL
24031 ! print *,i,j,evdwij,Fcav,ECL,rij_shift
24034 end subroutine eprot_pep_phosphate