2 !-----------------------------------------------------------------------------
13 !-----------------------------------------------------------------------------
14 ! Max. number of contacts per residue
16 !-----------------------------------------------------------------------------
17 ! Max. number of derivatives of virtual-bond and side-chain vectors in theta
20 !-----------------------------------------------------------------------------
21 ! Max. number of SC contacts
23 !-----------------------------------------------------------------------------
24 ! Max. number of variables
26 !-----------------------------------------------------------------------------
27 ! Max number of torsional terms in SCCOR in control_data
28 ! integer,parameter :: maxterm_sccor=6
29 !-----------------------------------------------------------------------------
30 ! Maximum number of SC local term fitting function coefficiants
31 integer,parameter :: maxsccoef=65
32 ! Maximum number of local shielding effectors
33 integer,parameter :: maxcontsshi=50
34 !-----------------------------------------------------------------------------
35 ! commom.calc common/calc/
36 !-----------------------------------------------------------------------------
39 ! Change 12/1/95 - common block CONTACTS1 included.
42 integer,dimension(:),allocatable :: num_cont !(maxres)
43 integer,dimension(:,:),allocatable :: jcont !(maxconts,maxres)
44 real(kind=8),dimension(:,:),allocatable :: facont,ees0plist !(maxconts,maxres)
45 real(kind=8),dimension(:,:,:),allocatable :: gacont !(3,maxconts,maxres)
46 integer,dimension(:),allocatable :: ishield_list
47 integer,dimension(:,:),allocatable :: shield_list
48 real(kind=8),dimension(:),allocatable :: enetube,enecavtube
50 ! 12/26/95 - H-bonding contacts
51 ! common /contacts_hb/
52 real(kind=8),dimension(:,:,:),allocatable :: gacontp_hb1,gacontp_hb2,&
53 gacontp_hb3,gacontm_hb1,gacontm_hb2,gacontm_hb3,gacont_hbr,grij_hb_cont !(3,maxconts,maxres)
54 real(kind=8),dimension(:,:),allocatable :: facont_hb,ees0p,&
55 ees0m,d_cont !(maxconts,maxres)
56 integer,dimension(:),allocatable :: num_cont_hb !(maxres)
57 integer,dimension(:,:),allocatable :: jcont_hb !(maxconts,maxres)
58 ! 9/23/99 Added improper rotation matrices and matrices of dipole-dipole
60 ! 7/25/08 commented out; not needed when cumulants used
61 ! Interactions of pseudo-dipoles generated by loc-el interactions.
63 real(kind=8),dimension(:,:,:),allocatable :: dip,&
64 dipderg !(4,maxconts,maxres)
65 real(kind=8),dimension(:,:,:,:,:),allocatable :: dipderx !(3,5,4,maxconts,maxres)
66 ! 10/30/99 Added other pre-computed vectors and matrices needed
67 ! to calculate three - six-order el-loc correlation terms
69 real(kind=8),dimension(:,:,:),allocatable :: Ug,Ugder,Ug2,Ug2der !(2,2,maxres)
70 real(kind=8),dimension(:,:),allocatable :: obrot,obrot2,obrot_der,&
71 obrot2_der !(2,maxres)
73 ! This common block contains vectors and matrices dependent on a single
76 real(kind=8),dimension(:,:),allocatable :: mu,muder,Ub2,Ub2der,&
77 Ctobr,Ctobrder,Dtobr2,Dtobr2der !(2,maxres)
78 real(kind=8),dimension(:,:,:),allocatable :: EUg,EUgder,CUg,&
79 CUgder,DUg,Dugder,DtUg2,DtUg2der !(2,2,maxres)
80 ! This common block contains vectors and matrices dependent on two
81 ! consecutive amino-acid residues.
83 real(kind=8),dimension(:,:),allocatable :: Ug2Db1t,Ug2Db1tder,&
84 CUgb2,CUgb2der !(2,maxres)
85 real(kind=8),dimension(:,:,:),allocatable :: EUgC,EUgCder,&
86 EUgD,EUgDder,DtUg2EUg,Ug2DtEUg !(2,2,maxres)
87 real(kind=8),dimension(:,:,:,:),allocatable :: Ug2DtEUgder,&
88 DtUg2EUgder !(2,2,2,maxres)
90 real(kind=8),dimension(:),allocatable :: costab,sintab,&
91 costab2,sintab2 !(maxres)
92 ! This common block contains dipole-interaction matrices and their
93 ! Cartesian derivatives.
95 real(kind=8),dimension(:,:,:,:),allocatable :: a_chuj !(2,2,maxconts,maxres)
96 real(kind=8),dimension(:,:,:,:,:,:),allocatable :: a_chuj_der !(2,2,3,5,maxconts,maxres)
98 real(kind=8),dimension(2,2,2) :: AEA,AEAderg,EAEA,AECA,&
99 AECAderg,ADtEA,ADtEA1,AEAb1,AEAb1derg,AEAb2
100 real(kind=8),dimension(2,2,2,2) :: EAEAderg,ADtEAderg,&
102 real(kind=8),dimension(2,2,3,5,2,2) :: AEAderx,EAEAderx,&
103 AECAderx,ADtEAderx,ADtEA1derx
104 real(kind=8),dimension(2,3,5,2,2,2) :: AEAb1derx,AEAb2derx
105 real(kind=8),dimension(3,2) :: g_contij
106 real(kind=8) :: ekont
107 ! 12/13/2008 (again Poland-Jaruzel war anniversary)
108 ! RE: Parallelization of 4th and higher order loc-el correlations
109 ! common /contdistrib/
110 integer,dimension(:),allocatable :: ncont_sent,ncont_recv !(maxres)
111 ! ncont_sent,ncont_recv są w multibody_ello i multibody_hb
112 !-----------------------------------------------------------------------------
115 ! real(kind=8),dimension(:,:),allocatable :: dcdv,dxdv !(6,maxdim)
116 ! real(kind=8),dimension(:,:),allocatable :: dxds !(6,maxres)
117 ! real(kind=8),dimension(:,:,:),allocatable :: gradx,gradc !(3,maxres,2)
118 real(kind=8),dimension(:,:),allocatable :: gvdwc,gelc,gelc_long,&
119 gvdwpp,gvdwc_scpp,gradx_scp,gvdwc_scp,ghpbx,ghpbc,&
120 gradcorr,gradcorr_long,gradcorr5_long,gradcorr6_long,&
121 gcorr6_turn_long,gradxorr,gradcorr5,gradcorr6,gliptran,gliptranc,&
123 gshieldx,gshieldc,gshieldc_loc,gshieldx_ec,&
124 gshieldc_ec,gshieldc_loc_ec,gshieldx_t3, &
125 gshieldc_t3,gshieldc_loc_t3,gshieldx_t4,gshieldc_t4, &
126 gshieldc_loc_t4,gshieldx_ll,gshieldc_ll,gshieldc_loc_ll,&
127 grad_shield,gg_tube,gg_tube_sc,gradafm !(3,maxres)
128 !-----------------------------NUCLEIC GRADIENT
129 real(kind=8),dimension(:,:),allocatable ::gradb_nucl,gradbx_nucl, &
130 gvdwpsb1,gelpp,gvdwpsb,gelsbc,gelsbx,gvdwsbx,gvdwsbc,gsbloc,&
131 gsblocx,gradcorr_nucl,gradxorr_nucl,gradcorr3_nucl,gradxorr3_nucl,&
133 !-----------------------------NUCLEIC-PROTEIN GRADIENT
134 real(kind=8),dimension(:,:),allocatable :: gvdwx_scbase,gvdwc_scbase,&
135 gvdwx_pepbase,gvdwc_pepbase,gvdwx_scpho,gvdwc_scpho,&
137 !------------------------------IONS GRADIENT
138 real(kind=8),dimension(:,:),allocatable :: gradcatcat, &
139 gradpepcat,gradpepcatx
140 ! real(kind=8),dimension(:,:),allocatable :: gloc,gloc_x !(maxvar,2)
143 real(kind=8),dimension(:,:),allocatable :: gel_loc,gel_loc_long,&
144 gcorr3_turn,gcorr4_turn,gcorr6_turn,gradb,gradbx !(3,maxres)
145 real(kind=8),dimension(:),allocatable :: gel_loc_loc,&
146 gel_loc_turn3,gel_loc_turn4,gel_loc_turn6,gcorr_loc,g_corr5_loc,&
147 g_corr6_loc !(maxvar)
148 real(kind=8),dimension(:,:),allocatable :: gsccorc,gsccorx !(3,maxres)
149 real(kind=8),dimension(:),allocatable :: gsccor_loc !(maxres)
150 ! real(kind=8),dimension(:,:,:),allocatable :: dtheta !(3,2,maxres)
151 real(kind=8),dimension(:,:),allocatable :: gscloc,gsclocx !(3,maxres)
152 ! real(kind=8),dimension(:,:,:),allocatable :: dphi,dalpha,domega !(3,3,maxres)
153 real(kind=8),dimension(:,:,:),allocatable :: grad_shield_side, &
154 grad_shield_loc ! (3,maxcontsshileding,maxnres)
157 real(kind=8), dimension(:),allocatable :: fac_shield
158 real(kind=8),dimension(3,5,2) :: derx,derx_turn
159 ! common /deriv_scloc/
160 real(kind=8),dimension(:,:),allocatable :: dXX_C1tab,dYY_C1tab,&
161 dZZ_C1tab,dXX_Ctab,dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,&
162 dZZ_XYZtab !(3,maxres)
163 !-----------------------------------------------------------------------------
166 real(kind=8) :: gvdwc_max,gvdwc_scp_max,gelc_max,gvdwpp_max,&
167 gradb_max,ghpbc_max,&
168 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
169 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
170 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
171 gsccorx_max,gsclocx_max
172 !-----------------------------------------------------------------------------
174 ! common /back_constr/
175 real(kind=8),dimension(:),allocatable :: dutheta,dugamma !(maxres)
176 real(kind=8),dimension(:,:),allocatable :: duscdiff,duscdiffx !(3,maxres)
178 real(kind=8) :: Ucdfrag,Ucdpair
179 real(kind=8),dimension(:,:),allocatable :: dUdconst,dUdxconst,&
180 dqwol,dxqwol !(3,0:MAXRES)
181 !-----------------------------------------------------------------------------
183 ! common /dyn_ssbond/
184 real(kind=8),dimension(:,:),allocatable :: dyn_ssbond_ij !(maxres,maxres)
185 !-----------------------------------------------------------------------------
187 ! Parameters of the SCCOR term
189 real(kind=8),dimension(:,:,:,:),allocatable :: dcostau,dsintau,&
190 dcosomicron,domicron !(3,3,3,maxres2)
191 !-----------------------------------------------------------------------------
194 real(kind=8),dimension(:,:),allocatable :: uy,uz !(3,maxres)
195 real(kind=8),dimension(:,:,:,:),allocatable :: uygrad,uzgrad !(3,3,2,maxres)
196 !-----------------------------------------------------------------------------
197 ! common /przechowalnia/
198 real(kind=8),dimension(:,:,:),allocatable :: zapas
199 real(kind=8),dimension(:,:,:,:),allocatable ::zapas2 !(max_dim,maxconts,max_fg_procs)
200 real(kind=8),dimension(:,:,:),allocatable :: fromto !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
201 !-----------------------------------------------------------------------------
202 !-----------------------------------------------------------------------------
205 !-----------------------------------------------------------------------------
207 !-----------------------------------------------------------------------------
208 ! energy_p_new_barrier.F
209 !-----------------------------------------------------------------------------
210 subroutine etotal(energia)
211 ! implicit real*8 (a-h,o-z)
212 ! include 'DIMENSIONS'
217 !MS$ATTRIBUTES C :: proc_proc
223 ! include 'COMMON.SETUP'
224 ! include 'COMMON.IOUNITS'
225 real(kind=8),dimension(0:n_ene) :: energia
226 ! include 'COMMON.LOCAL'
227 ! include 'COMMON.FFIELD'
228 ! include 'COMMON.DERIV'
229 ! include 'COMMON.INTERACT'
230 ! include 'COMMON.SBRIDGE'
231 ! include 'COMMON.CHAIN'
232 ! include 'COMMON.VAR'
233 ! include 'COMMON.MD'
234 ! include 'COMMON.CONTROL'
235 ! include 'COMMON.TIME1'
236 real(kind=8) :: time00
238 integer :: n_corr,n_corr1,ierror
239 real(kind=8) :: etors,edihcnstr,etors_d,esccor,ehpb
240 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,escloc,ees,eel_loc
241 real(kind=8) :: eello_turn3,eello_turn4,estr,ebe,eliptran,etube, &
242 Eafmforce,ethetacnstr
243 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
244 ! now energies for nulceic alone parameters
245 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
246 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
249 real(kind=8) :: ecation_prot,ecationcation
250 ! energies for protein nucleic acid interaction
251 real(kind=8) :: escbase,epepbase,escpho,epeppho
254 real(kind=8) :: weights_(n_ene) !,time_Bcast,time_Bcastw
255 ! shielding effect varibles for MPI
256 ! real(kind=8) fac_shieldbuf(maxres),
257 ! & grad_shield_locbuf(3,maxcontsshi,-1:maxres),
258 ! & grad_shield_sidebuf(3,maxcontsshi,-1:maxres),
259 ! & grad_shieldbuf(3,-1:maxres)
260 ! integer ishield_listbuf(maxres),
261 ! &shield_listbuf(maxcontsshi,maxres)
263 ! print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
264 ! & " nfgtasks",nfgtasks
265 if (nfgtasks.gt.1) then
267 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
268 if (fg_rank.eq.0) then
269 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
270 ! print *,"Processor",myrank," BROADCAST iorder"
271 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
272 ! FG slaves as WEIGHTS array.
292 weights_(26)=wvdwpp_nucl
298 weights_(32)=wbond_nucl
299 weights_(33)=wang_nucl
301 weights_(35)=wtor_nucl
302 weights_(36)=wtor_d_nucl
303 weights_(37)=wcorr_nucl
304 weights_(38)=wcorr3_nucl
306 weights_(42)=wcatprot
310 ! wcatcat= weights(41)
311 ! wcatprot=weights(42)
313 ! FG Master broadcasts the WEIGHTS_ array
314 call MPI_Bcast(weights_(1),n_ene,&
315 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
317 ! FG slaves receive the WEIGHTS array
318 call MPI_Bcast(weights(1),n_ene,&
319 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
339 wvdwpp_nucl =weights(26)
345 wbond_nucl =weights(32)
346 wang_nucl =weights(33)
348 wtor_nucl =weights(35)
349 wtor_d_nucl =weights(36)
350 wcorr_nucl =weights(37)
351 wcorr3_nucl =weights(38)
358 time_Bcast=time_Bcast+MPI_Wtime()-time00
359 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
360 ! call chainbuild_cart
362 ! print *,'Processor',myrank,' calling etotal ipot=',ipot
363 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
365 ! if (modecalc.eq.12.or.modecalc.eq.14) then
366 ! call int_from_cart1(.false.)
373 ! Compute the side-chain and electrostatic interaction energy
374 ! print *, "Before EVDW"
375 ! goto (101,102,103,104,105,106) ipot
377 ! Lennard-Jones potential.
381 !d print '(a)','Exit ELJcall el'
383 ! Lennard-Jones-Kihara potential (shifted).
384 ! 102 call eljk(evdw)
388 ! Berne-Pechukas potential (dilated LJ, angular dependence).
393 ! Gay-Berne potential (shifted LJ, angular dependence).
398 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
399 ! 105 call egbv(evdw)
403 ! Soft-sphere potential
404 ! 106 call e_softsphere(evdw)
406 call e_softsphere(evdw)
408 ! Calculate electrostatic (H-bonding) energy of the main chain.
412 write(iout,*)"Wrong ipot"
417 ! print *,"after EGB"
419 if (shield_mode.eq.2) then
422 ! print *,"AFTER EGB",ipot,evdw
424 !mc Sep-06: egb takes care of dynamic ss bonds too
426 ! if (dyn_ss) call dyn_set_nss
427 ! print *,"Processor",myrank," computed USCSC"
433 time_vec=time_vec+MPI_Wtime()-time01
435 ! print *,"Processor",myrank," left VEC_AND_DERIV"
438 ! print *,"after ipot if", ipot
439 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
440 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
441 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
442 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
444 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
445 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
446 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
447 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
449 ! print *,"just befor eelec call"
450 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
451 ! write (iout,*) "ELEC calc"
460 ! write (iout,*) "Soft-spheer ELEC potential"
461 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
464 ! print *,"Processor",myrank," computed UELEC"
466 ! Calculate excluded-volume interaction energy between peptide groups
469 !elwrite(iout,*) "in etotal calc exc;luded",ipot
473 call escp(evdw2,evdw2_14)
479 ! write (iout,*) "Soft-sphere SCP potential"
480 call escp_soft_sphere(evdw2,evdw2_14)
482 ! write(iout,*) "in etotal before ebond",ipot
485 ! Calculate the bond-stretching energy
488 ! print *,"EBOND",estr
489 ! write(iout,*) "in etotal afer ebond",ipot
492 ! Calculate the disulfide-bridge and other energy and the contributions
493 ! from other distance constraints.
494 ! print *,'Calling EHPB'
496 !elwrite(iout,*) "in etotal afer edis",ipot
497 ! print *,'EHPB exitted succesfully.'
499 ! Calculate the virtual-bond-angle energy.
501 if (wang.gt.0d0) then
502 call ebend(ebe,ethetacnstr)
507 ! print *,"Processor",myrank," computed UB"
509 ! Calculate the SC local energy.
512 !elwrite(iout,*) "in etotal afer esc",ipot
513 ! print *,"Processor",myrank," computed USC"
515 ! Calculate the virtual-bond torsional energy.
517 !d print *,'nterm=',nterm
519 call etor(etors,edihcnstr)
524 ! print *,"Processor",myrank," computed Utor"
526 ! 6/23/01 Calculate double-torsional energy
528 !elwrite(iout,*) "in etotal",ipot
529 if (wtor_d.gt.0) then
534 ! print *,"Processor",myrank," computed Utord"
536 ! 21/5/07 Calculate local sicdechain correlation energy
538 if (wsccor.gt.0.0d0) then
539 call eback_sc_corr(esccor)
543 ! print *,"Processor",myrank," computed Usccorr"
545 ! 12/1/95 Multi-body terms
549 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
550 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
551 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
552 !d write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
553 !d &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
560 !elwrite(iout,*) "in etotal",ipot
561 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
562 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
563 !d write (iout,*) "multibody_hb ecorr",ecorr
565 !elwrite(iout,*) "afeter multibody hb"
567 ! print *,"Processor",myrank," computed Ucorr"
569 ! If performing constraint dynamics, call the constraint energy
570 ! after the equilibration time
571 if(usampl.and.totT.gt.eq_time) then
572 !elwrite(iout,*) "afeter multibody hb"
574 !elwrite(iout,*) "afeter multibody hb"
576 !elwrite(iout,*) "afeter multibody hb"
582 ! write(iout,*) "after Econstr"
584 if (wliptran.gt.0) then
585 ! print *,"PRZED WYWOLANIEM"
586 call Eliptransfer(eliptran)
590 if (fg_rank.eq.0) then
591 if (AFMlog.gt.0) then
592 call AFMforce(Eafmforce)
593 else if (selfguide.gt.0) then
594 call AFMvel(Eafmforce)
597 if (tubemode.eq.1) then
599 else if (tubemode.eq.2) then
600 call calctube2(etube)
601 elseif (tubemode.eq.3) then
606 !--------------------------------------------------------
607 ! write (iout,*) "NRES_MOLEC(2),",nres_molec(2)
608 ! print *,"before",ees,evdw1,ecorr
609 if (nres_molec(2).gt.0) then
610 call ebond_nucl(estr_nucl)
611 call ebend_nucl(ebe_nucl)
612 call etor_nucl(etors_nucl)
613 call esb_gb(evdwsb,eelsb)
614 call epp_nucl_sub(evdwpp,eespp)
615 call epsb(evdwpsb,eelpsb)
617 call multibody_hb_nucl(ecorr_nucl,ecorr3_nucl,n_corr,n_corr1)
626 if (nfgtasks.gt.1) then
627 if (fg_rank.eq.0) then
628 call ecatcat(ecationcation)
631 call ecatcat(ecationcation)
633 call ecat_prot(ecation_prot)
634 if (nres_molec(2).gt.0) then
635 call eprot_sc_base(escbase)
636 call epep_sc_base(epepbase)
637 call eprot_sc_phosphate(escpho)
638 call eprot_pep_phosphate(epeppho)
640 ! call ecatcat(ecationcation)
641 ! print *,"after ebend", ebe_nucl
643 time_enecalc=time_enecalc+MPI_Wtime()-time00
645 ! print *,"Processor",myrank," computed Uconstr"
654 energia(2)=evdw2-evdw2_14
671 energia(8)=eello_turn3
672 energia(9)=eello_turn4
679 energia(19)=edihcnstr
681 energia(20)=Uconst+Uconst_back
684 energia(23)=Eafmforce
685 energia(24)=ethetacnstr
687 !---------------------------------------------------------------
694 energia(32)=estr_nucl
697 energia(35)=etors_nucl
698 energia(36)=etors_d_nucl
699 energia(37)=ecorr_nucl
700 energia(38)=ecorr3_nucl
701 !----------------------------------------------------------------------
702 ! Here are the energies showed per procesor if the are more processors
703 ! per molecule then we sum it up in sum_energy subroutine
704 ! print *," Processor",myrank," calls SUM_ENERGY"
705 energia(41)=ecation_prot
706 energia(42)=ecationcation
711 call sum_energy(energia,.true.)
712 if (dyn_ss) call dyn_set_nss
713 ! print *," Processor",myrank," left SUM_ENERGY"
715 time_sumene=time_sumene+MPI_Wtime()-time00
717 !el call enerprint(energia)
718 !elwrite(iout,*)"finish etotal"
720 end subroutine etotal
721 !-----------------------------------------------------------------------------
722 subroutine sum_energy(energia,reduce)
723 ! implicit real*8 (a-h,o-z)
724 ! include 'DIMENSIONS'
728 !MS$ATTRIBUTES C :: proc_proc
734 ! include 'COMMON.SETUP'
735 ! include 'COMMON.IOUNITS'
736 real(kind=8) :: energia(0:n_ene),enebuff(0:n_ene+1)
737 ! include 'COMMON.FFIELD'
738 ! include 'COMMON.DERIV'
739 ! include 'COMMON.INTERACT'
740 ! include 'COMMON.SBRIDGE'
741 ! include 'COMMON.CHAIN'
742 ! include 'COMMON.VAR'
743 ! include 'COMMON.CONTROL'
744 ! include 'COMMON.TIME1'
746 real(kind=8) :: evdw,evdw2,evdw2_14,ees,evdw1,ecorr,ecorr5,ecorr6
747 real(kind=8) :: eel_loc,eello_turn3,eello_turn4,eturn6,ebe,escloc
748 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,esccor,etot, &
749 eliptran,etube, Eafmforce,ethetacnstr
750 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
751 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
753 real(kind=8) :: ecation_prot,ecationcation
754 real(kind=8) :: escbase,epepbase,escpho,epeppho
758 real(kind=8) :: time00
759 if (nfgtasks.gt.1 .and. reduce) then
762 write (iout,*) "energies before REDUCE"
763 call enerprint(energia)
767 enebuff(i)=energia(i)
770 call MPI_Barrier(FG_COMM,IERR)
771 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
773 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,&
774 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
776 write (iout,*) "energies after REDUCE"
777 call enerprint(energia)
780 time_Reduce=time_Reduce+MPI_Wtime()-time00
782 if (fg_rank.eq.0) then
786 evdw2=energia(2)+energia(18)
802 eello_turn3=energia(8)
803 eello_turn4=energia(9)
810 edihcnstr=energia(19)
815 Eafmforce=energia(23)
816 ethetacnstr=energia(24)
824 estr_nucl=energia(32)
827 etors_nucl=energia(35)
828 etors_d_nucl=energia(36)
829 ecorr_nucl=energia(37)
830 ecorr3_nucl=energia(38)
831 ecation_prot=energia(41)
832 ecationcation=energia(42)
837 ! energia(41)=ecation_prot
838 ! energia(42)=ecationcation
842 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 &
843 +wang*ebe+wtor*etors+wscloc*escloc &
844 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
845 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
846 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
847 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
848 +Eafmforce+ethetacnstr &
849 +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
850 +wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
851 +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
852 +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
853 +wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
854 +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho
856 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) &
857 +wang*ebe+wtor*etors+wscloc*escloc &
858 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
859 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
860 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
861 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
862 +Eafmforce+ethetacnstr &
863 +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
864 +wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
865 +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
866 +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
867 +wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
868 +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho
874 if (isnan(etot).ne.0) energia(0)=1.0d+99
876 if (isnan(etot)) energia(0)=1.0d+99
881 idumm=proc_proc(etot,i)
883 call proc_proc(etot,i)
885 if(i.eq.1)energia(0)=1.0d+99
890 ! call enerprint(energia)
893 end subroutine sum_energy
894 !-----------------------------------------------------------------------------
895 subroutine rescale_weights(t_bath)
896 ! implicit real*8 (a-h,o-z)
900 ! include 'DIMENSIONS'
901 ! include 'COMMON.IOUNITS'
902 ! include 'COMMON.FFIELD'
903 ! include 'COMMON.SBRIDGE'
904 real(kind=8) :: kfac=2.4d0
905 real(kind=8) :: x,x2,x3,x4,x5,licznik=1.12692801104297249644
907 real(kind=8) :: t_bath,facT(6) !,facT2,facT3,facT4,facT5,facT6
908 real(kind=8) :: T0=3.0d2
911 ! facT=2*temp0/(t_bath+temp0)
912 if (rescale_mode.eq.0) then
919 else if (rescale_mode.eq.1) then
920 facT(1)=kfac/(kfac-1.0d0+t_bath/temp0)
921 facT(2)=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
922 facT(3)=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
923 facT(4)=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
924 facT(5)=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
926 !#if defined(WHAM_RUN) || defined(CLUSTER)
928 ! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
929 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
936 else if (rescale_mode.eq.2) then
942 facT(1)=licznik/dlog(dexp(x)+dexp(-x))
943 facT(2)=licznik/dlog(dexp(x2)+dexp(-x2))
944 facT(3)=licznik/dlog(dexp(x3)+dexp(-x3))
945 facT(4)=licznik/dlog(dexp(x4)+dexp(-x4))
946 facT(5)=licznik/dlog(dexp(x5)+dexp(-x5))
948 !#if defined(WHAM_RUN) || defined(CLUSTER)
950 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
958 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
959 write (*,*) "Wrong RESCALE_MODE",rescale_mode
961 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
965 welec=weights(3)*fact(1)
966 wcorr=weights(4)*fact(3)
967 wcorr5=weights(5)*fact(4)
968 wcorr6=weights(6)*fact(5)
969 wel_loc=weights(7)*fact(2)
970 wturn3=weights(8)*fact(2)
971 wturn4=weights(9)*fact(3)
972 wturn6=weights(10)*fact(5)
973 wtor=weights(13)*fact(1)
974 wtor_d=weights(14)*fact(2)
975 wsccor=weights(21)*fact(1)
978 end subroutine rescale_weights
979 !-----------------------------------------------------------------------------
980 subroutine enerprint(energia)
981 ! implicit real*8 (a-h,o-z)
982 ! include 'DIMENSIONS'
983 ! include 'COMMON.IOUNITS'
984 ! include 'COMMON.FFIELD'
985 ! include 'COMMON.SBRIDGE'
986 ! include 'COMMON.MD'
987 real(kind=8) :: energia(0:n_ene)
989 real(kind=8) :: etot,evdw,evdw2,ees,evdw1,ecorr,ecorr5,ecorr6,eel_loc
990 real(kind=8) :: eello_turn6,eello_turn3,eello_turn4,ebe,escloc
991 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,Uconst,esccor,eliptran,&
992 etube,ethetacnstr,Eafmforce
993 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
994 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
996 real(kind=8) :: ecation_prot,ecationcation
997 real(kind=8) :: escbase,epepbase,escpho,epeppho
1003 evdw2=energia(2)+energia(18)
1015 eello_turn3=energia(8)
1016 eello_turn4=energia(9)
1017 eello_turn6=energia(10)
1023 edihcnstr=energia(19)
1027 eliptran=energia(22)
1028 Eafmforce=energia(23)
1029 ethetacnstr=energia(24)
1037 estr_nucl=energia(32)
1038 ebe_nucl=energia(33)
1040 etors_nucl=energia(35)
1041 etors_d_nucl=energia(36)
1042 ecorr_nucl=energia(37)
1043 ecorr3_nucl=energia(38)
1044 ecation_prot=energia(41)
1045 ecationcation=energia(42)
1047 epepbase=energia(47)
1051 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,&
1052 estr,wbond,ebe,wang,&
1053 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
1055 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
1056 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,&
1057 edihcnstr,ethetacnstr,ebr*nss,&
1058 Uconst,eliptran,wliptran,Eafmforce,etube,wtube, & ! till now protein
1059 estr_nucl,wbond_nucl,ebe_nucl,wang_nucl, &
1060 evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb,&
1061 evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl,&
1062 etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
1063 ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, &
1064 escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
1066 10 format (/'Virtual-chain energies:'// &
1067 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
1068 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
1069 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
1070 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ &
1071 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
1072 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
1073 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
1074 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
1075 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
1076 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
1077 ' (SS bridges & dist. cnstr.)'/ &
1078 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1079 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1080 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1081 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
1082 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
1083 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
1084 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
1085 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
1086 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
1087 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
1088 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
1089 'UCONST= ',1pE16.6,' (Constraint energy)'/ &
1090 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/&
1091 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
1092 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
1093 'ESTR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
1094 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
1095 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
1096 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
1097 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
1098 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
1099 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
1100 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
1101 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
1102 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
1103 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
1104 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
1105 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
1106 'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ &
1107 'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ &
1108 'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ &
1109 'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
1110 'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
1111 'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
1112 'ETOT= ',1pE16.6,' (total)')
1114 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,&
1115 estr,wbond,ebe,wang,&
1116 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
1118 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
1119 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,&
1120 ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc, &
1122 estr_nucl,wbond_nucl, ebe_nucl,wang_nucl,&
1123 evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb&
1124 evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl&
1125 etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
1126 ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, &
1127 escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
1129 10 format (/'Virtual-chain energies:'// &
1130 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
1131 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
1132 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
1133 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
1134 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
1135 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
1136 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
1137 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
1138 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
1139 ' (SS bridges & dist. cnstr.)'/ &
1140 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1141 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1142 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1143 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
1144 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
1145 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
1146 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
1147 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
1148 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
1149 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
1150 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
1151 'UCONST=',1pE16.6,' (Constraint energy)'/ &
1152 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ &
1153 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
1154 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
1155 'ESTR_nucl= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
1156 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
1157 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
1158 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
1159 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
1160 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
1161 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
1162 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
1163 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
1164 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
1165 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
1166 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
1167 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
1168 'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ &
1169 'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ &
1170 'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ &
1171 'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
1172 'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
1173 'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
1174 'ETOT= ',1pE16.6,' (total)')
1177 end subroutine enerprint
1178 !-----------------------------------------------------------------------------
1179 subroutine elj(evdw)
1181 ! This subroutine calculates the interaction energy of nonbonded side chains
1182 ! assuming the LJ potential of interaction.
1184 ! implicit real*8 (a-h,o-z)
1185 ! include 'DIMENSIONS'
1186 real(kind=8),parameter :: accur=1.0d-10
1187 ! include 'COMMON.GEO'
1188 ! include 'COMMON.VAR'
1189 ! include 'COMMON.LOCAL'
1190 ! include 'COMMON.CHAIN'
1191 ! include 'COMMON.DERIV'
1192 ! include 'COMMON.INTERACT'
1193 ! include 'COMMON.TORSION'
1194 ! include 'COMMON.SBRIDGE'
1195 ! include 'COMMON.NAMES'
1196 ! include 'COMMON.IOUNITS'
1197 ! include 'COMMON.CONTACTS'
1198 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1199 integer :: num_conti
1201 integer :: i,itypi,iint,j,itypi1,itypj,k
1202 real(kind=8) :: rij,rcut,fcont,fprimcont,rrij
1203 real(kind=8) :: evdw,xi,yi,zi,xj,yj,zj
1204 real(kind=8) :: eps0ij,fac,e1,e2,evdwij,sigij,r0ij
1206 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1208 ! allocate(num_cont(iatsc_s:iatsc_e)) !(maxres) nnt,nct-2
1209 ! allocate(jcont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres) (maxconts=maxres/4)
1210 ! allocate(facont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres)
1211 ! allocate(gacont(3,nres/4,iatsc_s:iatsc_e)) !(3,maxconts,maxres)
1213 do i=iatsc_s,iatsc_e
1214 itypi=iabs(itype(i,1))
1215 if (itypi.eq.ntyp1) cycle
1216 itypi1=iabs(itype(i+1,1))
1223 ! Calculate SC interaction energy.
1225 do iint=1,nint_gr(i)
1226 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1227 !d & 'iend=',iend(i,iint)
1228 do j=istart(i,iint),iend(i,iint)
1229 itypj=iabs(itype(j,1))
1230 if (itypj.eq.ntyp1) cycle
1234 ! Change 12/1/95 to calculate four-body interactions
1235 rij=xj*xj+yj*yj+zj*zj
1237 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1238 eps0ij=eps(itypi,itypj)
1240 e1=fac*fac*aa_aq(itypi,itypj)
1241 e2=fac*bb_aq(itypi,itypj)
1243 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1244 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1245 !d write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1246 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1247 !d & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1248 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1251 ! Calculate the components of the gradient in DC and X
1253 fac=-rrij*(e1+evdwij)
1258 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1259 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1260 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1261 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1265 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1269 ! 12/1/95, revised on 5/20/97
1271 ! Calculate the contact function. The ith column of the array JCONT will
1272 ! contain the numbers of atoms that make contacts with the atom I (of numbers
1273 ! greater than I). The arrays FACONT and GACONT will contain the values of
1274 ! the contact function and its derivative.
1276 ! Uncomment next line, if the correlation interactions include EVDW explicitly.
1277 ! if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1278 ! Uncomment next line, if the correlation interactions are contact function only
1279 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1281 sigij=sigma(itypi,itypj)
1282 r0ij=rs0(itypi,itypj)
1284 ! Check whether the SC's are not too far to make a contact.
1287 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1288 ! Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1290 if (fcont.gt.0.0D0) then
1291 ! If the SC-SC distance if close to sigma, apply spline.
1292 !Adam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1293 !Adam & fcont1,fprimcont1)
1294 !Adam fcont1=1.0d0-fcont1
1295 !Adam if (fcont1.gt.0.0d0) then
1296 !Adam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1297 !Adam fcont=fcont*fcont1
1299 ! Uncomment following 4 lines to have the geometric average of the epsilon0's
1300 !ga eps0ij=1.0d0/dsqrt(eps0ij)
1302 !ga gg(k)=gg(k)*eps0ij
1304 !ga eps0ij=-evdwij*eps0ij
1305 ! Uncomment for AL's type of SC correlation interactions.
1306 !adam eps0ij=-evdwij
1307 num_conti=num_conti+1
1308 jcont(num_conti,i)=j
1309 facont(num_conti,i)=fcont*eps0ij
1310 fprimcont=eps0ij*fprimcont/rij
1312 !Adam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1313 !Adam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1314 !Adam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1315 ! Uncomment following 3 lines for Skolnick's type of SC correlation.
1316 gacont(1,num_conti,i)=-fprimcont*xj
1317 gacont(2,num_conti,i)=-fprimcont*yj
1318 gacont(3,num_conti,i)=-fprimcont*zj
1319 !d write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1320 !d write (iout,'(2i3,3f10.5)')
1321 !d & i,j,(gacont(kk,num_conti,i),kk=1,3)
1327 num_cont(i)=num_conti
1331 gvdwc(j,i)=expon*gvdwc(j,i)
1332 gvdwx(j,i)=expon*gvdwx(j,i)
1335 !******************************************************************************
1339 ! To save time, the factor of EXPON has been extracted from ALL components
1340 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
1343 !******************************************************************************
1346 !-----------------------------------------------------------------------------
1347 subroutine eljk(evdw)
1349 ! This subroutine calculates the interaction energy of nonbonded side chains
1350 ! assuming the LJK potential of interaction.
1352 ! implicit real*8 (a-h,o-z)
1353 ! include 'DIMENSIONS'
1354 ! include 'COMMON.GEO'
1355 ! include 'COMMON.VAR'
1356 ! include 'COMMON.LOCAL'
1357 ! include 'COMMON.CHAIN'
1358 ! include 'COMMON.DERIV'
1359 ! include 'COMMON.INTERACT'
1360 ! include 'COMMON.IOUNITS'
1361 ! include 'COMMON.NAMES'
1362 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1365 integer :: i,iint,j,itypi,itypi1,k,itypj
1366 real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij
1367 real(kind=8) :: evdw,rij,r_shift_inv,fac,e1,e2,evdwij
1369 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1371 do i=iatsc_s,iatsc_e
1372 itypi=iabs(itype(i,1))
1373 if (itypi.eq.ntyp1) cycle
1374 itypi1=iabs(itype(i+1,1))
1379 ! Calculate SC interaction energy.
1381 do iint=1,nint_gr(i)
1382 do j=istart(i,iint),iend(i,iint)
1383 itypj=iabs(itype(j,1))
1384 if (itypj.eq.ntyp1) cycle
1388 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1389 fac_augm=rrij**expon
1390 e_augm=augm(itypi,itypj)*fac_augm
1391 r_inv_ij=dsqrt(rrij)
1393 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1394 fac=r_shift_inv**expon
1395 e1=fac*fac*aa_aq(itypi,itypj)
1396 e2=fac*bb_aq(itypi,itypj)
1398 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1399 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1400 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1401 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1402 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1403 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1404 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1407 ! Calculate the components of the gradient in DC and X
1409 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1414 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1415 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1416 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1417 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1421 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1429 gvdwc(j,i)=expon*gvdwc(j,i)
1430 gvdwx(j,i)=expon*gvdwx(j,i)
1435 !-----------------------------------------------------------------------------
1436 subroutine ebp(evdw)
1438 ! This subroutine calculates the interaction energy of nonbonded side chains
1439 ! assuming the Berne-Pechukas potential of interaction.
1443 ! implicit real*8 (a-h,o-z)
1444 ! include 'DIMENSIONS'
1445 ! include 'COMMON.GEO'
1446 ! include 'COMMON.VAR'
1447 ! include 'COMMON.LOCAL'
1448 ! include 'COMMON.CHAIN'
1449 ! include 'COMMON.DERIV'
1450 ! include 'COMMON.NAMES'
1451 ! include 'COMMON.INTERACT'
1452 ! include 'COMMON.IOUNITS'
1453 ! include 'COMMON.CALC'
1455 !el integer :: icall
1456 !el common /srutu/ icall
1457 ! double precision rrsave(maxdim)
1460 integer :: iint,itypi,itypi1,itypj
1461 real(kind=8) :: rrij,xi,yi,zi
1462 real(kind=8) :: evdw,fac,e1,e2,sigm,epsi
1464 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1466 ! if (icall.eq.0) then
1472 do i=iatsc_s,iatsc_e
1473 itypi=iabs(itype(i,1))
1474 if (itypi.eq.ntyp1) cycle
1475 itypi1=iabs(itype(i+1,1))
1479 dxi=dc_norm(1,nres+i)
1480 dyi=dc_norm(2,nres+i)
1481 dzi=dc_norm(3,nres+i)
1482 ! dsci_inv=dsc_inv(itypi)
1483 dsci_inv=vbld_inv(i+nres)
1485 ! Calculate SC interaction energy.
1487 do iint=1,nint_gr(i)
1488 do j=istart(i,iint),iend(i,iint)
1490 itypj=iabs(itype(j,1))
1491 if (itypj.eq.ntyp1) cycle
1492 ! dscj_inv=dsc_inv(itypj)
1493 dscj_inv=vbld_inv(j+nres)
1494 chi1=chi(itypi,itypj)
1495 chi2=chi(itypj,itypi)
1502 alf12=0.5D0*(alf1+alf2)
1503 ! For diagnostics only!!!
1516 dxj=dc_norm(1,nres+j)
1517 dyj=dc_norm(2,nres+j)
1518 dzj=dc_norm(3,nres+j)
1519 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1520 !d if (icall.eq.0) then
1526 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
1528 ! Calculate whole angle-dependent part of epsilon and contributions
1529 ! to its derivatives
1530 fac=(rrij*sigsq)**expon2
1531 e1=fac*fac*aa_aq(itypi,itypj)
1532 e2=fac*bb_aq(itypi,itypj)
1533 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1534 eps2der=evdwij*eps3rt
1535 eps3der=evdwij*eps2rt
1536 evdwij=evdwij*eps2rt*eps3rt
1539 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1540 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1541 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1542 !d & restyp(itypi,1),i,restyp(itypj,1),j,
1543 !d & epsi,sigm,chi1,chi2,chip1,chip2,
1544 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1545 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
1548 ! Calculate gradient components.
1549 e1=e1*eps1*eps2rt**2*eps3rt**2
1550 fac=-expon*(e1+evdwij)
1553 ! Calculate radial part of the gradient
1557 ! Calculate the angular part of the gradient and sum add the contributions
1558 ! to the appropriate components of the Cartesian gradient.
1566 !-----------------------------------------------------------------------------
1567 subroutine egb(evdw)
1569 ! This subroutine calculates the interaction energy of nonbonded side chains
1570 ! assuming the Gay-Berne potential of interaction.
1573 ! implicit real*8 (a-h,o-z)
1574 ! include 'DIMENSIONS'
1575 ! include 'COMMON.GEO'
1576 ! include 'COMMON.VAR'
1577 ! include 'COMMON.LOCAL'
1578 ! include 'COMMON.CHAIN'
1579 ! include 'COMMON.DERIV'
1580 ! include 'COMMON.NAMES'
1581 ! include 'COMMON.INTERACT'
1582 ! include 'COMMON.IOUNITS'
1583 ! include 'COMMON.CALC'
1584 ! include 'COMMON.CONTROL'
1585 ! include 'COMMON.SBRIDGE'
1588 integer :: iint,itypi,itypi1,itypj,subchap
1589 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
1590 real(kind=8) :: evdw,sig0ij
1591 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
1592 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
1593 sslipi,sslipj,faclip
1595 real(kind=8) :: fracinbuf
1597 !cccc energy_dec=.false.
1598 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1601 ! if (icall.eq.0) lprn=.false.
1603 do i=iatsc_s,iatsc_e
1604 !C print *,"I am in EVDW",i
1605 itypi=iabs(itype(i,1))
1606 ! if (i.ne.47) cycle
1607 if (itypi.eq.ntyp1) cycle
1608 itypi1=iabs(itype(i+1,1))
1612 xi=dmod(xi,boxxsize)
1613 if (xi.lt.0) xi=xi+boxxsize
1614 yi=dmod(yi,boxysize)
1615 if (yi.lt.0) yi=yi+boxysize
1616 zi=dmod(zi,boxzsize)
1617 if (zi.lt.0) zi=zi+boxzsize
1619 if ((zi.gt.bordlipbot) &
1620 .and.(zi.lt.bordliptop)) then
1621 !C the energy transfer exist
1622 if (zi.lt.buflipbot) then
1623 !C what fraction I am in
1625 ((zi-bordlipbot)/lipbufthick)
1626 !C lipbufthick is thickenes of lipid buffore
1627 sslipi=sscalelip(fracinbuf)
1628 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1629 elseif (zi.gt.bufliptop) then
1630 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1631 sslipi=sscalelip(fracinbuf)
1632 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1641 ! print *, sslipi,ssgradlipi
1642 dxi=dc_norm(1,nres+i)
1643 dyi=dc_norm(2,nres+i)
1644 dzi=dc_norm(3,nres+i)
1645 ! dsci_inv=dsc_inv(itypi)
1646 dsci_inv=vbld_inv(i+nres)
1647 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1648 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1650 ! Calculate SC interaction energy.
1652 do iint=1,nint_gr(i)
1653 do j=istart(i,iint),iend(i,iint)
1654 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1655 call dyn_ssbond_ene(i,j,evdwij)
1657 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1658 'evdw',i,j,evdwij,' ss'
1659 ! if (energy_dec) write (iout,*) &
1660 ! 'evdw',i,j,evdwij,' ss'
1661 do k=j+1,iend(i,iint)
1662 !C search over all next residues
1663 if (dyn_ss_mask(k)) then
1664 !C check if they are cysteins
1665 !C write(iout,*) 'k=',k
1667 !c write(iout,*) "PRZED TRI", evdwij
1668 ! evdwij_przed_tri=evdwij
1669 call triple_ssbond_ene(i,j,k,evdwij)
1670 !c if(evdwij_przed_tri.ne.evdwij) then
1671 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1674 !c write(iout,*) "PO TRI", evdwij
1675 !C call the energy function that removes the artifical triple disulfide
1676 !C bond the soubroutine is located in ssMD.F
1678 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1679 'evdw',i,j,evdwij,'tss'
1680 endif!dyn_ss_mask(k)
1684 itypj=iabs(itype(j,1))
1685 if (itypj.eq.ntyp1) cycle
1686 ! if (j.ne.78) cycle
1687 ! dscj_inv=dsc_inv(itypj)
1688 dscj_inv=vbld_inv(j+nres)
1689 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,&
1690 ! 1.0d0/vbld(j+nres) !d
1691 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
1692 sig0ij=sigma(itypi,itypj)
1693 chi1=chi(itypi,itypj)
1694 chi2=chi(itypj,itypi)
1701 alf12=0.5D0*(alf1+alf2)
1702 ! For diagnostics only!!!
1715 xj=dmod(xj,boxxsize)
1716 if (xj.lt.0) xj=xj+boxxsize
1717 yj=dmod(yj,boxysize)
1718 if (yj.lt.0) yj=yj+boxysize
1719 zj=dmod(zj,boxzsize)
1720 if (zj.lt.0) zj=zj+boxzsize
1721 ! print *,"tu",xi,yi,zi,xj,yj,zj
1722 ! print *,"tu2",j,j+nres,c(1,j),c(1,j+nres)
1723 ! this fragment set correct epsilon for lipid phase
1724 if ((zj.gt.bordlipbot) &
1725 .and.(zj.lt.bordliptop)) then
1726 !C the energy transfer exist
1727 if (zj.lt.buflipbot) then
1728 !C what fraction I am in
1730 ((zj-bordlipbot)/lipbufthick)
1731 !C lipbufthick is thickenes of lipid buffore
1732 sslipj=sscalelip(fracinbuf)
1733 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1734 elseif (zj.gt.bufliptop) then
1735 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1736 sslipj=sscalelip(fracinbuf)
1737 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1746 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1747 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1748 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1749 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1750 !------------------------------------------------
1751 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1759 xj=xj_safe+xshift*boxxsize
1760 yj=yj_safe+yshift*boxysize
1761 zj=zj_safe+zshift*boxzsize
1762 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1763 if(dist_temp.lt.dist_init) then
1773 if (subchap.eq.1) then
1782 dxj=dc_norm(1,nres+j)
1783 dyj=dc_norm(2,nres+j)
1784 dzj=dc_norm(3,nres+j)
1785 ! write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1786 ! write (iout,*) "j",j," dc_norm",& !d
1787 ! dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1788 ! write(iout,*)"rrij ",rrij
1789 ! write(iout,*)"xj yj zj ", xj, yj, zj
1790 ! write(iout,*)"xi yi zi ", xi, yi, zi
1791 ! write(iout,*)"c ", c(1,:), c(2,:), c(3,:)
1792 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1794 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
1795 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
1796 ! print *,sss_ele_cut,sss_ele_grad,&
1797 ! 1.0d0/(rij),r_cut_ele,rlamb_ele
1798 if (sss_ele_cut.le.0.0) cycle
1799 ! Calculate angle-dependent terms of energy and contributions to their
1803 sig=sig0ij*dsqrt(sigsq)
1804 rij_shift=1.0D0/rij-sig+sig0ij
1805 ! write(iout,*)" rij_shift",rij_shift," rij",rij," sig",sig,&
1807 ! for diagnostics; uncomment
1808 ! rij_shift=1.2*sig0ij
1809 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1810 if (rij_shift.le.0.0D0) then
1812 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1813 !d & restyp(itypi,1),i,restyp(itypj,1),j,
1814 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1818 !---------------------------------------------------------------
1819 rij_shift=1.0D0/rij_shift
1820 fac=rij_shift**expon
1822 e1=fac*fac*aa!(itypi,itypj)
1823 e2=fac*bb!(itypi,itypj)
1824 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1825 eps2der=evdwij*eps3rt
1826 eps3der=evdwij*eps2rt
1827 ! write(iout,*)"aa, bb ",aa(:,:),bb(:,:)
1828 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,& !d
1829 ! " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2," fac",fac !d
1830 evdwij=evdwij*eps2rt*eps3rt
1831 evdw=evdw+evdwij*sss_ele_cut
1833 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1834 epsi=bb**2/aa!(itypi,itypj)
1835 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1836 restyp(itypi,1),i,restyp(itypj,1),j, &
1837 epsi,sigm,chi1,chi2,chip1,chip2, &
1838 eps1,eps2rt**2,eps3rt**2,sig,sig0ij, &
1839 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, &
1843 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2e10.2,e11.3)')&
1844 'evdw',i,j,evdwij,xi,xj,rij !,"egb"
1845 !C print *,i,j,c(1,i),c(1,j),c(2,i),c(2,j),c(3,i),c(3,j)
1846 ! if (energy_dec) write (iout,*) &
1848 ! print *,"ZALAMKA", evdw
1850 ! Calculate gradient components.
1851 e1=e1*eps1*eps2rt**2*eps3rt**2
1852 fac=-expon*(e1+evdwij)*rij_shift
1855 ! print *,'before fac',fac,rij,evdwij
1856 fac=fac+evdwij*sss_ele_grad/sss_ele_cut&
1857 /sigma(itypi,itypj)*rij
1858 ! print *,'grad part scale',fac, &
1859 ! evdwij*sss_ele_grad/sss_ele_cut &
1860 ! /sigma(itypi,itypj)*rij
1862 ! Calculate the radial part of the gradient
1866 !C Calculate the radial part of the gradient
1867 gg_lipi(3)=eps1*(eps2rt*eps2rt)&
1868 *(eps3rt*eps3rt)*sss_ele_cut/2.0d0*(faclip*faclip*&
1869 (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))&
1870 +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1871 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1872 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1874 ! print *,'before sc_grad', gg(1),gg(2),gg(3)
1875 ! Calculate angular part of the gradient.
1881 ! print *,"ZALAMKA", evdw
1882 ! write (iout,*) "Number of loop steps in EGB:",ind
1883 !ccc energy_dec=.false.
1886 !-----------------------------------------------------------------------------
1887 subroutine egbv(evdw)
1889 ! This subroutine calculates the interaction energy of nonbonded side chains
1890 ! assuming the Gay-Berne-Vorobjev potential of interaction.
1894 ! implicit real*8 (a-h,o-z)
1895 ! include 'DIMENSIONS'
1896 ! include 'COMMON.GEO'
1897 ! include 'COMMON.VAR'
1898 ! include 'COMMON.LOCAL'
1899 ! include 'COMMON.CHAIN'
1900 ! include 'COMMON.DERIV'
1901 ! include 'COMMON.NAMES'
1902 ! include 'COMMON.INTERACT'
1903 ! include 'COMMON.IOUNITS'
1904 ! include 'COMMON.CALC'
1906 !el integer :: icall
1907 !el common /srutu/ icall
1910 integer :: iint,itypi,itypi1,itypj
1911 real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2,sigm
1912 real(kind=8) :: evdw,sig0ij,sig,rij_shift,epsi
1914 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1917 ! if (icall.eq.0) lprn=.true.
1919 do i=iatsc_s,iatsc_e
1920 itypi=iabs(itype(i,1))
1921 if (itypi.eq.ntyp1) cycle
1922 itypi1=iabs(itype(i+1,1))
1926 dxi=dc_norm(1,nres+i)
1927 dyi=dc_norm(2,nres+i)
1928 dzi=dc_norm(3,nres+i)
1929 ! dsci_inv=dsc_inv(itypi)
1930 dsci_inv=vbld_inv(i+nres)
1932 ! Calculate SC interaction energy.
1934 do iint=1,nint_gr(i)
1935 do j=istart(i,iint),iend(i,iint)
1937 itypj=iabs(itype(j,1))
1938 if (itypj.eq.ntyp1) cycle
1939 ! dscj_inv=dsc_inv(itypj)
1940 dscj_inv=vbld_inv(j+nres)
1941 sig0ij=sigma(itypi,itypj)
1942 r0ij=r0(itypi,itypj)
1943 chi1=chi(itypi,itypj)
1944 chi2=chi(itypj,itypi)
1951 alf12=0.5D0*(alf1+alf2)
1952 ! For diagnostics only!!!
1965 dxj=dc_norm(1,nres+j)
1966 dyj=dc_norm(2,nres+j)
1967 dzj=dc_norm(3,nres+j)
1968 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1970 ! Calculate angle-dependent terms of energy and contributions to their
1974 sig=sig0ij*dsqrt(sigsq)
1975 rij_shift=1.0D0/rij-sig+r0ij
1976 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1977 if (rij_shift.le.0.0D0) then
1982 !---------------------------------------------------------------
1983 rij_shift=1.0D0/rij_shift
1984 fac=rij_shift**expon
1985 e1=fac*fac*aa_aq(itypi,itypj)
1986 e2=fac*bb_aq(itypi,itypj)
1987 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1988 eps2der=evdwij*eps3rt
1989 eps3der=evdwij*eps2rt
1990 fac_augm=rrij**expon
1991 e_augm=augm(itypi,itypj)*fac_augm
1992 evdwij=evdwij*eps2rt*eps3rt
1993 evdw=evdw+evdwij+e_augm
1995 sigm=dabs(aa_aq(itypi,itypj)/&
1996 bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1997 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1998 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1999 restyp(itypi,1),i,restyp(itypj,1),j,&
2000 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
2001 chi1,chi2,chip1,chip2,&
2002 eps1,eps2rt**2,eps3rt**2,&
2003 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
2006 ! Calculate gradient components.
2007 e1=e1*eps1*eps2rt**2*eps3rt**2
2008 fac=-expon*(e1+evdwij)*rij_shift
2010 fac=rij*fac-2*expon*rrij*e_augm
2011 ! Calculate the radial part of the gradient
2015 ! Calculate angular part of the gradient.
2021 !-----------------------------------------------------------------------------
2022 !el subroutine sc_angular in module geometry
2023 !-----------------------------------------------------------------------------
2024 subroutine e_softsphere(evdw)
2026 ! This subroutine calculates the interaction energy of nonbonded side chains
2027 ! assuming the LJ potential of interaction.
2029 ! implicit real*8 (a-h,o-z)
2030 ! include 'DIMENSIONS'
2031 real(kind=8),parameter :: accur=1.0d-10
2032 ! include 'COMMON.GEO'
2033 ! include 'COMMON.VAR'
2034 ! include 'COMMON.LOCAL'
2035 ! include 'COMMON.CHAIN'
2036 ! include 'COMMON.DERIV'
2037 ! include 'COMMON.INTERACT'
2038 ! include 'COMMON.TORSION'
2039 ! include 'COMMON.SBRIDGE'
2040 ! include 'COMMON.NAMES'
2041 ! include 'COMMON.IOUNITS'
2042 ! include 'COMMON.CONTACTS'
2043 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
2044 !d print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2046 integer :: i,iint,j,itypi,itypi1,itypj,k
2047 real(kind=8) :: evdw,xj,yj,zj,xi,yi,zi,rij,r0ij,r0ijsq,evdwij
2051 do i=iatsc_s,iatsc_e
2052 itypi=iabs(itype(i,1))
2053 if (itypi.eq.ntyp1) cycle
2054 itypi1=iabs(itype(i+1,1))
2059 ! Calculate SC interaction energy.
2061 do iint=1,nint_gr(i)
2062 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2063 !d & 'iend=',iend(i,iint)
2064 do j=istart(i,iint),iend(i,iint)
2065 itypj=iabs(itype(j,1))
2066 if (itypj.eq.ntyp1) cycle
2070 rij=xj*xj+yj*yj+zj*zj
2071 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2072 r0ij=r0(itypi,itypj)
2074 ! print *,i,j,r0ij,dsqrt(rij)
2075 if (rij.lt.r0ijsq) then
2076 evdwij=0.25d0*(rij-r0ijsq)**2
2084 ! Calculate the components of the gradient in DC and X
2090 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2091 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2092 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2093 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2097 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2104 end subroutine e_softsphere
2105 !-----------------------------------------------------------------------------
2106 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2108 ! Soft-sphere potential of p-p interaction
2110 ! implicit real*8 (a-h,o-z)
2111 ! include 'DIMENSIONS'
2112 ! include 'COMMON.CONTROL'
2113 ! include 'COMMON.IOUNITS'
2114 ! include 'COMMON.GEO'
2115 ! include 'COMMON.VAR'
2116 ! include 'COMMON.LOCAL'
2117 ! include 'COMMON.CHAIN'
2118 ! include 'COMMON.DERIV'
2119 ! include 'COMMON.INTERACT'
2120 ! include 'COMMON.CONTACTS'
2121 ! include 'COMMON.TORSION'
2122 ! include 'COMMON.VECTORS'
2123 ! include 'COMMON.FFIELD'
2124 real(kind=8),dimension(3) :: ggg
2125 !d write(iout,*) 'In EELEC_soft_sphere'
2127 integer :: i,j,k,num_conti,iteli,itelj
2128 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
2129 real(kind=8) :: dxi,dyi,dzi,xmedi,ymedi,zmedi,r0ij,r0ijsq
2130 real(kind=8) :: dxj,dyj,dzj,xj,yj,zj,rij,evdw1ij,fac
2138 do i=iatel_s,iatel_e
2139 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
2143 xmedi=c(1,i)+0.5d0*dxi
2144 ymedi=c(2,i)+0.5d0*dyi
2145 zmedi=c(3,i)+0.5d0*dzi
2147 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2148 do j=ielstart(i),ielend(i)
2149 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
2153 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2154 r0ij=rpp(iteli,itelj)
2159 xj=c(1,j)+0.5D0*dxj-xmedi
2160 yj=c(2,j)+0.5D0*dyj-ymedi
2161 zj=c(3,j)+0.5D0*dzj-zmedi
2162 rij=xj*xj+yj*yj+zj*zj
2163 if (rij.lt.r0ijsq) then
2164 evdw1ij=0.25d0*(rij-r0ijsq)**2
2172 ! Calculate contributions to the Cartesian gradient.
2178 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2179 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2182 ! Loop over residues i+1 thru j-1.
2186 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2191 !grad do i=nnt,nct-1
2193 !grad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2195 !grad do j=i+1,nct-1
2197 !grad gelc(k,i)=gelc(k,i)+gelc(k,j)
2202 end subroutine eelec_soft_sphere
2203 !-----------------------------------------------------------------------------
2204 subroutine vec_and_deriv
2205 ! implicit real*8 (a-h,o-z)
2206 ! include 'DIMENSIONS'
2210 ! include 'COMMON.IOUNITS'
2211 ! include 'COMMON.GEO'
2212 ! include 'COMMON.VAR'
2213 ! include 'COMMON.LOCAL'
2214 ! include 'COMMON.CHAIN'
2215 ! include 'COMMON.VECTORS'
2216 ! include 'COMMON.SETUP'
2217 ! include 'COMMON.TIME1'
2218 real(kind=8),dimension(3,3,2) :: uyder,uzder
2219 real(kind=8),dimension(2) :: vbld_inv_temp
2220 ! Compute the local reference systems. For reference system (i), the
2221 ! X-axis points from CA(i) to CA(i+1), the Y axis is in the
2222 ! CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2225 real(kind=8) :: facy,fac,costh
2228 do i=ivec_start,ivec_end
2232 if (i.eq.nres-1) then
2233 ! Case of the last full residue
2234 ! Compute the Z-axis
2235 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2236 costh=dcos(pi-theta(nres))
2237 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2241 ! Compute the derivatives of uz
2243 uzder(2,1,1)=-dc_norm(3,i-1)
2244 uzder(3,1,1)= dc_norm(2,i-1)
2245 uzder(1,2,1)= dc_norm(3,i-1)
2247 uzder(3,2,1)=-dc_norm(1,i-1)
2248 uzder(1,3,1)=-dc_norm(2,i-1)
2249 uzder(2,3,1)= dc_norm(1,i-1)
2252 uzder(2,1,2)= dc_norm(3,i)
2253 uzder(3,1,2)=-dc_norm(2,i)
2254 uzder(1,2,2)=-dc_norm(3,i)
2256 uzder(3,2,2)= dc_norm(1,i)
2257 uzder(1,3,2)= dc_norm(2,i)
2258 uzder(2,3,2)=-dc_norm(1,i)
2260 ! Compute the Y-axis
2263 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2265 ! Compute the derivatives of uy
2268 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) &
2269 -dc_norm(k,i)*dc_norm(j,i-1)
2270 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2272 uyder(j,j,1)=uyder(j,j,1)-costh
2273 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2278 uygrad(l,k,j,i)=uyder(l,k,j)
2279 uzgrad(l,k,j,i)=uzder(l,k,j)
2283 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2284 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2285 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2286 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2289 ! Compute the Z-axis
2290 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2291 costh=dcos(pi-theta(i+2))
2292 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2296 ! Compute the derivatives of uz
2298 uzder(2,1,1)=-dc_norm(3,i+1)
2299 uzder(3,1,1)= dc_norm(2,i+1)
2300 uzder(1,2,1)= dc_norm(3,i+1)
2302 uzder(3,2,1)=-dc_norm(1,i+1)
2303 uzder(1,3,1)=-dc_norm(2,i+1)
2304 uzder(2,3,1)= dc_norm(1,i+1)
2307 uzder(2,1,2)= dc_norm(3,i)
2308 uzder(3,1,2)=-dc_norm(2,i)
2309 uzder(1,2,2)=-dc_norm(3,i)
2311 uzder(3,2,2)= dc_norm(1,i)
2312 uzder(1,3,2)= dc_norm(2,i)
2313 uzder(2,3,2)=-dc_norm(1,i)
2315 ! Compute the Y-axis
2318 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2320 ! Compute the derivatives of uy
2323 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) &
2324 -dc_norm(k,i)*dc_norm(j,i+1)
2325 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2327 uyder(j,j,1)=uyder(j,j,1)-costh
2328 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2333 uygrad(l,k,j,i)=uyder(l,k,j)
2334 uzgrad(l,k,j,i)=uzder(l,k,j)
2338 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2339 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2340 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2341 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2345 vbld_inv_temp(1)=vbld_inv(i+1)
2346 if (i.lt.nres-1) then
2347 vbld_inv_temp(2)=vbld_inv(i+2)
2349 vbld_inv_temp(2)=vbld_inv(i)
2354 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2355 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2360 #if defined(PARVEC) && defined(MPI)
2361 if (nfgtasks1.gt.1) then
2363 ! print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2364 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2365 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2366 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),&
2367 MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2369 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),&
2370 MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2372 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),&
2373 ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),&
2374 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2375 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),&
2376 ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),&
2377 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2378 time_gather=time_gather+MPI_Wtime()-time00
2380 ! if (fg_rank.eq.0) then
2381 ! write (iout,*) "Arrays UY and UZ"
2383 ! write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2389 end subroutine vec_and_deriv
2390 !-----------------------------------------------------------------------------
2391 subroutine check_vecgrad
2392 ! implicit real*8 (a-h,o-z)
2393 ! include 'DIMENSIONS'
2394 ! include 'COMMON.IOUNITS'
2395 ! include 'COMMON.GEO'
2396 ! include 'COMMON.VAR'
2397 ! include 'COMMON.LOCAL'
2398 ! include 'COMMON.CHAIN'
2399 ! include 'COMMON.VECTORS'
2400 real(kind=8),dimension(3,3,2,nres) :: uygradt,uzgradt !(3,3,2,maxres)
2401 real(kind=8),dimension(3,nres) :: uyt,uzt !(3,maxres)
2402 real(kind=8),dimension(3,3,2) :: uygradn,uzgradn
2403 real(kind=8),dimension(3) :: erij
2404 real(kind=8) :: delta=1.0d-7
2410 !rc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2411 !rc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2412 !rc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2413 !d write(iout,'(2i5,2(3f10.5,5x))') i,1,
2414 !d & (dc_norm(if90,i),if90=1,3)
2415 !d write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2416 !d write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2417 !d write(iout,'(a)')
2423 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2424 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2437 !d write (iout,*) 'i=',i
2439 erij(k)=dc_norm(k,i)
2443 dc_norm(k,i)=erij(k)
2445 dc_norm(j,i)=dc_norm(j,i)+delta
2446 ! fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2448 ! dc_norm(k,i)=dc_norm(k,i)/fac
2450 ! write (iout,*) (dc_norm(k,i),k=1,3)
2451 ! write (iout,*) (erij(k),k=1,3)
2454 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2455 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2456 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2457 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2459 ! write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2460 ! & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2461 ! & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2464 dc_norm(k,i)=erij(k)
2467 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2468 !d & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2469 !d & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2470 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2471 !d & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2472 !d & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2473 !d write (iout,'(a)')
2477 end subroutine check_vecgrad
2478 !-----------------------------------------------------------------------------
2479 subroutine set_matrices
2480 ! implicit real*8 (a-h,o-z)
2481 ! include 'DIMENSIONS'
2484 ! include "COMMON.SETUP"
2486 integer :: status(MPI_STATUS_SIZE)
2488 ! include 'COMMON.IOUNITS'
2489 ! include 'COMMON.GEO'
2490 ! include 'COMMON.VAR'
2491 ! include 'COMMON.LOCAL'
2492 ! include 'COMMON.CHAIN'
2493 ! include 'COMMON.DERIV'
2494 ! include 'COMMON.INTERACT'
2495 ! include 'COMMON.CONTACTS'
2496 ! include 'COMMON.TORSION'
2497 ! include 'COMMON.VECTORS'
2498 ! include 'COMMON.FFIELD'
2499 real(kind=8) :: auxvec(2),auxmat(2,2)
2500 integer :: i,iti1,iti,k,l
2501 real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2
2502 ! print *,"in set matrices"
2504 ! Compute the virtual-bond-torsional-angle dependent quantities needed
2505 ! to calculate the el-loc multibody terms of various order.
2509 do i=ivec_start+2,ivec_end+2
2514 if (i .lt. nres+1) then
2551 if (i .gt. 3 .and. i .lt. nres+1) then
2552 obrot_der(1,i-2)=-sin1
2553 obrot_der(2,i-2)= cos1
2554 Ugder(1,1,i-2)= sin1
2555 Ugder(1,2,i-2)=-cos1
2556 Ugder(2,1,i-2)=-cos1
2557 Ugder(2,2,i-2)=-sin1
2560 obrot2_der(1,i-2)=-dwasin2
2561 obrot2_der(2,i-2)= dwacos2
2562 Ug2der(1,1,i-2)= dwasin2
2563 Ug2der(1,2,i-2)=-dwacos2
2564 Ug2der(2,1,i-2)=-dwacos2
2565 Ug2der(2,2,i-2)=-dwasin2
2567 obrot_der(1,i-2)=0.0d0
2568 obrot_der(2,i-2)=0.0d0
2569 Ugder(1,1,i-2)=0.0d0
2570 Ugder(1,2,i-2)=0.0d0
2571 Ugder(2,1,i-2)=0.0d0
2572 Ugder(2,2,i-2)=0.0d0
2573 obrot2_der(1,i-2)=0.0d0
2574 obrot2_der(2,i-2)=0.0d0
2575 Ug2der(1,1,i-2)=0.0d0
2576 Ug2der(1,2,i-2)=0.0d0
2577 Ug2der(2,1,i-2)=0.0d0
2578 Ug2der(2,2,i-2)=0.0d0
2580 ! if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2581 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2582 if (itype(i-2,1).eq.0) then
2585 iti = itortyp(itype(i-2,1))
2590 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2591 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2592 if (itype(i-1,1).eq.0) then
2595 iti1 = itortyp(itype(i-1,1))
2600 ! print *,iti,i,"iti",iti1,itype(i-1,1),itype(i-2,1)
2601 !d write (iout,*) '*******i',i,' iti1',iti
2602 !d write (iout,*) 'b1',b1(:,iti)
2603 !d write (iout,*) 'b2',b2(:,iti)
2604 !d write (iout,*) 'Ug',Ug(:,:,i-2)
2605 ! if (i .gt. iatel_s+2) then
2606 if (i .gt. nnt+2) then
2607 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2608 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2609 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2611 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2612 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2613 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2614 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2615 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2626 DtUg2(l,k,i-2)=0.0d0
2630 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2631 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2633 muder(k,i-2)=Ub2der(k,i-2)
2635 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2636 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2637 if (itype(i-1,1).eq.0) then
2639 elseif (itype(i-1,1).le.ntyp) then
2640 iti1 = itortyp(itype(i-1,1))
2648 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2650 ! if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2)
2651 ! if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,iti1)
2652 ! if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2)
2653 !d write (iout,*) 'mu1',mu1(:,i-2)
2654 !d write (iout,*) 'mu2',mu2(:,i-2)
2655 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2657 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2658 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2659 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2660 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2661 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2662 ! Vectors and matrices dependent on a single virtual-bond dihedral.
2663 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2664 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2665 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2666 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2667 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2668 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2669 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2670 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2671 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2674 ! Matrices dependent on two consecutive virtual-bond dihedrals.
2675 ! The order of matrices is from left to right.
2676 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2678 ! do i=max0(ivec_start,2),ivec_end
2680 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2681 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2682 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2683 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2684 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2685 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2686 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2687 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2690 #if defined(MPI) && defined(PARMAT)
2692 ! if (fg_rank.eq.0) then
2693 write (iout,*) "Arrays UG and UGDER before GATHER"
2695 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2696 ((ug(l,k,i),l=1,2),k=1,2),&
2697 ((ugder(l,k,i),l=1,2),k=1,2)
2699 write (iout,*) "Arrays UG2 and UG2DER"
2701 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2702 ((ug2(l,k,i),l=1,2),k=1,2),&
2703 ((ug2der(l,k,i),l=1,2),k=1,2)
2705 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2707 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2708 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2709 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2711 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2713 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2714 costab(i),sintab(i),costab2(i),sintab2(i)
2716 write (iout,*) "Array MUDER"
2718 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2722 if (nfgtasks.gt.1) then
2724 ! write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2725 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2726 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2728 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),&
2729 MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2731 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),&
2732 MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2734 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),&
2735 MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2737 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),&
2738 MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2740 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),&
2741 MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2743 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),&
2744 MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2746 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),&
2747 MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),&
2748 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2749 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),&
2750 MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),&
2751 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2752 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),&
2753 MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),&
2754 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2755 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),&
2756 MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),&
2757 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2758 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2760 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),&
2761 MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2763 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),&
2764 MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2766 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),&
2767 MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2769 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),&
2770 MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2772 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),&
2773 MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2775 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),&
2776 ivec_count(fg_rank1),&
2777 MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2779 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),&
2780 MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2782 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),&
2783 MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2785 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),&
2786 MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2788 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),&
2789 MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2791 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),&
2792 MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2794 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),&
2795 MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2797 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),&
2798 MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2800 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),&
2801 ivec_count(fg_rank1),&
2802 MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2804 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),&
2805 MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2807 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),&
2808 MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2810 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),&
2811 MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2813 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),&
2814 MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2816 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),&
2817 ivec_count(fg_rank1),&
2818 MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2820 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),&
2821 ivec_count(fg_rank1),&
2822 MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2824 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),&
2825 ivec_count(fg_rank1),&
2826 MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2827 MPI_MAT2,FG_COMM1,IERR)
2828 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),&
2829 ivec_count(fg_rank1),&
2830 MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2831 MPI_MAT2,FG_COMM1,IERR)
2834 ! Passes matrix info through the ring
2837 if (irecv.lt.0) irecv=nfgtasks1-1
2840 if (inext.ge.nfgtasks1) inext=0
2842 ! write (iout,*) "isend",isend," irecv",irecv
2844 lensend=lentyp(isend)
2845 lenrecv=lentyp(irecv)
2846 ! write (iout,*) "lensend",lensend," lenrecv",lenrecv
2847 ! call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2848 ! & MPI_ROTAT1(lensend),inext,2200+isend,
2849 ! & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2850 ! & iprev,2200+irecv,FG_COMM,status,IERR)
2851 ! write (iout,*) "Gather ROTAT1"
2853 ! call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2854 ! & MPI_ROTAT2(lensend),inext,3300+isend,
2855 ! & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2856 ! & iprev,3300+irecv,FG_COMM,status,IERR)
2857 ! write (iout,*) "Gather ROTAT2"
2859 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,&
2860 MPI_ROTAT_OLD(lensend),inext,4400+isend,&
2861 costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),&
2862 iprev,4400+irecv,FG_COMM,status,IERR)
2863 ! write (iout,*) "Gather ROTAT_OLD"
2865 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,&
2866 MPI_PRECOMP11(lensend),inext,5500+isend,&
2867 mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),&
2868 iprev,5500+irecv,FG_COMM,status,IERR)
2869 ! write (iout,*) "Gather PRECOMP11"
2871 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,&
2872 MPI_PRECOMP12(lensend),inext,6600+isend,&
2873 Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),&
2874 iprev,6600+irecv,FG_COMM,status,IERR)
2875 ! write (iout,*) "Gather PRECOMP12"
2877 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2879 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,&
2880 MPI_ROTAT2(lensend),inext,7700+isend,&
2881 ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),&
2882 iprev,7700+irecv,FG_COMM,status,IERR)
2883 ! write (iout,*) "Gather PRECOMP21"
2885 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,&
2886 MPI_PRECOMP22(lensend),inext,8800+isend,&
2887 EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),&
2888 iprev,8800+irecv,FG_COMM,status,IERR)
2889 ! write (iout,*) "Gather PRECOMP22"
2891 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,&
2892 MPI_PRECOMP23(lensend),inext,9900+isend,&
2893 Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,&
2894 MPI_PRECOMP23(lenrecv),&
2895 iprev,9900+irecv,FG_COMM,status,IERR)
2896 ! write (iout,*) "Gather PRECOMP23"
2901 if (irecv.lt.0) irecv=nfgtasks1-1
2904 time_gather=time_gather+MPI_Wtime()-time00
2907 ! if (fg_rank.eq.0) then
2908 write (iout,*) "Arrays UG and UGDER"
2910 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2911 ((ug(l,k,i),l=1,2),k=1,2),&
2912 ((ugder(l,k,i),l=1,2),k=1,2)
2914 write (iout,*) "Arrays UG2 and UG2DER"
2916 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2917 ((ug2(l,k,i),l=1,2),k=1,2),&
2918 ((ug2der(l,k,i),l=1,2),k=1,2)
2920 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2922 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2923 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2924 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2926 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2928 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2929 costab(i),sintab(i),costab2(i),sintab2(i)
2931 write (iout,*) "Array MUDER"
2933 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2939 !d iti = itortyp(itype(i,1))
2942 !d write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2943 !d & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2947 end subroutine set_matrices
2948 !-----------------------------------------------------------------------------
2949 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2951 ! This subroutine calculates the average interaction energy and its gradient
2952 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
2953 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2954 ! The potential depends both on the distance of peptide-group centers and on
2955 ! the orientation of the CA-CA virtual bonds.
2958 ! implicit real*8 (a-h,o-z)
2962 ! include 'DIMENSIONS'
2963 ! include 'COMMON.CONTROL'
2964 ! include 'COMMON.SETUP'
2965 ! include 'COMMON.IOUNITS'
2966 ! include 'COMMON.GEO'
2967 ! include 'COMMON.VAR'
2968 ! include 'COMMON.LOCAL'
2969 ! include 'COMMON.CHAIN'
2970 ! include 'COMMON.DERIV'
2971 ! include 'COMMON.INTERACT'
2972 ! include 'COMMON.CONTACTS'
2973 ! include 'COMMON.TORSION'
2974 ! include 'COMMON.VECTORS'
2975 ! include 'COMMON.FFIELD'
2976 ! include 'COMMON.TIME1'
2977 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
2978 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
2979 real(kind=8),dimension(2,2) :: acipa !el,a_temp
2980 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
2981 real(kind=8),dimension(4) :: muij
2982 !el integer :: num_conti,j1,j2
2983 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
2984 !el dz_normi,xmedi,ymedi,zmedi
2986 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
2987 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
2990 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2992 real(kind=8) :: scal_el=1.0d0
2994 real(kind=8) :: scal_el=0.5d0
2997 ! 13-go grudnia roku pamietnego...
2998 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
3000 0.0d0,0.0d0,1.0d0/),shape(unmat))
3003 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
3004 real(kind=8) :: fac,t_eelecij,fracinbuf
3007 !d write(iout,*) 'In EELEC'
3008 ! print *,"IN EELEC"
3010 !d write(iout,*) 'Type',i
3011 !d write(iout,*) 'B1',B1(:,i)
3012 !d write(iout,*) 'B2',B2(:,i)
3013 !d write(iout,*) 'CC',CC(:,:,i)
3014 !d write(iout,*) 'DD',DD(:,:,i)
3015 !d write(iout,*) 'EE',EE(:,:,i)
3017 !d call check_vecgrad
3032 if (icheckgrad.eq.1) then
3035 ! dc_norm(1,i)=0.0d0
3036 ! dc_norm(2,i)=0.0d0
3037 ! dc_norm(3,i)=0.0d0
3040 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3042 dc_norm(k,i)=dc(k,i)*fac
3044 ! write (iout,*) 'i',i,' fac',fac
3047 ! print *,wel_loc,"wel_loc",wcorr4,wcorr5,wcorr6,wturn3,wturn4, &
3049 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3050 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
3051 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3052 ! call vec_and_deriv
3056 ! print *, "before set matrices"
3058 ! print *, "after set matrices"
3061 time_mat=time_mat+MPI_Wtime()-time01
3064 ! print *, "after set matrices"
3066 !d write (iout,*) 'i=',i
3068 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3071 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3072 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3085 !d print '(a)','Enter EELEC'
3086 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3087 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
3088 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
3090 gel_loc_loc(i)=0.0d0
3095 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3097 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
3101 ! print *,"before iturn3 loop"
3102 do i=iturn3_start,iturn3_end
3103 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
3104 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
3108 dx_normi=dc_norm(1,i)
3109 dy_normi=dc_norm(2,i)
3110 dz_normi=dc_norm(3,i)
3111 xmedi=c(1,i)+0.5d0*dxi
3112 ymedi=c(2,i)+0.5d0*dyi
3113 zmedi=c(3,i)+0.5d0*dzi
3114 xmedi=dmod(xmedi,boxxsize)
3115 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3116 ymedi=dmod(ymedi,boxysize)
3117 if (ymedi.lt.0) ymedi=ymedi+boxysize
3118 zmedi=dmod(zmedi,boxzsize)
3119 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3121 if ((zmedi.gt.bordlipbot) &
3122 .and.(zmedi.lt.bordliptop)) then
3123 !C the energy transfer exist
3124 if (zmedi.lt.buflipbot) then
3125 !C what fraction I am in
3127 ((zmedi-bordlipbot)/lipbufthick)
3128 !C lipbufthick is thickenes of lipid buffore
3129 sslipi=sscalelip(fracinbuf)
3130 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3131 elseif (zmedi.gt.bufliptop) then
3132 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3133 sslipi=sscalelip(fracinbuf)
3134 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3143 ! print *,i,sslipi,ssgradlipi
3144 call eelecij(i,i+2,ees,evdw1,eel_loc)
3145 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3146 num_cont_hb(i)=num_conti
3148 do i=iturn4_start,iturn4_end
3149 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
3150 .or. itype(i+3,1).eq.ntyp1 &
3151 .or. itype(i+4,1).eq.ntyp1) cycle
3155 dx_normi=dc_norm(1,i)
3156 dy_normi=dc_norm(2,i)
3157 dz_normi=dc_norm(3,i)
3158 xmedi=c(1,i)+0.5d0*dxi
3159 ymedi=c(2,i)+0.5d0*dyi
3160 zmedi=c(3,i)+0.5d0*dzi
3161 xmedi=dmod(xmedi,boxxsize)
3162 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3163 ymedi=dmod(ymedi,boxysize)
3164 if (ymedi.lt.0) ymedi=ymedi+boxysize
3165 zmedi=dmod(zmedi,boxzsize)
3166 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3167 if ((zmedi.gt.bordlipbot) &
3168 .and.(zmedi.lt.bordliptop)) then
3169 !C the energy transfer exist
3170 if (zmedi.lt.buflipbot) then
3171 !C what fraction I am in
3173 ((zmedi-bordlipbot)/lipbufthick)
3174 !C lipbufthick is thickenes of lipid buffore
3175 sslipi=sscalelip(fracinbuf)
3176 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3177 elseif (zmedi.gt.bufliptop) then
3178 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3179 sslipi=sscalelip(fracinbuf)
3180 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3190 num_conti=num_cont_hb(i)
3191 call eelecij(i,i+3,ees,evdw1,eel_loc)
3192 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
3193 call eturn4(i,eello_turn4)
3194 num_cont_hb(i)=num_conti
3197 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3199 ! print *,"iatel_s,iatel_e,",iatel_s,iatel_e
3200 do i=iatel_s,iatel_e
3201 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
3205 dx_normi=dc_norm(1,i)
3206 dy_normi=dc_norm(2,i)
3207 dz_normi=dc_norm(3,i)
3208 xmedi=c(1,i)+0.5d0*dxi
3209 ymedi=c(2,i)+0.5d0*dyi
3210 zmedi=c(3,i)+0.5d0*dzi
3211 xmedi=dmod(xmedi,boxxsize)
3212 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3213 ymedi=dmod(ymedi,boxysize)
3214 if (ymedi.lt.0) ymedi=ymedi+boxysize
3215 zmedi=dmod(zmedi,boxzsize)
3216 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3217 if ((zmedi.gt.bordlipbot) &
3218 .and.(zmedi.lt.bordliptop)) then
3219 !C the energy transfer exist
3220 if (zmedi.lt.buflipbot) then
3221 !C what fraction I am in
3223 ((zmedi-bordlipbot)/lipbufthick)
3224 !C lipbufthick is thickenes of lipid buffore
3225 sslipi=sscalelip(fracinbuf)
3226 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3227 elseif (zmedi.gt.bufliptop) then
3228 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3229 sslipi=sscalelip(fracinbuf)
3230 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3240 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3241 num_conti=num_cont_hb(i)
3242 do j=ielstart(i),ielend(i)
3243 ! write (iout,*) i,j,itype(i,1),itype(j,1)
3244 if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
3245 call eelecij(i,j,ees,evdw1,eel_loc)
3247 num_cont_hb(i)=num_conti
3249 ! write (iout,*) "Number of loop steps in EELEC:",ind
3251 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
3252 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3254 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3255 !cc eel_loc=eel_loc+eello_turn3
3256 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
3258 end subroutine eelec
3259 !-----------------------------------------------------------------------------
3260 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3263 ! implicit real*8 (a-h,o-z)
3264 ! include 'DIMENSIONS'
3268 ! include 'COMMON.CONTROL'
3269 ! include 'COMMON.IOUNITS'
3270 ! include 'COMMON.GEO'
3271 ! include 'COMMON.VAR'
3272 ! include 'COMMON.LOCAL'
3273 ! include 'COMMON.CHAIN'
3274 ! include 'COMMON.DERIV'
3275 ! include 'COMMON.INTERACT'
3276 ! include 'COMMON.CONTACTS'
3277 ! include 'COMMON.TORSION'
3278 ! include 'COMMON.VECTORS'
3279 ! include 'COMMON.FFIELD'
3280 ! include 'COMMON.TIME1'
3281 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
3282 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
3283 real(kind=8),dimension(2,2) :: acipa !el,a_temp
3284 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3285 real(kind=8),dimension(4) :: muij
3286 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
3287 dist_temp, dist_init,rlocshield,fracinbuf
3288 integer xshift,yshift,zshift,ilist,iresshield
3289 !el integer :: num_conti,j1,j2
3290 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3291 !el dz_normi,xmedi,ymedi,zmedi
3293 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3294 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3297 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3299 real(kind=8) :: scal_el=1.0d0
3301 real(kind=8) :: scal_el=0.5d0
3304 ! 13-go grudnia roku pamietnego...
3305 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
3307 0.0d0,0.0d0,1.0d0/),shape(unmat))
3308 ! integer :: maxconts=nres/4
3310 integer :: k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap
3311 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
3312 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
3313 real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
3314 rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
3315 evdwij,el1,el2,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
3316 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
3317 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
3318 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
3319 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
3320 ecosgp,ecosam,ecosbm,ecosgm,ghalf
3322 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
3323 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
3325 ! time00=MPI_Wtime()
3326 !d write (iout,*) "eelecij",i,j
3330 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3331 aaa=app(iteli,itelj)
3332 bbb=bpp(iteli,itelj)
3333 ael6i=ael6(iteli,itelj)
3334 ael3i=ael3(iteli,itelj)
3338 dx_normj=dc_norm(1,j)
3339 dy_normj=dc_norm(2,j)
3340 dz_normj=dc_norm(3,j)
3341 ! xj=c(1,j)+0.5D0*dxj-xmedi
3342 ! yj=c(2,j)+0.5D0*dyj-ymedi
3343 ! zj=c(3,j)+0.5D0*dzj-zmedi
3348 if (xj.lt.0) xj=xj+boxxsize
3350 if (yj.lt.0) yj=yj+boxysize
3352 if (zj.lt.0) zj=zj+boxzsize
3353 if ((zj.gt.bordlipbot) &
3354 .and.(zj.lt.bordliptop)) then
3355 !C the energy transfer exist
3356 if (zj.lt.buflipbot) then
3357 !C what fraction I am in
3359 ((zj-bordlipbot)/lipbufthick)
3360 !C lipbufthick is thickenes of lipid buffore
3361 sslipj=sscalelip(fracinbuf)
3362 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
3363 elseif (zj.gt.bufliptop) then
3364 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
3365 sslipj=sscalelip(fracinbuf)
3366 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
3377 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3384 xj=xj_safe+xshift*boxxsize
3385 yj=yj_safe+yshift*boxysize
3386 zj=zj_safe+zshift*boxzsize
3387 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3388 if(dist_temp.lt.dist_init) then
3398 if (isubchap.eq.1) then
3409 rij=xj*xj+yj*yj+zj*zj
3412 !C print *,xmedi,ymedi,zmedi,xj,yj,zj,boxxsize,rij
3413 sss_ele_cut=sscale_ele(rij)
3414 sss_ele_grad=sscagrad_ele(rij)
3416 ! sss_ele_grad=0.0d0
3417 ! print *,sss_ele_cut,sss_ele_grad,&
3418 ! (rij),r_cut_ele,rlamb_ele
3419 ! if (sss_ele_cut.le.0.0) go to 128
3424 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3425 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3426 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3427 fac=cosa-3.0D0*cosb*cosg
3429 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3430 if (j.eq.i+2) ev1=scal_el*ev1
3435 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3438 if (shield_mode.gt.0) then
3439 !C fac_shield(i)=0.4
3440 !C fac_shield(j)=0.6
3441 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3442 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3444 ees=ees+eesij*sss_ele_cut
3445 !C FOR NOW SHIELD IS NOT USED WITH LIPSCALE
3446 !C & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3452 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)*sss_ele_cut
3453 !C print *,"TUCC",(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
3456 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
3457 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3458 ! ees=ees+eesij*sss_ele_cut
3459 evdw1=evdw1+evdwij*sss_ele_cut &
3460 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3461 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3462 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3463 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3464 !d & xmedi,ymedi,zmedi,xj,yj,zj
3466 if (energy_dec) then
3467 ! write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') &
3468 ! 'evdw1',i,j,evdwij,&
3469 ! iteli,itelj,aaa,evdw1
3470 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3471 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3474 ! Calculate contributions to the Cartesian gradient.
3477 facvdw=-6*rrmij*(ev1+evdwij)*sss_ele_cut &
3478 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3479 facel=-3*rrmij*(el1+eesij)*sss_ele_cut &
3480 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3486 ! Radial derivatives. First process both termini of the fragment (i,j)
3488 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj* &
3489 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3490 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj* &
3491 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3492 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj* &
3493 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3495 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3496 (shield_mode.gt.0)) then
3498 do ilist=1,ishield_list(i)
3499 iresshield=shield_list(ilist,i)
3501 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)&
3503 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3505 +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0 &
3507 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3510 do ilist=1,ishield_list(j)
3511 iresshield=shield_list(ilist,j)
3513 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j) &
3515 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3517 +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0 &
3519 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3523 gshieldc(k,i)=gshieldc(k,i)+ &
3524 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3527 gshieldc(k,j)=gshieldc(k,j)+ &
3528 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3531 gshieldc(k,i-1)=gshieldc(k,i-1)+ &
3532 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3535 gshieldc(k,j-1)=gshieldc(k,j-1)+ &
3536 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3544 ! ghalf=0.5D0*ggg(k)
3545 ! gelc(k,i)=gelc(k,i)+ghalf
3546 ! gelc(k,j)=gelc(k,j)+ghalf
3548 ! 9/28/08 AL Gradient compotents will be summed only at the end
3550 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3551 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3553 gelc_long(3,j)=gelc_long(3,j)+ &
3554 ssgradlipj*eesij/2.0d0*lipscale**2&
3557 gelc_long(3,i)=gelc_long(3,i)+ &
3558 ssgradlipi*eesij/2.0d0*lipscale**2&
3563 ! Loop over residues i+1 thru j-1.
3567 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3570 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj &
3571 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3572 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj &
3573 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3574 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj &
3575 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3578 ! ghalf=0.5D0*ggg(k)
3579 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3580 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3582 ! 9/28/08 AL Gradient compotents will be summed only at the end
3584 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3585 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3588 !C Lipidic part for scaling weight
3589 gvdwpp(3,j)=gvdwpp(3,j)+ &
3590 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3591 gvdwpp(3,i)=gvdwpp(3,i)+ &
3592 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3593 !! Loop over residues i+1 thru j-1.
3597 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3601 facvdw=(ev1+evdwij)*sss_ele_cut &
3602 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3604 facel=(el1+eesij)*sss_ele_cut
3606 fac=-3*rrmij*(facvdw+facvdw+facel)
3611 ! Radial derivatives. First process both termini of the fragment (i,j)
3613 ggg(1)=fac*xj+sss_ele_grad*rmij*(eesij+evdwij)*xj
3614 ggg(2)=fac*yj+sss_ele_grad*rmij*(eesij+evdwij)*yj
3615 ggg(3)=fac*zj+sss_ele_grad*rmij*(eesij+evdwij)*zj
3617 ! ghalf=0.5D0*ggg(k)
3618 ! gelc(k,i)=gelc(k,i)+ghalf
3619 ! gelc(k,j)=gelc(k,j)+ghalf
3621 ! 9/28/08 AL Gradient compotents will be summed only at the end
3623 gelc_long(k,j)=gelc(k,j)+ggg(k)
3624 gelc_long(k,i)=gelc(k,i)-ggg(k)
3627 ! Loop over residues i+1 thru j-1.
3631 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3634 ! 9/28/08 AL Gradient compotents will be summed only at the end
3636 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3638 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3640 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3643 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3644 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3646 gvdwpp(3,j)=gvdwpp(3,j)+ &
3647 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3648 gvdwpp(3,i)=gvdwpp(3,i)+ &
3649 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3655 ecosa=2.0D0*fac3*fac1+fac4
3658 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3659 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3661 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3662 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3664 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3665 !d & (dcosg(k),k=1,3)
3667 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*sss_ele_cut &
3668 *fac_shield(i)**2*fac_shield(j)**2 &
3669 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3673 ! ghalf=0.5D0*ggg(k)
3674 ! gelc(k,i)=gelc(k,i)+ghalf
3675 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3676 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3677 ! gelc(k,j)=gelc(k,j)+ghalf
3678 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3679 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3683 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3687 gelc(k,i)=gelc(k,i) &
3688 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3689 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
3691 *fac_shield(i)**2*fac_shield(j)**2 &
3692 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3694 gelc(k,j)=gelc(k,j) &
3695 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3696 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
3698 *fac_shield(i)**2*fac_shield(j)**2 &
3699 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3701 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3702 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3705 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3706 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
3707 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3709 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3710 ! energy of a peptide unit is assumed in the form of a second-order
3711 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3712 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3713 ! are computed for EVERY pair of non-contiguous peptide groups.
3715 if (j.lt.nres-1) then
3726 muij(kkk)=mu(k,i)*mu(l,j)
3729 !d write (iout,*) 'EELEC: i',i,' j',j
3730 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
3731 !d write(iout,*) 'muij',muij
3732 ury=scalar(uy(1,i),erij)
3733 urz=scalar(uz(1,i),erij)
3734 vry=scalar(uy(1,j),erij)
3735 vrz=scalar(uz(1,j),erij)
3736 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3737 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3738 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3739 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3740 fac=dsqrt(-ael6i)*r3ij
3745 !d write (iout,'(4i5,4f10.5)')
3746 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
3747 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3748 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3749 !d & uy(:,j),uz(:,j)
3750 !d write (iout,'(4f10.5)')
3751 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3752 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3753 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
3754 !d write (iout,'(9f10.5/)')
3755 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3756 ! Derivatives of the elements of A in virtual-bond vectors
3757 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3759 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3760 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3761 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3762 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3763 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3764 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3765 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3766 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3767 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3768 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3769 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3770 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3772 ! Compute radial contributions to the gradient
3790 ! Add the contributions coming from er
3793 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3794 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3795 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3796 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3799 ! Derivatives in DC(i)
3800 !grad ghalf1=0.5d0*agg(k,1)
3801 !grad ghalf2=0.5d0*agg(k,2)
3802 !grad ghalf3=0.5d0*agg(k,3)
3803 !grad ghalf4=0.5d0*agg(k,4)
3804 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
3805 -3.0d0*uryg(k,2)*vry)!+ghalf1
3806 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
3807 -3.0d0*uryg(k,2)*vrz)!+ghalf2
3808 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
3809 -3.0d0*urzg(k,2)*vry)!+ghalf3
3810 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
3811 -3.0d0*urzg(k,2)*vrz)!+ghalf4
3812 ! Derivatives in DC(i+1)
3813 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
3814 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3815 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
3816 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3817 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
3818 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3819 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
3820 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3821 ! Derivatives in DC(j)
3822 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
3823 -3.0d0*vryg(k,2)*ury)!+ghalf1
3824 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
3825 -3.0d0*vrzg(k,2)*ury)!+ghalf2
3826 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
3827 -3.0d0*vryg(k,2)*urz)!+ghalf3
3828 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
3829 -3.0d0*vrzg(k,2)*urz)!+ghalf4
3830 ! Derivatives in DC(j+1) or DC(nres-1)
3831 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
3832 -3.0d0*vryg(k,3)*ury)
3833 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
3834 -3.0d0*vrzg(k,3)*ury)
3835 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
3836 -3.0d0*vryg(k,3)*urz)
3837 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
3838 -3.0d0*vrzg(k,3)*urz)
3839 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
3841 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3854 aggi(k,l)=-aggi(k,l)
3855 aggi1(k,l)=-aggi1(k,l)
3856 aggj(k,l)=-aggj(k,l)
3857 aggj1(k,l)=-aggj1(k,l)
3860 if (j.lt.nres-1) then
3866 aggi(k,l)=-aggi(k,l)
3867 aggi1(k,l)=-aggi1(k,l)
3868 aggj(k,l)=-aggj(k,l)
3869 aggj1(k,l)=-aggj1(k,l)
3880 aggi(k,l)=-aggi(k,l)
3881 aggi1(k,l)=-aggi1(k,l)
3882 aggj(k,l)=-aggj(k,l)
3883 aggj1(k,l)=-aggj1(k,l)
3888 IF (wel_loc.gt.0.0d0) THEN
3889 ! Contribution to the local-electrostatic energy coming from the i-j pair
3890 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
3892 if (shield_mode.eq.0) then
3896 eel_loc_ij=eel_loc_ij &
3897 *fac_shield(i)*fac_shield(j) &
3898 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3899 !C Now derivative over eel_loc
3900 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3901 (shield_mode.gt.0)) then
3904 do ilist=1,ishield_list(i)
3905 iresshield=shield_list(ilist,i)
3907 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij &
3910 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
3912 +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i) &
3915 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
3919 do ilist=1,ishield_list(j)
3920 iresshield=shield_list(ilist,j)
3922 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij &
3925 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
3927 +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j) &
3930 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
3937 gshieldc_ll(k,i)=gshieldc_ll(k,i)+ &
3938 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
3940 gshieldc_ll(k,j)=gshieldc_ll(k,j)+ &
3941 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
3943 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+ &
3944 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
3946 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+ &
3947 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
3954 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3956 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3957 'eelloc',i,j,eel_loc_ij
3958 ! if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33
3959 ! if (energy_dec) write (iout,*) "muij",muij
3960 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3962 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
3963 ! Partial derivatives in virtual-bond dihedral angles gamma
3965 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
3966 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
3967 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
3969 *fac_shield(i)*fac_shield(j) &
3970 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3972 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
3973 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
3974 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
3976 *fac_shield(i)*fac_shield(j) &
3977 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3978 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3980 ! ggg(1)=(agg(1,1)*muij(1)+ &
3981 ! agg(1,2)*muij(2)+agg(1,3)*muij(3)+agg(1,4)*muij(4)) &
3983 ! +eel_loc_ij*sss_ele_grad*rmij*xj
3984 ! ggg(2)=(agg(2,1)*muij(1)+ &
3985 ! agg(2,2)*muij(2)+agg(2,3)*muij(3)+agg(2,4)*muij(4)) &
3987 ! +eel_loc_ij*sss_ele_grad*rmij*yj
3988 ! ggg(3)=(agg(3,1)*muij(1)+ &
3989 ! agg(3,2)*muij(2)+agg(3,3)*muij(3)+agg(3,4)*muij(4)) &
3991 ! +eel_loc_ij*sss_ele_grad*rmij*zj
3997 ggg(l)=(agg(l,1)*muij(1)+ &
3998 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
4000 *fac_shield(i)*fac_shield(j) &
4001 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) &
4002 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4005 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4006 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4007 !grad ghalf=0.5d0*ggg(l)
4008 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
4009 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
4011 gel_loc_long(3,j)=gel_loc_long(3,j)+ &
4012 ssgradlipj*eel_loc_ij/2.0d0*lipscale/ &
4013 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
4015 gel_loc_long(3,i)=gel_loc_long(3,i)+ &
4016 ssgradlipi*eel_loc_ij/2.0d0*lipscale/ &
4017 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
4021 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4024 ! Remaining derivatives of eello
4026 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
4027 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
4029 *fac_shield(i)*fac_shield(j) &
4030 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4032 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4033 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
4034 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3) &
4035 +aggi1(l,4)*muij(4))&
4037 *fac_shield(i)*fac_shield(j) &
4038 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4040 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4041 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
4042 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
4044 *fac_shield(i)*fac_shield(j) &
4045 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4047 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4048 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
4049 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3) &
4050 +aggj1(l,4)*muij(4))&
4052 *fac_shield(i)*fac_shield(j) &
4053 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4055 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4058 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
4059 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
4060 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
4061 .and. num_conti.le.maxconts) then
4062 ! write (iout,*) i,j," entered corr"
4064 ! Calculate the contact function. The ith column of the array JCONT will
4065 ! contain the numbers of atoms that make contacts with the atom I (of numbers
4066 ! greater than I). The arrays FACONT and GACONT will contain the values of
4067 ! the contact function and its derivative.
4068 ! r0ij=1.02D0*rpp(iteli,itelj)
4069 ! r0ij=1.11D0*rpp(iteli,itelj)
4070 r0ij=2.20D0*rpp(iteli,itelj)
4071 ! r0ij=1.55D0*rpp(iteli,itelj)
4072 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4073 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
4074 if (fcont.gt.0.0D0) then
4075 num_conti=num_conti+1
4076 if (num_conti.gt.maxconts) then
4077 !el write (iout,*) "esrgresgdsrgdfsrgdswrgaresfgaerwgae"
4078 !el write (iout,*) "num_conti",num_conti, "maxconts",maxconts
4079 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
4080 ' will skip next contacts for this conf.', num_conti
4082 jcont_hb(num_conti,i)=j
4083 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
4084 !d & " jcont_hb",jcont_hb(num_conti,i)
4085 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
4086 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4087 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4089 d_cont(num_conti,i)=rij
4090 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4091 ! --- Electrostatic-interaction matrix ---
4092 a_chuj(1,1,num_conti,i)=a22
4093 a_chuj(1,2,num_conti,i)=a23
4094 a_chuj(2,1,num_conti,i)=a32
4095 a_chuj(2,2,num_conti,i)=a33
4096 ! --- Gradient of rij
4098 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4105 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4106 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4107 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4108 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4109 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4114 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4115 ! Calculate contact energies
4117 wij=cosa-3.0D0*cosb*cosg
4120 ! fac3=dsqrt(-ael6i)/r0ij**3
4121 fac3=dsqrt(-ael6i)*r3ij
4122 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4123 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4124 if (ees0tmp.gt.0) then
4125 ees0pij=dsqrt(ees0tmp)
4129 if (shield_mode.eq.0) then
4133 ees0plist(num_conti,i)=j
4135 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4136 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4137 if (ees0tmp.gt.0) then
4138 ees0mij=dsqrt(ees0tmp)
4143 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
4145 *fac_shield(i)*fac_shield(j)
4147 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
4149 *fac_shield(i)*fac_shield(j)
4151 ! Diagnostics. Comment out or remove after debugging!
4152 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4153 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4154 ! ees0m(num_conti,i)=0.0D0
4156 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4157 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4158 ! Angular derivatives of the contact function
4159 ees0pij1=fac3/ees0pij
4160 ees0mij1=fac3/ees0mij
4161 fac3p=-3.0D0*fac3*rrmij
4162 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4163 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4165 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4166 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4167 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4168 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4169 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4170 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4171 ecosap=ecosa1+ecosa2
4172 ecosbp=ecosb1+ecosb2
4173 ecosgp=ecosg1+ecosg2
4174 ecosam=ecosa1-ecosa2
4175 ecosbm=ecosb1-ecosb2
4176 ecosgm=ecosg1-ecosg2
4185 facont_hb(num_conti,i)=fcont
4186 fprimcont=fprimcont/rij
4187 !d facont_hb(num_conti,i)=1.0D0
4188 ! Following line is for diagnostics.
4191 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4192 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4195 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4196 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4198 gggp(1)=gggp(1)+ees0pijp*xj &
4199 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
4200 gggp(2)=gggp(2)+ees0pijp*yj &
4201 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
4202 gggp(3)=gggp(3)+ees0pijp*zj &
4203 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
4205 gggm(1)=gggm(1)+ees0mijp*xj &
4206 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
4208 gggm(2)=gggm(2)+ees0mijp*yj &
4209 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
4211 gggm(3)=gggm(3)+ees0mijp*zj &
4212 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
4214 ! Derivatives due to the contact function
4215 gacont_hbr(1,num_conti,i)=fprimcont*xj
4216 gacont_hbr(2,num_conti,i)=fprimcont*yj
4217 gacont_hbr(3,num_conti,i)=fprimcont*zj
4220 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
4221 ! following the change of gradient-summation algorithm.
4223 !grad ghalfp=0.5D0*gggp(k)
4224 !grad ghalfm=0.5D0*gggm(k)
4225 gacontp_hb1(k,num_conti,i)= & !ghalfp+
4226 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4227 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
4228 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4230 gacontp_hb2(k,num_conti,i)= & !ghalfp+
4231 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4232 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
4233 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4235 gacontp_hb3(k,num_conti,i)=gggp(k) &
4236 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4238 gacontm_hb1(k,num_conti,i)= & !ghalfm+
4239 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4240 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
4241 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4243 gacontm_hb2(k,num_conti,i)= & !ghalfm+
4244 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4245 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
4246 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4248 gacontm_hb3(k,num_conti,i)=gggm(k) &
4249 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4252 ! Diagnostics. Comment out or remove after debugging!
4254 !diag gacontp_hb1(k,num_conti,i)=0.0D0
4255 !diag gacontp_hb2(k,num_conti,i)=0.0D0
4256 !diag gacontp_hb3(k,num_conti,i)=0.0D0
4257 !diag gacontm_hb1(k,num_conti,i)=0.0D0
4258 !diag gacontm_hb2(k,num_conti,i)=0.0D0
4259 !diag gacontm_hb3(k,num_conti,i)=0.0D0
4262 endif ! num_conti.le.maxconts
4265 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4268 ghalf=0.5d0*agg(l,k)
4269 aggi(l,k)=aggi(l,k)+ghalf
4270 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4271 aggj(l,k)=aggj(l,k)+ghalf
4274 if (j.eq.nres-1 .and. i.lt.j-2) then
4277 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4283 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
4285 end subroutine eelecij
4286 !-----------------------------------------------------------------------------
4287 subroutine eturn3(i,eello_turn3)
4288 ! Third- and fourth-order contributions from turns
4291 ! implicit real*8 (a-h,o-z)
4292 ! include 'DIMENSIONS'
4293 ! include 'COMMON.IOUNITS'
4294 ! include 'COMMON.GEO'
4295 ! include 'COMMON.VAR'
4296 ! include 'COMMON.LOCAL'
4297 ! include 'COMMON.CHAIN'
4298 ! include 'COMMON.DERIV'
4299 ! include 'COMMON.INTERACT'
4300 ! include 'COMMON.CONTACTS'
4301 ! include 'COMMON.TORSION'
4302 ! include 'COMMON.VECTORS'
4303 ! include 'COMMON.FFIELD'
4304 ! include 'COMMON.CONTROL'
4305 real(kind=8),dimension(3) :: ggg
4306 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4307 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
4308 real(kind=8),dimension(2) :: auxvec,auxvec1
4309 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4310 real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
4311 !el integer :: num_conti,j1,j2
4312 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4313 !el dz_normi,xmedi,ymedi,zmedi
4315 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4316 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4319 integer :: i,j,l,k,ilist,iresshield
4320 real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield
4323 ! write (iout,*) "eturn3",i,j,j1,j2
4324 zj=(c(3,j)+c(3,j+1))/2.0d0
4326 if (zj.lt.0) zj=zj+boxzsize
4327 if ((zj.lt.0)) write (*,*) "CHUJ"
4328 if ((zj.gt.bordlipbot) &
4329 .and.(zj.lt.bordliptop)) then
4330 !C the energy transfer exist
4331 if (zj.lt.buflipbot) then
4332 !C what fraction I am in
4334 ((zj-bordlipbot)/lipbufthick)
4335 !C lipbufthick is thickenes of lipid buffore
4336 sslipj=sscalelip(fracinbuf)
4337 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4338 elseif (zj.gt.bufliptop) then
4339 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4340 sslipj=sscalelip(fracinbuf)
4341 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4355 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4357 ! Third-order contributions
4364 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4365 !d call checkint_turn3(i,a_temp,eello_turn3_num)
4366 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4367 call transpose2(auxmat(1,1),auxmat1(1,1))
4368 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4369 if (shield_mode.eq.0) then
4374 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) &
4375 *fac_shield(i)*fac_shield(j) &
4376 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4378 0.5d0*(pizda(1,1)+pizda(2,2)) &
4379 *fac_shield(i)*fac_shield(j)
4381 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4382 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4383 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4384 (shield_mode.gt.0)) then
4387 do ilist=1,ishield_list(i)
4388 iresshield=shield_list(ilist,i)
4390 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4391 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4393 +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4394 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4398 do ilist=1,ishield_list(j)
4399 iresshield=shield_list(ilist,j)
4401 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4402 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4404 +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4405 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4412 gshieldc_t3(k,i)=gshieldc_t3(k,i)+ &
4413 grad_shield(k,i)*eello_t3/fac_shield(i)
4414 gshieldc_t3(k,j)=gshieldc_t3(k,j)+ &
4415 grad_shield(k,j)*eello_t3/fac_shield(j)
4416 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+ &
4417 grad_shield(k,i)*eello_t3/fac_shield(i)
4418 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+ &
4419 grad_shield(k,j)*eello_t3/fac_shield(j)
4423 !d write (2,*) 'i,',i,' j',j,'eello_turn3',
4424 !d & 0.5d0*(pizda(1,1)+pizda(2,2)),
4425 !d & ' eello_turn3_num',4*eello_turn3_num
4426 ! Derivatives in gamma(i)
4427 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4428 call transpose2(auxmat2(1,1),auxmat3(1,1))
4429 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4430 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))&
4431 *fac_shield(i)*fac_shield(j) &
4432 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4433 ! Derivatives in gamma(i+1)
4434 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4435 call transpose2(auxmat2(1,1),auxmat3(1,1))
4436 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4437 gel_loc_turn3(i+1)=gel_loc_turn3(i+1) &
4438 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4439 *fac_shield(i)*fac_shield(j) &
4440 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4442 ! Cartesian derivatives
4444 ! ghalf1=0.5d0*agg(l,1)
4445 ! ghalf2=0.5d0*agg(l,2)
4446 ! ghalf3=0.5d0*agg(l,3)
4447 ! ghalf4=0.5d0*agg(l,4)
4448 a_temp(1,1)=aggi(l,1)!+ghalf1
4449 a_temp(1,2)=aggi(l,2)!+ghalf2
4450 a_temp(2,1)=aggi(l,3)!+ghalf3
4451 a_temp(2,2)=aggi(l,4)!+ghalf4
4452 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4453 gcorr3_turn(l,i)=gcorr3_turn(l,i) &
4454 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4455 *fac_shield(i)*fac_shield(j) &
4456 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4458 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4459 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4460 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4461 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4462 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4463 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) &
4464 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4465 *fac_shield(i)*fac_shield(j) &
4466 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4468 a_temp(1,1)=aggj(l,1)!+ghalf1
4469 a_temp(1,2)=aggj(l,2)!+ghalf2
4470 a_temp(2,1)=aggj(l,3)!+ghalf3
4471 a_temp(2,2)=aggj(l,4)!+ghalf4
4472 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4473 gcorr3_turn(l,j)=gcorr3_turn(l,j) &
4474 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4475 *fac_shield(i)*fac_shield(j) &
4476 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4478 a_temp(1,1)=aggj1(l,1)
4479 a_temp(1,2)=aggj1(l,2)
4480 a_temp(2,1)=aggj1(l,3)
4481 a_temp(2,2)=aggj1(l,4)
4482 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4483 gcorr3_turn(l,j1)=gcorr3_turn(l,j1) &
4484 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4485 *fac_shield(i)*fac_shield(j) &
4486 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4488 gshieldc_t3(3,i)=gshieldc_t3(3,i)+ &
4489 ssgradlipi*eello_t3/4.0d0*lipscale
4490 gshieldc_t3(3,j)=gshieldc_t3(3,j)+ &
4491 ssgradlipj*eello_t3/4.0d0*lipscale
4492 gshieldc_t3(3,i-1)=gshieldc_t3(3,i-1)+ &
4493 ssgradlipi*eello_t3/4.0d0*lipscale
4494 gshieldc_t3(3,j-1)=gshieldc_t3(3,j-1)+ &
4495 ssgradlipj*eello_t3/4.0d0*lipscale
4498 end subroutine eturn3
4499 !-----------------------------------------------------------------------------
4500 subroutine eturn4(i,eello_turn4)
4501 ! Third- and fourth-order contributions from turns
4504 ! implicit real*8 (a-h,o-z)
4505 ! include 'DIMENSIONS'
4506 ! include 'COMMON.IOUNITS'
4507 ! include 'COMMON.GEO'
4508 ! include 'COMMON.VAR'
4509 ! include 'COMMON.LOCAL'
4510 ! include 'COMMON.CHAIN'
4511 ! include 'COMMON.DERIV'
4512 ! include 'COMMON.INTERACT'
4513 ! include 'COMMON.CONTACTS'
4514 ! include 'COMMON.TORSION'
4515 ! include 'COMMON.VECTORS'
4516 ! include 'COMMON.FFIELD'
4517 ! include 'COMMON.CONTROL'
4518 real(kind=8),dimension(3) :: ggg
4519 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4520 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
4521 real(kind=8),dimension(2) :: auxvec,auxvec1
4522 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4523 real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
4524 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4525 !el dz_normi,xmedi,ymedi,zmedi
4526 !el integer :: num_conti,j1,j2
4527 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4528 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4531 integer :: i,j,iti1,iti2,iti3,l,k,ilist,iresshield
4532 real(kind=8) :: eello_turn4,s1,s2,s3,zj,fracinbuf,eello_t4,&
4536 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4538 ! Fourth-order contributions
4546 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4547 !d call checkint_turn4(i,a_temp,eello_turn4_num)
4548 ! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4549 zj=(c(3,j)+c(3,j+1))/2.0d0
4551 if (zj.lt.0) zj=zj+boxzsize
4552 if ((zj.gt.bordlipbot) &
4553 .and.(zj.lt.bordliptop)) then
4554 !C the energy transfer exist
4555 if (zj.lt.buflipbot) then
4556 !C what fraction I am in
4558 ((zj-bordlipbot)/lipbufthick)
4559 !C lipbufthick is thickenes of lipid buffore
4560 sslipj=sscalelip(fracinbuf)
4561 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4562 elseif (zj.gt.bufliptop) then
4563 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4564 sslipj=sscalelip(fracinbuf)
4565 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4579 iti1=itortyp(itype(i+1,1))
4580 iti2=itortyp(itype(i+2,1))
4581 iti3=itortyp(itype(i+3,1))
4582 ! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4583 call transpose2(EUg(1,1,i+1),e1t(1,1))
4584 call transpose2(Eug(1,1,i+2),e2t(1,1))
4585 call transpose2(Eug(1,1,i+3),e3t(1,1))
4586 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4587 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4588 s1=scalar2(b1(1,iti2),auxvec(1))
4589 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4590 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4591 s2=scalar2(b1(1,iti1),auxvec(1))
4592 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4593 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4594 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4595 if (shield_mode.eq.0) then
4600 eello_turn4=eello_turn4-(s1+s2+s3) &
4601 *fac_shield(i)*fac_shield(j) &
4602 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4603 eello_t4=-(s1+s2+s3) &
4604 *fac_shield(i)*fac_shield(j)
4605 !C Now derivative over shield:
4606 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4607 (shield_mode.gt.0)) then
4610 do ilist=1,ishield_list(i)
4611 iresshield=shield_list(ilist,i)
4613 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
4614 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
4616 +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
4617 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
4621 do ilist=1,ishield_list(j)
4622 iresshield=shield_list(ilist,j)
4624 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
4625 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
4627 +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
4628 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
4635 gshieldc_t4(k,i)=gshieldc_t4(k,i)+ &
4636 grad_shield(k,i)*eello_t4/fac_shield(i)
4637 gshieldc_t4(k,j)=gshieldc_t4(k,j)+ &
4638 grad_shield(k,j)*eello_t4/fac_shield(j)
4639 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+ &
4640 grad_shield(k,i)*eello_t4/fac_shield(i)
4641 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+ &
4642 grad_shield(k,j)*eello_t4/fac_shield(j)
4646 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4647 'eturn4',i,j,-(s1+s2+s3)
4648 !d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4649 !d & ' eello_turn4_num',8*eello_turn4_num
4650 ! Derivatives in gamma(i)
4651 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4652 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4653 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4654 s1=scalar2(b1(1,iti2),auxvec(1))
4655 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4656 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4657 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) &
4658 *fac_shield(i)*fac_shield(j) &
4659 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4661 ! Derivatives in gamma(i+1)
4662 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4663 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4664 s2=scalar2(b1(1,iti1),auxvec(1))
4665 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4666 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4667 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4668 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) &
4669 *fac_shield(i)*fac_shield(j) &
4670 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4672 ! Derivatives in gamma(i+2)
4673 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4674 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4675 s1=scalar2(b1(1,iti2),auxvec(1))
4676 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4677 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4678 s2=scalar2(b1(1,iti1),auxvec(1))
4679 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4680 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4681 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4682 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) &
4683 *fac_shield(i)*fac_shield(j) &
4684 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4686 ! Cartesian derivatives
4687 ! Derivatives of this turn contributions in DC(i+2)
4688 if (j.lt.nres-1) then
4690 a_temp(1,1)=agg(l,1)
4691 a_temp(1,2)=agg(l,2)
4692 a_temp(2,1)=agg(l,3)
4693 a_temp(2,2)=agg(l,4)
4694 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4695 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4696 s1=scalar2(b1(1,iti2),auxvec(1))
4697 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4698 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4699 s2=scalar2(b1(1,iti1),auxvec(1))
4700 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4701 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4702 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4704 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)&
4705 *fac_shield(i)*fac_shield(j) &
4706 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4710 ! Remaining derivatives of this turn contribution
4712 a_temp(1,1)=aggi(l,1)
4713 a_temp(1,2)=aggi(l,2)
4714 a_temp(2,1)=aggi(l,3)
4715 a_temp(2,2)=aggi(l,4)
4716 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4717 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4718 s1=scalar2(b1(1,iti2),auxvec(1))
4719 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4720 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4721 s2=scalar2(b1(1,iti1),auxvec(1))
4722 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4723 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4724 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4725 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) &
4726 *fac_shield(i)*fac_shield(j) &
4727 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4730 a_temp(1,1)=aggi1(l,1)
4731 a_temp(1,2)=aggi1(l,2)
4732 a_temp(2,1)=aggi1(l,3)
4733 a_temp(2,2)=aggi1(l,4)
4734 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4735 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4736 s1=scalar2(b1(1,iti2),auxvec(1))
4737 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4738 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4739 s2=scalar2(b1(1,iti1),auxvec(1))
4740 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4741 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4742 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4743 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) &
4744 *fac_shield(i)*fac_shield(j) &
4745 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4748 a_temp(1,1)=aggj(l,1)
4749 a_temp(1,2)=aggj(l,2)
4750 a_temp(2,1)=aggj(l,3)
4751 a_temp(2,2)=aggj(l,4)
4752 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4753 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4754 s1=scalar2(b1(1,iti2),auxvec(1))
4755 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4756 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4757 s2=scalar2(b1(1,iti1),auxvec(1))
4758 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4759 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4760 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4761 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) &
4762 *fac_shield(i)*fac_shield(j) &
4763 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4766 a_temp(1,1)=aggj1(l,1)
4767 a_temp(1,2)=aggj1(l,2)
4768 a_temp(2,1)=aggj1(l,3)
4769 a_temp(2,2)=aggj1(l,4)
4770 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4771 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4772 s1=scalar2(b1(1,iti2),auxvec(1))
4773 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4774 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4775 s2=scalar2(b1(1,iti1),auxvec(1))
4776 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4777 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4778 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4779 ! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4780 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) &
4781 *fac_shield(i)*fac_shield(j) &
4782 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4785 gshieldc_t4(3,i)=gshieldc_t4(3,i)+ &
4786 ssgradlipi*eello_t4/4.0d0*lipscale
4787 gshieldc_t4(3,j)=gshieldc_t4(3,j)+ &
4788 ssgradlipj*eello_t4/4.0d0*lipscale
4789 gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+ &
4790 ssgradlipi*eello_t4/4.0d0*lipscale
4791 gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+ &
4792 ssgradlipj*eello_t4/4.0d0*lipscale
4795 end subroutine eturn4
4796 !-----------------------------------------------------------------------------
4797 subroutine unormderiv(u,ugrad,unorm,ungrad)
4798 ! This subroutine computes the derivatives of a normalized vector u, given
4799 ! the derivatives computed without normalization conditions, ugrad. Returns
4802 real(kind=8),dimension(3) :: u,vec
4803 real(kind=8),dimension(3,3) ::ugrad,ungrad
4804 real(kind=8) :: unorm !,scalar
4806 ! write (2,*) 'ugrad',ugrad
4809 vec(i)=scalar(ugrad(1,i),u(1))
4811 ! write (2,*) 'vec',vec
4814 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4817 ! write (2,*) 'ungrad',ungrad
4819 end subroutine unormderiv
4820 !-----------------------------------------------------------------------------
4821 subroutine escp_soft_sphere(evdw2,evdw2_14)
4823 ! This subroutine calculates the excluded-volume interaction energy between
4824 ! peptide-group centers and side chains and its gradient in virtual-bond and
4825 ! side-chain vectors.
4827 ! implicit real*8 (a-h,o-z)
4828 ! include 'DIMENSIONS'
4829 ! include 'COMMON.GEO'
4830 ! include 'COMMON.VAR'
4831 ! include 'COMMON.LOCAL'
4832 ! include 'COMMON.CHAIN'
4833 ! include 'COMMON.DERIV'
4834 ! include 'COMMON.INTERACT'
4835 ! include 'COMMON.FFIELD'
4836 ! include 'COMMON.IOUNITS'
4837 ! include 'COMMON.CONTROL'
4838 real(kind=8),dimension(3) :: ggg
4840 integer :: i,iint,j,k,iteli,itypj
4841 real(kind=8) :: evdw2,evdw2_14,r0_scp,xi,yi,zi,xj,yj,zj,&
4842 fac,rij,r0ij,r0ijsq,evdwij,e1,e2
4847 !d print '(a)','Enter ESCP'
4848 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4849 do i=iatscp_s,iatscp_e
4850 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
4852 xi=0.5D0*(c(1,i)+c(1,i+1))
4853 yi=0.5D0*(c(2,i)+c(2,i+1))
4854 zi=0.5D0*(c(3,i)+c(3,i+1))
4856 do iint=1,nscp_gr(i)
4858 do j=iscpstart(i,iint),iscpend(i,iint)
4859 if (itype(j,1).eq.ntyp1) cycle
4860 itypj=iabs(itype(j,1))
4861 ! Uncomment following three lines for SC-p interactions
4865 ! Uncomment following three lines for Ca-p interactions
4869 rij=xj*xj+yj*yj+zj*zj
4872 if (rij.lt.r0ijsq) then
4873 evdwij=0.25d0*(rij-r0ijsq)**2
4881 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
4886 !grad if (j.lt.i) then
4887 !d write (iout,*) 'j<i'
4888 ! Uncomment following three lines for SC-p interactions
4890 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4893 !d write (iout,*) 'j>i'
4895 !grad ggg(k)=-ggg(k)
4896 ! Uncomment following line for SC-p interactions
4897 ! gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4901 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4903 !grad kstart=min0(i+1,j)
4904 !grad kend=max0(i-1,j-1)
4905 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4906 !d write (iout,*) ggg(1),ggg(2),ggg(3)
4907 !grad do k=kstart,kend
4909 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4913 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4914 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4921 end subroutine escp_soft_sphere
4922 !-----------------------------------------------------------------------------
4923 subroutine escp(evdw2,evdw2_14)
4925 ! This subroutine calculates the excluded-volume interaction energy between
4926 ! peptide-group centers and side chains and its gradient in virtual-bond and
4927 ! side-chain vectors.
4929 ! implicit real*8 (a-h,o-z)
4930 ! include 'DIMENSIONS'
4931 ! include 'COMMON.GEO'
4932 ! include 'COMMON.VAR'
4933 ! include 'COMMON.LOCAL'
4934 ! include 'COMMON.CHAIN'
4935 ! include 'COMMON.DERIV'
4936 ! include 'COMMON.INTERACT'
4937 ! include 'COMMON.FFIELD'
4938 ! include 'COMMON.IOUNITS'
4939 ! include 'COMMON.CONTROL'
4940 real(kind=8),dimension(3) :: ggg
4942 integer :: i,iint,j,k,iteli,itypj,subchap
4943 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
4945 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
4946 dist_temp, dist_init
4947 integer xshift,yshift,zshift
4951 !d print '(a)','Enter ESCP'
4952 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4953 do i=iatscp_s,iatscp_e
4954 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
4956 xi=0.5D0*(c(1,i)+c(1,i+1))
4957 yi=0.5D0*(c(2,i)+c(2,i+1))
4958 zi=0.5D0*(c(3,i)+c(3,i+1))
4960 if (xi.lt.0) xi=xi+boxxsize
4962 if (yi.lt.0) yi=yi+boxysize
4964 if (zi.lt.0) zi=zi+boxzsize
4966 do iint=1,nscp_gr(i)
4968 do j=iscpstart(i,iint),iscpend(i,iint)
4969 itypj=iabs(itype(j,1))
4970 if (itypj.eq.ntyp1) cycle
4971 ! Uncomment following three lines for SC-p interactions
4975 ! Uncomment following three lines for Ca-p interactions
4983 if (xj.lt.0) xj=xj+boxxsize
4985 if (yj.lt.0) yj=yj+boxysize
4987 if (zj.lt.0) zj=zj+boxzsize
4988 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4996 xj=xj_safe+xshift*boxxsize
4997 yj=yj_safe+yshift*boxysize
4998 zj=zj_safe+zshift*boxzsize
4999 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5000 if(dist_temp.lt.dist_init) then
5010 if (subchap.eq.1) then
5020 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5021 rij=dsqrt(1.0d0/rrij)
5022 sss_ele_cut=sscale_ele(rij)
5023 sss_ele_grad=sscagrad_ele(rij)
5024 ! print *,sss_ele_cut,sss_ele_grad,&
5025 ! (rij),r_cut_ele,rlamb_ele
5026 if (sss_ele_cut.le.0.0) cycle
5028 e1=fac*fac*aad(itypj,iteli)
5029 e2=fac*bad(itypj,iteli)
5030 if (iabs(j-i) .le. 2) then
5033 evdw2_14=evdw2_14+(e1+e2)*sss_ele_cut
5036 evdw2=evdw2+evdwij*sss_ele_cut
5037 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') &
5038 ! 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),&
5039 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
5042 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
5044 fac=-(evdwij+e1)*rrij*sss_ele_cut
5045 fac=fac+evdwij*sss_ele_grad/rij/expon
5049 !grad if (j.lt.i) then
5050 !d write (iout,*) 'j<i'
5051 ! Uncomment following three lines for SC-p interactions
5053 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5056 !d write (iout,*) 'j>i'
5058 !grad ggg(k)=-ggg(k)
5059 ! Uncomment following line for SC-p interactions
5060 !cgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5061 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5065 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5067 !grad kstart=min0(i+1,j)
5068 !grad kend=max0(i-1,j-1)
5069 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5070 !d write (iout,*) ggg(1),ggg(2),ggg(3)
5071 !grad do k=kstart,kend
5073 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5077 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5078 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5086 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5087 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5088 gradx_scp(j,i)=expon*gradx_scp(j,i)
5091 !******************************************************************************
5095 ! To save time the factor EXPON has been extracted from ALL components
5096 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
5099 !******************************************************************************
5102 !-----------------------------------------------------------------------------
5103 subroutine edis(ehpb)
5105 ! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5107 ! implicit real*8 (a-h,o-z)
5108 ! include 'DIMENSIONS'
5109 ! include 'COMMON.SBRIDGE'
5110 ! include 'COMMON.CHAIN'
5111 ! include 'COMMON.DERIV'
5112 ! include 'COMMON.VAR'
5113 ! include 'COMMON.INTERACT'
5114 ! include 'COMMON.IOUNITS'
5115 real(kind=8),dimension(3) :: ggg
5117 integer :: i,j,ii,jj,iii,jjj,k
5118 real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
5121 !d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5122 !d write(iout,*)'link_start=',link_start,' link_end=',link_end
5123 if (link_end.eq.0) return
5124 do i=link_start,link_end
5125 ! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5126 ! CA-CA distance used in regularization of structure.
5129 ! iii and jjj point to the residues for which the distance is assigned.
5130 if (ii.gt.nres) then
5137 ! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5138 ! & dhpb(i),dhpb1(i),forcon(i)
5139 ! 24/11/03 AL: SS bridges handled separately because of introducing a specific
5140 ! distance and angle dependent SS bond potential.
5141 !mc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5142 ! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5143 if (.not.dyn_ss .and. i.le.nss) then
5144 ! 15/02/13 CC dynamic SSbond - additional check
5145 if (ii.gt.nres .and. iabs(itype(iii,1)).eq.1 .and. &
5146 iabs(itype(jjj,1)).eq.1) then
5147 call ssbond_ene(iii,jjj,eij)
5149 !d write (iout,*) "eij",eij
5151 else if (ii.gt.nres .and. jj.gt.nres) then
5152 !c Restraints from contact prediction
5154 if (constr_dist.eq.11) then
5155 ehpb=ehpb+fordepth(i)**4.0d0 &
5156 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5157 fac=fordepth(i)**4.0d0 &
5158 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5159 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
5162 if (dhpb1(i).gt.0.0d0) then
5163 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5164 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5165 !c write (iout,*) "beta nmr",
5166 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5170 !C Get the force constant corresponding to this distance.
5172 !C Calculate the contribution to energy.
5173 ehpb=ehpb+waga*rdis*rdis
5174 !c write (iout,*) "beta reg",dd,waga*rdis*rdis
5176 !C Evaluate gradient.
5182 ggg(j)=fac*(c(j,jj)-c(j,ii))
5185 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5186 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5189 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5190 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5194 if (constr_dist.eq.11) then
5195 ehpb=ehpb+fordepth(i)**4.0d0 &
5196 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5197 fac=fordepth(i)**4.0d0 &
5198 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5199 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
5202 if (dhpb1(i).gt.0.0d0) then
5203 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5204 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5205 !c write (iout,*) "alph nmr",
5206 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5209 !C Get the force constant corresponding to this distance.
5211 !C Calculate the contribution to energy.
5212 ehpb=ehpb+waga*rdis*rdis
5213 !c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5215 !C Evaluate gradient.
5222 ggg(j)=fac*(c(j,jj)-c(j,ii))
5224 !cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5225 !C If this is a SC-SC distance, we need to calculate the contributions to the
5226 !C Cartesian gradient in the SC vectors (ghpbx).
5229 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5230 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5233 !cgrad do j=iii,jjj-1
5235 !cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5239 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5240 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5244 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5248 !-----------------------------------------------------------------------------
5249 subroutine ssbond_ene(i,j,eij)
5251 ! Calculate the distance and angle dependent SS-bond potential energy
5252 ! using a free-energy function derived based on RHF/6-31G** ab initio
5253 ! calculations of diethyl disulfide.
5255 ! A. Liwo and U. Kozlowska, 11/24/03
5257 ! implicit real*8 (a-h,o-z)
5258 ! include 'DIMENSIONS'
5259 ! include 'COMMON.SBRIDGE'
5260 ! include 'COMMON.CHAIN'
5261 ! include 'COMMON.DERIV'
5262 ! include 'COMMON.LOCAL'
5263 ! include 'COMMON.INTERACT'
5264 ! include 'COMMON.VAR'
5265 ! include 'COMMON.IOUNITS'
5266 real(kind=8),dimension(3) :: erij,dcosom1,dcosom2,gg
5268 integer :: i,j,itypi,itypj,k
5269 real(kind=8) :: eij,rij,rrij,xi,yi,zi,dxi,dyi,dzi,dsci_inv,&
5270 xj,yj,zj,dxj,dyj,dzj,om1,om2,om12,deltad,dscj_inv,&
5271 deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,&
5274 itypi=iabs(itype(i,1))
5278 dxi=dc_norm(1,nres+i)
5279 dyi=dc_norm(2,nres+i)
5280 dzi=dc_norm(3,nres+i)
5281 ! dsci_inv=dsc_inv(itypi)
5282 dsci_inv=vbld_inv(nres+i)
5283 itypj=iabs(itype(j,1))
5284 ! dscj_inv=dsc_inv(itypj)
5285 dscj_inv=vbld_inv(nres+j)
5289 dxj=dc_norm(1,nres+j)
5290 dyj=dc_norm(2,nres+j)
5291 dzj=dc_norm(3,nres+j)
5292 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5297 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5298 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5299 om12=dxi*dxj+dyi*dyj+dzi*dzj
5301 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5302 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5308 deltat12=om2-om1+2.0d0
5310 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
5311 +akct*deltad*deltat12 &
5312 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5313 ! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5314 ! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5315 ! & " deltat12",deltat12," eij",eij
5316 ed=2*akcm*deltad+akct*deltat12
5318 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5319 eom1=-2*akth*deltat1-pom1-om2*pom2
5320 eom2= 2*akth*deltat2+pom1-om1*pom2
5323 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5324 ghpbx(k,i)=ghpbx(k,i)-ggk &
5325 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
5326 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5327 ghpbx(k,j)=ghpbx(k,j)+ggk &
5328 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
5329 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5330 ghpbc(k,i)=ghpbc(k,i)-ggk
5331 ghpbc(k,j)=ghpbc(k,j)+ggk
5334 ! Calculate the components of the gradient in DC and X
5338 !grad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5342 end subroutine ssbond_ene
5343 !-----------------------------------------------------------------------------
5344 subroutine ebond(estr)
5346 ! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5348 ! implicit real*8 (a-h,o-z)
5349 ! include 'DIMENSIONS'
5350 ! include 'COMMON.LOCAL'
5351 ! include 'COMMON.GEO'
5352 ! include 'COMMON.INTERACT'
5353 ! include 'COMMON.DERIV'
5354 ! include 'COMMON.VAR'
5355 ! include 'COMMON.CHAIN'
5356 ! include 'COMMON.IOUNITS'
5357 ! include 'COMMON.NAMES'
5358 ! include 'COMMON.FFIELD'
5359 ! include 'COMMON.CONTROL'
5360 ! include 'COMMON.SETUP'
5361 real(kind=8),dimension(3) :: u,ud
5363 integer :: i,j,iti,nbi,k
5364 real(kind=8) :: estr,estr1,diff,uprod,usum,usumsqder,&
5369 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
5370 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
5372 do i=ibondp_start,ibondp_end
5373 if (itype(i-1,1).eq.ntyp1 .and. itype(i,1).eq.ntyp1) cycle
5374 if (itype(i-1,1).eq.ntyp1 .or. itype(i,1).eq.ntyp1) then
5375 !C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5377 !C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) &
5378 !C *dc(j,i-1)/vbld(i)
5380 !C if (energy_dec) write(iout,*) &
5381 !C "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5382 diff = vbld(i)-vbldpDUM
5384 diff = vbld(i)-vbldp0
5386 if (energy_dec) write (iout,'(a7,i5,4f7.3)') &
5387 "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5390 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5392 ! write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5395 estr=0.5d0*AKP*estr+estr1
5396 ! print *,"estr_bb",estr,AKP
5398 ! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5400 do i=ibond_start,ibond_end
5401 iti=iabs(itype(i,1))
5402 if (iti.eq.0) print *,"WARNING WRONG SETTTING",i
5403 if (iti.ne.10 .and. iti.ne.ntyp1) then
5406 diff=vbld(i+nres)-vbldsc0(1,iti)
5407 if (energy_dec) write (iout,*) &
5408 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5409 AKSC(1,iti),AKSC(1,iti)*diff*diff
5410 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5411 ! print *,"estr_sc",estr
5413 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5417 diff=vbld(i+nres)-vbldsc0(j,iti)
5418 ud(j)=aksc(j,iti)*diff
5419 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5433 uprod2=uprod2*u(k)*u(k)
5437 usumsqder=usumsqder+ud(j)*uprod2
5439 estr=estr+uprod/usum
5440 ! print *,"estr_sc",estr,i
5442 if (energy_dec) write (iout,*) &
5443 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5444 AKSC(1,iti),uprod/usum
5446 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5452 end subroutine ebond
5454 !-----------------------------------------------------------------------------
5455 subroutine ebend(etheta)
5457 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5458 ! angles gamma and its derivatives in consecutive thetas and gammas.
5461 ! implicit real*8 (a-h,o-z)
5462 ! include 'DIMENSIONS'
5463 ! include 'COMMON.LOCAL'
5464 ! include 'COMMON.GEO'
5465 ! include 'COMMON.INTERACT'
5466 ! include 'COMMON.DERIV'
5467 ! include 'COMMON.VAR'
5468 ! include 'COMMON.CHAIN'
5469 ! include 'COMMON.IOUNITS'
5470 ! include 'COMMON.NAMES'
5471 ! include 'COMMON.FFIELD'
5472 ! include 'COMMON.CONTROL'
5473 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5474 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5475 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5477 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5478 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5479 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5481 integer :: i,k,ichir1,ichir2,itype1,ichir11,ichir12,itype2,&
5483 real(kind=8) :: etheta,delta,ss,ssd,phii,phii1,thet_pred_mean,&
5484 athetk,bthetk,dthett,dthetg1,dthetg2,f0,fprim0,E_tc0,fprim_tc0,&
5485 f1,fprim1,E_tc1,ethetai,E_theta,E_tc
5486 real(kind=8),dimension(2) :: y,z
5489 ! time11=dexp(-2*time)
5492 ! write (*,'(a,i2)') 'EBEND ICG=',icg
5493 do i=ithet_start,ithet_end
5494 if (itype(i-1,1).eq.ntyp1) cycle
5495 ! Zero the energy function and its derivative at 0 or pi.
5496 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5498 ichir1=isign(1,itype(i-2,1))
5499 ichir2=isign(1,itype(i,1))
5500 if (itype(i-2,1).eq.10) ichir1=isign(1,itype(i-1,1))
5501 if (itype(i,1).eq.10) ichir2=isign(1,itype(i-1,1))
5502 if (itype(i-1,1).eq.10) then
5503 itype1=isign(10,itype(i-2,1))
5504 ichir11=isign(1,itype(i-2,1))
5505 ichir12=isign(1,itype(i-2,1))
5506 itype2=isign(10,itype(i,1))
5507 ichir21=isign(1,itype(i,1))
5508 ichir22=isign(1,itype(i,1))
5511 if (i.gt.3 .and. itype(i-2,1).ne.ntyp1) then
5514 if (phii.ne.phii) phii=150.0
5524 if (i.lt.nres .and. itype(i,1).ne.ntyp1) then
5527 if (phii1.ne.phii1) phii1=150.0
5539 ! Calculate the "mean" value of theta from the part of the distribution
5540 ! dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5541 ! In following comments this theta will be referred to as t_c.
5542 thet_pred_mean=0.0d0
5544 athetk=athet(k,it,ichir1,ichir2)
5545 bthetk=bthet(k,it,ichir1,ichir2)
5547 athetk=athet(k,itype1,ichir11,ichir12)
5548 bthetk=bthet(k,itype2,ichir21,ichir22)
5550 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5552 dthett=thet_pred_mean*ssd
5553 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5554 ! Derivatives of the "mean" values in gamma1 and gamma2.
5555 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) &
5556 +athet(2,it,ichir1,ichir2)*y(1))*ss
5557 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) &
5558 +bthet(2,it,ichir1,ichir2)*z(1))*ss
5560 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) &
5561 +athet(2,itype1,ichir11,ichir12)*y(1))*ss
5562 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) &
5563 +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5565 if (theta(i).gt.pi-delta) then
5566 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,&
5568 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5569 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5570 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,&
5572 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,&
5574 else if (theta(i).lt.delta) then
5575 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5576 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5577 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,&
5579 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5580 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,&
5583 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,&
5586 etheta=etheta+ethetai
5587 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5589 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5590 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5591 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
5593 ! print *,ithetaconstr_start,ithetaconstr_end,"TU"
5595 ! Ufff.... We've done all this!!!
5597 end subroutine ebend
5598 !-----------------------------------------------------------------------------
5599 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
5602 ! implicit real*8 (a-h,o-z)
5603 ! include 'DIMENSIONS'
5604 ! include 'COMMON.LOCAL'
5605 ! include 'COMMON.IOUNITS'
5606 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5607 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5608 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5610 real(kind=8) :: thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc
5612 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5613 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5614 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5616 real(kind=8) :: sig,fac,escloci0,escloci1,esclocbi0,dersc12,&
5617 esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5619 ! Calculate the contributions to both Gaussian lobes.
5620 ! 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5621 ! The "polynomial part" of the "standard deviation" of this part of
5625 sig=sig*thet_pred_mean+polthet(j,it)
5627 ! Derivative of the "interior part" of the "standard deviation of the"
5628 ! gamma-dependent Gaussian lobe in t_c.
5629 sigtc=3*polthet(3,it)
5631 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5634 ! Set the parameters of both Gaussian lobes of the distribution.
5635 ! "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5636 fac=sig*sig+sigc0(it)
5639 ! Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5640 sigsqtc=-4.0D0*sigcsq*sigtc
5641 ! print *,i,sig,sigtc,sigsqtc
5642 ! Following variable (sigtc) is d[sigma(t_c)]/dt_c
5643 sigtc=-sigtc/(fac*fac)
5644 ! Following variable is sigma(t_c)**(-2)
5645 sigcsq=sigcsq*sigcsq
5647 sig0inv=1.0D0/sig0i**2
5648 delthec=thetai-thet_pred_mean
5649 delthe0=thetai-theta0i
5650 term1=-0.5D0*sigcsq*delthec*delthec
5651 term2=-0.5D0*sig0inv*delthe0*delthe0
5652 ! Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5653 ! NaNs in taking the logarithm. We extract the largest exponent which is added
5654 ! to the energy (this being the log of the distribution) at the end of energy
5655 ! term evaluation for this virtual-bond angle.
5656 if (term1.gt.term2) then
5658 term2=dexp(term2-termm)
5662 term1=dexp(term1-termm)
5665 ! The ratio between the gamma-independent and gamma-dependent lobes of
5666 ! the distribution is a Gaussian function of thet_pred_mean too.
5667 diffak=gthet(2,it)-thet_pred_mean
5668 ratak=diffak/gthet(3,it)**2
5669 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5670 ! Let's differentiate it in thet_pred_mean NOW.
5672 ! Now put together the distribution terms to make complete distribution.
5673 termexp=term1+ak*term2
5674 termpre=sigc+ak*sig0i
5675 ! Contribution of the bending energy from this theta is just the -log of
5676 ! the sum of the contributions from the two lobes and the pre-exponential
5677 ! factor. Simple enough, isn't it?
5678 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5679 ! NOW the derivatives!!!
5680 ! 6/6/97 Take into account the deformation.
5681 E_theta=(delthec*sigcsq*term1 &
5682 +ak*delthe0*sig0inv*term2)/termexp
5683 E_tc=((sigtc+aktc*sig0i)/termpre &
5684 -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ &
5685 aktc*term2)/termexp)
5687 end subroutine theteng
5689 !-----------------------------------------------------------------------------
5690 subroutine ebend(etheta,ethetacnstr)
5692 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5693 ! angles gamma and its derivatives in consecutive thetas and gammas.
5694 ! ab initio-derived potentials from
5695 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5697 ! implicit real*8 (a-h,o-z)
5698 ! include 'DIMENSIONS'
5699 ! include 'COMMON.LOCAL'
5700 ! include 'COMMON.GEO'
5701 ! include 'COMMON.INTERACT'
5702 ! include 'COMMON.DERIV'
5703 ! include 'COMMON.VAR'
5704 ! include 'COMMON.CHAIN'
5705 ! include 'COMMON.IOUNITS'
5706 ! include 'COMMON.NAMES'
5707 ! include 'COMMON.FFIELD'
5708 ! include 'COMMON.CONTROL'
5709 real(kind=8),dimension(nntheterm) :: coskt,sinkt !mmaxtheterm
5710 real(kind=8),dimension(nsingle) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
5711 real(kind=8),dimension(ndouble,ndouble) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
5712 logical :: lprn=.false., lprn1=.false.
5714 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
5715 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
5716 real(kind=8) :: aux,etheta,ccl,ssl,scl,csl,ethetacnstr
5717 ! local variables for constrains
5718 real(kind=8) :: difi,thetiii
5722 do i=ithet_start,ithet_end
5723 if (itype(i-1,1).eq.ntyp1) cycle
5724 if (itype(i-2,1).eq.ntyp1.or.itype(i,1).eq.ntyp1) cycle
5725 if (iabs(itype(i+1,1)).eq.20) iblock=2
5726 if (iabs(itype(i+1,1)).ne.20) iblock=1
5730 theti2=0.5d0*theta(i)
5731 ityp2=ithetyp((itype(i-1,1)))
5733 coskt(k)=dcos(k*theti2)
5734 sinkt(k)=dsin(k*theti2)
5736 if (i.gt.3 .and. itype(max0(i-3,1),1).ne.ntyp1) then
5739 if (phii.ne.phii) phii=150.0
5743 ityp1=ithetyp((itype(i-2,1)))
5744 ! propagation of chirality for glycine type
5746 cosph1(k)=dcos(k*phii)
5747 sinph1(k)=dsin(k*phii)
5751 ityp1=ithetyp(itype(i-2,1))
5757 if (i.lt.nres .and. itype(i+1,1).ne.ntyp1) then
5760 if (phii1.ne.phii1) phii1=150.0
5765 ityp3=ithetyp((itype(i,1)))
5767 cosph2(k)=dcos(k*phii1)
5768 sinph2(k)=dsin(k*phii1)
5772 ityp3=ithetyp(itype(i,1))
5778 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5781 ccl=cosph1(l)*cosph2(k-l)
5782 ssl=sinph1(l)*sinph2(k-l)
5783 scl=sinph1(l)*cosph2(k-l)
5784 csl=cosph1(l)*sinph2(k-l)
5785 cosph1ph2(l,k)=ccl-ssl
5786 cosph1ph2(k,l)=ccl+ssl
5787 sinph1ph2(l,k)=scl+csl
5788 sinph1ph2(k,l)=scl-csl
5792 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
5793 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5794 write (iout,*) "coskt and sinkt"
5796 write (iout,*) k,coskt(k),sinkt(k)
5800 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5801 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) &
5804 write (iout,*) "k",k,&
5805 "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),&
5809 write (iout,*) "cosph and sinph"
5811 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5813 write (iout,*) "cosph1ph2 and sinph2ph2"
5816 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
5817 sinph1ph2(l,k),sinph1ph2(k,l)
5820 write(iout,*) "ethetai",ethetai
5824 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) &
5825 +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) &
5826 +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) &
5827 +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5828 ethetai=ethetai+sinkt(m)*aux
5829 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5830 dephii=dephii+k*sinkt(m)* &
5831 (ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- &
5832 bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5833 dephii1=dephii1+k*sinkt(m)* &
5834 (eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- &
5835 ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5837 write (iout,*) "m",m," k",k," bbthet", &
5838 bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", &
5839 ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", &
5840 ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", &
5841 eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5845 write(iout,*) "ethetai",ethetai
5849 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
5850 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ &
5851 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
5852 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5853 ethetai=ethetai+sinkt(m)*aux
5854 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5855 dephii=dephii+l*sinkt(m)* &
5856 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- &
5857 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
5858 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
5859 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5860 dephii1=dephii1+(k-l)*sinkt(m)* &
5861 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
5862 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
5863 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- &
5864 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5866 write (iout,*) "m",m," k",k," l",l," ffthet",&
5867 ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
5868 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",&
5869 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
5870 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),&
5872 write (iout,*) cosph1ph2(l,k)*sinkt(m),&
5873 cosph1ph2(k,l)*sinkt(m),&
5874 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5882 write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
5883 i,theta(i)*rad2deg,phii*rad2deg,&
5884 phii1*rad2deg,ethetai
5886 etheta=etheta+ethetai
5887 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5889 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5890 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5891 gloc(nphi+i-2,icg)=wang*dethetai
5893 !-----------thete constrains
5894 ! if (tor_mode.ne.2) then
5896 ! print *,ithetaconstr_start,ithetaconstr_end,"TU"
5897 do i=ithetaconstr_start,ithetaconstr_end
5898 itheta=itheta_constr(i)
5899 thetiii=theta(itheta)
5900 difi=pinorm(thetiii-theta_constr0(i))
5901 if (difi.gt.theta_drange(i)) then
5902 difi=difi-theta_drange(i)
5903 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5904 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
5905 +for_thet_constr(i)*difi**3
5906 else if (difi.lt.-drange(i)) then
5908 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5909 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
5910 +for_thet_constr(i)*difi**3
5914 if (energy_dec) then
5915 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc", &
5916 i,itheta,rad2deg*thetiii, &
5917 rad2deg*theta_constr0(i), rad2deg*theta_drange(i), &
5918 rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4, &
5919 gloc(itheta+nphi-2,icg)
5925 end subroutine ebend
5928 !-----------------------------------------------------------------------------
5929 subroutine esc(escloc)
5930 ! Calculate the local energy of a side chain and its derivatives in the
5931 ! corresponding virtual-bond valence angles THETA and the spherical angles
5935 ! implicit real*8 (a-h,o-z)
5936 ! include 'DIMENSIONS'
5937 ! include 'COMMON.GEO'
5938 ! include 'COMMON.LOCAL'
5939 ! include 'COMMON.VAR'
5940 ! include 'COMMON.INTERACT'
5941 ! include 'COMMON.DERIV'
5942 ! include 'COMMON.CHAIN'
5943 ! include 'COMMON.IOUNITS'
5944 ! include 'COMMON.NAMES'
5945 ! include 'COMMON.FFIELD'
5946 ! include 'COMMON.CONTROL'
5947 real(kind=8),dimension(3) :: x,dersc,xemp,dersc0,dersc1,&
5948 ddersc0,ddummy,xtemp,temp
5949 !el real(kind=8) :: time11,time12,time112,theti
5950 real(kind=8) :: escloc,delta
5951 !el integer :: it,nlobit
5952 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5955 real(kind=8) :: escloci0,escloci1,escloci,esclocbi0,&
5956 dersc12,esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5959 ! write (iout,'(a)') 'ESC'
5960 do i=loc_start,loc_end
5962 if (it.eq.ntyp1) cycle
5963 if (it.eq.10) goto 1
5964 nlobit=nlob(iabs(it))
5965 ! print *,'i=',i,' it=',it,' nlobit=',nlobit
5966 ! write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5967 theti=theta(i+1)-pipol
5972 if (x(2).gt.pi-delta) then
5976 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5978 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5979 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),&
5981 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
5982 ddersc0(1),dersc(1))
5983 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),&
5984 ddersc0(3),dersc(3))
5986 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5988 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5989 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,&
5990 dersc0(2),esclocbi,dersc02)
5991 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
5993 call splinthet(x(2),0.5d0*delta,ss,ssd)
5998 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6000 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6001 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6003 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6005 ! write (iout,*) escloci
6006 else if (x(2).lt.delta) then
6010 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6012 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6013 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),&
6015 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
6016 ddersc0(1),dersc(1))
6017 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),&
6018 ddersc0(3),dersc(3))
6020 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6022 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6023 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,&
6024 dersc0(2),esclocbi,dersc02)
6025 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
6030 call splinthet(x(2),0.5d0*delta,ss,ssd)
6032 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6034 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6035 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6037 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6038 ! write (iout,*) escloci
6040 call enesc(x,escloci,dersc,ddummy,.false.)
6043 escloc=escloc+escloci
6044 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6046 ! write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6048 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ &
6050 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6051 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6056 !-----------------------------------------------------------------------------
6057 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6060 ! implicit real*8 (a-h,o-z)
6061 ! include 'DIMENSIONS'
6062 ! include 'COMMON.GEO'
6063 ! include 'COMMON.LOCAL'
6064 ! include 'COMMON.IOUNITS'
6065 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6066 real(kind=8),dimension(3) :: x,z,dersc,ddersc
6067 real(kind=8),dimension(3,nlobit,-1:1) :: Ax !(3,maxlob,-1:1)
6068 real(kind=8),dimension(nlobit,-1:1) :: contr !(maxlob,-1:1)
6069 real(kind=8) :: escloci
6072 integer :: j,iii,l,k !el,it,nlobit
6073 real(kind=8) :: escloc_i,x3,Axk,expfac,emin !el,theti,&
6074 !el time11,time12,time112
6075 ! write (iout,*) 'it=',it,' nlobit=',nlobit
6079 if (mixed) ddersc(j)=0.0d0
6083 ! Because of periodicity of the dependence of the SC energy in omega we have
6084 ! to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6085 ! To avoid underflows, first compute & store the exponents.
6093 z(k)=x(k)-censc(k,j,it)
6098 Axk=Axk+gaussc(l,k,j,it)*z(l)
6104 expfac=expfac+Ax(k,j,iii)*z(k)
6112 ! As in the case of ebend, we want to avoid underflows in exponentiation and
6113 ! subsequent NaNs and INFs in energy calculation.
6114 ! Find the largest exponent
6118 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6122 !d print *,'it=',it,' emin=',emin
6124 ! Compute the contribution to SC energy and derivatives
6129 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6130 if(adexp.ne.adexp) adexp=1.0
6133 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6135 !d print *,'j=',j,' expfac=',expfac
6136 escloc_i=escloc_i+expfac
6138 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6142 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) &
6143 +gaussc(k,2,j,it))*expfac
6150 dersc(1)=dersc(1)/cos(theti)**2
6151 ddersc(1)=ddersc(1)/cos(theti)**2
6154 escloci=-(dlog(escloc_i)-emin)
6156 dersc(j)=dersc(j)/escloc_i
6160 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6164 end subroutine enesc
6165 !-----------------------------------------------------------------------------
6166 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6169 ! implicit real*8 (a-h,o-z)
6170 ! include 'DIMENSIONS'
6171 ! include 'COMMON.GEO'
6172 ! include 'COMMON.LOCAL'
6173 ! include 'COMMON.IOUNITS'
6174 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6175 real(kind=8),dimension(3) :: x,z,dersc
6176 real(kind=8),dimension(3,nlobit) :: Ax !(3,maxlob)
6177 real(kind=8),dimension(nlobit) :: contr !(maxlob)
6178 real(kind=8) :: escloci,dersc12,emin
6181 integer :: j,k,l !el,it,nlobit
6182 real(kind=8) :: escloc_i,Axk,expfac !el,time11,time12,time112,theti
6192 z(k)=x(k)-censc(k,j,it)
6198 Axk=Axk+gaussc(l,k,j,it)*z(l)
6204 expfac=expfac+Ax(k,j)*z(k)
6209 ! As in the case of ebend, we want to avoid underflows in exponentiation and
6210 ! subsequent NaNs and INFs in energy calculation.
6211 ! Find the largest exponent
6214 if (emin.gt.contr(j)) emin=contr(j)
6218 ! Compute the contribution to SC energy and derivatives
6222 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6223 escloc_i=escloc_i+expfac
6225 dersc(k)=dersc(k)+Ax(k,j)*expfac
6227 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) &
6228 +gaussc(1,2,j,it))*expfac
6232 dersc(1)=dersc(1)/cos(theti)**2
6233 dersc12=dersc12/cos(theti)**2
6234 escloci=-(dlog(escloc_i)-emin)
6236 dersc(j)=dersc(j)/escloc_i
6238 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6240 end subroutine enesc_bound
6242 !-----------------------------------------------------------------------------
6243 subroutine esc(escloc)
6244 ! Calculate the local energy of a side chain and its derivatives in the
6245 ! corresponding virtual-bond valence angles THETA and the spherical angles
6246 ! ALPHA and OMEGA derived from AM1 all-atom calculations.
6247 ! added by Urszula Kozlowska. 07/11/2007
6250 ! implicit real*8 (a-h,o-z)
6251 ! include 'DIMENSIONS'
6252 ! include 'COMMON.GEO'
6253 ! include 'COMMON.LOCAL'
6254 ! include 'COMMON.VAR'
6255 ! include 'COMMON.SCROT'
6256 ! include 'COMMON.INTERACT'
6257 ! include 'COMMON.DERIV'
6258 ! include 'COMMON.CHAIN'
6259 ! include 'COMMON.IOUNITS'
6260 ! include 'COMMON.NAMES'
6261 ! include 'COMMON.FFIELD'
6262 ! include 'COMMON.CONTROL'
6263 ! include 'COMMON.VECTORS'
6264 real(kind=8),dimension(3) :: x_prime,y_prime,z_prime
6265 real(kind=8),dimension(65) :: x
6266 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1,sumene2,sumene3,&
6267 sumene4,s1,s1_6,s2,s2_6,de_dxx,de_dyy,de_dzz,de_dt
6268 real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
6269 real(kind=8),dimension(3) :: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,dYY_Ci,&
6270 dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
6272 integer :: i,j,k !el,it,nlobit
6273 real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
6274 !el real(kind=8) :: time11,time12,time112,theti
6275 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6276 real(kind=8) :: dscp1,dscp2,pom_s1,pom_s16,pom_s2,pom_s26,&
6277 pom,pom_dx,pom_dy,pom_dt1,pom_dt2,pom1,pom2,&
6278 sumene1x,sumene2x,sumene3x,sumene4x,&
6279 sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,&
6282 real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,&
6283 de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,&
6286 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
6290 do i=loc_start,loc_end
6291 if (itype(i,1).eq.ntyp1) cycle
6292 costtab(i+1) =dcos(theta(i+1))
6293 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6294 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6295 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6296 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6297 cosfac=dsqrt(cosfac2)
6298 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6299 sinfac=dsqrt(sinfac2)
6301 if (it.eq.10) goto 1
6303 ! Compute the axes of tghe local cartesian coordinates system; store in
6304 ! x_prime, y_prime and z_prime
6311 ! write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6312 ! & dc_norm(3,i+nres)
6314 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6315 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6318 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i,1)))
6321 ! write (2,*) "x_prime",(x_prime(j),j=1,3)
6322 ! write (2,*) "y_prime",(y_prime(j),j=1,3)
6323 ! write (2,*) "z_prime",(z_prime(j),j=1,3)
6324 ! write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6325 ! & " xy",scalar(x_prime(1),y_prime(1)),
6326 ! & " xz",scalar(x_prime(1),z_prime(1)),
6327 ! & " yy",scalar(y_prime(1),y_prime(1)),
6328 ! & " yz",scalar(y_prime(1),z_prime(1)),
6329 ! & " zz",scalar(z_prime(1),z_prime(1))
6331 ! Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6332 ! to local coordinate system. Store in xx, yy, zz.
6338 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6339 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6340 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6347 ! Compute the energy of the ith side cbain
6349 ! write (2,*) "xx",xx," yy",yy," zz",zz
6352 x(j) = sc_parmin(j,it)
6355 !c diagnostics - remove later
6357 yy1 = dsin(alph(2))*dcos(omeg(2))
6358 zz1 = -dsign(1.0,dfloat(itype(i,1)))*dsin(alph(2))*dsin(omeg(2))
6359 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
6360 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
6362 !," --- ", xx_w,yy_w,zz_w
6365 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6366 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6368 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6369 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6371 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6372 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6373 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6374 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6375 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6377 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6378 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6379 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6380 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6381 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6383 dsc_i = 0.743d0+x(61)
6385 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6386 *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6387 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6388 *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6389 s1=(1+x(63))/(0.1d0 + dscp1)
6390 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6391 s2=(1+x(65))/(0.1d0 + dscp2)
6392 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6393 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) &
6394 + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6395 ! write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6397 ! & dscp1,dscp2,sumene
6398 ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6399 escloc = escloc + sumene
6400 ! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i,1)
6405 ! This section to check the numerical derivatives of the energy of ith side
6406 ! chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6407 ! #define DEBUG in the code to turn it on.
6409 write (2,*) "sumene =",sumene
6413 write (2,*) xx,yy,zz
6414 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6415 de_dxx_num=(sumenep-sumene)/aincr
6417 write (2,*) "xx+ sumene from enesc=",sumenep
6420 write (2,*) xx,yy,zz
6421 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6422 de_dyy_num=(sumenep-sumene)/aincr
6424 write (2,*) "yy+ sumene from enesc=",sumenep
6427 write (2,*) xx,yy,zz
6428 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6429 de_dzz_num=(sumenep-sumene)/aincr
6431 write (2,*) "zz+ sumene from enesc=",sumenep
6432 costsave=cost2tab(i+1)
6433 sintsave=sint2tab(i+1)
6434 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6435 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6436 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6437 de_dt_num=(sumenep-sumene)/aincr
6438 write (2,*) " t+ sumene from enesc=",sumenep
6439 cost2tab(i+1)=costsave
6440 sint2tab(i+1)=sintsave
6441 ! End of diagnostics section.
6444 ! Compute the gradient of esc
6446 ! zz=zz*dsign(1.0,dfloat(itype(i,1)))
6447 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6448 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6449 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6450 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6451 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6452 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6453 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6454 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6455 pom1=(sumene3*sint2tab(i+1)+sumene1) &
6456 *(pom_s1/dscp1+pom_s16*dscp1**4)
6457 pom2=(sumene4*cost2tab(i+1)+sumene2) &
6458 *(pom_s2/dscp2+pom_s26*dscp2**4)
6459 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6460 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 &
6461 +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) &
6463 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6464 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 &
6465 +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) &
6467 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) &
6468 +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
6471 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i,1)
6474 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6475 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 &
6476 +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) &
6478 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6479 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz &
6480 +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz &
6481 +x(59)*zz**2 +x(60)*xx*zz
6482 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) &
6483 +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
6486 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i,1)
6489 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
6490 +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx &
6491 +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) &
6492 +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) &
6493 +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 &
6494 +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy &
6495 +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
6496 + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6498 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i,1)
6501 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
6502 -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
6503 +pom1*pom_dt1+pom2*pom_dt2
6505 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i,1)
6509 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6510 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6511 cosfac2xx=cosfac2*xx
6512 sinfac2yy=sinfac2*yy
6514 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* &
6516 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* &
6518 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6519 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6520 ! write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6521 ! & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6522 ! write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6523 ! & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6524 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6525 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6526 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6527 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6531 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
6532 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
6533 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
6534 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
6537 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6538 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6539 dZZ_XYZ(k)=vbld_inv(i+nres)* &
6540 (z_prime(k)-zz*dC_norm(k,i+nres))
6542 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6543 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6547 dXX_Ctab(k,i)=dXX_Ci(k)
6548 dXX_C1tab(k,i)=dXX_Ci1(k)
6549 dYY_Ctab(k,i)=dYY_Ci(k)
6550 dYY_C1tab(k,i)=dYY_Ci1(k)
6551 dZZ_Ctab(k,i)=dZZ_Ci(k)
6552 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6553 dXX_XYZtab(k,i)=dXX_XYZ(k)
6554 dYY_XYZtab(k,i)=dYY_XYZ(k)
6555 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6559 ! write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6560 ! & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6561 ! write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6562 ! & dyy_ci(k)," dzz_ci",dzz_ci(k)
6563 ! write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6565 ! write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6566 ! & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6567 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) &
6568 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6569 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) &
6570 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6571 gsclocx(k,i)= de_dxx*dxx_XYZ(k) &
6572 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6574 ! write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6575 ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6577 ! to check gradient call subroutine check_grad
6583 !-----------------------------------------------------------------------------
6584 real(kind=8) function enesc(x,xx,yy,zz,cost2,sint2)
6586 real(kind=8),dimension(65) :: x
6587 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2,sumene3,&
6588 sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6590 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6591 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6593 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6594 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6596 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6597 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6598 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6599 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6600 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6602 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6603 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6604 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6605 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6606 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6608 dsc_i = 0.743d0+x(61)
6610 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6611 *(xx*cost2+yy*sint2))
6612 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6613 *(xx*cost2-yy*sint2))
6614 s1=(1+x(63))/(0.1d0 + dscp1)
6615 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6616 s2=(1+x(65))/(0.1d0 + dscp2)
6617 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6618 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) &
6619 + (sumene4*cost2 +sumene2)*(s2+s2_6)
6624 !-----------------------------------------------------------------------------
6625 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6627 ! This procedure calculates two-body contact function g(rij) and its derivative:
6630 ! g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6633 ! where x=(rij-r0ij)/delta
6635 ! rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6638 real(kind=8) :: rij,r0ij,eps0ij,fcont,fprimcont
6639 real(kind=8) :: x,x2,x4,delta
6643 if (x.lt.-1.0D0) then
6646 else if (x.le.1.0D0) then
6649 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6650 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6656 end subroutine gcont
6657 !-----------------------------------------------------------------------------
6658 subroutine splinthet(theti,delta,ss,ssder)
6659 ! implicit real*8 (a-h,o-z)
6660 ! include 'DIMENSIONS'
6661 ! include 'COMMON.VAR'
6662 ! include 'COMMON.GEO'
6663 real(kind=8) :: theti,delta,ss,ssder
6664 real(kind=8) :: thetup,thetlow
6667 if (theti.gt.pipol) then
6668 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6670 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6674 end subroutine splinthet
6675 !-----------------------------------------------------------------------------
6676 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6678 real(kind=8) :: x,x0,delta,f0,f1,fprim0,f,fprim
6679 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6680 a1=fprim0*delta/(f1-f0)
6686 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6687 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6689 end subroutine spline1
6690 !-----------------------------------------------------------------------------
6691 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6693 real(kind=8) :: x,x0,delta,f0x,f1x,fprim0x,fx
6694 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6699 a2=3*(f1x-f0x)-2*fprim0x*delta
6700 a3=fprim0x*delta-2*(f1x-f0x)
6701 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6703 end subroutine spline2
6704 !-----------------------------------------------------------------------------
6706 !-----------------------------------------------------------------------------
6707 subroutine etor(etors,edihcnstr)
6708 ! implicit real*8 (a-h,o-z)
6709 ! include 'DIMENSIONS'
6710 ! include 'COMMON.VAR'
6711 ! include 'COMMON.GEO'
6712 ! include 'COMMON.LOCAL'
6713 ! include 'COMMON.TORSION'
6714 ! include 'COMMON.INTERACT'
6715 ! include 'COMMON.DERIV'
6716 ! include 'COMMON.CHAIN'
6717 ! include 'COMMON.NAMES'
6718 ! include 'COMMON.IOUNITS'
6719 ! include 'COMMON.FFIELD'
6720 ! include 'COMMON.TORCNSTR'
6721 ! include 'COMMON.CONTROL'
6722 real(kind=8) :: etors,edihcnstr
6726 real(kind=8) :: phii,fac,etors_ii
6728 ! Set lprn=.true. for debugging
6732 do i=iphi_start,iphi_end
6734 if (itype(i-2,1).eq.ntyp1.or. itype(i-1,1).eq.ntyp1 &
6735 .or. itype(i,1).eq.ntyp1) cycle
6736 itori=itortyp(itype(i-2,1))
6737 itori1=itortyp(itype(i-1,1))
6740 ! Proline-Proline pair is a special case...
6741 if (itori.eq.3 .and. itori1.eq.3) then
6742 if (phii.gt.-dwapi3) then
6744 fac=1.0D0/(1.0D0-cosphi)
6745 etorsi=v1(1,3,3)*fac
6746 etorsi=etorsi+etorsi
6747 etors=etors+etorsi-v1(1,3,3)
6748 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6749 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6752 v1ij=v1(j+1,itori,itori1)
6753 v2ij=v2(j+1,itori,itori1)
6756 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6757 if (energy_dec) etors_ii=etors_ii+ &
6758 v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6759 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6763 v1ij=v1(j,itori,itori1)
6764 v2ij=v2(j,itori,itori1)
6767 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6768 if (energy_dec) etors_ii=etors_ii+ &
6769 v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6770 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6773 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6776 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6777 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
6778 (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6779 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6780 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6782 ! 6/20/98 - dihedral angle constraints
6785 itori=idih_constr(i)
6788 if (difi.gt.drange(i)) then
6790 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6791 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6792 else if (difi.lt.-drange(i)) then
6794 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6795 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6797 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6798 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6800 ! write (iout,*) 'edihcnstr',edihcnstr
6803 !-----------------------------------------------------------------------------
6804 subroutine etor_d(etors_d)
6805 real(kind=8) :: etors_d
6808 end subroutine etor_d
6810 !-----------------------------------------------------------------------------
6811 subroutine etor(etors,edihcnstr)
6812 ! implicit real*8 (a-h,o-z)
6813 ! include 'DIMENSIONS'
6814 ! include 'COMMON.VAR'
6815 ! include 'COMMON.GEO'
6816 ! include 'COMMON.LOCAL'
6817 ! include 'COMMON.TORSION'
6818 ! include 'COMMON.INTERACT'
6819 ! include 'COMMON.DERIV'
6820 ! include 'COMMON.CHAIN'
6821 ! include 'COMMON.NAMES'
6822 ! include 'COMMON.IOUNITS'
6823 ! include 'COMMON.FFIELD'
6824 ! include 'COMMON.TORCNSTR'
6825 ! include 'COMMON.CONTROL'
6826 real(kind=8) :: etors,edihcnstr
6829 integer :: i,j,iblock,itori,itori1
6830 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
6831 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
6832 ! Set lprn=.true. for debugging
6836 do i=iphi_start,iphi_end
6837 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
6838 .or. itype(i-3,1).eq.ntyp1 &
6839 .or. itype(i,1).eq.ntyp1) cycle
6841 if (iabs(itype(i,1)).eq.20) then
6846 itori=itortyp(itype(i-2,1))
6847 itori1=itortyp(itype(i-1,1))
6850 ! Regular cosine and sine terms
6851 do j=1,nterm(itori,itori1,iblock)
6852 v1ij=v1(j,itori,itori1,iblock)
6853 v2ij=v2(j,itori,itori1,iblock)
6856 etors=etors+v1ij*cosphi+v2ij*sinphi
6857 if (energy_dec) etors_ii=etors_ii+ &
6858 v1ij*cosphi+v2ij*sinphi
6859 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6863 ! E = SUM ----------------------------------- - v1
6864 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6866 cosphi=dcos(0.5d0*phii)
6867 sinphi=dsin(0.5d0*phii)
6868 do j=1,nlor(itori,itori1,iblock)
6869 vl1ij=vlor1(j,itori,itori1)
6870 vl2ij=vlor2(j,itori,itori1)
6871 vl3ij=vlor3(j,itori,itori1)
6872 pom=vl2ij*cosphi+vl3ij*sinphi
6873 pom1=1.0d0/(pom*pom+1.0d0)
6874 etors=etors+vl1ij*pom1
6875 if (energy_dec) etors_ii=etors_ii+ &
6878 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6880 ! Subtract the constant term
6881 etors=etors-v0(itori,itori1,iblock)
6882 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6883 'etor',i,etors_ii-v0(itori,itori1,iblock)
6885 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6886 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
6887 (v1(j,itori,itori1,iblock),j=1,6),&
6888 (v2(j,itori,itori1,iblock),j=1,6)
6889 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6890 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6892 ! 6/20/98 - dihedral angle constraints
6894 ! do i=1,ndih_constr
6895 do i=idihconstr_start,idihconstr_end
6896 itori=idih_constr(i)
6898 difi=pinorm(phii-phi0(i))
6899 if (difi.gt.drange(i)) then
6901 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6902 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6903 else if (difi.lt.-drange(i)) then
6905 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6906 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6910 !d write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6911 !d & rad2deg*phi0(i), rad2deg*drange(i),
6912 !d & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6914 !d write (iout,*) 'edihcnstr',edihcnstr
6917 !-----------------------------------------------------------------------------
6918 subroutine etor_d(etors_d)
6919 ! 6/23/01 Compute double torsional energy
6920 ! implicit real*8 (a-h,o-z)
6921 ! include 'DIMENSIONS'
6922 ! include 'COMMON.VAR'
6923 ! include 'COMMON.GEO'
6924 ! include 'COMMON.LOCAL'
6925 ! include 'COMMON.TORSION'
6926 ! include 'COMMON.INTERACT'
6927 ! include 'COMMON.DERIV'
6928 ! include 'COMMON.CHAIN'
6929 ! include 'COMMON.NAMES'
6930 ! include 'COMMON.IOUNITS'
6931 ! include 'COMMON.FFIELD'
6932 ! include 'COMMON.TORCNSTR'
6933 real(kind=8) :: etors_d,etors_d_ii
6936 integer :: i,j,k,l,itori,itori1,itori2,iblock
6937 real(kind=8) :: phii,phii1,gloci1,gloci2,&
6938 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
6939 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
6940 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
6941 ! Set lprn=.true. for debugging
6945 ! write(iout,*) "a tu??"
6946 do i=iphid_start,iphid_end
6948 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
6949 .or. itype(i-3,1).eq.ntyp1 &
6950 .or. itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
6951 itori=itortyp(itype(i-2,1))
6952 itori1=itortyp(itype(i-1,1))
6953 itori2=itortyp(itype(i,1))
6959 if (iabs(itype(i+1,1)).eq.20) iblock=2
6961 ! Regular cosine and sine terms
6962 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6963 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6964 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6965 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6966 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6967 cosphi1=dcos(j*phii)
6968 sinphi1=dsin(j*phii)
6969 cosphi2=dcos(j*phii1)
6970 sinphi2=dsin(j*phii1)
6971 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
6972 v2cij*cosphi2+v2sij*sinphi2
6973 if (energy_dec) etors_d_ii=etors_d_ii+ &
6974 v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
6975 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6976 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6978 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6980 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6981 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6982 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6983 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6984 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6985 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6986 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6987 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6988 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
6989 v1sdij*sinphi1p2+v2sdij*sinphi1m2
6990 if (energy_dec) etors_d_ii=etors_d_ii+ &
6991 v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
6992 v1sdij*sinphi1p2+v2sdij*sinphi1m2
6993 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
6994 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6995 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
6996 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6999 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
7000 'etor_d',i,etors_d_ii
7001 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7002 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7005 end subroutine etor_d
7007 !-----------------------------------------------------------------------------
7008 subroutine eback_sc_corr(esccor)
7009 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
7010 ! conformational states; temporarily implemented as differences
7011 ! between UNRES torsional potentials (dependent on three types of
7012 ! residues) and the torsional potentials dependent on all 20 types
7013 ! of residues computed from AM1 energy surfaces of terminally-blocked
7014 ! amino-acid residues.
7015 ! implicit real*8 (a-h,o-z)
7016 ! include 'DIMENSIONS'
7017 ! include 'COMMON.VAR'
7018 ! include 'COMMON.GEO'
7019 ! include 'COMMON.LOCAL'
7020 ! include 'COMMON.TORSION'
7021 ! include 'COMMON.SCCOR'
7022 ! include 'COMMON.INTERACT'
7023 ! include 'COMMON.DERIV'
7024 ! include 'COMMON.CHAIN'
7025 ! include 'COMMON.NAMES'
7026 ! include 'COMMON.IOUNITS'
7027 ! include 'COMMON.FFIELD'
7028 ! include 'COMMON.CONTROL'
7029 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
7032 integer :: i,interty,j,isccori,isccori1,intertyp
7033 ! Set lprn=.true. for debugging
7036 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7038 do i=itau_start,itau_end
7039 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1)) cycle
7041 isccori=isccortyp(itype(i-2,1))
7042 isccori1=isccortyp(itype(i-1,1))
7044 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7046 do intertyp=1,3 !intertyp
7048 !c Added 09 May 2012 (Adasko)
7049 !c Intertyp means interaction type of backbone mainchain correlation:
7050 ! 1 = SC...Ca...Ca...Ca
7051 ! 2 = Ca...Ca...Ca...SC
7052 ! 3 = SC...Ca...Ca...SCi
7054 if (((intertyp.eq.3).and.((itype(i-2,1).eq.10).or. &
7055 (itype(i-1,1).eq.10).or.(itype(i-2,1).eq.ntyp1).or. &
7056 (itype(i-1,1).eq.ntyp1))) &
7057 .or. ((intertyp.eq.1).and.((itype(i-2,1).eq.10) &
7058 .or.(itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1) &
7059 .or.(itype(i,1).eq.ntyp1))) &
7060 .or.((intertyp.eq.2).and.((itype(i-1,1).eq.10).or. &
7061 (itype(i-1,1).eq.ntyp1).or.(itype(i-2,1).eq.ntyp1).or. &
7062 (itype(i-3,1).eq.ntyp1)))) cycle
7063 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1,1).eq.ntyp1)) cycle
7064 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres,1).eq.ntyp1)) &
7066 do j=1,nterm_sccor(isccori,isccori1)
7067 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7068 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7069 cosphi=dcos(j*tauangle(intertyp,i))
7070 sinphi=dsin(j*tauangle(intertyp,i))
7071 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
7072 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7073 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7075 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
7076 'esccor',i,intertyp,esccor_ii
7077 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7078 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7080 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
7081 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,isccori,isccori1,&
7082 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
7083 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7084 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7089 end subroutine eback_sc_corr
7090 !-----------------------------------------------------------------------------
7091 subroutine multibody(ecorr)
7092 ! This subroutine calculates multi-body contributions to energy following
7093 ! the idea of Skolnick et al. If side chains I and J make a contact and
7094 ! at the same time side chains I+1 and J+1 make a contact, an extra
7095 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7096 ! implicit real*8 (a-h,o-z)
7097 ! include 'DIMENSIONS'
7098 ! include 'COMMON.IOUNITS'
7099 ! include 'COMMON.DERIV'
7100 ! include 'COMMON.INTERACT'
7101 ! include 'COMMON.CONTACTS'
7102 real(kind=8),dimension(3) :: gx,gx1
7104 real(kind=8) :: ecorr
7105 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
7106 ! Set lprn=.true. for debugging
7110 write (iout,'(a)') 'Contact function values:'
7112 write (iout,'(i2,20(1x,i2,f10.5))') &
7113 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7118 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7119 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7131 num_conti=num_cont(i)
7132 num_conti1=num_cont(i1)
7137 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7138 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7139 !d & ' ishift=',ishift
7140 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7141 ! The system gains extra energy.
7142 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7143 endif ! j1==j+-ishift
7151 end subroutine multibody
7152 !-----------------------------------------------------------------------------
7153 real(kind=8) function esccorr(i,j,k,l,jj,kk)
7154 ! implicit real*8 (a-h,o-z)
7155 ! include 'DIMENSIONS'
7156 ! include 'COMMON.IOUNITS'
7157 ! include 'COMMON.DERIV'
7158 ! include 'COMMON.INTERACT'
7159 ! include 'COMMON.CONTACTS'
7160 real(kind=8),dimension(3) :: gx,gx1
7162 integer :: i,j,k,l,jj,kk,m,ll
7163 real(kind=8) :: eij,ekl
7167 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7168 ! Calculate the multi-body contribution to energy.
7169 ! Calculate multi-body contributions to the gradient.
7170 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7171 !d & k,l,(gacont(m,kk,k),m=1,3)
7173 gx(m) =ekl*gacont(m,jj,i)
7174 gx1(m)=eij*gacont(m,kk,k)
7175 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7176 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7177 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7178 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7182 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7187 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7192 end function esccorr
7193 !-----------------------------------------------------------------------------
7194 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7195 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7196 ! implicit real*8 (a-h,o-z)
7197 ! include 'DIMENSIONS'
7198 ! include 'COMMON.IOUNITS'
7201 ! integer :: maxconts !max_cont=maxconts =nres/4
7202 integer,parameter :: max_dim=26
7203 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7204 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7205 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7206 !el common /przechowalnia/ zapas
7207 integer :: status(MPI_STATUS_SIZE)
7208 integer,dimension((nres/4)*2) :: req !maxconts*2
7209 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
7211 ! include 'COMMON.SETUP'
7212 ! include 'COMMON.FFIELD'
7213 ! include 'COMMON.DERIV'
7214 ! include 'COMMON.INTERACT'
7215 ! include 'COMMON.CONTACTS'
7216 ! include 'COMMON.CONTROL'
7217 ! include 'COMMON.LOCAL'
7218 real(kind=8),dimension(3) :: gx,gx1
7219 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
7220 logical :: lprn,ldone
7222 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
7223 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
7225 ! Set lprn=.true. for debugging
7229 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7232 if (nfgtasks.le.1) goto 30
7234 write (iout,'(a)') 'Contact function values before RECEIVE:'
7236 write (iout,'(2i3,50(1x,i2,f5.2))') &
7237 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7242 do i=1,ntask_cont_from
7245 do i=1,ntask_cont_to
7248 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7250 ! Make the list of contacts to send to send to other procesors
7251 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7253 do i=iturn3_start,iturn3_end
7254 ! write (iout,*) "make contact list turn3",i," num_cont",
7256 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7258 do i=iturn4_start,iturn4_end
7259 ! write (iout,*) "make contact list turn4",i," num_cont",
7261 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7265 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7267 do j=1,num_cont_hb(i)
7270 iproc=iint_sent_local(k,jjc,ii)
7271 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7272 if (iproc.gt.0) then
7273 ncont_sent(iproc)=ncont_sent(iproc)+1
7274 nn=ncont_sent(iproc)
7276 zapas(2,nn,iproc)=jjc
7277 zapas(3,nn,iproc)=facont_hb(j,i)
7278 zapas(4,nn,iproc)=ees0p(j,i)
7279 zapas(5,nn,iproc)=ees0m(j,i)
7280 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7281 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7282 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7283 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7284 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7285 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7286 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7287 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7288 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7289 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7290 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7291 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7292 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7293 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7294 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7295 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7296 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7297 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7298 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7299 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7300 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7307 "Numbers of contacts to be sent to other processors",&
7308 (ncont_sent(i),i=1,ntask_cont_to)
7309 write (iout,*) "Contacts sent"
7310 do ii=1,ntask_cont_to
7312 iproc=itask_cont_to(ii)
7313 write (iout,*) nn," contacts to processor",iproc,&
7314 " of CONT_TO_COMM group"
7316 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7324 CorrelID1=nfgtasks+fg_rank+1
7326 ! Receive the numbers of needed contacts from other processors
7327 do ii=1,ntask_cont_from
7328 iproc=itask_cont_from(ii)
7330 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7331 FG_COMM,req(ireq),IERR)
7333 ! write (iout,*) "IRECV ended"
7335 ! Send the number of contacts needed by other processors
7336 do ii=1,ntask_cont_to
7337 iproc=itask_cont_to(ii)
7339 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7340 FG_COMM,req(ireq),IERR)
7342 ! write (iout,*) "ISEND ended"
7343 ! write (iout,*) "number of requests (nn)",ireq
7346 call MPI_Waitall(ireq,req,status_array,ierr)
7348 ! & "Numbers of contacts to be received from other processors",
7349 ! & (ncont_recv(i),i=1,ntask_cont_from)
7353 do ii=1,ntask_cont_from
7354 iproc=itask_cont_from(ii)
7356 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7357 ! & " of CONT_TO_COMM group"
7361 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7362 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7363 ! write (iout,*) "ireq,req",ireq,req(ireq)
7366 ! Send the contacts to processors that need them
7367 do ii=1,ntask_cont_to
7368 iproc=itask_cont_to(ii)
7370 ! write (iout,*) nn," contacts to processor",iproc,
7371 ! & " of CONT_TO_COMM group"
7374 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7375 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7376 ! write (iout,*) "ireq,req",ireq,req(ireq)
7378 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7382 ! write (iout,*) "number of requests (contacts)",ireq
7383 ! write (iout,*) "req",(req(i),i=1,4)
7386 call MPI_Waitall(ireq,req,status_array,ierr)
7387 do iii=1,ntask_cont_from
7388 iproc=itask_cont_from(iii)
7391 write (iout,*) "Received",nn," contacts from processor",iproc,&
7392 " of CONT_FROM_COMM group"
7395 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7400 ii=zapas_recv(1,i,iii)
7401 ! Flag the received contacts to prevent double-counting
7402 jj=-zapas_recv(2,i,iii)
7403 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7405 nnn=num_cont_hb(ii)+1
7408 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7409 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7410 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7411 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7412 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7413 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7414 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7415 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7416 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7417 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7418 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7419 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7420 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7421 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7422 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7423 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7424 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7425 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7426 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7427 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7428 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7429 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7430 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7431 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7436 write (iout,'(a)') 'Contact function values after receive:'
7438 write (iout,'(2i3,50(1x,i3,f5.2))') &
7439 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7447 write (iout,'(a)') 'Contact function values:'
7449 write (iout,'(2i3,50(1x,i3,f5.2))') &
7450 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7456 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7457 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7458 ! Remove the loop below after debugging !!!
7465 ! Calculate the local-electrostatic correlation terms
7466 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7468 num_conti=num_cont_hb(i)
7469 num_conti1=num_cont_hb(i+1)
7476 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
7477 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
7478 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7479 .or. j.lt.0 .and. j1.gt.0) .and. &
7480 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7481 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7482 ! The system gains extra energy.
7483 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7484 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
7485 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7487 else if (j1.eq.j) then
7488 ! Contacts I-J and I-(J+1) occur simultaneously.
7489 ! The system loses extra energy.
7490 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7495 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7496 ! & ' jj=',jj,' kk=',kk
7498 ! Contacts I-J and (I+1)-J occur simultaneously.
7499 ! The system loses extra energy.
7500 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7506 end subroutine multibody_hb
7507 !-----------------------------------------------------------------------------
7508 subroutine add_hb_contact(ii,jj,itask)
7509 ! implicit real*8 (a-h,o-z)
7510 ! include "DIMENSIONS"
7511 ! include "COMMON.IOUNITS"
7512 ! include "COMMON.CONTACTS"
7513 ! integer,parameter :: maxconts=nres/4
7514 integer,parameter :: max_dim=26
7515 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7516 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7517 ! common /przechowalnia/ zapas
7518 integer :: i,j,ii,jj,iproc,nn,jjc
7519 integer,dimension(4) :: itask
7520 ! write (iout,*) "itask",itask
7523 if (iproc.gt.0) then
7524 do j=1,num_cont_hb(ii)
7526 ! write (iout,*) "i",ii," j",jj," jjc",jjc
7528 ncont_sent(iproc)=ncont_sent(iproc)+1
7529 nn=ncont_sent(iproc)
7530 zapas(1,nn,iproc)=ii
7531 zapas(2,nn,iproc)=jjc
7532 zapas(3,nn,iproc)=facont_hb(j,ii)
7533 zapas(4,nn,iproc)=ees0p(j,ii)
7534 zapas(5,nn,iproc)=ees0m(j,ii)
7535 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7536 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7537 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7538 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7539 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7540 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7541 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7542 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7543 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7544 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7545 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7546 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7547 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7548 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7549 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7550 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7551 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7552 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7553 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7554 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7555 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7562 end subroutine add_hb_contact
7563 !-----------------------------------------------------------------------------
7564 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
7565 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7566 ! implicit real*8 (a-h,o-z)
7567 ! include 'DIMENSIONS'
7568 ! include 'COMMON.IOUNITS'
7569 integer,parameter :: max_dim=70
7572 ! integer :: maxconts !max_cont=maxconts=nres/4
7573 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7574 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7575 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7576 ! common /przechowalnia/ zapas
7577 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
7578 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
7581 ! include 'COMMON.SETUP'
7582 ! include 'COMMON.FFIELD'
7583 ! include 'COMMON.DERIV'
7584 ! include 'COMMON.LOCAL'
7585 ! include 'COMMON.INTERACT'
7586 ! include 'COMMON.CONTACTS'
7587 ! include 'COMMON.CHAIN'
7588 ! include 'COMMON.CONTROL'
7589 real(kind=8),dimension(3) :: gx,gx1
7590 integer,dimension(nres) :: num_cont_hb_old
7591 logical :: lprn,ldone
7592 !EL double precision eello4,eello5,eelo6,eello_turn6
7593 !EL external eello4,eello5,eello6,eello_turn6
7595 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
7596 j1,jp1,i1,num_conti1
7597 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
7598 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
7600 ! Set lprn=.true. for debugging
7605 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7607 num_cont_hb_old(i)=num_cont_hb(i)
7611 if (nfgtasks.le.1) goto 30
7613 write (iout,'(a)') 'Contact function values before RECEIVE:'
7615 write (iout,'(2i3,50(1x,i2,f5.2))') &
7616 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7621 do i=1,ntask_cont_from
7624 do i=1,ntask_cont_to
7627 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7629 ! Make the list of contacts to send to send to other procesors
7630 do i=iturn3_start,iturn3_end
7631 ! write (iout,*) "make contact list turn3",i," num_cont",
7633 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7635 do i=iturn4_start,iturn4_end
7636 ! write (iout,*) "make contact list turn4",i," num_cont",
7638 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7642 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7644 do j=1,num_cont_hb(i)
7647 iproc=iint_sent_local(k,jjc,ii)
7648 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7649 if (iproc.ne.0) then
7650 ncont_sent(iproc)=ncont_sent(iproc)+1
7651 nn=ncont_sent(iproc)
7653 zapas(2,nn,iproc)=jjc
7654 zapas(3,nn,iproc)=d_cont(j,i)
7658 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7663 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7671 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7682 "Numbers of contacts to be sent to other processors",&
7683 (ncont_sent(i),i=1,ntask_cont_to)
7684 write (iout,*) "Contacts sent"
7685 do ii=1,ntask_cont_to
7687 iproc=itask_cont_to(ii)
7688 write (iout,*) nn," contacts to processor",iproc,&
7689 " of CONT_TO_COMM group"
7691 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7699 CorrelID1=nfgtasks+fg_rank+1
7701 ! Receive the numbers of needed contacts from other processors
7702 do ii=1,ntask_cont_from
7703 iproc=itask_cont_from(ii)
7705 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7706 FG_COMM,req(ireq),IERR)
7708 ! write (iout,*) "IRECV ended"
7710 ! Send the number of contacts needed by other processors
7711 do ii=1,ntask_cont_to
7712 iproc=itask_cont_to(ii)
7714 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7715 FG_COMM,req(ireq),IERR)
7717 ! write (iout,*) "ISEND ended"
7718 ! write (iout,*) "number of requests (nn)",ireq
7721 call MPI_Waitall(ireq,req,status_array,ierr)
7723 ! & "Numbers of contacts to be received from other processors",
7724 ! & (ncont_recv(i),i=1,ntask_cont_from)
7728 do ii=1,ntask_cont_from
7729 iproc=itask_cont_from(ii)
7731 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7732 ! & " of CONT_TO_COMM group"
7736 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7737 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7738 ! write (iout,*) "ireq,req",ireq,req(ireq)
7741 ! Send the contacts to processors that need them
7742 do ii=1,ntask_cont_to
7743 iproc=itask_cont_to(ii)
7745 ! write (iout,*) nn," contacts to processor",iproc,
7746 ! & " of CONT_TO_COMM group"
7749 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7750 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7751 ! write (iout,*) "ireq,req",ireq,req(ireq)
7753 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7757 ! write (iout,*) "number of requests (contacts)",ireq
7758 ! write (iout,*) "req",(req(i),i=1,4)
7761 call MPI_Waitall(ireq,req,status_array,ierr)
7762 do iii=1,ntask_cont_from
7763 iproc=itask_cont_from(iii)
7766 write (iout,*) "Received",nn," contacts from processor",iproc,&
7767 " of CONT_FROM_COMM group"
7770 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7775 ii=zapas_recv(1,i,iii)
7776 ! Flag the received contacts to prevent double-counting
7777 jj=-zapas_recv(2,i,iii)
7778 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7780 nnn=num_cont_hb(ii)+1
7783 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7787 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7792 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7800 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7809 write (iout,'(a)') 'Contact function values after receive:'
7811 write (iout,'(2i3,50(1x,i3,5f6.3))') &
7812 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
7813 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7820 write (iout,'(a)') 'Contact function values:'
7822 write (iout,'(2i3,50(1x,i2,5f6.3))') &
7823 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
7824 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7831 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7832 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7833 ! Remove the loop below after debugging !!!
7840 ! Calculate the dipole-dipole interaction energies
7841 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7842 do i=iatel_s,iatel_e+1
7843 num_conti=num_cont_hb(i)
7852 ! Calculate the local-electrostatic correlation terms
7853 ! write (iout,*) "gradcorr5 in eello5 before loop"
7855 ! write (iout,'(i5,3f10.5)')
7856 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7858 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7859 ! write (iout,*) "corr loop i",i
7861 num_conti=num_cont_hb(i)
7862 num_conti1=num_cont_hb(i+1)
7869 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7870 ! & ' jj=',jj,' kk=',kk
7871 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
7872 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7873 .or. j.lt.0 .and. j1.gt.0) .and. &
7874 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7875 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7876 ! The system gains extra energy.
7878 sqd1=dsqrt(d_cont(jj,i))
7879 sqd2=dsqrt(d_cont(kk,i1))
7880 sred_geom = sqd1*sqd2
7881 IF (sred_geom.lt.cutoff_corr) THEN
7882 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
7884 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7885 !d & ' jj=',jj,' kk=',kk
7886 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7887 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7889 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7890 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7893 !d write (iout,*) 'sred_geom=',sred_geom,
7894 !d & ' ekont=',ekont,' fprim=',fprimcont,
7895 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7896 !d write (iout,*) "g_contij",g_contij
7897 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7898 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7899 call calc_eello(i,jp,i+1,jp1,jj,kk)
7900 if (wcorr4.gt.0.0d0) &
7901 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7902 if (energy_dec.and.wcorr4.gt.0.0d0) &
7903 write (iout,'(a6,4i5,0pf7.3)') &
7904 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7905 ! write (iout,*) "gradcorr5 before eello5"
7907 ! write (iout,'(i5,3f10.5)')
7908 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7910 if (wcorr5.gt.0.0d0) &
7911 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7912 ! write (iout,*) "gradcorr5 after eello5"
7914 ! write (iout,'(i5,3f10.5)')
7915 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7917 if (energy_dec.and.wcorr5.gt.0.0d0) &
7918 write (iout,'(a6,4i5,0pf7.3)') &
7919 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7920 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7921 !d write(2,*)'ijkl',i,jp,i+1,jp1
7922 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
7923 .or. wturn6.eq.0.0d0))then
7924 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7925 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7926 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
7927 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7928 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7929 !d & 'ecorr6=',ecorr6
7930 !d write (iout,'(4e15.5)') sred_geom,
7931 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7932 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7933 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7934 else if (wturn6.gt.0.0d0 &
7935 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7936 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7937 eturn6=eturn6+eello_turn6(i,jj,kk)
7938 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
7939 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7940 !d write (2,*) 'multibody_eello:eturn6',eturn6
7949 num_cont_hb(i)=num_cont_hb_old(i)
7951 ! write (iout,*) "gradcorr5 in eello5"
7953 ! write (iout,'(i5,3f10.5)')
7954 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7957 end subroutine multibody_eello
7958 !-----------------------------------------------------------------------------
7959 subroutine add_hb_contact_eello(ii,jj,itask)
7960 ! implicit real*8 (a-h,o-z)
7961 ! include "DIMENSIONS"
7962 ! include "COMMON.IOUNITS"
7963 ! include "COMMON.CONTACTS"
7964 ! integer,parameter :: maxconts=nres/4
7965 integer,parameter :: max_dim=70
7966 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7967 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7968 ! common /przechowalnia/ zapas
7970 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
7971 integer,dimension(4) ::itask
7972 ! write (iout,*) "itask",itask
7975 if (iproc.gt.0) then
7976 do j=1,num_cont_hb(ii)
7978 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7980 ncont_sent(iproc)=ncont_sent(iproc)+1
7981 nn=ncont_sent(iproc)
7982 zapas(1,nn,iproc)=ii
7983 zapas(2,nn,iproc)=jjc
7984 zapas(3,nn,iproc)=d_cont(j,ii)
7988 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7993 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8001 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8012 end subroutine add_hb_contact_eello
8013 !-----------------------------------------------------------------------------
8014 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8015 ! implicit real*8 (a-h,o-z)
8016 ! include 'DIMENSIONS'
8017 ! include 'COMMON.IOUNITS'
8018 ! include 'COMMON.DERIV'
8019 ! include 'COMMON.INTERACT'
8020 ! include 'COMMON.CONTACTS'
8021 real(kind=8),dimension(3) :: gx,gx1
8024 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
8025 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
8026 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
8027 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
8038 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8039 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8040 ! Following 4 lines for diagnostics.
8045 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8046 ! & 'Contacts ',i,j,
8047 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8048 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8050 ! Calculate the multi-body contribution to energy.
8051 ! ecorr=ecorr+ekont*ees
8052 ! Calculate multi-body contributions to the gradient.
8053 coeffpees0pij=coeffp*ees0pij
8054 coeffmees0mij=coeffm*ees0mij
8055 coeffpees0pkl=coeffp*ees0pkl
8056 coeffmees0mkl=coeffm*ees0mkl
8058 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8059 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
8060 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
8061 coeffmees0mkl*gacontm_hb1(ll,jj,i))
8062 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
8063 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
8064 coeffmees0mkl*gacontm_hb2(ll,jj,i))
8065 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8066 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
8067 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
8068 coeffmees0mij*gacontm_hb1(ll,kk,k))
8069 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
8070 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
8071 coeffmees0mij*gacontm_hb2(ll,kk,k))
8072 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
8073 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
8074 coeffmees0mkl*gacontm_hb3(ll,jj,i))
8075 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8076 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8077 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
8078 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
8079 coeffmees0mij*gacontm_hb3(ll,kk,k))
8080 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8081 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8082 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8087 !grad gradcorr(ll,m)=gradcorr(ll,m)+
8088 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
8089 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8090 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8095 !grad gradcorr(ll,m)=gradcorr(ll,m)+
8096 !grad & ees*eij*gacont_hbr(ll,kk,k)-
8097 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8098 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8101 ! write (iout,*) "ehbcorr",ekont*ees
8103 if (shield_mode.gt.0) then
8106 !C print *,i,j,fac_shield(i),fac_shield(j),
8107 !C &fac_shield(k),fac_shield(l)
8108 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
8109 (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
8110 do ilist=1,ishield_list(i)
8111 iresshield=shield_list(ilist,i)
8113 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
8114 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8116 +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
8117 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8121 do ilist=1,ishield_list(j)
8122 iresshield=shield_list(ilist,j)
8124 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
8125 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8127 +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
8128 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8133 do ilist=1,ishield_list(k)
8134 iresshield=shield_list(ilist,k)
8136 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
8137 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8139 +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
8140 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8144 do ilist=1,ishield_list(l)
8145 iresshield=shield_list(ilist,l)
8147 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
8148 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8150 +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
8151 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8156 gshieldc_ec(m,i)=gshieldc_ec(m,i)+ &
8157 grad_shield(m,i)*ehbcorr/fac_shield(i)
8158 gshieldc_ec(m,j)=gshieldc_ec(m,j)+ &
8159 grad_shield(m,j)*ehbcorr/fac_shield(j)
8160 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ &
8161 grad_shield(m,i)*ehbcorr/fac_shield(i)
8162 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ &
8163 grad_shield(m,j)*ehbcorr/fac_shield(j)
8165 gshieldc_ec(m,k)=gshieldc_ec(m,k)+ &
8166 grad_shield(m,k)*ehbcorr/fac_shield(k)
8167 gshieldc_ec(m,l)=gshieldc_ec(m,l)+ &
8168 grad_shield(m,l)*ehbcorr/fac_shield(l)
8169 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ &
8170 grad_shield(m,k)*ehbcorr/fac_shield(k)
8171 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ &
8172 grad_shield(m,l)*ehbcorr/fac_shield(l)
8178 end function ehbcorr
8180 !-----------------------------------------------------------------------------
8181 subroutine dipole(i,j,jj)
8182 ! implicit real*8 (a-h,o-z)
8183 ! include 'DIMENSIONS'
8184 ! include 'COMMON.IOUNITS'
8185 ! include 'COMMON.CHAIN'
8186 ! include 'COMMON.FFIELD'
8187 ! include 'COMMON.DERIV'
8188 ! include 'COMMON.INTERACT'
8189 ! include 'COMMON.CONTACTS'
8190 ! include 'COMMON.TORSION'
8191 ! include 'COMMON.VAR'
8192 ! include 'COMMON.GEO'
8193 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
8194 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
8195 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
8197 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
8198 allocate(dipderx(3,5,4,maxconts,nres))
8201 iti1 = itortyp(itype(i+1,1))
8202 if (j.lt.nres-1) then
8203 itj1 = itortyp(itype(j+1,1))
8208 dipi(iii,1)=Ub2(iii,i)
8209 dipderi(iii)=Ub2der(iii,i)
8210 dipi(iii,2)=b1(iii,iti1)
8211 dipj(iii,1)=Ub2(iii,j)
8212 dipderj(iii)=Ub2der(iii,j)
8213 dipj(iii,2)=b1(iii,itj1)
8217 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8220 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8227 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
8231 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8236 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8237 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8239 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8241 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8243 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8246 end subroutine dipole
8248 !-----------------------------------------------------------------------------
8249 subroutine calc_eello(i,j,k,l,jj,kk)
8251 ! This subroutine computes matrices and vectors needed to calculate
8252 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
8255 ! implicit real*8 (a-h,o-z)
8256 ! include 'DIMENSIONS'
8257 ! include 'COMMON.IOUNITS'
8258 ! include 'COMMON.CHAIN'
8259 ! include 'COMMON.DERIV'
8260 ! include 'COMMON.INTERACT'
8261 ! include 'COMMON.CONTACTS'
8262 ! include 'COMMON.TORSION'
8263 ! include 'COMMON.VAR'
8264 ! include 'COMMON.GEO'
8265 ! include 'COMMON.FFIELD'
8266 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
8267 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
8268 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
8271 !el common /kutas/ lprn
8272 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8273 !d & ' jj=',jj,' kk=',kk
8274 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8275 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8276 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8279 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8280 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8283 call transpose2(aa1(1,1),aa1t(1,1))
8284 call transpose2(aa2(1,1),aa2t(1,1))
8287 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
8288 aa1tder(1,1,lll,kkk))
8289 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
8290 aa2tder(1,1,lll,kkk))
8294 ! parallel orientation of the two CA-CA-CA frames.
8296 iti=itortyp(itype(i,1))
8300 itk1=itortyp(itype(k+1,1))
8301 itj=itortyp(itype(j,1))
8302 if (l.lt.nres-1) then
8303 itl1=itortyp(itype(l+1,1))
8307 ! A1 kernel(j+1) A2T
8309 !d write (iout,'(3f10.5,5x,3f10.5)')
8310 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8312 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8313 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
8314 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8315 ! Following matrices are needed only for 6-th order cumulants
8316 IF (wcorr6.gt.0.0d0) THEN
8317 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8318 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
8319 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8320 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8321 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
8322 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8323 ADtEAderx(1,1,1,1,1,1))
8325 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8326 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
8327 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8328 ADtEA1derx(1,1,1,1,1,1))
8330 ! End 6-th order cumulants
8333 !d write (2,*) 'In calc_eello6'
8335 !d write (2,*) 'iii=',iii
8337 !d write (2,*) 'kkk=',kkk
8339 !d write (2,'(3(2f10.5),5x)')
8340 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8345 call transpose2(EUgder(1,1,k),auxmat(1,1))
8346 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8347 call transpose2(EUg(1,1,k),auxmat(1,1))
8348 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8349 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8353 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8354 EAEAderx(1,1,lll,kkk,iii,1))
8358 ! A1T kernel(i+1) A2
8359 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8360 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
8361 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8362 ! Following matrices are needed only for 6-th order cumulants
8363 IF (wcorr6.gt.0.0d0) THEN
8364 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8365 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
8366 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8367 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8368 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
8369 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8370 ADtEAderx(1,1,1,1,1,2))
8371 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8372 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
8373 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8374 ADtEA1derx(1,1,1,1,1,2))
8376 ! End 6-th order cumulants
8377 call transpose2(EUgder(1,1,l),auxmat(1,1))
8378 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8379 call transpose2(EUg(1,1,l),auxmat(1,1))
8380 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8381 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8385 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8386 EAEAderx(1,1,lll,kkk,iii,2))
8391 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8392 ! They are needed only when the fifth- or the sixth-order cumulants are
8394 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8395 call transpose2(AEA(1,1,1),auxmat(1,1))
8396 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8397 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8398 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8399 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8400 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8401 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8402 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8403 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8404 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8405 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8406 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8407 call transpose2(AEA(1,1,2),auxmat(1,1))
8408 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
8409 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8410 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8411 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8412 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
8413 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8414 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
8415 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
8416 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8417 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8418 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8419 ! Calculate the Cartesian derivatives of the vectors.
8423 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8424 call matvec2(auxmat(1,1),b1(1,iti),&
8425 AEAb1derx(1,lll,kkk,iii,1,1))
8426 call matvec2(auxmat(1,1),Ub2(1,i),&
8427 AEAb2derx(1,lll,kkk,iii,1,1))
8428 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8429 AEAb1derx(1,lll,kkk,iii,2,1))
8430 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8431 AEAb2derx(1,lll,kkk,iii,2,1))
8432 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8433 call matvec2(auxmat(1,1),b1(1,itj),&
8434 AEAb1derx(1,lll,kkk,iii,1,2))
8435 call matvec2(auxmat(1,1),Ub2(1,j),&
8436 AEAb2derx(1,lll,kkk,iii,1,2))
8437 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
8438 AEAb1derx(1,lll,kkk,iii,2,2))
8439 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
8440 AEAb2derx(1,lll,kkk,iii,2,2))
8447 ! Antiparallel orientation of the two CA-CA-CA frames.
8449 iti=itortyp(itype(i,1))
8453 itk1=itortyp(itype(k+1,1))
8454 itl=itortyp(itype(l,1))
8455 itj=itortyp(itype(j,1))
8456 if (j.lt.nres-1) then
8457 itj1=itortyp(itype(j+1,1))
8461 ! A2 kernel(j-1)T A1T
8462 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8463 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
8464 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8465 ! Following matrices are needed only for 6-th order cumulants
8466 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8467 j.eq.i+4 .and. l.eq.i+3)) THEN
8468 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8469 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
8470 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8471 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8472 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
8473 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8474 ADtEAderx(1,1,1,1,1,1))
8475 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8476 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
8477 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8478 ADtEA1derx(1,1,1,1,1,1))
8480 ! End 6-th order cumulants
8481 call transpose2(EUgder(1,1,k),auxmat(1,1))
8482 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8483 call transpose2(EUg(1,1,k),auxmat(1,1))
8484 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8485 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8489 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8490 EAEAderx(1,1,lll,kkk,iii,1))
8494 ! A2T kernel(i+1)T A1
8495 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8496 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
8497 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8498 ! Following matrices are needed only for 6-th order cumulants
8499 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8500 j.eq.i+4 .and. l.eq.i+3)) THEN
8501 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8502 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
8503 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8504 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8505 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
8506 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8507 ADtEAderx(1,1,1,1,1,2))
8508 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8509 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
8510 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8511 ADtEA1derx(1,1,1,1,1,2))
8513 ! End 6-th order cumulants
8514 call transpose2(EUgder(1,1,j),auxmat(1,1))
8515 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8516 call transpose2(EUg(1,1,j),auxmat(1,1))
8517 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8518 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8522 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8523 EAEAderx(1,1,lll,kkk,iii,2))
8528 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8529 ! They are needed only when the fifth- or the sixth-order cumulants are
8531 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
8532 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8533 call transpose2(AEA(1,1,1),auxmat(1,1))
8534 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8535 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8536 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8537 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8538 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8539 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8540 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8541 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8542 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8543 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8544 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8545 call transpose2(AEA(1,1,2),auxmat(1,1))
8546 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
8547 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8548 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8549 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8550 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
8551 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8552 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
8553 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
8554 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8555 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8556 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8557 ! Calculate the Cartesian derivatives of the vectors.
8561 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8562 call matvec2(auxmat(1,1),b1(1,iti),&
8563 AEAb1derx(1,lll,kkk,iii,1,1))
8564 call matvec2(auxmat(1,1),Ub2(1,i),&
8565 AEAb2derx(1,lll,kkk,iii,1,1))
8566 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8567 AEAb1derx(1,lll,kkk,iii,2,1))
8568 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8569 AEAb2derx(1,lll,kkk,iii,2,1))
8570 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8571 call matvec2(auxmat(1,1),b1(1,itl),&
8572 AEAb1derx(1,lll,kkk,iii,1,2))
8573 call matvec2(auxmat(1,1),Ub2(1,l),&
8574 AEAb2derx(1,lll,kkk,iii,1,2))
8575 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
8576 AEAb1derx(1,lll,kkk,iii,2,2))
8577 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
8578 AEAb2derx(1,lll,kkk,iii,2,2))
8586 end subroutine calc_eello
8587 !-----------------------------------------------------------------------------
8588 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
8593 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
8594 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
8595 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
8596 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
8597 integer :: iii,kkk,lll
8600 !el common /kutas/ lprn
8601 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8603 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
8606 !d if (lprn) write (2,*) 'In kernel'
8608 !d if (lprn) write (2,*) 'kkk=',kkk
8610 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
8611 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8613 !d write (2,*) 'lll=',lll
8614 !d write (2,*) 'iii=1'
8616 !d write (2,'(3(2f10.5),5x)')
8617 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8620 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
8621 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8623 !d write (2,*) 'lll=',lll
8624 !d write (2,*) 'iii=2'
8626 !d write (2,'(3(2f10.5),5x)')
8627 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8633 end subroutine kernel
8634 !-----------------------------------------------------------------------------
8635 real(kind=8) function eello4(i,j,k,l,jj,kk)
8636 ! implicit real*8 (a-h,o-z)
8637 ! include 'DIMENSIONS'
8638 ! include 'COMMON.IOUNITS'
8639 ! include 'COMMON.CHAIN'
8640 ! include 'COMMON.DERIV'
8641 ! include 'COMMON.INTERACT'
8642 ! include 'COMMON.CONTACTS'
8643 ! include 'COMMON.TORSION'
8644 ! include 'COMMON.VAR'
8645 ! include 'COMMON.GEO'
8646 real(kind=8),dimension(2,2) :: pizda
8647 real(kind=8),dimension(3) :: ggg1,ggg2
8648 real(kind=8) :: eel4,glongij,glongkl
8649 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
8650 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8654 !d print *,'eello4:',i,j,k,l,jj,kk
8655 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
8656 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
8657 !old eij=facont_hb(jj,i)
8658 !old ekl=facont_hb(kk,k)
8660 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8661 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8662 gcorr_loc(k-1)=gcorr_loc(k-1) &
8663 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8665 gcorr_loc(l-1)=gcorr_loc(l-1) &
8666 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8668 gcorr_loc(j-1)=gcorr_loc(j-1) &
8669 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8674 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
8675 -EAEAderx(2,2,lll,kkk,iii,1)
8676 !d derx(lll,kkk,iii)=0.0d0
8680 !d gcorr_loc(l-1)=0.0d0
8681 !d gcorr_loc(j-1)=0.0d0
8682 !d gcorr_loc(k-1)=0.0d0
8684 !d write (iout,*)'Contacts have occurred for peptide groups',
8685 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
8686 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8687 if (j.lt.nres-1) then
8694 if (l.lt.nres-1) then
8702 !grad ggg1(ll)=eel4*g_contij(ll,1)
8703 !grad ggg2(ll)=eel4*g_contij(ll,2)
8704 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8705 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8706 !grad ghalf=0.5d0*ggg1(ll)
8707 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8708 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8709 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8710 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8711 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8712 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8713 !grad ghalf=0.5d0*ggg2(ll)
8714 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8715 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8716 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8717 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8718 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8719 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8723 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8728 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8733 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8738 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8742 !d write (2,*) iii,gcorr_loc(iii)
8745 !d write (2,*) 'ekont',ekont
8746 !d write (iout,*) 'eello4',ekont*eel4
8749 !-----------------------------------------------------------------------------
8750 real(kind=8) function eello5(i,j,k,l,jj,kk)
8751 ! implicit real*8 (a-h,o-z)
8752 ! include 'DIMENSIONS'
8753 ! include 'COMMON.IOUNITS'
8754 ! include 'COMMON.CHAIN'
8755 ! include 'COMMON.DERIV'
8756 ! include 'COMMON.INTERACT'
8757 ! include 'COMMON.CONTACTS'
8758 ! include 'COMMON.TORSION'
8759 ! include 'COMMON.VAR'
8760 ! include 'COMMON.GEO'
8761 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8762 real(kind=8),dimension(2) :: vv
8763 real(kind=8),dimension(3) :: ggg1,ggg2
8764 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
8765 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
8766 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
8767 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8772 ! /l\ / \ \ / \ / \ / C
8773 ! / \ / \ \ / \ / \ / C
8774 ! j| o |l1 | o | o| o | | o |o C
8775 ! \ |/k\| |/ \| / |/ \| |/ \| C
8776 ! \i/ \ / \ / / \ / \ C
8778 ! (I) (II) (III) (IV) C
8780 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8782 ! Antiparallel chains C
8785 ! /j\ / \ \ / \ / \ / C
8786 ! / \ / \ \ / \ / \ / C
8787 ! j1| o |l | o | o| o | | o |o C
8788 ! \ |/k\| |/ \| / |/ \| |/ \| C
8789 ! \i/ \ / \ / / \ / \ C
8791 ! (I) (II) (III) (IV) C
8793 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8795 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
8797 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8798 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8803 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8805 itk=itortyp(itype(k,1))
8806 itl=itortyp(itype(l,1))
8807 itj=itortyp(itype(j,1))
8812 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8813 !d & eel5_3_num,eel5_4_num)
8817 derx(lll,kkk,iii)=0.0d0
8821 !d eij=facont_hb(jj,i)
8822 !d ekl=facont_hb(kk,k)
8824 !d write (iout,*)'Contacts have occurred for peptide groups',
8825 !d & i,j,' fcont:',eij,' eij',' and ',k,l
8827 ! Contribution from the graph I.
8828 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8829 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8830 call transpose2(EUg(1,1,k),auxmat(1,1))
8831 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8832 vv(1)=pizda(1,1)-pizda(2,2)
8833 vv(2)=pizda(1,2)+pizda(2,1)
8834 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
8835 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8836 ! Explicit gradient in virtual-dihedral angles.
8837 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
8838 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
8839 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8840 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8841 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8842 vv(1)=pizda(1,1)-pizda(2,2)
8843 vv(2)=pizda(1,2)+pizda(2,1)
8844 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8845 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
8846 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8847 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8848 vv(1)=pizda(1,1)-pizda(2,2)
8849 vv(2)=pizda(1,2)+pizda(2,1)
8851 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8852 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
8853 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8855 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8856 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
8857 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8859 ! Cartesian gradient
8863 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
8865 vv(1)=pizda(1,1)-pizda(2,2)
8866 vv(2)=pizda(1,2)+pizda(2,1)
8867 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8868 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
8869 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8875 ! Contribution from graph II
8876 call transpose2(EE(1,1,itk),auxmat(1,1))
8877 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8878 vv(1)=pizda(1,1)+pizda(2,2)
8879 vv(2)=pizda(2,1)-pizda(1,2)
8880 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
8881 -0.5d0*scalar2(vv(1),Ctobr(1,k))
8882 ! Explicit gradient in virtual-dihedral angles.
8883 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8884 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8885 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8886 vv(1)=pizda(1,1)+pizda(2,2)
8887 vv(2)=pizda(2,1)-pizda(1,2)
8889 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8890 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
8891 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8893 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8894 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
8895 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8897 ! Cartesian gradient
8901 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8903 vv(1)=pizda(1,1)+pizda(2,2)
8904 vv(2)=pizda(2,1)-pizda(1,2)
8905 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8906 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
8907 -0.5d0*scalar2(vv(1),Ctobr(1,k))
8915 ! Parallel orientation
8916 ! Contribution from graph III
8917 call transpose2(EUg(1,1,l),auxmat(1,1))
8918 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8919 vv(1)=pizda(1,1)-pizda(2,2)
8920 vv(2)=pizda(1,2)+pizda(2,1)
8921 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
8922 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8923 ! Explicit gradient in virtual-dihedral angles.
8924 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8925 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
8926 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8927 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8928 vv(1)=pizda(1,1)-pizda(2,2)
8929 vv(2)=pizda(1,2)+pizda(2,1)
8930 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8931 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
8932 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8933 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8934 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8935 vv(1)=pizda(1,1)-pizda(2,2)
8936 vv(2)=pizda(1,2)+pizda(2,1)
8937 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8938 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
8939 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8940 ! Cartesian gradient
8944 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
8946 vv(1)=pizda(1,1)-pizda(2,2)
8947 vv(2)=pizda(1,2)+pizda(2,1)
8948 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8949 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
8950 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8955 ! Contribution from graph IV
8957 call transpose2(EE(1,1,itl),auxmat(1,1))
8958 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8959 vv(1)=pizda(1,1)+pizda(2,2)
8960 vv(2)=pizda(2,1)-pizda(1,2)
8961 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
8962 -0.5d0*scalar2(vv(1),Ctobr(1,l))
8963 ! Explicit gradient in virtual-dihedral angles.
8964 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8965 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8966 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8967 vv(1)=pizda(1,1)+pizda(2,2)
8968 vv(2)=pizda(2,1)-pizda(1,2)
8969 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8970 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
8971 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8972 ! Cartesian gradient
8976 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8978 vv(1)=pizda(1,1)+pizda(2,2)
8979 vv(2)=pizda(2,1)-pizda(1,2)
8980 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8981 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
8982 -0.5d0*scalar2(vv(1),Ctobr(1,l))
8987 ! Antiparallel orientation
8988 ! Contribution from graph III
8990 call transpose2(EUg(1,1,j),auxmat(1,1))
8991 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8992 vv(1)=pizda(1,1)-pizda(2,2)
8993 vv(2)=pizda(1,2)+pizda(2,1)
8994 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
8995 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8996 ! Explicit gradient in virtual-dihedral angles.
8997 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8998 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
8999 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9000 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9001 vv(1)=pizda(1,1)-pizda(2,2)
9002 vv(2)=pizda(1,2)+pizda(2,1)
9003 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9004 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
9005 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9006 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9007 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9008 vv(1)=pizda(1,1)-pizda(2,2)
9009 vv(2)=pizda(1,2)+pizda(2,1)
9010 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9011 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
9012 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9013 ! Cartesian gradient
9017 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
9019 vv(1)=pizda(1,1)-pizda(2,2)
9020 vv(2)=pizda(1,2)+pizda(2,1)
9021 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
9022 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
9023 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9028 ! Contribution from graph IV
9030 call transpose2(EE(1,1,itj),auxmat(1,1))
9031 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9032 vv(1)=pizda(1,1)+pizda(2,2)
9033 vv(2)=pizda(2,1)-pizda(1,2)
9034 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
9035 -0.5d0*scalar2(vv(1),Ctobr(1,j))
9036 ! Explicit gradient in virtual-dihedral angles.
9037 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9038 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9039 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9040 vv(1)=pizda(1,1)+pizda(2,2)
9041 vv(2)=pizda(2,1)-pizda(1,2)
9042 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9043 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
9044 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9045 ! Cartesian gradient
9049 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
9051 vv(1)=pizda(1,1)+pizda(2,2)
9052 vv(2)=pizda(2,1)-pizda(1,2)
9053 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
9054 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
9055 -0.5d0*scalar2(vv(1),Ctobr(1,j))
9061 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9062 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9063 !d write (2,*) 'ijkl',i,j,k,l
9064 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9065 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
9067 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9068 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9069 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9070 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9071 if (j.lt.nres-1) then
9078 if (l.lt.nres-1) then
9088 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9089 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
9090 ! summed up outside the subrouine as for the other subroutines
9091 ! handling long-range interactions. The old code is commented out
9092 ! with "cgrad" to keep track of changes.
9094 !grad ggg1(ll)=eel5*g_contij(ll,1)
9095 !grad ggg2(ll)=eel5*g_contij(ll,2)
9096 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9097 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9098 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9099 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9100 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9101 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9102 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9103 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9105 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9106 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9107 !grad ghalf=0.5d0*ggg1(ll)
9109 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9110 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9111 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9112 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9113 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9114 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9115 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9116 !grad ghalf=0.5d0*ggg2(ll)
9118 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
9119 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9120 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
9121 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9122 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9123 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9128 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9129 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9134 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9135 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9141 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9146 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9150 !d write (2,*) iii,g_corr5_loc(iii)
9153 !d write (2,*) 'ekont',ekont
9154 !d write (iout,*) 'eello5',ekont*eel5
9157 !-----------------------------------------------------------------------------
9158 real(kind=8) function eello6(i,j,k,l,jj,kk)
9159 ! implicit real*8 (a-h,o-z)
9160 ! include 'DIMENSIONS'
9161 ! include 'COMMON.IOUNITS'
9162 ! include 'COMMON.CHAIN'
9163 ! include 'COMMON.DERIV'
9164 ! include 'COMMON.INTERACT'
9165 ! include 'COMMON.CONTACTS'
9166 ! include 'COMMON.TORSION'
9167 ! include 'COMMON.VAR'
9168 ! include 'COMMON.GEO'
9169 ! include 'COMMON.FFIELD'
9170 real(kind=8),dimension(3) :: ggg1,ggg2
9171 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
9173 real(kind=8) :: gradcorr6ij,gradcorr6kl
9174 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
9175 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9180 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9188 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9189 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9193 derx(lll,kkk,iii)=0.0d0
9197 !d eij=facont_hb(jj,i)
9198 !d ekl=facont_hb(kk,k)
9204 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9205 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9206 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9207 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9208 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9209 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9211 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9212 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9213 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9214 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9215 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9216 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9220 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9222 ! If turn contributions are considered, they will be handled separately.
9223 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9224 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9225 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9226 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9227 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9228 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9229 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9231 if (j.lt.nres-1) then
9238 if (l.lt.nres-1) then
9246 !grad ggg1(ll)=eel6*g_contij(ll,1)
9247 !grad ggg2(ll)=eel6*g_contij(ll,2)
9248 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9249 !grad ghalf=0.5d0*ggg1(ll)
9251 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9252 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9253 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9254 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9255 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9256 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9257 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9258 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9259 !grad ghalf=0.5d0*ggg2(ll)
9260 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9262 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9263 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9264 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9265 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9266 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9267 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9272 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9273 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9278 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9279 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9285 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9290 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9294 !d write (2,*) iii,g_corr6_loc(iii)
9297 !d write (2,*) 'ekont',ekont
9298 !d write (iout,*) 'eello6',ekont*eel6
9301 !-----------------------------------------------------------------------------
9302 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
9304 ! implicit real*8 (a-h,o-z)
9305 ! include 'DIMENSIONS'
9306 ! include 'COMMON.IOUNITS'
9307 ! include 'COMMON.CHAIN'
9308 ! include 'COMMON.DERIV'
9309 ! include 'COMMON.INTERACT'
9310 ! include 'COMMON.CONTACTS'
9311 ! include 'COMMON.TORSION'
9312 ! include 'COMMON.VAR'
9313 ! include 'COMMON.GEO'
9314 real(kind=8),dimension(2) :: vv,vv1
9315 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
9318 !el common /kutas/ lprn
9319 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
9320 real(kind=8) :: s1,s2,s3,s4,s5
9321 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9323 ! Parallel Antiparallel C
9329 ! \ j|/k\| / \ |/k\|l / C
9334 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9335 itk=itortyp(itype(k,1))
9336 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9337 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9338 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9339 call transpose2(EUgC(1,1,k),auxmat(1,1))
9340 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9341 vv1(1)=pizda1(1,1)-pizda1(2,2)
9342 vv1(2)=pizda1(1,2)+pizda1(2,1)
9343 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9344 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
9345 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
9346 s5=scalar2(vv(1),Dtobr2(1,i))
9347 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9348 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9349 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
9350 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
9351 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
9352 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
9353 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
9354 +scalar2(vv(1),Dtobr2der(1,i)))
9355 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9356 vv1(1)=pizda1(1,1)-pizda1(2,2)
9357 vv1(2)=pizda1(1,2)+pizda1(2,1)
9358 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
9359 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
9361 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
9362 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
9363 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
9364 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
9365 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9367 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
9368 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
9369 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
9370 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
9371 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9373 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9374 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9375 vv1(1)=pizda1(1,1)-pizda1(2,2)
9376 vv1(2)=pizda1(1,2)+pizda1(2,1)
9377 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
9378 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
9379 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
9380 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9389 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9390 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9391 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9392 call transpose2(EUgC(1,1,k),auxmat(1,1))
9393 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
9395 vv1(1)=pizda1(1,1)-pizda1(2,2)
9396 vv1(2)=pizda1(1,2)+pizda1(2,1)
9397 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9398 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
9399 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
9400 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
9401 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
9402 s5=scalar2(vv(1),Dtobr2(1,i))
9403 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9408 end function eello6_graph1
9409 !-----------------------------------------------------------------------------
9410 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
9412 ! implicit real*8 (a-h,o-z)
9413 ! include 'DIMENSIONS'
9414 ! include 'COMMON.IOUNITS'
9415 ! include 'COMMON.CHAIN'
9416 ! include 'COMMON.DERIV'
9417 ! include 'COMMON.INTERACT'
9418 ! include 'COMMON.CONTACTS'
9419 ! include 'COMMON.TORSION'
9420 ! include 'COMMON.VAR'
9421 ! include 'COMMON.GEO'
9423 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
9424 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9426 !el common /kutas/ lprn
9427 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
9428 real(kind=8) :: s2,s3,s4
9429 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9431 ! Parallel Antiparallel C
9437 ! \ j|/k\| \ |/k\|l C
9442 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9443 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9444 ! AL 7/4/01 s1 would occur in the sixth-order moment,
9445 ! but not in a cluster cumulant
9447 s1=dip(1,jj,i)*dip(1,kk,k)
9449 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9450 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9451 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9452 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9453 call transpose2(EUg(1,1,k),auxmat(1,1))
9454 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9455 vv(1)=pizda(1,1)-pizda(2,2)
9456 vv(2)=pizda(1,2)+pizda(2,1)
9457 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9458 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9460 eello6_graph2=-(s1+s2+s3+s4)
9462 eello6_graph2=-(s2+s3+s4)
9465 ! Derivatives in gamma(i-1)
9468 s1=dipderg(1,jj,i)*dip(1,kk,k)
9470 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9471 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9472 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9473 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9475 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9477 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9479 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9481 ! Derivatives in gamma(k-1)
9483 s1=dip(1,jj,i)*dipderg(1,kk,k)
9485 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9486 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9487 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9488 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9489 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9490 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9491 vv(1)=pizda(1,1)-pizda(2,2)
9492 vv(2)=pizda(1,2)+pizda(2,1)
9493 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9495 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9497 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9499 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9500 ! Derivatives in gamma(j-1) or gamma(l-1)
9503 s1=dipderg(3,jj,i)*dip(1,kk,k)
9505 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9506 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9507 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9508 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9509 vv(1)=pizda(1,1)-pizda(2,2)
9510 vv(2)=pizda(1,2)+pizda(2,1)
9511 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9514 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9516 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9519 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9520 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9522 ! Derivatives in gamma(l-1) or gamma(j-1)
9525 s1=dip(1,jj,i)*dipderg(3,kk,k)
9527 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9528 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9529 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9530 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9531 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9532 vv(1)=pizda(1,1)-pizda(2,2)
9533 vv(2)=pizda(1,2)+pizda(2,1)
9534 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9537 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9539 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9542 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9543 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9545 ! Cartesian derivatives.
9547 write (2,*) 'In eello6_graph2'
9549 write (2,*) 'iii=',iii
9551 write (2,*) 'kkk=',kkk
9553 write (2,'(3(2f10.5),5x)') &
9554 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9564 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9566 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9569 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
9571 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9572 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
9574 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9575 call transpose2(EUg(1,1,k),auxmat(1,1))
9576 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
9578 vv(1)=pizda(1,1)-pizda(2,2)
9579 vv(2)=pizda(1,2)+pizda(2,1)
9580 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9581 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9583 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9585 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9588 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9590 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9596 end function eello6_graph2
9597 !-----------------------------------------------------------------------------
9598 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
9599 ! implicit real*8 (a-h,o-z)
9600 ! include 'DIMENSIONS'
9601 ! include 'COMMON.IOUNITS'
9602 ! include 'COMMON.CHAIN'
9603 ! include 'COMMON.DERIV'
9604 ! include 'COMMON.INTERACT'
9605 ! include 'COMMON.CONTACTS'
9606 ! include 'COMMON.TORSION'
9607 ! include 'COMMON.VAR'
9608 ! include 'COMMON.GEO'
9609 real(kind=8),dimension(2) :: vv,auxvec
9610 real(kind=8),dimension(2,2) :: pizda,auxmat
9612 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
9613 real(kind=8) :: s1,s2,s3,s4
9614 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9616 ! Parallel Antiparallel C
9622 ! j|/k\| / |/k\|l / C
9627 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9629 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9630 ! energy moment and not to the cluster cumulant.
9631 iti=itortyp(itype(i,1))
9632 if (j.lt.nres-1) then
9633 itj1=itortyp(itype(j+1,1))
9637 itk=itortyp(itype(k,1))
9638 itk1=itortyp(itype(k+1,1))
9639 if (l.lt.nres-1) then
9640 itl1=itortyp(itype(l+1,1))
9645 s1=dip(4,jj,i)*dip(4,kk,k)
9647 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
9648 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9649 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
9650 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9651 call transpose2(EE(1,1,itk),auxmat(1,1))
9652 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9653 vv(1)=pizda(1,1)+pizda(2,2)
9654 vv(2)=pizda(2,1)-pizda(1,2)
9655 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9656 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9657 !d & "sum",-(s2+s3+s4)
9659 eello6_graph3=-(s1+s2+s3+s4)
9661 eello6_graph3=-(s2+s3+s4)
9664 ! Derivatives in gamma(k-1)
9665 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
9666 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9667 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9668 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9669 ! Derivatives in gamma(l-1)
9670 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
9671 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9672 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9673 vv(1)=pizda(1,1)+pizda(2,2)
9674 vv(2)=pizda(2,1)-pizda(1,2)
9675 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9676 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9677 ! Cartesian derivatives.
9683 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9685 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9688 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
9690 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9691 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
9693 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9694 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
9696 vv(1)=pizda(1,1)+pizda(2,2)
9697 vv(2)=pizda(2,1)-pizda(1,2)
9698 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9700 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9702 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9705 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9707 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9709 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9714 end function eello6_graph3
9715 !-----------------------------------------------------------------------------
9716 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9717 ! implicit real*8 (a-h,o-z)
9718 ! include 'DIMENSIONS'
9719 ! include 'COMMON.IOUNITS'
9720 ! include 'COMMON.CHAIN'
9721 ! include 'COMMON.DERIV'
9722 ! include 'COMMON.INTERACT'
9723 ! include 'COMMON.CONTACTS'
9724 ! include 'COMMON.TORSION'
9725 ! include 'COMMON.VAR'
9726 ! include 'COMMON.GEO'
9727 ! include 'COMMON.FFIELD'
9728 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
9729 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9731 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
9733 real(kind=8) :: s1,s2,s3,s4
9734 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9736 ! Parallel Antiparallel C
9742 ! \ j|/k\| \ |/k\|l C
9747 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9749 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9750 ! energy moment and not to the cluster cumulant.
9751 !d write (2,*) 'eello_graph4: wturn6',wturn6
9752 iti=itortyp(itype(i,1))
9753 itj=itortyp(itype(j,1))
9754 if (j.lt.nres-1) then
9755 itj1=itortyp(itype(j+1,1))
9759 itk=itortyp(itype(k,1))
9760 if (k.lt.nres-1) then
9761 itk1=itortyp(itype(k+1,1))
9765 itl=itortyp(itype(l,1))
9766 if (l.lt.nres-1) then
9767 itl1=itortyp(itype(l+1,1))
9771 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9772 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9773 !d & ' itl',itl,' itl1',itl1
9776 s1=dip(3,jj,i)*dip(3,kk,k)
9778 s1=dip(2,jj,j)*dip(2,kk,l)
9781 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9782 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9784 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9785 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9787 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9788 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9790 call transpose2(EUg(1,1,k),auxmat(1,1))
9791 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9792 vv(1)=pizda(1,1)-pizda(2,2)
9793 vv(2)=pizda(2,1)+pizda(1,2)
9794 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9795 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9797 eello6_graph4=-(s1+s2+s3+s4)
9799 eello6_graph4=-(s2+s3+s4)
9801 ! Derivatives in gamma(i-1)
9805 s1=dipderg(2,jj,i)*dip(3,kk,k)
9807 s1=dipderg(4,jj,j)*dip(2,kk,l)
9810 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9812 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9813 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9815 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9816 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9818 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9819 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9820 !d write (2,*) 'turn6 derivatives'
9822 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9824 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9828 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9830 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9834 ! Derivatives in gamma(k-1)
9837 s1=dip(3,jj,i)*dipderg(2,kk,k)
9839 s1=dip(2,jj,j)*dipderg(4,kk,l)
9842 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9843 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9845 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9846 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9848 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9849 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9851 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9852 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9853 vv(1)=pizda(1,1)-pizda(2,2)
9854 vv(2)=pizda(2,1)+pizda(1,2)
9855 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9856 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9858 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9860 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9864 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9866 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9869 ! Derivatives in gamma(j-1) or gamma(l-1)
9870 if (l.eq.j+1 .and. l.gt.1) then
9871 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9872 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9873 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9874 vv(1)=pizda(1,1)-pizda(2,2)
9875 vv(2)=pizda(2,1)+pizda(1,2)
9876 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9877 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9878 else if (j.gt.1) then
9879 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9880 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9881 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9882 vv(1)=pizda(1,1)-pizda(2,2)
9883 vv(2)=pizda(2,1)+pizda(1,2)
9884 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9885 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9886 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9888 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9891 ! Cartesian derivatives.
9898 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9900 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9904 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9906 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9910 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
9912 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9914 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
9915 b1(1,itj1),auxvec(1))
9916 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9918 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
9919 b1(1,itl1),auxvec(1))
9920 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9922 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
9924 vv(1)=pizda(1,1)-pizda(2,2)
9925 vv(2)=pizda(2,1)+pizda(1,2)
9926 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9928 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9930 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
9933 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
9936 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9939 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9941 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9943 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9947 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9949 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9952 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9954 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9961 end function eello6_graph4
9962 !-----------------------------------------------------------------------------
9963 real(kind=8) function eello_turn6(i,jj,kk)
9964 ! implicit real*8 (a-h,o-z)
9965 ! include 'DIMENSIONS'
9966 ! include 'COMMON.IOUNITS'
9967 ! include 'COMMON.CHAIN'
9968 ! include 'COMMON.DERIV'
9969 ! include 'COMMON.INTERACT'
9970 ! include 'COMMON.CONTACTS'
9971 ! include 'COMMON.TORSION'
9972 ! include 'COMMON.VAR'
9973 ! include 'COMMON.GEO'
9974 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
9975 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
9976 real(kind=8),dimension(3) :: ggg1,ggg2
9977 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
9978 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
9979 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9980 ! the respective energy moment and not to the cluster cumulant.
9982 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
9983 integer :: j1,j2,l1,l2,ll
9984 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
9985 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
9994 iti=itortyp(itype(i,1))
9995 itk=itortyp(itype(k,1))
9996 itk1=itortyp(itype(k+1,1))
9997 itl=itortyp(itype(l,1))
9998 itj=itortyp(itype(j,1))
9999 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10000 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
10001 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10006 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10008 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
10012 derx_turn(lll,kkk,iii)=0.0d0
10019 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10021 !d write (2,*) 'eello6_5',eello6_5
10023 call transpose2(AEA(1,1,1),auxmat(1,1))
10024 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10025 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
10026 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10028 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
10029 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10030 s2 = scalar2(b1(1,itk),vtemp1(1))
10032 call transpose2(AEA(1,1,2),atemp(1,1))
10033 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10034 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10035 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10037 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10038 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10039 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10041 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10042 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10043 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10044 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10045 ss13 = scalar2(b1(1,itk),vtemp4(1))
10046 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10048 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10054 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10055 ! Derivatives in gamma(i+2)
10059 call transpose2(AEA(1,1,1),auxmatd(1,1))
10060 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10061 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10062 call transpose2(AEAderg(1,1,2),atempd(1,1))
10063 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10064 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10066 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10067 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10068 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10074 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10075 ! Derivatives in gamma(i+3)
10077 call transpose2(AEA(1,1,1),auxmatd(1,1))
10078 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10079 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
10080 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10082 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
10083 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10084 s2d = scalar2(b1(1,itk),vtemp1d(1))
10086 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10087 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10089 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10091 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10092 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10093 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10101 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
10102 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10104 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
10105 -0.5d0*ekont*(s2d+s12d)
10107 ! Derivatives in gamma(i+4)
10108 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10109 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10110 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10112 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10113 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10114 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10122 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10124 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10126 ! Derivatives in gamma(i+5)
10128 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10129 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10130 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10132 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
10133 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10134 s2d = scalar2(b1(1,itk),vtemp1d(1))
10136 call transpose2(AEA(1,1,2),atempd(1,1))
10137 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10138 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10140 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10141 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10143 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10144 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10145 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10153 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
10154 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10156 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
10157 -0.5d0*ekont*(s2d+s12d)
10159 ! Cartesian derivatives
10164 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10165 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10166 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10168 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
10169 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
10171 s2d = scalar2(b1(1,itk),vtemp1d(1))
10173 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10174 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10175 s8d = -(atempd(1,1)+atempd(2,2))* &
10176 scalar2(cc(1,1,itl),vtemp2(1))
10178 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
10180 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10181 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10188 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
10191 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
10195 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
10198 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
10207 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
10209 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10210 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10211 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10212 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10213 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
10215 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10216 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10217 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10221 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10222 !d & 16*eel_turn6_num
10224 if (j.lt.nres-1) then
10231 if (l.lt.nres-1) then
10239 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
10240 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
10241 !grad ghalf=0.5d0*ggg1(ll)
10243 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10244 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10245 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
10246 +ekont*derx_turn(ll,2,1)
10247 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10248 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
10249 +ekont*derx_turn(ll,4,1)
10250 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10251 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10252 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10253 !grad ghalf=0.5d0*ggg2(ll)
10255 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
10256 +ekont*derx_turn(ll,2,2)
10257 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10258 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
10259 +ekont*derx_turn(ll,4,2)
10260 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10261 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10262 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10267 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10272 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10278 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10283 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10287 !d write (2,*) iii,g_corr6_loc(iii)
10289 eello_turn6=ekont*eel_turn6
10290 !d write (2,*) 'ekont',ekont
10291 !d write (2,*) 'eel_turn6',ekont*eel_turn6
10293 end function eello_turn6
10294 !-----------------------------------------------------------------------------
10295 subroutine MATVEC2(A1,V1,V2)
10296 !DIR$ INLINEALWAYS MATVEC2
10298 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10300 ! implicit real*8 (a-h,o-z)
10301 ! include 'DIMENSIONS'
10302 real(kind=8),dimension(2) :: V1,V2
10303 real(kind=8),dimension(2,2) :: A1
10304 real(kind=8) :: vaux1,vaux2
10308 ! 3 VI=VI+A1(I,K)*V1(K)
10312 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10313 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10317 end subroutine MATVEC2
10318 !-----------------------------------------------------------------------------
10319 subroutine MATMAT2(A1,A2,A3)
10321 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10323 ! implicit real*8 (a-h,o-z)
10324 ! include 'DIMENSIONS'
10325 real(kind=8),dimension(2,2) :: A1,A2,A3
10326 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
10327 ! DIMENSION AI3(2,2)
10331 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
10337 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10338 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10339 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10340 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10346 end subroutine MATMAT2
10347 !-----------------------------------------------------------------------------
10348 real(kind=8) function scalar2(u,v)
10349 !DIR$ INLINEALWAYS scalar2
10351 real(kind=8),dimension(2) :: u,v
10354 scalar2=u(1)*v(1)+u(2)*v(2)
10356 end function scalar2
10357 !-----------------------------------------------------------------------------
10358 subroutine transpose2(a,at)
10359 !DIR$ INLINEALWAYS transpose2
10361 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
10364 real(kind=8),dimension(2,2) :: a,at
10370 end subroutine transpose2
10371 !-----------------------------------------------------------------------------
10372 subroutine transpose(n,a,at)
10375 real(kind=8),dimension(n,n) :: a,at
10382 end subroutine transpose
10383 !-----------------------------------------------------------------------------
10384 subroutine prodmat3(a1,a2,kk,transp,prod)
10385 !DIR$ INLINEALWAYS prodmat3
10387 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
10391 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
10393 !rc double precision auxmat(2,2),prod_(2,2)
10396 !rc call transpose2(kk(1,1),auxmat(1,1))
10397 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10398 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10400 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
10401 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10402 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
10403 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10404 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
10405 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10406 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
10407 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10410 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10411 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10413 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
10414 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10415 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
10416 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10417 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
10418 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10419 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
10420 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10423 ! call transpose2(a2(1,1),a2t(1,1))
10426 !rc print *,((prod_(i,j),i=1,2),j=1,2)
10427 !rc print *,((prod(i,j),i=1,2),j=1,2)
10430 end subroutine prodmat3
10431 !-----------------------------------------------------------------------------
10432 ! energy_p_new_barrier.F
10433 !-----------------------------------------------------------------------------
10434 subroutine sum_gradient
10435 ! implicit real*8 (a-h,o-z)
10436 use io_base, only: pdbout
10437 ! include 'DIMENSIONS'
10441 !MS$ATTRIBUTES C :: proc_proc
10447 real(kind=8),dimension(3,-1:nres) :: gradbufc,gradbufx,gradbufc_sum,&
10448 gloc_scbuf !(3,maxres)
10450 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
10452 !el local variables
10453 integer :: i,j,k,ierror,ierr
10454 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
10455 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
10456 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
10457 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
10458 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
10459 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
10460 gsccorr_max,gsccorrx_max,time00
10462 ! include 'COMMON.SETUP'
10463 ! include 'COMMON.IOUNITS'
10464 ! include 'COMMON.FFIELD'
10465 ! include 'COMMON.DERIV'
10466 ! include 'COMMON.INTERACT'
10467 ! include 'COMMON.SBRIDGE'
10468 ! include 'COMMON.CHAIN'
10469 ! include 'COMMON.VAR'
10470 ! include 'COMMON.CONTROL'
10471 ! include 'COMMON.TIME1'
10472 ! include 'COMMON.MAXGRAD'
10473 ! include 'COMMON.SCCOR'
10478 write (iout,*) "sum_gradient gvdwc, gvdwx"
10480 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10481 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
10491 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
10492 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
10493 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
10496 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
10497 ! in virtual-bond-vector coordinates
10500 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
10502 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
10503 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
10505 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
10507 ! write (iout,'(i5,3f10.5,2x,f10.5)')
10508 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
10510 write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
10512 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10513 i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
10514 (gvdwc_scpp(j,i),j=1,3)
10516 write (iout,*) "gelc_long gvdwpp gel_loc_long"
10518 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10519 i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
10520 (gelc_loc_long(j,i),j=1,3)
10527 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10528 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10529 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10530 wel_loc*gel_loc_long(j,i)+ &
10531 wcorr*gradcorr_long(j,i)+ &
10532 wcorr5*gradcorr5_long(j,i)+ &
10533 wcorr6*gradcorr6_long(j,i)+ &
10534 wturn6*gcorr6_turn_long(j,i)+ &
10535 wstrain*ghpbc(j,i) &
10536 +wliptran*gliptranc(j,i) &
10538 +welec*gshieldc(j,i) &
10539 +wcorr*gshieldc_ec(j,i) &
10540 +wturn3*gshieldc_t3(j,i)&
10541 +wturn4*gshieldc_t4(j,i)&
10542 +wel_loc*gshieldc_ll(j,i)&
10543 +wtube*gg_tube(j,i) &
10544 +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
10545 wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
10546 wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
10547 wcorr_nucl*gradcorr_nucl(j,i)&
10548 +wcorr3_nucl*gradcorr3_nucl(j,i)+&
10549 wcatprot* gradpepcat(j,i)+ &
10550 wcatcat*gradcatcat(j,i)+ &
10551 wscbase*gvdwc_scbase(j,i)+ &
10552 wpepbase*gvdwc_pepbase(j,i)+&
10553 wscpho*gvdwc_scpho(j,i)+ &
10554 wpeppho*gvdwc_peppho(j,i)
10565 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10566 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10567 welec*gelc_long(j,i)+ &
10568 wbond*gradb(j,i)+ &
10569 wel_loc*gel_loc_long(j,i)+ &
10570 wcorr*gradcorr_long(j,i)+ &
10571 wcorr5*gradcorr5_long(j,i)+ &
10572 wcorr6*gradcorr6_long(j,i)+ &
10573 wturn6*gcorr6_turn_long(j,i)+ &
10574 wstrain*ghpbc(j,i) &
10575 +wliptran*gliptranc(j,i) &
10577 +welec*gshieldc(j,i)&
10578 +wcorr*gshieldc_ec(j,i) &
10579 +wturn4*gshieldc_t4(j,i) &
10580 +wel_loc*gshieldc_ll(j,i)&
10581 +wtube*gg_tube(j,i) &
10582 +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
10583 wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
10584 wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
10585 wcorr_nucl*gradcorr_nucl(j,i) &
10586 +wcorr3_nucl*gradcorr3_nucl(j,i) +&
10587 wcatprot* gradpepcat(j,i)+ &
10588 wcatcat*gradcatcat(j,i)+ &
10589 wscbase*gvdwc_scbase(j,i) &
10590 wpepbase*gvdwc_pepbase(j,i)+&
10591 wscpho*gvdwc_scpho(j,i)+&
10592 wpeppho*gvdwc_peppho(j,i)
10599 if (nfgtasks.gt.1) then
10602 write (iout,*) "gradbufc before allreduce"
10604 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10610 gradbufc_sum(j,i)=gradbufc(j,i)
10613 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
10614 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
10615 ! time_reduce=time_reduce+MPI_Wtime()-time00
10617 ! write (iout,*) "gradbufc_sum after allreduce"
10619 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
10624 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
10628 gradbufc(k,i)=0.0d0
10632 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
10633 write (iout,*) (i," jgrad_start",jgrad_start(i),&
10634 " jgrad_end ",jgrad_end(i),&
10635 i=igrad_start,igrad_end)
10638 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
10639 ! do not parallelize this part.
10641 ! do i=igrad_start,igrad_end
10642 ! do j=jgrad_start(i),jgrad_end(i)
10644 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
10649 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10653 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10657 write (iout,*) "gradbufc after summing"
10659 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10667 write (iout,*) "gradbufc"
10669 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10676 gradbufc_sum(j,i)=gradbufc(j,i)
10677 gradbufc(j,i)=0.0d0
10681 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10685 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10690 ! gradbufc(k,i)=0.0d0
10694 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
10700 write (iout,*) "gradbufc after summing"
10702 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10711 gradbufc(k,nres)=0.0d0
10713 !el----------------
10714 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
10715 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
10716 !el-----------------
10720 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10721 wel_loc*gel_loc(j,i)+ &
10722 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10723 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10724 wel_loc*gel_loc_long(j,i)+ &
10725 wcorr*gradcorr_long(j,i)+ &
10726 wcorr5*gradcorr5_long(j,i)+ &
10727 wcorr6*gradcorr6_long(j,i)+ &
10728 wturn6*gcorr6_turn_long(j,i))+ &
10729 wbond*gradb(j,i)+ &
10730 wcorr*gradcorr(j,i)+ &
10731 wturn3*gcorr3_turn(j,i)+ &
10732 wturn4*gcorr4_turn(j,i)+ &
10733 wcorr5*gradcorr5(j,i)+ &
10734 wcorr6*gradcorr6(j,i)+ &
10735 wturn6*gcorr6_turn(j,i)+ &
10736 wsccor*gsccorc(j,i) &
10737 +wscloc*gscloc(j,i) &
10738 +wliptran*gliptranc(j,i) &
10740 +welec*gshieldc(j,i) &
10741 +welec*gshieldc_loc(j,i) &
10742 +wcorr*gshieldc_ec(j,i) &
10743 +wcorr*gshieldc_loc_ec(j,i) &
10744 +wturn3*gshieldc_t3(j,i) &
10745 +wturn3*gshieldc_loc_t3(j,i) &
10746 +wturn4*gshieldc_t4(j,i) &
10747 +wturn4*gshieldc_loc_t4(j,i) &
10748 +wel_loc*gshieldc_ll(j,i) &
10749 +wel_loc*gshieldc_loc_ll(j,i) &
10750 +wtube*gg_tube(j,i) &
10751 +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
10752 +wvdwpsb*gvdwpsb1(j,i))&
10753 +wbond_nucl*gradb_nucl(j,i)+wsbloc*gsbloc(j,i)
10755 ! if ((i.le.2).and.(i.ge.1))
10756 ! print *,gradc(j,i,icg),&
10757 ! gradbufc(j,i),welec*gelc(j,i), &
10758 ! wel_loc*gel_loc(j,i), &
10759 ! wscp*gvdwc_scpp(j,i), &
10760 ! welec*gelc_long(j,i),wvdwpp*gvdwpp(j,i), &
10761 ! wel_loc*gel_loc_long(j,i), &
10762 ! wcorr*gradcorr_long(j,i), &
10763 ! wcorr5*gradcorr5_long(j,i), &
10764 ! wcorr6*gradcorr6_long(j,i), &
10765 ! wturn6*gcorr6_turn_long(j,i), &
10766 ! wbond*gradb(j,i), &
10767 ! wcorr*gradcorr(j,i), &
10768 ! wturn3*gcorr3_turn(j,i), &
10769 ! wturn4*gcorr4_turn(j,i), &
10770 ! wcorr5*gradcorr5(j,i), &
10771 ! wcorr6*gradcorr6(j,i), &
10772 ! wturn6*gcorr6_turn(j,i), &
10773 ! wsccor*gsccorc(j,i) &
10774 ! ,wscloc*gscloc(j,i) &
10775 ! ,wliptran*gliptranc(j,i) &
10777 ! ,welec*gshieldc(j,i) &
10778 ! ,welec*gshieldc_loc(j,i) &
10779 ! ,wcorr*gshieldc_ec(j,i) &
10780 ! ,wcorr*gshieldc_loc_ec(j,i) &
10781 ! ,wturn3*gshieldc_t3(j,i) &
10782 ! ,wturn3*gshieldc_loc_t3(j,i) &
10783 ! ,wturn4*gshieldc_t4(j,i) &
10784 ! ,wturn4*gshieldc_loc_t4(j,i) &
10785 ! ,wel_loc*gshieldc_ll(j,i) &
10786 ! ,wel_loc*gshieldc_loc_ll(j,i) &
10787 ! ,wtube*gg_tube(j,i) &
10788 ! ,wbond_nucl*gradb_nucl(j,i) &
10789 ! ,wvdwpp_nucl*gvdwpp_nucl(j,i),welpp*gelpp(j,i),&
10790 ! wvdwpsb*gvdwpsb1(j,i)&
10791 ! ,wbond_nucl*gradb_nucl(j,i),wsbloc*gsbloc(j,i)
10795 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10796 wel_loc*gel_loc(j,i)+ &
10797 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10798 welec*gelc_long(j,i)+ &
10799 wel_loc*gel_loc_long(j,i)+ &
10800 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
10801 wcorr5*gradcorr5_long(j,i)+ &
10802 wcorr6*gradcorr6_long(j,i)+ &
10803 wturn6*gcorr6_turn_long(j,i))+ &
10804 wbond*gradb(j,i)+ &
10805 wcorr*gradcorr(j,i)+ &
10806 wturn3*gcorr3_turn(j,i)+ &
10807 wturn4*gcorr4_turn(j,i)+ &
10808 wcorr5*gradcorr5(j,i)+ &
10809 wcorr6*gradcorr6(j,i)+ &
10810 wturn6*gcorr6_turn(j,i)+ &
10811 wsccor*gsccorc(j,i) &
10812 +wscloc*gscloc(j,i) &
10814 +wliptran*gliptranc(j,i) &
10815 +welec*gshieldc(j,i) &
10816 +welec*gshieldc_loc(j,) &
10817 +wcorr*gshieldc_ec(j,i) &
10818 +wcorr*gshieldc_loc_ec(j,i) &
10819 +wturn3*gshieldc_t3(j,i) &
10820 +wturn3*gshieldc_loc_t3(j,i) &
10821 +wturn4*gshieldc_t4(j,i) &
10822 +wturn4*gshieldc_loc_t4(j,i) &
10823 +wel_loc*gshieldc_ll(j,i) &
10824 +wel_loc*gshieldc_loc_ll(j,i) &
10825 +wtube*gg_tube(j,i) &
10826 +wbond_nucl*gradb_nucl(j,i) &
10827 +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
10828 +wvdwpsb*gvdwpsb1(j,i))&
10829 +wsbloc*gsbloc(j,i)
10835 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
10836 wbond*gradbx(j,i)+ &
10837 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
10838 wsccor*gsccorx(j,i) &
10839 +wscloc*gsclocx(j,i) &
10840 +wliptran*gliptranx(j,i) &
10841 +welec*gshieldx(j,i) &
10842 +wcorr*gshieldx_ec(j,i) &
10843 +wturn3*gshieldx_t3(j,i) &
10844 +wturn4*gshieldx_t4(j,i) &
10845 +wel_loc*gshieldx_ll(j,i)&
10846 +wtube*gg_tube_sc(j,i) &
10847 +wbond_nucl*gradbx_nucl(j,i) &
10848 +wvdwsb*gvdwsbx(j,i) &
10849 +welsb*gelsbx(j,i) &
10850 +wcorr_nucl*gradxorr_nucl(j,i)&
10851 +wcorr3_nucl*gradxorr3_nucl(j,i) &
10852 +wsbloc*gsblocx(j,i) &
10853 +wcatprot* gradpepcatx(j,i)&
10854 +wscbase*gvdwx_scbase(j,i) &
10855 +wpepbase*gvdwx_pepbase(j,i)&
10856 +wscpho*gvdwx_scpho(j,i)
10857 ! if (i.eq.3) print *,"tu?", wscpho,gvdwx_scpho(j,i)
10862 write (iout,*) "gloc before adding corr"
10864 write (iout,*) i,gloc(i,icg)
10868 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
10869 +wcorr5*g_corr5_loc(i) &
10870 +wcorr6*g_corr6_loc(i) &
10871 +wturn4*gel_loc_turn4(i) &
10872 +wturn3*gel_loc_turn3(i) &
10873 +wturn6*gel_loc_turn6(i) &
10874 +wel_loc*gel_loc_loc(i)
10877 write (iout,*) "gloc after adding corr"
10879 write (iout,*) i,gloc(i,icg)
10883 if (nfgtasks.gt.1) then
10886 gradbufc(j,i)=gradc(j,i,icg)
10887 gradbufx(j,i)=gradx(j,i,icg)
10891 glocbuf(i)=gloc(i,icg)
10895 write (iout,*) "gloc_sc before reduce"
10898 write (iout,*) i,j,gloc_sc(j,i,icg)
10905 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
10909 call MPI_Barrier(FG_COMM,IERR)
10910 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
10912 call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,&
10913 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10914 call MPI_Reduce(gradbufx(1,0),gradx(1,0,icg),3*nres+3,&
10915 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10916 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
10917 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10918 time_reduce=time_reduce+MPI_Wtime()-time00
10919 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
10920 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10921 time_reduce=time_reduce+MPI_Wtime()-time00
10923 ! print *,"gradbuf",gradbufc(1,1),gradc(1,1,icg)
10925 write (iout,*) "gloc_sc after reduce"
10928 write (iout,*) i,j,gloc_sc(j,i,icg)
10934 write (iout,*) "gloc after reduce"
10936 write (iout,*) i,gloc(i,icg)
10941 if (gnorm_check) then
10943 ! Compute the maximum elements of the gradient
10946 gvdwc_scp_max=0.0d0
10953 gcorr3_turn_max=0.0d0
10954 gcorr4_turn_max=0.0d0
10955 gradcorr5_max=0.0d0
10956 gradcorr6_max=0.0d0
10957 gcorr6_turn_max=0.0d0
10961 gradx_scp_max=0.0d0
10967 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
10968 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
10969 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
10970 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
10971 gvdwc_scp_max=gvdwc_scp_norm
10972 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
10973 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
10974 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
10975 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
10976 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
10977 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
10978 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
10979 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
10980 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
10981 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
10982 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
10983 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
10984 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
10986 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
10987 gcorr3_turn_max=gcorr3_turn_norm
10988 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
10990 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
10991 gcorr4_turn_max=gcorr4_turn_norm
10992 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
10993 if (gradcorr5_norm.gt.gradcorr5_max) &
10994 gradcorr5_max=gradcorr5_norm
10995 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
10996 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
10997 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
10999 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
11000 gcorr6_turn_max=gcorr6_turn_norm
11001 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
11002 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
11003 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
11004 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
11005 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
11006 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
11007 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
11008 if (gradx_scp_norm.gt.gradx_scp_max) &
11009 gradx_scp_max=gradx_scp_norm
11010 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
11011 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
11012 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
11013 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
11014 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
11015 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
11016 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
11017 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
11021 open(istat,file=statname,position="append")
11023 open(istat,file=statname,access="append")
11025 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
11026 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
11027 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
11028 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
11029 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
11030 gsccorx_max,gsclocx_max
11032 if (gvdwc_max.gt.1.0d4) then
11033 write (iout,*) "gvdwc gvdwx gradb gradbx"
11035 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
11036 gradb(j,i),gradbx(j,i),j=1,3)
11038 call pdbout(0.0d0,'cipiszcze',iout)
11045 write (iout,*) "gradc gradx gloc"
11047 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
11048 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
11053 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
11056 end subroutine sum_gradient
11057 !-----------------------------------------------------------------------------
11059 ! implicit real*8 (a-h,o-z)
11061 ! include 'DIMENSIONS'
11062 ! include 'COMMON.CHAIN'
11063 ! include 'COMMON.DERIV'
11064 ! include 'COMMON.CALC'
11065 ! include 'COMMON.IOUNITS'
11066 real(kind=8), dimension(3) :: dcosom1,dcosom2
11067 ! print *,"wchodze"
11068 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
11069 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
11070 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
11071 -2.0D0*alf12*eps3der+sigder*sigsq_om12
11075 ! eom12=evdwij*eps1_om12
11077 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
11079 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
11080 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
11081 !C print *,sss_ele_cut,'in sc_grad'
11083 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
11084 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
11087 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
11088 !C print *,'gg',k,gg(k)
11090 ! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
11091 ! write (iout,*) "gg",(gg(k),k=1,3)
11093 gvdwx(k,i)=gvdwx(k,i)-gg(k) +gg_lipi(k)&
11094 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
11095 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
11098 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)&
11099 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
11100 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv &
11103 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
11104 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
11105 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
11106 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
11109 ! Calculate the components of the gradient in DC and X
11113 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
11117 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
11118 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
11121 end subroutine sc_grad
11123 !-----------------------------------------------------------------------------
11124 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
11127 ! implicit real*8 (a-h,o-z)
11128 ! include 'DIMENSIONS'
11129 ! include 'COMMON.LOCAL'
11130 ! include 'COMMON.IOUNITS'
11131 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
11132 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
11133 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
11134 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
11135 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
11137 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
11138 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
11139 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
11140 !el local variables
11142 delthec=thetai-thet_pred_mean
11143 delthe0=thetai-theta0i
11144 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
11145 t3 = thetai-thet_pred_mean
11149 t14 = t12+t6*sigsqtc
11151 t21 = thetai-theta0i
11157 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
11158 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
11159 *(-t12*t9-ak*sig0inv*t27)
11161 end subroutine mixder
11163 !-----------------------------------------------------------------------------
11165 !-----------------------------------------------------------------------------
11167 !-----------------------------------------------------------------------------
11168 ! This subroutine calculates the derivatives of the consecutive virtual
11169 ! bond vectors and the SC vectors in the virtual-bond angles theta and
11170 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
11171 ! in the angles alpha and omega, describing the location of a side chain
11172 ! in its local coordinate system.
11174 ! The derivatives are stored in the following arrays:
11176 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
11177 ! The structure is as follows:
11179 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
11180 ! 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)
11181 ! . . . . . . . . . . . . . . . . . .
11182 ! 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)
11186 ! 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)
11188 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
11189 ! The structure is same as above.
11191 ! DCDS - the derivatives of the side chain vectors in the local spherical
11192 ! andgles alph and omega:
11194 ! 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)
11195 ! 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)
11199 ! 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)
11201 ! Version of March '95, based on an early version of November '91.
11203 !**********************************************************************
11204 ! implicit real*8 (a-h,o-z)
11205 ! include 'DIMENSIONS'
11206 ! include 'COMMON.VAR'
11207 ! include 'COMMON.CHAIN'
11208 ! include 'COMMON.DERIV'
11209 ! include 'COMMON.GEO'
11210 ! include 'COMMON.LOCAL'
11211 ! include 'COMMON.INTERACT'
11212 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
11213 real(kind=8),dimension(3,3) :: dp,temp
11214 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
11215 real(kind=8),dimension(3) :: xx,xx1
11216 !el local variables
11217 integer :: i,k,l,j,m,ind,ind1,jjj
11218 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
11219 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
11220 sint2,xp,yp,xxp,yyp,zzp,dj
11222 ! common /przechowalnia/ fromto
11223 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
11224 ! get the position of the jth ijth fragment of the chain coordinate system
11225 ! in the fromto array.
11226 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
11228 ! maxdim=(nres-1)*(nres-2)/2
11229 ! allocate(dcdv(6,maxdim),dxds(6,nres))
11230 ! calculate the derivatives of transformation matrix elements in theta
11233 !el call flush(iout) !el
11235 rdt(1,1,i)=-rt(1,2,i)
11236 rdt(1,2,i)= rt(1,1,i)
11238 rdt(2,1,i)=-rt(2,2,i)
11239 rdt(2,2,i)= rt(2,1,i)
11241 rdt(3,1,i)=-rt(3,2,i)
11242 rdt(3,2,i)= rt(3,1,i)
11246 ! derivatives in phi
11252 drt(2,1,i)= rt(3,1,i)
11253 drt(2,2,i)= rt(3,2,i)
11254 drt(2,3,i)= rt(3,3,i)
11255 drt(3,1,i)=-rt(2,1,i)
11256 drt(3,2,i)=-rt(2,2,i)
11257 drt(3,3,i)=-rt(2,3,i)
11260 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
11266 temp(k,l)=rt(k,l,i)
11271 fromto(k,l,ind)=temp(k,l)
11280 dpkl=dpkl+temp(k,m)*rt(m,l,j)
11283 fromto(k,l,ind)=dpkl
11294 ! Calculate derivatives.
11300 ! Derivatives of DC(i+1) in theta(i+2)
11306 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
11309 prordt(j,k,i)=dp(j,k)
11312 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
11315 ! Derivatives of SC(i+1) in theta(i+2)
11317 xx1(1)=-0.5D0*xloc(2,i+1)
11318 xx1(2)= 0.5D0*xloc(1,i+1)
11322 xj=xj+r(j,k,i)*xx1(k)
11329 rj=rj+prod(j,k,i)*xx(k)
11334 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
11335 ! than the other off-diagonal derivatives.
11340 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
11342 dxdv(j,ind1+1)=dxoiij
11344 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
11346 ! Derivatives of DC(i+1) in phi(i+2)
11352 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
11355 prodrt(j,k,i)=dp(j,k)
11357 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
11360 ! Derivatives of SC(i+1) in phi(i+2)
11363 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
11364 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
11368 rj=rj+prod(j,k,i)*xx(k)
11373 ! Derivatives of SC(i+1) in phi(i+3).
11378 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
11380 dxdv(j+3,ind1+1)=dxoiij
11383 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
11384 ! theta(nres) and phi(i+3) thru phi(nres).
11388 ind=indmat(i+1,j+1)
11389 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
11394 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
11399 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
11400 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
11401 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
11402 ! Derivatives of virtual-bond vectors in theta
11404 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
11406 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
11407 ! Derivatives of SC vectors in theta
11411 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
11413 dxdv(k,ind1+1)=dxoijk
11416 !--- Calculate the derivatives in phi
11422 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
11428 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
11433 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
11435 dxdv(k+3,ind1+1)=dxoijk
11440 ! Derivatives in alpha and omega:
11443 ! dsci=dsc(itype(i,1))
11448 if(alphi.ne.alphi) alphi=100.0
11449 if(omegi.ne.omegi) omegi=-100.0
11454 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
11455 cosalphi=dcos(alphi)
11456 sinalphi=dsin(alphi)
11457 cosomegi=dcos(omegi)
11458 sinomegi=dsin(omegi)
11459 temp(1,1)=-dsci*sinalphi
11460 temp(2,1)= dsci*cosalphi*cosomegi
11461 temp(3,1)=-dsci*cosalphi*sinomegi
11463 temp(2,2)=-dsci*sinalphi*sinomegi
11464 temp(3,2)=-dsci*sinalphi*cosomegi
11465 theta2=pi-0.5D0*theta(i+1)
11469 !d print *,((temp(l,k),l=1,3),k=1,2)
11473 xxp= xp*cost2+yp*sint2
11474 yyp=-xp*sint2+yp*cost2
11477 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
11478 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
11482 dj=dj+prod(k,l,i-1)*xx(l)
11490 end subroutine cartder
11491 !-----------------------------------------------------------------------------
11493 !-----------------------------------------------------------------------------
11494 subroutine check_cartgrad
11495 ! Check the gradient of Cartesian coordinates in internal coordinates.
11496 ! implicit real*8 (a-h,o-z)
11497 ! include 'DIMENSIONS'
11498 ! include 'COMMON.IOUNITS'
11499 ! include 'COMMON.VAR'
11500 ! include 'COMMON.CHAIN'
11501 ! include 'COMMON.GEO'
11502 ! include 'COMMON.LOCAL'
11503 ! include 'COMMON.DERIV'
11504 real(kind=8),dimension(6,nres) :: temp
11505 real(kind=8),dimension(3) :: xx,gg
11506 integer :: i,k,j,ii
11507 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
11508 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
11510 ! Check the gradient of the virtual-bond and SC vectors in the internal
11516 write (iout,'(a)') '**************** dx/dalpha'
11520 alph(i)=alph(i)+aincr
11522 temp(k,i)=dc(k,nres+i)
11526 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11527 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
11529 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11530 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
11536 write (iout,'(a)') '**************** dx/domega'
11540 omeg(i)=omeg(i)+aincr
11542 temp(k,i)=dc(k,nres+i)
11546 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11547 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
11548 (aincr*dabs(dxds(k+3,i))+aincr))
11550 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11551 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
11557 write (iout,'(a)') '**************** dx/dtheta'
11561 theta(i)=theta(i)+aincr
11564 temp(k,j)=dc(k,nres+j)
11570 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
11572 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11573 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
11574 (aincr*dabs(dxdv(k,ii))+aincr))
11576 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11577 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
11584 write (iout,'(a)') '***************** dx/dphi'
11587 phi(i)=phi(i)+aincr
11590 temp(k,j)=dc(k,nres+j)
11598 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11599 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
11600 (aincr*dabs(dxdv(k+3,ii))+aincr))
11602 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11603 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11606 phi(i)=phi(i)-aincr
11609 write (iout,'(a)') '****************** ddc/dtheta'
11612 theta(i+2)=thet+aincr
11623 gg(k)=(dc(k,j)-temp(k,j))/aincr
11624 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
11625 (aincr*dabs(dcdv(k,ii))+aincr))
11627 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11628 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
11638 write (iout,'(a)') '******************* ddc/dphi'
11641 phi(i+3)=phii+aincr
11652 gg(k)=(dc(k,j)-temp(k,j))/aincr
11653 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
11654 (aincr*dabs(dcdv(k+3,ii))+aincr))
11656 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11657 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11668 end subroutine check_cartgrad
11669 !-----------------------------------------------------------------------------
11670 subroutine check_ecart
11671 ! Check the gradient of the energy in Cartesian coordinates.
11672 ! implicit real*8 (a-h,o-z)
11673 ! include 'DIMENSIONS'
11674 ! include 'COMMON.CHAIN'
11675 ! include 'COMMON.DERIV'
11676 ! include 'COMMON.IOUNITS'
11677 ! include 'COMMON.VAR'
11678 ! include 'COMMON.CONTACTS'
11680 !el integer :: icall
11681 !el common /srutu/ icall
11682 real(kind=8),dimension(6) :: ggg
11683 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
11684 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11685 real(kind=8),dimension(6,nres) :: grad_s
11686 real(kind=8),dimension(0:n_ene) :: energia,energia1
11687 integer :: uiparm(1)
11688 real(kind=8) :: urparm(1)
11690 integer :: nf,i,j,k
11691 real(kind=8) :: aincr,etot,etot1
11697 print '(a)','CG processor',me,' calling CHECK_CART.',aincr
11700 call geom_to_var(nvar,x)
11701 call etotal(energia)
11703 !el call enerprint(energia)
11704 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
11707 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11711 grad_s(j,i)=gradc(j,i,icg)
11712 grad_s(j+3,i)=gradx(j,i,icg)
11716 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11721 ddx(j)=dc(j,i+nres)
11724 dc(j,i)=dc(j,i)+aincr
11726 c(j,k)=c(j,k)+aincr
11727 c(j,k+nres)=c(j,k+nres)+aincr
11729 call etotal(energia1)
11731 ggg(j)=(etot1-etot)/aincr
11734 c(j,k)=c(j,k)-aincr
11735 c(j,k+nres)=c(j,k+nres)-aincr
11739 c(j,i+nres)=c(j,i+nres)+aincr
11740 dc(j,i+nres)=dc(j,i+nres)+aincr
11741 call etotal(energia1)
11743 ggg(j+3)=(etot1-etot)/aincr
11745 dc(j,i+nres)=ddx(j)
11747 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
11748 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
11751 end subroutine check_ecart
11753 !-----------------------------------------------------------------------------
11754 subroutine check_ecartint
11755 ! Check the gradient of the energy in Cartesian coordinates.
11756 use io_base, only: intout
11757 ! implicit real*8 (a-h,o-z)
11758 ! include 'DIMENSIONS'
11759 ! include 'COMMON.CONTROL'
11760 ! include 'COMMON.CHAIN'
11761 ! include 'COMMON.DERIV'
11762 ! include 'COMMON.IOUNITS'
11763 ! include 'COMMON.VAR'
11764 ! include 'COMMON.CONTACTS'
11765 ! include 'COMMON.MD'
11766 ! include 'COMMON.LOCAL'
11767 ! include 'COMMON.SPLITELE'
11769 !el integer :: icall
11770 !el common /srutu/ icall
11771 real(kind=8),dimension(6) :: ggg,ggg1
11772 real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
11773 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11774 real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
11775 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
11776 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
11777 real(kind=8),dimension(0:n_ene) :: energia,energia1
11778 integer :: uiparm(1)
11779 real(kind=8) :: urparm(1)
11781 integer :: i,j,k,nf
11782 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
11790 ! call intcartderiv
11791 ! call checkintcartgrad
11794 write(iout,*) 'Calling CHECK_ECARTINT.'
11797 write (iout,*) "Before geom_to_var"
11798 call geom_to_var(nvar,x)
11799 write (iout,*) "after geom_to_var"
11800 write (iout,*) "split_ene ",split_ene
11802 if (.not.split_ene) then
11803 write(iout,*) 'Calling CHECK_ECARTINT if'
11804 call etotal(energia)
11805 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11807 write (iout,*) "etot",etot
11809 !el call enerprint(energia)
11810 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11812 write (iout,*) "enter cartgrad"
11815 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11816 write (iout,*) "exit cartgrad"
11820 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11823 grad_s(j,0)=gcart(j,0)
11825 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11828 grad_s(j,i)=gcart(j,i)
11829 grad_s(j+3,i)=gxcart(j,i)
11833 write(iout,*) 'Calling CHECK_ECARTIN else.'
11834 !- split gradient check
11836 call etotal_long(energia)
11837 !el call enerprint(energia)
11839 write (iout,*) "enter cartgrad"
11842 write (iout,*) "exit cartgrad"
11845 write (iout,*) "longrange grad"
11847 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11848 (gxcart(j,i),j=1,3)
11851 grad_s(j,0)=gcart(j,0)
11855 grad_s(j,i)=gcart(j,i)
11856 grad_s(j+3,i)=gxcart(j,i)
11860 call etotal_short(energia)
11861 call enerprint(energia)
11863 write (iout,*) "enter cartgrad"
11866 write (iout,*) "exit cartgrad"
11869 write (iout,*) "shortrange grad"
11871 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11872 (gxcart(j,i),j=1,3)
11875 grad_s1(j,0)=gcart(j,0)
11879 grad_s1(j,i)=gcart(j,i)
11880 grad_s1(j+3,i)=gxcart(j,i)
11884 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11888 if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
11889 if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
11892 dcnorm_safe1(j)=dc_norm(j,i-1)
11893 dcnorm_safe2(j)=dc_norm(j,i)
11894 dxnorm_safe(j)=dc_norm(j,i+nres)
11897 c(j,i)=ddc(j)+aincr
11898 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
11899 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
11900 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11901 dc(j,i)=c(j,i+1)-c(j,i)
11902 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11903 call int_from_cart1(.false.)
11904 if (.not.split_ene) then
11905 call etotal(energia1)
11907 write (iout,*) "ij",i,j," etot1",etot1
11910 call etotal_long(energia1)
11912 call etotal_short(energia1)
11915 !- end split gradient
11916 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11917 c(j,i)=ddc(j)-aincr
11918 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
11919 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
11920 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11921 dc(j,i)=c(j,i+1)-c(j,i)
11922 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11923 call int_from_cart1(.false.)
11924 if (.not.split_ene) then
11925 call etotal(energia1)
11927 write (iout,*) "ij",i,j," etot2",etot2
11928 ggg(j)=(etot1-etot2)/(2*aincr)
11931 call etotal_long(energia1)
11933 ggg(j)=(etot11-etot21)/(2*aincr)
11934 call etotal_short(energia1)
11936 ggg1(j)=(etot12-etot22)/(2*aincr)
11937 !- end split gradient
11938 ! write (iout,*) "etot21",etot21," etot22",etot22
11940 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11942 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
11943 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
11944 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11945 dc(j,i)=c(j,i+1)-c(j,i)
11946 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11947 dc_norm(j,i-1)=dcnorm_safe1(j)
11948 dc_norm(j,i)=dcnorm_safe2(j)
11949 dc_norm(j,i+nres)=dxnorm_safe(j)
11952 c(j,i+nres)=ddx(j)+aincr
11953 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11954 call int_from_cart1(.false.)
11955 if (.not.split_ene) then
11956 call etotal(energia1)
11960 call etotal_long(energia1)
11962 call etotal_short(energia1)
11965 !- end split gradient
11966 c(j,i+nres)=ddx(j)-aincr
11967 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11968 call int_from_cart1(.false.)
11969 if (.not.split_ene) then
11970 call etotal(energia1)
11972 ggg(j+3)=(etot1-etot2)/(2*aincr)
11975 call etotal_long(energia1)
11977 ggg(j+3)=(etot11-etot21)/(2*aincr)
11978 call etotal_short(energia1)
11980 ggg1(j+3)=(etot12-etot22)/(2*aincr)
11981 !- end split gradient
11983 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11985 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11986 dc_norm(j,i+nres)=dxnorm_safe(j)
11987 call int_from_cart1(.false.)
11989 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11990 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
11991 if (split_ene) then
11992 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11993 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
11995 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11996 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
11997 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
12001 end subroutine check_ecartint
12003 !-----------------------------------------------------------------------------
12004 subroutine check_ecartint
12005 ! Check the gradient of the energy in Cartesian coordinates.
12006 use io_base, only: intout
12007 ! implicit real*8 (a-h,o-z)
12008 ! include 'DIMENSIONS'
12009 ! include 'COMMON.CONTROL'
12010 ! include 'COMMON.CHAIN'
12011 ! include 'COMMON.DERIV'
12012 ! include 'COMMON.IOUNITS'
12013 ! include 'COMMON.VAR'
12014 ! include 'COMMON.CONTACTS'
12015 ! include 'COMMON.MD'
12016 ! include 'COMMON.LOCAL'
12017 ! include 'COMMON.SPLITELE'
12019 !el integer :: icall
12020 !el common /srutu/ icall
12021 real(kind=8),dimension(6) :: ggg,ggg1
12022 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
12023 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
12024 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
12025 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
12026 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
12027 real(kind=8),dimension(0:n_ene) :: energia,energia1
12028 integer :: uiparm(1)
12029 real(kind=8) :: urparm(1)
12031 integer :: i,j,k,nf
12032 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
12040 ! call intcartderiv
12041 ! call checkintcartgrad
12044 write(iout,*) 'Calling CHECK_ECARTINT.',aincr
12047 call geom_to_var(nvar,x)
12048 if (.not.split_ene) then
12049 call etotal(energia)
12051 !el call enerprint(energia)
12053 write (iout,*) "enter cartgrad"
12056 write (iout,*) "exit cartgrad"
12060 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
12063 grad_s(j,0)=gcart(j,0)
12067 grad_s(j,i)=gcart(j,i)
12068 ! if (i.le.2) print *,"tu?!",gcart(j,i),grad_s(j,i),gxcart(j,i)
12069 grad_s(j+3,i)=gxcart(j,i)
12073 !- split gradient check
12075 call etotal_long(energia)
12076 !el call enerprint(energia)
12078 write (iout,*) "enter cartgrad"
12081 write (iout,*) "exit cartgrad"
12084 write (iout,*) "longrange grad"
12086 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12087 (gxcart(j,i),j=1,3)
12090 grad_s(j,0)=gcart(j,0)
12094 grad_s(j,i)=gcart(j,i)
12095 grad_s(j+3,i)=gxcart(j,i)
12099 call etotal_short(energia)
12100 !el call enerprint(energia)
12102 write (iout,*) "enter cartgrad"
12105 write (iout,*) "exit cartgrad"
12108 write (iout,*) "shortrange grad"
12110 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12111 (gxcart(j,i),j=1,3)
12114 grad_s1(j,0)=gcart(j,0)
12118 grad_s1(j,i)=gcart(j,i)
12119 grad_s1(j+3,i)=gxcart(j,i)
12123 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
12128 ddx(j)=dc(j,i+nres)
12130 dcnorm_safe(k)=dc_norm(k,i)
12131 dxnorm_safe(k)=dc_norm(k,i+nres)
12135 dc(j,i)=ddc(j)+aincr
12136 call chainbuild_cart
12138 ! Broadcast the order to compute internal coordinates to the slaves.
12139 ! if (nfgtasks.gt.1)
12140 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
12142 ! call int_from_cart1(.false.)
12143 if (.not.split_ene) then
12144 call etotal(energia1)
12146 ! call enerprint(energia1)
12149 call etotal_long(energia1)
12151 call etotal_short(energia1)
12153 ! write (iout,*) "etot11",etot11," etot12",etot12
12155 !- end split gradient
12156 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12157 dc(j,i)=ddc(j)-aincr
12158 call chainbuild_cart
12159 ! call int_from_cart1(.false.)
12160 if (.not.split_ene) then
12161 call etotal(energia1)
12163 ggg(j)=(etot1-etot2)/(2*aincr)
12166 call etotal_long(energia1)
12168 ggg(j)=(etot11-etot21)/(2*aincr)
12169 call etotal_short(energia1)
12171 ggg1(j)=(etot12-etot22)/(2*aincr)
12172 !- end split gradient
12173 ! write (iout,*) "etot21",etot21," etot22",etot22
12175 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12177 call chainbuild_cart
12180 dc(j,i+nres)=ddx(j)+aincr
12181 call chainbuild_cart
12182 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
12183 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
12184 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
12185 ! write (iout,*) "dxnormnorm",dsqrt(
12186 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
12187 ! write (iout,*) "dxnormnormsafe",dsqrt(
12188 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
12190 if (.not.split_ene) then
12191 call etotal(energia1)
12195 call etotal_long(energia1)
12197 call etotal_short(energia1)
12200 !- end split gradient
12201 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12202 dc(j,i+nres)=ddx(j)-aincr
12203 call chainbuild_cart
12204 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
12205 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
12206 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
12208 ! write (iout,*) "dxnormnorm",dsqrt(
12209 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
12210 ! write (iout,*) "dxnormnormsafe",dsqrt(
12211 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
12212 if (.not.split_ene) then
12213 call etotal(energia1)
12215 ggg(j+3)=(etot1-etot2)/(2*aincr)
12218 call etotal_long(energia1)
12220 ggg(j+3)=(etot11-etot21)/(2*aincr)
12221 call etotal_short(energia1)
12223 ggg1(j+3)=(etot12-etot22)/(2*aincr)
12224 !- end split gradient
12226 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12227 dc(j,i+nres)=ddx(j)
12228 call chainbuild_cart
12230 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12231 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
12232 if (split_ene) then
12233 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12234 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
12236 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12237 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
12238 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
12242 end subroutine check_ecartint
12244 !-----------------------------------------------------------------------------
12245 subroutine check_eint
12246 ! Check the gradient of energy in internal coordinates.
12247 ! implicit real*8 (a-h,o-z)
12248 ! include 'DIMENSIONS'
12249 ! include 'COMMON.CHAIN'
12250 ! include 'COMMON.DERIV'
12251 ! include 'COMMON.IOUNITS'
12252 ! include 'COMMON.VAR'
12253 ! include 'COMMON.GEO'
12255 !el integer :: icall
12256 !el common /srutu/ icall
12257 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
12258 integer :: uiparm(1)
12259 real(kind=8) :: urparm(1)
12260 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
12261 character(len=6) :: key
12264 real(kind=8) :: xi,aincr,etot,etot1,etot2
12267 print '(a)','Calling CHECK_INT.'
12271 call geom_to_var(nvar,x)
12272 call var_to_geom(nvar,x)
12275 ! print *,'ICG=',ICG
12276 call etotal(energia)
12278 !el call enerprint(energia)
12279 ! print *,'ICG=',ICG
12281 if (MyID.ne.BossID) then
12282 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
12290 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
12291 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
12292 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
12296 x(i)=xi-0.5D0*aincr
12297 call var_to_geom(nvar,x)
12299 call etotal(energia1)
12301 x(i)=xi+0.5D0*aincr
12302 call var_to_geom(nvar,x)
12304 call etotal(energia2)
12306 gg(i)=(etot2-etot1)/aincr
12307 write (iout,*) i,etot1,etot2
12310 write (iout,'(/2a)')' Variable Numerical Analytical',&
12313 if (i.le.nphi) then
12316 else if (i.le.nphi+ntheta) then
12319 else if (i.le.nphi+ntheta+nside) then
12323 ii=i-(nphi+ntheta+nside)
12326 write (iout,'(i3,a,i3,3(1pd16.6))') &
12327 i,key,ii,gg(i),gana(i),&
12328 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
12331 end subroutine check_eint
12332 !-----------------------------------------------------------------------------
12334 !-----------------------------------------------------------------------------
12335 subroutine Econstr_back
12336 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
12337 ! implicit real*8 (a-h,o-z)
12338 ! include 'DIMENSIONS'
12339 ! include 'COMMON.CONTROL'
12340 ! include 'COMMON.VAR'
12341 ! include 'COMMON.MD'
12344 ! include 'COMMON.LANGEVIN'
12346 ! include 'COMMON.LANGEVIN.lang0'
12348 ! include 'COMMON.CHAIN'
12349 ! include 'COMMON.DERIV'
12350 ! include 'COMMON.GEO'
12351 ! include 'COMMON.LOCAL'
12352 ! include 'COMMON.INTERACT'
12353 ! include 'COMMON.IOUNITS'
12354 ! include 'COMMON.NAMES'
12355 ! include 'COMMON.TIME1'
12356 integer :: i,j,ii,k
12357 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
12359 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
12360 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
12361 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
12368 duscdiff(j,i)=0.0d0
12369 duscdiffx(j,i)=0.0d0
12373 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
12375 ! Deviations from theta angles
12378 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
12379 dtheta_i=theta(j)-thetaref(j)
12380 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
12381 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
12383 utheta(i)=utheta_i/(ii-1)
12385 ! Deviations from gamma angles
12388 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
12389 dgamma_i=pinorm(phi(j)-phiref(j))
12390 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
12391 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
12392 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
12393 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
12395 ugamma(i)=ugamma_i/(ii-2)
12397 ! Deviations from local SC geometry
12400 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
12401 dxx=xxtab(j)-xxref(j)
12402 dyy=yytab(j)-yyref(j)
12403 dzz=zztab(j)-zzref(j)
12404 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
12406 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
12407 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
12409 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
12410 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
12412 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
12413 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
12416 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
12417 ! & xxref(j),yyref(j),zzref(j)
12419 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
12420 ! write (iout,*) i," uscdiff",uscdiff(i)
12422 ! Put together deviations from local geometry
12424 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
12425 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
12426 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
12427 ! & " uconst_back",uconst_back
12428 utheta(i)=dsqrt(utheta(i))
12429 ugamma(i)=dsqrt(ugamma(i))
12430 uscdiff(i)=dsqrt(uscdiff(i))
12433 end subroutine Econstr_back
12434 !-----------------------------------------------------------------------------
12435 ! energy_p_new-sep_barrier.F
12436 !-----------------------------------------------------------------------------
12437 real(kind=8) function sscale(r)
12438 ! include "COMMON.SPLITELE"
12439 real(kind=8) :: r,gamm
12440 if(r.lt.r_cut-rlamb) then
12442 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
12443 gamm=(r-(r_cut-rlamb))/rlamb
12444 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12449 end function sscale
12450 real(kind=8) function sscale_grad(r)
12451 ! include "COMMON.SPLITELE"
12452 real(kind=8) :: r,gamm
12453 if(r.lt.r_cut-rlamb) then
12455 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
12456 gamm=(r-(r_cut-rlamb))/rlamb
12457 sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
12462 end function sscale_grad
12464 !!!!!!!!!! PBCSCALE
12465 real(kind=8) function sscale_ele(r)
12466 ! include "COMMON.SPLITELE"
12467 real(kind=8) :: r,gamm
12468 if(r.lt.r_cut_ele-rlamb_ele) then
12470 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12471 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12472 sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12477 end function sscale_ele
12479 real(kind=8) function sscagrad_ele(r)
12480 real(kind=8) :: r,gamm
12481 ! include "COMMON.SPLITELE"
12482 if(r.lt.r_cut_ele-rlamb_ele) then
12484 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12485 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12486 sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
12491 end function sscagrad_ele
12492 real(kind=8) function sscalelip(r)
12493 real(kind=8) r,gamm
12494 sscalelip=1.0d0+r*r*(2.0d0*r-3.0d0)
12496 end function sscalelip
12497 !C-----------------------------------------------------------------------
12498 real(kind=8) function sscagradlip(r)
12499 real(kind=8) r,gamm
12500 sscagradlip=r*(6.0d0*r-6.0d0)
12502 end function sscagradlip
12505 !-----------------------------------------------------------------------------
12506 subroutine elj_long(evdw)
12508 ! This subroutine calculates the interaction energy of nonbonded side chains
12509 ! assuming the LJ potential of interaction.
12511 ! implicit real*8 (a-h,o-z)
12512 ! include 'DIMENSIONS'
12513 ! include 'COMMON.GEO'
12514 ! include 'COMMON.VAR'
12515 ! include 'COMMON.LOCAL'
12516 ! include 'COMMON.CHAIN'
12517 ! include 'COMMON.DERIV'
12518 ! include 'COMMON.INTERACT'
12519 ! include 'COMMON.TORSION'
12520 ! include 'COMMON.SBRIDGE'
12521 ! include 'COMMON.NAMES'
12522 ! include 'COMMON.IOUNITS'
12523 ! include 'COMMON.CONTACTS'
12524 real(kind=8),parameter :: accur=1.0d-10
12525 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12526 !el local variables
12527 integer :: i,iint,j,k,itypi,itypi1,itypj
12528 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12529 real(kind=8) :: e1,e2,evdwij,evdw
12530 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12532 do i=iatsc_s,iatsc_e
12534 if (itypi.eq.ntyp1) cycle
12535 itypi1=itype(i+1,1)
12540 ! Calculate SC interaction energy.
12542 do iint=1,nint_gr(i)
12543 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12544 !d & 'iend=',iend(i,iint)
12545 do j=istart(i,iint),iend(i,iint)
12547 if (itypj.eq.ntyp1) cycle
12551 rij=xj*xj+yj*yj+zj*zj
12552 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12553 if (sss.lt.1.0d0) then
12555 eps0ij=eps(itypi,itypj)
12557 e1=fac*fac*aa_aq(itypi,itypj)
12558 e2=fac*bb_aq(itypi,itypj)
12560 evdw=evdw+(1.0d0-sss)*evdwij
12562 ! Calculate the components of the gradient in DC and X
12564 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
12569 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12570 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12571 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12572 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12580 gvdwc(j,i)=expon*gvdwc(j,i)
12581 gvdwx(j,i)=expon*gvdwx(j,i)
12584 !******************************************************************************
12588 ! To save time, the factor of EXPON has been extracted from ALL components
12589 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12592 !******************************************************************************
12594 end subroutine elj_long
12595 !-----------------------------------------------------------------------------
12596 subroutine elj_short(evdw)
12598 ! This subroutine calculates the interaction energy of nonbonded side chains
12599 ! assuming the LJ potential of interaction.
12601 ! implicit real*8 (a-h,o-z)
12602 ! include 'DIMENSIONS'
12603 ! include 'COMMON.GEO'
12604 ! include 'COMMON.VAR'
12605 ! include 'COMMON.LOCAL'
12606 ! include 'COMMON.CHAIN'
12607 ! include 'COMMON.DERIV'
12608 ! include 'COMMON.INTERACT'
12609 ! include 'COMMON.TORSION'
12610 ! include 'COMMON.SBRIDGE'
12611 ! include 'COMMON.NAMES'
12612 ! include 'COMMON.IOUNITS'
12613 ! include 'COMMON.CONTACTS'
12614 real(kind=8),parameter :: accur=1.0d-10
12615 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12616 !el local variables
12617 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
12618 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12619 real(kind=8) :: e1,e2,evdwij,evdw
12620 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12622 do i=iatsc_s,iatsc_e
12624 if (itypi.eq.ntyp1) cycle
12625 itypi1=itype(i+1,1)
12632 ! Calculate SC interaction energy.
12634 do iint=1,nint_gr(i)
12635 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12636 !d & 'iend=',iend(i,iint)
12637 do j=istart(i,iint),iend(i,iint)
12639 if (itypj.eq.ntyp1) cycle
12643 ! Change 12/1/95 to calculate four-body interactions
12644 rij=xj*xj+yj*yj+zj*zj
12645 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12646 if (sss.gt.0.0d0) then
12648 eps0ij=eps(itypi,itypj)
12650 e1=fac*fac*aa_aq(itypi,itypj)
12651 e2=fac*bb_aq(itypi,itypj)
12653 evdw=evdw+sss*evdwij
12655 ! Calculate the components of the gradient in DC and X
12657 fac=-rrij*(e1+evdwij)*sss
12662 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12663 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12664 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12665 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12673 gvdwc(j,i)=expon*gvdwc(j,i)
12674 gvdwx(j,i)=expon*gvdwx(j,i)
12677 !******************************************************************************
12681 ! To save time, the factor of EXPON has been extracted from ALL components
12682 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12685 !******************************************************************************
12687 end subroutine elj_short
12688 !-----------------------------------------------------------------------------
12689 subroutine eljk_long(evdw)
12691 ! This subroutine calculates the interaction energy of nonbonded side chains
12692 ! assuming the LJK potential of interaction.
12694 ! implicit real*8 (a-h,o-z)
12695 ! include 'DIMENSIONS'
12696 ! include 'COMMON.GEO'
12697 ! include 'COMMON.VAR'
12698 ! include 'COMMON.LOCAL'
12699 ! include 'COMMON.CHAIN'
12700 ! include 'COMMON.DERIV'
12701 ! include 'COMMON.INTERACT'
12702 ! include 'COMMON.IOUNITS'
12703 ! include 'COMMON.NAMES'
12704 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12706 !el local variables
12707 integer :: i,iint,j,k,itypi,itypi1,itypj
12708 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12709 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12710 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12712 do i=iatsc_s,iatsc_e
12714 if (itypi.eq.ntyp1) cycle
12715 itypi1=itype(i+1,1)
12720 ! Calculate SC interaction energy.
12722 do iint=1,nint_gr(i)
12723 do j=istart(i,iint),iend(i,iint)
12725 if (itypj.eq.ntyp1) cycle
12729 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12730 fac_augm=rrij**expon
12731 e_augm=augm(itypi,itypj)*fac_augm
12732 r_inv_ij=dsqrt(rrij)
12734 sss=sscale(rij/sigma(itypi,itypj))
12735 if (sss.lt.1.0d0) then
12736 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12737 fac=r_shift_inv**expon
12738 e1=fac*fac*aa_aq(itypi,itypj)
12739 e2=fac*bb_aq(itypi,itypj)
12740 evdwij=e_augm+e1+e2
12741 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12742 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12743 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12744 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
12745 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12746 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12747 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12748 evdw=evdw+(1.0d0-sss)*evdwij
12750 ! Calculate the components of the gradient in DC and X
12752 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12753 fac=fac*(1.0d0-sss)
12758 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12759 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12760 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12761 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12769 gvdwc(j,i)=expon*gvdwc(j,i)
12770 gvdwx(j,i)=expon*gvdwx(j,i)
12774 end subroutine eljk_long
12775 !-----------------------------------------------------------------------------
12776 subroutine eljk_short(evdw)
12778 ! This subroutine calculates the interaction energy of nonbonded side chains
12779 ! assuming the LJK potential of interaction.
12781 ! implicit real*8 (a-h,o-z)
12782 ! include 'DIMENSIONS'
12783 ! include 'COMMON.GEO'
12784 ! include 'COMMON.VAR'
12785 ! include 'COMMON.LOCAL'
12786 ! include 'COMMON.CHAIN'
12787 ! include 'COMMON.DERIV'
12788 ! include 'COMMON.INTERACT'
12789 ! include 'COMMON.IOUNITS'
12790 ! include 'COMMON.NAMES'
12791 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12793 !el local variables
12794 integer :: i,iint,j,k,itypi,itypi1,itypj
12795 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12796 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12797 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12799 do i=iatsc_s,iatsc_e
12801 if (itypi.eq.ntyp1) cycle
12802 itypi1=itype(i+1,1)
12807 ! Calculate SC interaction energy.
12809 do iint=1,nint_gr(i)
12810 do j=istart(i,iint),iend(i,iint)
12812 if (itypj.eq.ntyp1) cycle
12816 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12817 fac_augm=rrij**expon
12818 e_augm=augm(itypi,itypj)*fac_augm
12819 r_inv_ij=dsqrt(rrij)
12821 sss=sscale(rij/sigma(itypi,itypj))
12822 if (sss.gt.0.0d0) then
12823 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12824 fac=r_shift_inv**expon
12825 e1=fac*fac*aa_aq(itypi,itypj)
12826 e2=fac*bb_aq(itypi,itypj)
12827 evdwij=e_augm+e1+e2
12828 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12829 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12830 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12831 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
12832 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12833 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12834 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12835 evdw=evdw+sss*evdwij
12837 ! Calculate the components of the gradient in DC and X
12839 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12845 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12846 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12847 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12848 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12856 gvdwc(j,i)=expon*gvdwc(j,i)
12857 gvdwx(j,i)=expon*gvdwx(j,i)
12861 end subroutine eljk_short
12862 !-----------------------------------------------------------------------------
12863 subroutine ebp_long(evdw)
12865 ! This subroutine calculates the interaction energy of nonbonded side chains
12866 ! assuming the Berne-Pechukas potential of interaction.
12869 ! implicit real*8 (a-h,o-z)
12870 ! include 'DIMENSIONS'
12871 ! include 'COMMON.GEO'
12872 ! include 'COMMON.VAR'
12873 ! include 'COMMON.LOCAL'
12874 ! include 'COMMON.CHAIN'
12875 ! include 'COMMON.DERIV'
12876 ! include 'COMMON.NAMES'
12877 ! include 'COMMON.INTERACT'
12878 ! include 'COMMON.IOUNITS'
12879 ! include 'COMMON.CALC'
12881 !el integer :: icall
12882 !el common /srutu/ icall
12883 ! double precision rrsave(maxdim)
12885 !el local variables
12886 integer :: iint,itypi,itypi1,itypj
12887 real(kind=8) :: rrij,xi,yi,zi,fac
12888 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
12890 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
12892 ! if (icall.eq.0) then
12898 do i=iatsc_s,iatsc_e
12900 if (itypi.eq.ntyp1) cycle
12901 itypi1=itype(i+1,1)
12905 dxi=dc_norm(1,nres+i)
12906 dyi=dc_norm(2,nres+i)
12907 dzi=dc_norm(3,nres+i)
12908 ! dsci_inv=dsc_inv(itypi)
12909 dsci_inv=vbld_inv(i+nres)
12911 ! Calculate SC interaction energy.
12913 do iint=1,nint_gr(i)
12914 do j=istart(i,iint),iend(i,iint)
12917 if (itypj.eq.ntyp1) cycle
12918 ! dscj_inv=dsc_inv(itypj)
12919 dscj_inv=vbld_inv(j+nres)
12920 chi1=chi(itypi,itypj)
12921 chi2=chi(itypj,itypi)
12928 alf12=0.5D0*(alf1+alf2)
12932 dxj=dc_norm(1,nres+j)
12933 dyj=dc_norm(2,nres+j)
12934 dzj=dc_norm(3,nres+j)
12935 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12937 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12939 if (sss.lt.1.0d0) then
12941 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
12943 ! Calculate whole angle-dependent part of epsilon and contributions
12944 ! to its derivatives
12945 fac=(rrij*sigsq)**expon2
12946 e1=fac*fac*aa_aq(itypi,itypj)
12947 e2=fac*bb_aq(itypi,itypj)
12948 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12949 eps2der=evdwij*eps3rt
12950 eps3der=evdwij*eps2rt
12951 evdwij=evdwij*eps2rt*eps3rt
12952 evdw=evdw+evdwij*(1.0d0-sss)
12954 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
12955 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
12956 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
12957 !d & restyp(itypi,1),i,restyp(itypj,1),j,
12958 !d & epsi,sigm,chi1,chi2,chip1,chip2,
12959 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
12960 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
12963 ! Calculate gradient components.
12964 e1=e1*eps1*eps2rt**2*eps3rt**2
12965 fac=-expon*(e1+evdwij)
12968 ! Calculate radial part of the gradient
12972 ! Calculate the angular part of the gradient and sum add the contributions
12973 ! to the appropriate components of the Cartesian gradient.
12974 call sc_grad_scale(1.0d0-sss)
12981 end subroutine ebp_long
12982 !-----------------------------------------------------------------------------
12983 subroutine ebp_short(evdw)
12985 ! This subroutine calculates the interaction energy of nonbonded side chains
12986 ! assuming the Berne-Pechukas potential of interaction.
12989 ! implicit real*8 (a-h,o-z)
12990 ! include 'DIMENSIONS'
12991 ! include 'COMMON.GEO'
12992 ! include 'COMMON.VAR'
12993 ! include 'COMMON.LOCAL'
12994 ! include 'COMMON.CHAIN'
12995 ! include 'COMMON.DERIV'
12996 ! include 'COMMON.NAMES'
12997 ! include 'COMMON.INTERACT'
12998 ! include 'COMMON.IOUNITS'
12999 ! include 'COMMON.CALC'
13001 !el integer :: icall
13002 !el common /srutu/ icall
13003 ! double precision rrsave(maxdim)
13005 !el local variables
13006 integer :: iint,itypi,itypi1,itypj
13007 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
13008 real(kind=8) :: sss,e1,e2,evdw
13010 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
13012 ! if (icall.eq.0) then
13018 do i=iatsc_s,iatsc_e
13020 if (itypi.eq.ntyp1) cycle
13021 itypi1=itype(i+1,1)
13025 dxi=dc_norm(1,nres+i)
13026 dyi=dc_norm(2,nres+i)
13027 dzi=dc_norm(3,nres+i)
13028 ! dsci_inv=dsc_inv(itypi)
13029 dsci_inv=vbld_inv(i+nres)
13031 ! Calculate SC interaction energy.
13033 do iint=1,nint_gr(i)
13034 do j=istart(i,iint),iend(i,iint)
13037 if (itypj.eq.ntyp1) cycle
13038 ! dscj_inv=dsc_inv(itypj)
13039 dscj_inv=vbld_inv(j+nres)
13040 chi1=chi(itypi,itypj)
13041 chi2=chi(itypj,itypi)
13048 alf12=0.5D0*(alf1+alf2)
13052 dxj=dc_norm(1,nres+j)
13053 dyj=dc_norm(2,nres+j)
13054 dzj=dc_norm(3,nres+j)
13055 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13057 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13059 if (sss.gt.0.0d0) then
13061 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
13063 ! Calculate whole angle-dependent part of epsilon and contributions
13064 ! to its derivatives
13065 fac=(rrij*sigsq)**expon2
13066 e1=fac*fac*aa_aq(itypi,itypj)
13067 e2=fac*bb_aq(itypi,itypj)
13068 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13069 eps2der=evdwij*eps3rt
13070 eps3der=evdwij*eps2rt
13071 evdwij=evdwij*eps2rt*eps3rt
13072 evdw=evdw+evdwij*sss
13074 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13075 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13076 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
13077 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13078 !d & epsi,sigm,chi1,chi2,chip1,chip2,
13079 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
13080 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
13083 ! Calculate gradient components.
13084 e1=e1*eps1*eps2rt**2*eps3rt**2
13085 fac=-expon*(e1+evdwij)
13088 ! Calculate radial part of the gradient
13092 ! Calculate the angular part of the gradient and sum add the contributions
13093 ! to the appropriate components of the Cartesian gradient.
13094 call sc_grad_scale(sss)
13101 end subroutine ebp_short
13102 !-----------------------------------------------------------------------------
13103 subroutine egb_long(evdw)
13105 ! This subroutine calculates the interaction energy of nonbonded side chains
13106 ! assuming the Gay-Berne potential of interaction.
13109 ! implicit real*8 (a-h,o-z)
13110 ! include 'DIMENSIONS'
13111 ! include 'COMMON.GEO'
13112 ! include 'COMMON.VAR'
13113 ! include 'COMMON.LOCAL'
13114 ! include 'COMMON.CHAIN'
13115 ! include 'COMMON.DERIV'
13116 ! include 'COMMON.NAMES'
13117 ! include 'COMMON.INTERACT'
13118 ! include 'COMMON.IOUNITS'
13119 ! include 'COMMON.CALC'
13120 ! include 'COMMON.CONTROL'
13122 !el local variables
13123 integer :: iint,itypi,itypi1,itypj,subchap
13124 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
13125 real(kind=8) :: sss,e1,e2,evdw,sss_grad
13126 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13127 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13128 ssgradlipi,ssgradlipj
13132 !cccc energy_dec=.false.
13133 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13136 ! if (icall.eq.0) lprn=.false.
13138 do i=iatsc_s,iatsc_e
13140 if (itypi.eq.ntyp1) cycle
13141 itypi1=itype(i+1,1)
13145 xi=mod(xi,boxxsize)
13146 if (xi.lt.0) xi=xi+boxxsize
13147 yi=mod(yi,boxysize)
13148 if (yi.lt.0) yi=yi+boxysize
13149 zi=mod(zi,boxzsize)
13150 if (zi.lt.0) zi=zi+boxzsize
13151 if ((zi.gt.bordlipbot) &
13152 .and.(zi.lt.bordliptop)) then
13153 !C the energy transfer exist
13154 if (zi.lt.buflipbot) then
13155 !C what fraction I am in
13157 ((zi-bordlipbot)/lipbufthick)
13158 !C lipbufthick is thickenes of lipid buffore
13159 sslipi=sscalelip(fracinbuf)
13160 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
13161 elseif (zi.gt.bufliptop) then
13162 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
13163 sslipi=sscalelip(fracinbuf)
13164 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
13174 dxi=dc_norm(1,nres+i)
13175 dyi=dc_norm(2,nres+i)
13176 dzi=dc_norm(3,nres+i)
13177 ! dsci_inv=dsc_inv(itypi)
13178 dsci_inv=vbld_inv(i+nres)
13179 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
13180 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
13182 ! Calculate SC interaction energy.
13184 do iint=1,nint_gr(i)
13185 do j=istart(i,iint),iend(i,iint)
13186 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
13187 ! call dyn_ssbond_ene(i,j,evdwij)
13189 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13190 ! 'evdw',i,j,evdwij,' ss'
13191 ! if (energy_dec) write (iout,*) &
13192 ! 'evdw',i,j,evdwij,' ss'
13193 ! do k=j+1,iend(i,iint)
13194 !C search over all next residues
13195 ! if (dyn_ss_mask(k)) then
13196 !C check if they are cysteins
13197 !C write(iout,*) 'k=',k
13199 !c write(iout,*) "PRZED TRI", evdwij
13200 ! evdwij_przed_tri=evdwij
13201 ! call triple_ssbond_ene(i,j,k,evdwij)
13202 !c if(evdwij_przed_tri.ne.evdwij) then
13203 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
13206 !c write(iout,*) "PO TRI", evdwij
13207 !C call the energy function that removes the artifical triple disulfide
13208 !C bond the soubroutine is located in ssMD.F
13210 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13211 'evdw',i,j,evdwij,'tss'
13212 ! endif!dyn_ss_mask(k)
13218 if (itypj.eq.ntyp1) cycle
13219 ! dscj_inv=dsc_inv(itypj)
13220 dscj_inv=vbld_inv(j+nres)
13221 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
13222 ! & 1.0d0/vbld(j+nres)
13223 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
13224 sig0ij=sigma(itypi,itypj)
13225 chi1=chi(itypi,itypj)
13226 chi2=chi(itypj,itypi)
13233 alf12=0.5D0*(alf1+alf2)
13237 ! Searching for nearest neighbour
13238 xj=mod(xj,boxxsize)
13239 if (xj.lt.0) xj=xj+boxxsize
13240 yj=mod(yj,boxysize)
13241 if (yj.lt.0) yj=yj+boxysize
13242 zj=mod(zj,boxzsize)
13243 if (zj.lt.0) zj=zj+boxzsize
13244 if ((zj.gt.bordlipbot) &
13245 .and.(zj.lt.bordliptop)) then
13246 !C the energy transfer exist
13247 if (zj.lt.buflipbot) then
13248 !C what fraction I am in
13250 ((zj-bordlipbot)/lipbufthick)
13251 !C lipbufthick is thickenes of lipid buffore
13252 sslipj=sscalelip(fracinbuf)
13253 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
13254 elseif (zj.gt.bufliptop) then
13255 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
13256 sslipj=sscalelip(fracinbuf)
13257 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13266 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13267 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13268 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13269 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13271 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13279 xj=xj_safe+xshift*boxxsize
13280 yj=yj_safe+yshift*boxysize
13281 zj=zj_safe+zshift*boxzsize
13282 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13283 if(dist_temp.lt.dist_init) then
13284 dist_init=dist_temp
13293 if (subchap.eq.1) then
13303 dxj=dc_norm(1,nres+j)
13304 dyj=dc_norm(2,nres+j)
13305 dzj=dc_norm(3,nres+j)
13306 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13308 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13309 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
13310 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
13311 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13312 if (sss_ele_cut.le.0.0) cycle
13313 if (sss.lt.1.0d0) then
13315 ! Calculate angle-dependent terms of energy and contributions to their
13319 sig=sig0ij*dsqrt(sigsq)
13320 rij_shift=1.0D0/rij-sig+sig0ij
13321 ! for diagnostics; uncomment
13322 ! rij_shift=1.2*sig0ij
13323 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13324 if (rij_shift.le.0.0D0) then
13326 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13327 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13328 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13332 !---------------------------------------------------------------
13333 rij_shift=1.0D0/rij_shift
13334 fac=rij_shift**expon
13337 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13338 eps2der=evdwij*eps3rt
13339 eps3der=evdwij*eps2rt
13340 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13341 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13342 evdwij=evdwij*eps2rt*eps3rt
13343 evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
13345 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13346 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13347 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13348 restyp(itypi,1),i,restyp(itypj,1),j,&
13349 epsi,sigm,chi1,chi2,chip1,chip2,&
13350 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13351 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13355 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13357 ! if (energy_dec) write (iout,*) &
13358 ! 'evdw',i,j,evdwij,"egb_long"
13360 ! Calculate gradient components.
13361 e1=e1*eps1*eps2rt**2*eps3rt**2
13362 fac=-expon*(e1+evdwij)*rij_shift
13365 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13366 /sigma(itypi,itypj)*rij-sss_grad/(1.0-sss)*rij &
13367 /sigmaii(itypi,itypj))
13369 ! Calculate the radial part of the gradient
13373 ! Calculate angular part of the gradient.
13374 call sc_grad_scale(1.0d0-sss)
13380 ! write (iout,*) "Number of loop steps in EGB:",ind
13381 !ccc energy_dec=.false.
13383 end subroutine egb_long
13384 !-----------------------------------------------------------------------------
13385 subroutine egb_short(evdw)
13387 ! This subroutine calculates the interaction energy of nonbonded side chains
13388 ! assuming the Gay-Berne potential of interaction.
13391 ! implicit real*8 (a-h,o-z)
13392 ! include 'DIMENSIONS'
13393 ! include 'COMMON.GEO'
13394 ! include 'COMMON.VAR'
13395 ! include 'COMMON.LOCAL'
13396 ! include 'COMMON.CHAIN'
13397 ! include 'COMMON.DERIV'
13398 ! include 'COMMON.NAMES'
13399 ! include 'COMMON.INTERACT'
13400 ! include 'COMMON.IOUNITS'
13401 ! include 'COMMON.CALC'
13402 ! include 'COMMON.CONTROL'
13404 !el local variables
13405 integer :: iint,itypi,itypi1,itypj,subchap
13406 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
13407 real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad
13408 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13409 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13410 ssgradlipi,ssgradlipj
13412 !cccc energy_dec=.false.
13413 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13416 ! if (icall.eq.0) lprn=.false.
13418 do i=iatsc_s,iatsc_e
13420 if (itypi.eq.ntyp1) cycle
13421 itypi1=itype(i+1,1)
13425 xi=mod(xi,boxxsize)
13426 if (xi.lt.0) xi=xi+boxxsize
13427 yi=mod(yi,boxysize)
13428 if (yi.lt.0) yi=yi+boxysize
13429 zi=mod(zi,boxzsize)
13430 if (zi.lt.0) zi=zi+boxzsize
13431 if ((zi.gt.bordlipbot) &
13432 .and.(zi.lt.bordliptop)) then
13433 !C the energy transfer exist
13434 if (zi.lt.buflipbot) then
13435 !C what fraction I am in
13437 ((zi-bordlipbot)/lipbufthick)
13438 !C lipbufthick is thickenes of lipid buffore
13439 sslipi=sscalelip(fracinbuf)
13440 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
13441 elseif (zi.gt.bufliptop) then
13442 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
13443 sslipi=sscalelip(fracinbuf)
13444 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
13454 dxi=dc_norm(1,nres+i)
13455 dyi=dc_norm(2,nres+i)
13456 dzi=dc_norm(3,nres+i)
13457 ! dsci_inv=dsc_inv(itypi)
13458 dsci_inv=vbld_inv(i+nres)
13460 dxi=dc_norm(1,nres+i)
13461 dyi=dc_norm(2,nres+i)
13462 dzi=dc_norm(3,nres+i)
13463 ! dsci_inv=dsc_inv(itypi)
13464 dsci_inv=vbld_inv(i+nres)
13465 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
13466 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
13468 ! Calculate SC interaction energy.
13470 do iint=1,nint_gr(i)
13471 do j=istart(i,iint),iend(i,iint)
13472 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
13473 call dyn_ssbond_ene(i,j,evdwij)
13475 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13476 'evdw',i,j,evdwij,' ss'
13477 do k=j+1,iend(i,iint)
13478 !C search over all next residues
13479 if (dyn_ss_mask(k)) then
13480 !C check if they are cysteins
13481 !C write(iout,*) 'k=',k
13483 !c write(iout,*) "PRZED TRI", evdwij
13484 ! evdwij_przed_tri=evdwij
13485 call triple_ssbond_ene(i,j,k,evdwij)
13486 !c if(evdwij_przed_tri.ne.evdwij) then
13487 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
13490 !c write(iout,*) "PO TRI", evdwij
13491 !C call the energy function that removes the artifical triple disulfide
13492 !C bond the soubroutine is located in ssMD.F
13494 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13495 'evdw',i,j,evdwij,'tss'
13496 endif!dyn_ss_mask(k)
13499 ! if (energy_dec) write (iout,*) &
13500 ! 'evdw',i,j,evdwij,' ss'
13504 if (itypj.eq.ntyp1) cycle
13505 ! dscj_inv=dsc_inv(itypj)
13506 dscj_inv=vbld_inv(j+nres)
13507 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
13508 ! & 1.0d0/vbld(j+nres)
13509 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
13510 sig0ij=sigma(itypi,itypj)
13511 chi1=chi(itypi,itypj)
13512 chi2=chi(itypj,itypi)
13519 alf12=0.5D0*(alf1+alf2)
13520 ! xj=c(1,nres+j)-xi
13521 ! yj=c(2,nres+j)-yi
13522 ! zj=c(3,nres+j)-zi
13526 ! Searching for nearest neighbour
13527 xj=mod(xj,boxxsize)
13528 if (xj.lt.0) xj=xj+boxxsize
13529 yj=mod(yj,boxysize)
13530 if (yj.lt.0) yj=yj+boxysize
13531 zj=mod(zj,boxzsize)
13532 if (zj.lt.0) zj=zj+boxzsize
13533 if ((zj.gt.bordlipbot) &
13534 .and.(zj.lt.bordliptop)) then
13535 !C the energy transfer exist
13536 if (zj.lt.buflipbot) then
13537 !C what fraction I am in
13539 ((zj-bordlipbot)/lipbufthick)
13540 !C lipbufthick is thickenes of lipid buffore
13541 sslipj=sscalelip(fracinbuf)
13542 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
13543 elseif (zj.gt.bufliptop) then
13544 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
13545 sslipj=sscalelip(fracinbuf)
13546 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13555 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13556 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13557 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13558 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13560 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13569 xj=xj_safe+xshift*boxxsize
13570 yj=yj_safe+yshift*boxysize
13571 zj=zj_safe+zshift*boxzsize
13572 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13573 if(dist_temp.lt.dist_init) then
13574 dist_init=dist_temp
13583 if (subchap.eq.1) then
13593 dxj=dc_norm(1,nres+j)
13594 dyj=dc_norm(2,nres+j)
13595 dzj=dc_norm(3,nres+j)
13596 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13598 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13599 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13600 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
13601 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
13602 if (sss_ele_cut.le.0.0) cycle
13604 if (sss.gt.0.0d0) then
13606 ! Calculate angle-dependent terms of energy and contributions to their
13610 sig=sig0ij*dsqrt(sigsq)
13611 rij_shift=1.0D0/rij-sig+sig0ij
13612 ! for diagnostics; uncomment
13613 ! rij_shift=1.2*sig0ij
13614 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13615 if (rij_shift.le.0.0D0) then
13617 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13618 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13619 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13623 !---------------------------------------------------------------
13624 rij_shift=1.0D0/rij_shift
13625 fac=rij_shift**expon
13628 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13629 eps2der=evdwij*eps3rt
13630 eps3der=evdwij*eps2rt
13631 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13632 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13633 evdwij=evdwij*eps2rt*eps3rt
13634 evdw=evdw+evdwij*sss*sss_ele_cut
13636 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13637 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13638 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13639 restyp(itypi,1),i,restyp(itypj,1),j,&
13640 epsi,sigm,chi1,chi2,chip1,chip2,&
13641 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13642 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13646 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13648 ! if (energy_dec) write (iout,*) &
13649 ! 'evdw',i,j,evdwij,"egb_short"
13651 ! Calculate gradient components.
13652 e1=e1*eps1*eps2rt**2*eps3rt**2
13653 fac=-expon*(e1+evdwij)*rij_shift
13656 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13657 /sigma(itypi,itypj)*rij+sss_grad/sss*rij &
13658 /sigmaii(itypi,itypj))
13661 ! Calculate the radial part of the gradient
13665 ! Calculate angular part of the gradient.
13666 call sc_grad_scale(sss)
13672 ! write (iout,*) "Number of loop steps in EGB:",ind
13673 !ccc energy_dec=.false.
13675 end subroutine egb_short
13676 !-----------------------------------------------------------------------------
13677 subroutine egbv_long(evdw)
13679 ! This subroutine calculates the interaction energy of nonbonded side chains
13680 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13683 ! implicit real*8 (a-h,o-z)
13684 ! include 'DIMENSIONS'
13685 ! include 'COMMON.GEO'
13686 ! include 'COMMON.VAR'
13687 ! include 'COMMON.LOCAL'
13688 ! include 'COMMON.CHAIN'
13689 ! include 'COMMON.DERIV'
13690 ! include 'COMMON.NAMES'
13691 ! include 'COMMON.INTERACT'
13692 ! include 'COMMON.IOUNITS'
13693 ! include 'COMMON.CALC'
13695 !el integer :: icall
13696 !el common /srutu/ icall
13698 !el local variables
13699 integer :: iint,itypi,itypi1,itypj
13700 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
13701 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
13703 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13706 ! if (icall.eq.0) lprn=.true.
13708 do i=iatsc_s,iatsc_e
13710 if (itypi.eq.ntyp1) cycle
13711 itypi1=itype(i+1,1)
13715 dxi=dc_norm(1,nres+i)
13716 dyi=dc_norm(2,nres+i)
13717 dzi=dc_norm(3,nres+i)
13718 ! dsci_inv=dsc_inv(itypi)
13719 dsci_inv=vbld_inv(i+nres)
13721 ! Calculate SC interaction energy.
13723 do iint=1,nint_gr(i)
13724 do j=istart(i,iint),iend(i,iint)
13727 if (itypj.eq.ntyp1) cycle
13728 ! dscj_inv=dsc_inv(itypj)
13729 dscj_inv=vbld_inv(j+nres)
13730 sig0ij=sigma(itypi,itypj)
13731 r0ij=r0(itypi,itypj)
13732 chi1=chi(itypi,itypj)
13733 chi2=chi(itypj,itypi)
13740 alf12=0.5D0*(alf1+alf2)
13744 dxj=dc_norm(1,nres+j)
13745 dyj=dc_norm(2,nres+j)
13746 dzj=dc_norm(3,nres+j)
13747 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13750 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13752 if (sss.lt.1.0d0) then
13754 ! Calculate angle-dependent terms of energy and contributions to their
13758 sig=sig0ij*dsqrt(sigsq)
13759 rij_shift=1.0D0/rij-sig+r0ij
13760 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13761 if (rij_shift.le.0.0D0) then
13766 !---------------------------------------------------------------
13767 rij_shift=1.0D0/rij_shift
13768 fac=rij_shift**expon
13769 e1=fac*fac*aa_aq(itypi,itypj)
13770 e2=fac*bb_aq(itypi,itypj)
13771 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13772 eps2der=evdwij*eps3rt
13773 eps3der=evdwij*eps2rt
13774 fac_augm=rrij**expon
13775 e_augm=augm(itypi,itypj)*fac_augm
13776 evdwij=evdwij*eps2rt*eps3rt
13777 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
13779 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13780 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13781 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13782 restyp(itypi,1),i,restyp(itypj,1),j,&
13783 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13784 chi1,chi2,chip1,chip2,&
13785 eps1,eps2rt**2,eps3rt**2,&
13786 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13789 ! Calculate gradient components.
13790 e1=e1*eps1*eps2rt**2*eps3rt**2
13791 fac=-expon*(e1+evdwij)*rij_shift
13793 fac=rij*fac-2*expon*rrij*e_augm
13794 ! Calculate the radial part of the gradient
13798 ! Calculate angular part of the gradient.
13799 call sc_grad_scale(1.0d0-sss)
13804 end subroutine egbv_long
13805 !-----------------------------------------------------------------------------
13806 subroutine egbv_short(evdw)
13808 ! This subroutine calculates the interaction energy of nonbonded side chains
13809 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13812 ! implicit real*8 (a-h,o-z)
13813 ! include 'DIMENSIONS'
13814 ! include 'COMMON.GEO'
13815 ! include 'COMMON.VAR'
13816 ! include 'COMMON.LOCAL'
13817 ! include 'COMMON.CHAIN'
13818 ! include 'COMMON.DERIV'
13819 ! include 'COMMON.NAMES'
13820 ! include 'COMMON.INTERACT'
13821 ! include 'COMMON.IOUNITS'
13822 ! include 'COMMON.CALC'
13824 !el integer :: icall
13825 !el common /srutu/ icall
13827 !el local variables
13828 integer :: iint,itypi,itypi1,itypj
13829 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
13830 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
13832 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13835 ! if (icall.eq.0) lprn=.true.
13837 do i=iatsc_s,iatsc_e
13839 if (itypi.eq.ntyp1) cycle
13840 itypi1=itype(i+1,1)
13844 dxi=dc_norm(1,nres+i)
13845 dyi=dc_norm(2,nres+i)
13846 dzi=dc_norm(3,nres+i)
13847 ! dsci_inv=dsc_inv(itypi)
13848 dsci_inv=vbld_inv(i+nres)
13850 ! Calculate SC interaction energy.
13852 do iint=1,nint_gr(i)
13853 do j=istart(i,iint),iend(i,iint)
13856 if (itypj.eq.ntyp1) cycle
13857 ! dscj_inv=dsc_inv(itypj)
13858 dscj_inv=vbld_inv(j+nres)
13859 sig0ij=sigma(itypi,itypj)
13860 r0ij=r0(itypi,itypj)
13861 chi1=chi(itypi,itypj)
13862 chi2=chi(itypj,itypi)
13869 alf12=0.5D0*(alf1+alf2)
13873 dxj=dc_norm(1,nres+j)
13874 dyj=dc_norm(2,nres+j)
13875 dzj=dc_norm(3,nres+j)
13876 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13879 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13881 if (sss.gt.0.0d0) then
13883 ! Calculate angle-dependent terms of energy and contributions to their
13887 sig=sig0ij*dsqrt(sigsq)
13888 rij_shift=1.0D0/rij-sig+r0ij
13889 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13890 if (rij_shift.le.0.0D0) then
13895 !---------------------------------------------------------------
13896 rij_shift=1.0D0/rij_shift
13897 fac=rij_shift**expon
13898 e1=fac*fac*aa_aq(itypi,itypj)
13899 e2=fac*bb_aq(itypi,itypj)
13900 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13901 eps2der=evdwij*eps3rt
13902 eps3der=evdwij*eps2rt
13903 fac_augm=rrij**expon
13904 e_augm=augm(itypi,itypj)*fac_augm
13905 evdwij=evdwij*eps2rt*eps3rt
13906 evdw=evdw+(evdwij+e_augm)*sss
13908 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13909 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13910 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13911 restyp(itypi,1),i,restyp(itypj,1),j,&
13912 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13913 chi1,chi2,chip1,chip2,&
13914 eps1,eps2rt**2,eps3rt**2,&
13915 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13918 ! Calculate gradient components.
13919 e1=e1*eps1*eps2rt**2*eps3rt**2
13920 fac=-expon*(e1+evdwij)*rij_shift
13922 fac=rij*fac-2*expon*rrij*e_augm
13923 ! Calculate the radial part of the gradient
13927 ! Calculate angular part of the gradient.
13928 call sc_grad_scale(sss)
13933 end subroutine egbv_short
13934 !-----------------------------------------------------------------------------
13935 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
13937 ! This subroutine calculates the average interaction energy and its gradient
13938 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
13939 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
13940 ! The potential depends both on the distance of peptide-group centers and on
13941 ! the orientation of the CA-CA virtual bonds.
13943 ! implicit real*8 (a-h,o-z)
13949 ! include 'DIMENSIONS'
13950 ! include 'COMMON.CONTROL'
13951 ! include 'COMMON.SETUP'
13952 ! include 'COMMON.IOUNITS'
13953 ! include 'COMMON.GEO'
13954 ! include 'COMMON.VAR'
13955 ! include 'COMMON.LOCAL'
13956 ! include 'COMMON.CHAIN'
13957 ! include 'COMMON.DERIV'
13958 ! include 'COMMON.INTERACT'
13959 ! include 'COMMON.CONTACTS'
13960 ! include 'COMMON.TORSION'
13961 ! include 'COMMON.VECTORS'
13962 ! include 'COMMON.FFIELD'
13963 ! include 'COMMON.TIME1'
13964 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
13965 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
13966 real(kind=8),dimension(2,2) :: acipa !el,a_temp
13967 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
13968 real(kind=8),dimension(4) :: muij
13969 !el integer :: num_conti,j1,j2
13970 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
13971 !el dz_normi,xmedi,ymedi,zmedi
13972 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
13973 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
13974 !el num_conti,j1,j2
13975 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
13977 real(kind=8) :: scal_el=1.0d0
13979 real(kind=8) :: scal_el=0.5d0
13982 ! 13-go grudnia roku pamietnego...
13983 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
13984 0.0d0,1.0d0,0.0d0,&
13985 0.0d0,0.0d0,1.0d0/),shape(unmat))
13986 !el local variables
13988 real(kind=8) :: fac
13989 real(kind=8) :: dxj,dyj,dzj
13990 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
13992 ! allocate(num_cont_hb(nres)) !(maxres)
13993 !d write(iout,*) 'In EELEC'
13995 !d write(iout,*) 'Type',i
13996 !d write(iout,*) 'B1',B1(:,i)
13997 !d write(iout,*) 'B2',B2(:,i)
13998 !d write(iout,*) 'CC',CC(:,:,i)
13999 !d write(iout,*) 'DD',DD(:,:,i)
14000 !d write(iout,*) 'EE',EE(:,:,i)
14002 !d call check_vecgrad
14004 if (icheckgrad.eq.1) then
14006 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
14008 dc_norm(k,i)=dc(k,i)*fac
14010 ! write (iout,*) 'i',i,' fac',fac
14013 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
14014 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
14015 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
14016 ! call vec_and_deriv
14020 ! print *, "before set matrices"
14022 ! print *,"after set martices"
14024 time_mat=time_mat+MPI_Wtime()-time01
14028 !d write (iout,*) 'i=',i
14030 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
14033 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
14034 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
14047 !d print '(a)','Enter EELEC'
14048 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
14049 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
14050 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
14052 gel_loc_loc(i)=0.0d0
14057 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
14059 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
14061 do i=iturn3_start,iturn3_end
14062 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1 &
14063 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
14067 dx_normi=dc_norm(1,i)
14068 dy_normi=dc_norm(2,i)
14069 dz_normi=dc_norm(3,i)
14070 xmedi=c(1,i)+0.5d0*dxi
14071 ymedi=c(2,i)+0.5d0*dyi
14072 zmedi=c(3,i)+0.5d0*dzi
14073 xmedi=dmod(xmedi,boxxsize)
14074 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14075 ymedi=dmod(ymedi,boxysize)
14076 if (ymedi.lt.0) ymedi=ymedi+boxysize
14077 zmedi=dmod(zmedi,boxzsize)
14078 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14080 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
14081 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
14082 num_cont_hb(i)=num_conti
14084 do i=iturn4_start,iturn4_end
14085 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
14086 .or. itype(i+3,1).eq.ntyp1 &
14087 .or. itype(i+4,1).eq.ntyp1) cycle
14091 dx_normi=dc_norm(1,i)
14092 dy_normi=dc_norm(2,i)
14093 dz_normi=dc_norm(3,i)
14094 xmedi=c(1,i)+0.5d0*dxi
14095 ymedi=c(2,i)+0.5d0*dyi
14096 zmedi=c(3,i)+0.5d0*dzi
14097 xmedi=dmod(xmedi,boxxsize)
14098 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14099 ymedi=dmod(ymedi,boxysize)
14100 if (ymedi.lt.0) ymedi=ymedi+boxysize
14101 zmedi=dmod(zmedi,boxzsize)
14102 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14103 num_conti=num_cont_hb(i)
14104 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
14105 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
14106 call eturn4(i,eello_turn4)
14107 num_cont_hb(i)=num_conti
14110 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
14112 do i=iatel_s,iatel_e
14113 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
14117 dx_normi=dc_norm(1,i)
14118 dy_normi=dc_norm(2,i)
14119 dz_normi=dc_norm(3,i)
14120 xmedi=c(1,i)+0.5d0*dxi
14121 ymedi=c(2,i)+0.5d0*dyi
14122 zmedi=c(3,i)+0.5d0*dzi
14123 xmedi=dmod(xmedi,boxxsize)
14124 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14125 ymedi=dmod(ymedi,boxysize)
14126 if (ymedi.lt.0) ymedi=ymedi+boxysize
14127 zmedi=dmod(zmedi,boxzsize)
14128 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14129 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
14130 num_conti=num_cont_hb(i)
14131 do j=ielstart(i),ielend(i)
14132 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
14133 call eelecij_scale(i,j,ees,evdw1,eel_loc)
14135 num_cont_hb(i)=num_conti
14137 ! write (iout,*) "Number of loop steps in EELEC:",ind
14139 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
14140 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
14142 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
14143 !cc eel_loc=eel_loc+eello_turn3
14144 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
14146 end subroutine eelec_scale
14147 !-----------------------------------------------------------------------------
14148 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
14149 ! implicit real*8 (a-h,o-z)
14152 ! include 'DIMENSIONS'
14156 ! include 'COMMON.CONTROL'
14157 ! include 'COMMON.IOUNITS'
14158 ! include 'COMMON.GEO'
14159 ! include 'COMMON.VAR'
14160 ! include 'COMMON.LOCAL'
14161 ! include 'COMMON.CHAIN'
14162 ! include 'COMMON.DERIV'
14163 ! include 'COMMON.INTERACT'
14164 ! include 'COMMON.CONTACTS'
14165 ! include 'COMMON.TORSION'
14166 ! include 'COMMON.VECTORS'
14167 ! include 'COMMON.FFIELD'
14168 ! include 'COMMON.TIME1'
14169 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
14170 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
14171 real(kind=8),dimension(2,2) :: acipa !el,a_temp
14172 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
14173 real(kind=8),dimension(4) :: muij
14174 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14175 dist_temp, dist_init,sss_grad
14176 integer xshift,yshift,zshift
14178 !el integer :: num_conti,j1,j2
14179 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
14180 !el dz_normi,xmedi,ymedi,zmedi
14181 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
14182 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14183 !el num_conti,j1,j2
14184 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14186 real(kind=8) :: scal_el=1.0d0
14188 real(kind=8) :: scal_el=0.5d0
14191 ! 13-go grudnia roku pamietnego...
14192 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
14193 0.0d0,1.0d0,0.0d0,&
14194 0.0d0,0.0d0,1.0d0/),shape(unmat))
14195 !el local variables
14196 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m,isubchap
14197 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
14198 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
14199 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
14200 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
14201 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
14202 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
14203 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
14204 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
14205 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
14206 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
14207 ecosam,ecosbm,ecosgm,ghalf,time00
14208 ! integer :: maxconts
14209 ! maxconts = nres/4
14210 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14211 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14212 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14213 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14214 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14215 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14216 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14217 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14218 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
14219 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
14220 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
14221 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
14222 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
14224 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
14225 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
14230 !d write (iout,*) "eelecij",i,j
14234 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
14235 aaa=app(iteli,itelj)
14236 bbb=bpp(iteli,itelj)
14237 ael6i=ael6(iteli,itelj)
14238 ael3i=ael3(iteli,itelj)
14242 dx_normj=dc_norm(1,j)
14243 dy_normj=dc_norm(2,j)
14244 dz_normj=dc_norm(3,j)
14245 ! xj=c(1,j)+0.5D0*dxj-xmedi
14246 ! yj=c(2,j)+0.5D0*dyj-ymedi
14247 ! zj=c(3,j)+0.5D0*dzj-zmedi
14248 xj=c(1,j)+0.5D0*dxj
14249 yj=c(2,j)+0.5D0*dyj
14250 zj=c(3,j)+0.5D0*dzj
14251 xj=mod(xj,boxxsize)
14252 if (xj.lt.0) xj=xj+boxxsize
14253 yj=mod(yj,boxysize)
14254 if (yj.lt.0) yj=yj+boxysize
14255 zj=mod(zj,boxzsize)
14256 if (zj.lt.0) zj=zj+boxzsize
14258 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14265 xj=xj_safe+xshift*boxxsize
14266 yj=yj_safe+yshift*boxysize
14267 zj=zj_safe+zshift*boxzsize
14268 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14269 if(dist_temp.lt.dist_init) then
14270 dist_init=dist_temp
14279 if (isubchap.eq.1) then
14290 rij=xj*xj+yj*yj+zj*zj
14294 ! For extracting the short-range part of Evdwpp
14295 sss=sscale(rij/rpp(iteli,itelj))
14296 sss_ele_cut=sscale_ele(rij)
14297 sss_ele_grad=sscagrad_ele(rij)
14298 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
14299 ! sss_ele_cut=1.0d0
14300 ! sss_ele_grad=0.0d0
14301 if (sss_ele_cut.le.0.0) go to 128
14305 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
14306 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
14307 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
14308 fac=cosa-3.0D0*cosb*cosg
14310 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
14311 if (j.eq.i+2) ev1=scal_el*ev1
14316 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
14319 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
14320 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
14321 ees=ees+eesij*sss_ele_cut
14322 evdw1=evdw1+evdwij*(1.0d0-sss)*sss_ele_cut
14323 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
14324 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
14325 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
14326 !d & xmedi,ymedi,zmedi,xj,yj,zj
14328 if (energy_dec) then
14329 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
14330 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
14334 ! Calculate contributions to the Cartesian gradient.
14337 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
14338 facel=-3*rrmij*(el1+eesij)*sss_ele_cut
14344 ! Radial derivatives. First process both termini of the fragment (i,j)
14346 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj
14347 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj
14348 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj
14350 ! ghalf=0.5D0*ggg(k)
14351 ! gelc(k,i)=gelc(k,i)+ghalf
14352 ! gelc(k,j)=gelc(k,j)+ghalf
14354 ! 9/28/08 AL Gradient compotents will be summed only at the end
14356 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14357 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14360 ! Loop over residues i+1 thru j-1.
14364 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14367 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*(1.0d0-sss) &
14368 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
14369 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*(1.0d0-sss) &
14370 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
14371 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*(1.0d0-sss) &
14372 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
14374 ! ghalf=0.5D0*ggg(k)
14375 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
14376 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
14378 ! 9/28/08 AL Gradient compotents will be summed only at the end
14380 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14381 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14384 ! Loop over residues i+1 thru j-1.
14388 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
14392 facvdw=(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
14393 facel=(el1+eesij)*sss_ele_cut
14395 fac=-3*rrmij*(facvdw+facvdw+facel)
14400 ! Radial derivatives. First process both termini of the fragment (i,j)
14406 ! ghalf=0.5D0*ggg(k)
14407 ! gelc(k,i)=gelc(k,i)+ghalf
14408 ! gelc(k,j)=gelc(k,j)+ghalf
14410 ! 9/28/08 AL Gradient compotents will be summed only at the end
14412 gelc_long(k,j)=gelc(k,j)+ggg(k)
14413 gelc_long(k,i)=gelc(k,i)-ggg(k)
14416 ! Loop over residues i+1 thru j-1.
14420 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14423 ! 9/28/08 AL Gradient compotents will be summed only at the end
14428 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14429 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14435 ecosa=2.0D0*fac3*fac1+fac4
14438 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
14439 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
14441 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14442 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14444 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
14445 !d & (dcosg(k),k=1,3)
14447 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k) )*sss_ele_cut
14450 ! ghalf=0.5D0*ggg(k)
14451 ! gelc(k,i)=gelc(k,i)+ghalf
14452 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
14453 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14454 ! gelc(k,j)=gelc(k,j)+ghalf
14455 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
14456 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14460 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14464 gelc(k,i)=gelc(k,i) &
14465 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14466 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
14468 gelc(k,j)=gelc(k,j) &
14469 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14470 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14472 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14473 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14475 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
14476 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
14477 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14479 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
14480 ! energy of a peptide unit is assumed in the form of a second-order
14481 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
14482 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
14483 ! are computed for EVERY pair of non-contiguous peptide groups.
14485 if (j.lt.nres-1) then
14496 muij(kkk)=mu(k,i)*mu(l,j)
14499 !d write (iout,*) 'EELEC: i',i,' j',j
14500 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
14501 !d write(iout,*) 'muij',muij
14502 ury=scalar(uy(1,i),erij)
14503 urz=scalar(uz(1,i),erij)
14504 vry=scalar(uy(1,j),erij)
14505 vrz=scalar(uz(1,j),erij)
14506 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
14507 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
14508 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
14509 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
14510 fac=dsqrt(-ael6i)*r3ij
14515 !d write (iout,'(4i5,4f10.5)')
14516 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
14517 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
14518 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
14519 !d & uy(:,j),uz(:,j)
14520 !d write (iout,'(4f10.5)')
14521 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
14522 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
14523 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
14524 !d write (iout,'(9f10.5/)')
14525 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
14526 ! Derivatives of the elements of A in virtual-bond vectors
14527 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
14529 uryg(k,1)=scalar(erder(1,k),uy(1,i))
14530 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
14531 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
14532 urzg(k,1)=scalar(erder(1,k),uz(1,i))
14533 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
14534 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
14535 vryg(k,1)=scalar(erder(1,k),uy(1,j))
14536 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
14537 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
14538 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
14539 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
14540 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
14542 ! Compute radial contributions to the gradient
14560 ! Add the contributions coming from er
14563 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
14564 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
14565 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
14566 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
14569 ! Derivatives in DC(i)
14570 !grad ghalf1=0.5d0*agg(k,1)
14571 !grad ghalf2=0.5d0*agg(k,2)
14572 !grad ghalf3=0.5d0*agg(k,3)
14573 !grad ghalf4=0.5d0*agg(k,4)
14574 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
14575 -3.0d0*uryg(k,2)*vry)!+ghalf1
14576 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
14577 -3.0d0*uryg(k,2)*vrz)!+ghalf2
14578 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
14579 -3.0d0*urzg(k,2)*vry)!+ghalf3
14580 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
14581 -3.0d0*urzg(k,2)*vrz)!+ghalf4
14582 ! Derivatives in DC(i+1)
14583 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
14584 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
14585 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
14586 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
14587 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
14588 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
14589 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
14590 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
14591 ! Derivatives in DC(j)
14592 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
14593 -3.0d0*vryg(k,2)*ury)!+ghalf1
14594 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
14595 -3.0d0*vrzg(k,2)*ury)!+ghalf2
14596 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
14597 -3.0d0*vryg(k,2)*urz)!+ghalf3
14598 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
14599 -3.0d0*vrzg(k,2)*urz)!+ghalf4
14600 ! Derivatives in DC(j+1) or DC(nres-1)
14601 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
14602 -3.0d0*vryg(k,3)*ury)
14603 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
14604 -3.0d0*vrzg(k,3)*ury)
14605 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
14606 -3.0d0*vryg(k,3)*urz)
14607 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
14608 -3.0d0*vrzg(k,3)*urz)
14609 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
14611 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
14624 aggi(k,l)=-aggi(k,l)
14625 aggi1(k,l)=-aggi1(k,l)
14626 aggj(k,l)=-aggj(k,l)
14627 aggj1(k,l)=-aggj1(k,l)
14630 if (j.lt.nres-1) then
14636 aggi(k,l)=-aggi(k,l)
14637 aggi1(k,l)=-aggi1(k,l)
14638 aggj(k,l)=-aggj(k,l)
14639 aggj1(k,l)=-aggj1(k,l)
14650 aggi(k,l)=-aggi(k,l)
14651 aggi1(k,l)=-aggi1(k,l)
14652 aggj(k,l)=-aggj(k,l)
14653 aggj1(k,l)=-aggj1(k,l)
14658 IF (wel_loc.gt.0.0d0) THEN
14659 ! Contribution to the local-electrostatic energy coming from the i-j pair
14660 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
14662 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
14664 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
14665 'eelloc',i,j,eel_loc_ij
14666 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
14668 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
14669 ! Partial derivatives in virtual-bond dihedral angles gamma
14671 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
14672 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
14673 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
14675 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
14676 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
14677 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
14683 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
14685 ggg(l)=(agg(l,1)*muij(1)+ &
14686 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
14688 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
14690 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
14691 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
14692 !grad ghalf=0.5d0*ggg(l)
14693 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
14694 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
14698 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
14701 ! Remaining derivatives of eello
14703 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
14704 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
14707 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
14708 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))&
14711 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
14712 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
14715 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
14716 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))&
14721 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
14722 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
14723 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
14724 .and. num_conti.le.maxconts) then
14725 ! write (iout,*) i,j," entered corr"
14727 ! Calculate the contact function. The ith column of the array JCONT will
14728 ! contain the numbers of atoms that make contacts with the atom I (of numbers
14729 ! greater than I). The arrays FACONT and GACONT will contain the values of
14730 ! the contact function and its derivative.
14731 ! r0ij=1.02D0*rpp(iteli,itelj)
14732 ! r0ij=1.11D0*rpp(iteli,itelj)
14733 r0ij=2.20D0*rpp(iteli,itelj)
14734 ! r0ij=1.55D0*rpp(iteli,itelj)
14735 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
14736 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14737 if (fcont.gt.0.0D0) then
14738 num_conti=num_conti+1
14739 if (num_conti.gt.maxconts) then
14740 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14741 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
14742 ' will skip next contacts for this conf.',num_conti
14744 jcont_hb(num_conti,i)=j
14745 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
14746 !d & " jcont_hb",jcont_hb(num_conti,i)
14747 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
14748 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14749 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
14751 d_cont(num_conti,i)=rij
14752 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
14753 ! --- Electrostatic-interaction matrix ---
14754 a_chuj(1,1,num_conti,i)=a22
14755 a_chuj(1,2,num_conti,i)=a23
14756 a_chuj(2,1,num_conti,i)=a32
14757 a_chuj(2,2,num_conti,i)=a33
14758 ! --- Gradient of rij
14760 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
14767 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
14768 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
14769 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
14770 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
14771 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
14776 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
14777 ! Calculate contact energies
14779 wij=cosa-3.0D0*cosb*cosg
14782 ! fac3=dsqrt(-ael6i)/r0ij**3
14783 fac3=dsqrt(-ael6i)*r3ij
14784 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
14785 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
14786 if (ees0tmp.gt.0) then
14787 ees0pij=dsqrt(ees0tmp)
14791 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
14792 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
14793 if (ees0tmp.gt.0) then
14794 ees0mij=dsqrt(ees0tmp)
14799 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
14802 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
14805 ! Diagnostics. Comment out or remove after debugging!
14806 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
14807 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
14808 ! ees0m(num_conti,i)=0.0D0
14810 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
14811 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
14812 ! Angular derivatives of the contact function
14813 ees0pij1=fac3/ees0pij
14814 ees0mij1=fac3/ees0mij
14815 fac3p=-3.0D0*fac3*rrmij
14816 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
14817 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
14819 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
14820 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
14821 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
14822 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
14823 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
14824 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
14825 ecosap=ecosa1+ecosa2
14826 ecosbp=ecosb1+ecosb2
14827 ecosgp=ecosg1+ecosg2
14828 ecosam=ecosa1-ecosa2
14829 ecosbm=ecosb1-ecosb2
14830 ecosgm=ecosg1-ecosg2
14839 facont_hb(num_conti,i)=fcont
14840 fprimcont=fprimcont/rij
14841 !d facont_hb(num_conti,i)=1.0D0
14842 ! Following line is for diagnostics.
14845 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14846 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14849 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
14850 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
14852 ! gggp(1)=gggp(1)+ees0pijp*xj
14853 ! gggp(2)=gggp(2)+ees0pijp*yj
14854 ! gggp(3)=gggp(3)+ees0pijp*zj
14855 ! gggm(1)=gggm(1)+ees0mijp*xj
14856 ! gggm(2)=gggm(2)+ees0mijp*yj
14857 ! gggm(3)=gggm(3)+ees0mijp*zj
14858 gggp(1)=gggp(1)+ees0pijp*xj &
14859 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14860 gggp(2)=gggp(2)+ees0pijp*yj &
14861 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14862 gggp(3)=gggp(3)+ees0pijp*zj &
14863 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14865 gggm(1)=gggm(1)+ees0mijp*xj &
14866 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14868 gggm(2)=gggm(2)+ees0mijp*yj &
14869 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14871 gggm(3)=gggm(3)+ees0mijp*zj &
14872 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14874 ! Derivatives due to the contact function
14875 gacont_hbr(1,num_conti,i)=fprimcont*xj
14876 gacont_hbr(2,num_conti,i)=fprimcont*yj
14877 gacont_hbr(3,num_conti,i)=fprimcont*zj
14880 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
14881 ! following the change of gradient-summation algorithm.
14883 !grad ghalfp=0.5D0*gggp(k)
14884 !grad ghalfm=0.5D0*gggm(k)
14885 ! gacontp_hb1(k,num_conti,i)= & !ghalfp
14886 ! +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14887 ! + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14888 ! gacontp_hb2(k,num_conti,i)= & !ghalfp
14889 ! +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14890 ! + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14891 ! gacontp_hb3(k,num_conti,i)=gggp(k)
14892 ! gacontm_hb1(k,num_conti,i)= &!ghalfm
14893 ! +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14894 ! + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14895 ! gacontm_hb2(k,num_conti,i)= & !ghalfm
14896 ! +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14897 ! + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14898 ! gacontm_hb3(k,num_conti,i)=gggm(k)
14899 gacontp_hb1(k,num_conti,i)= & !ghalfp+
14900 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14901 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14904 gacontp_hb2(k,num_conti,i)= & !ghalfp+
14905 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14906 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14909 gacontp_hb3(k,num_conti,i)=gggp(k) &
14912 gacontm_hb1(k,num_conti,i)= & !ghalfm+
14913 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14914 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14917 gacontm_hb2(k,num_conti,i)= & !ghalfm+
14918 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14919 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
14922 gacontm_hb3(k,num_conti,i)=gggm(k) &
14927 endif ! num_conti.le.maxconts
14930 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
14933 ghalf=0.5d0*agg(l,k)
14934 aggi(l,k)=aggi(l,k)+ghalf
14935 aggi1(l,k)=aggi1(l,k)+agg(l,k)
14936 aggj(l,k)=aggj(l,k)+ghalf
14939 if (j.eq.nres-1 .and. i.lt.j-2) then
14942 aggj1(l,k)=aggj1(l,k)+agg(l,k)
14948 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
14950 end subroutine eelecij_scale
14951 !-----------------------------------------------------------------------------
14952 subroutine evdwpp_short(evdw1)
14956 ! implicit real*8 (a-h,o-z)
14957 ! include 'DIMENSIONS'
14958 ! include 'COMMON.CONTROL'
14959 ! include 'COMMON.IOUNITS'
14960 ! include 'COMMON.GEO'
14961 ! include 'COMMON.VAR'
14962 ! include 'COMMON.LOCAL'
14963 ! include 'COMMON.CHAIN'
14964 ! include 'COMMON.DERIV'
14965 ! include 'COMMON.INTERACT'
14966 ! include 'COMMON.CONTACTS'
14967 ! include 'COMMON.TORSION'
14968 ! include 'COMMON.VECTORS'
14969 ! include 'COMMON.FFIELD'
14970 real(kind=8),dimension(3) :: ggg
14971 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14973 real(kind=8) :: scal_el=1.0d0
14975 real(kind=8) :: scal_el=0.5d0
14977 !el local variables
14978 integer :: i,j,k,iteli,itelj,num_conti,isubchap
14979 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
14980 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
14981 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14982 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
14983 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14984 dist_temp, dist_init,sss_grad
14985 integer xshift,yshift,zshift
14989 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
14990 ! & " iatel_e_vdw",iatel_e_vdw
14992 do i=iatel_s_vdw,iatel_e_vdw
14993 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1) cycle
14997 dx_normi=dc_norm(1,i)
14998 dy_normi=dc_norm(2,i)
14999 dz_normi=dc_norm(3,i)
15000 xmedi=c(1,i)+0.5d0*dxi
15001 ymedi=c(2,i)+0.5d0*dyi
15002 zmedi=c(3,i)+0.5d0*dzi
15003 xmedi=dmod(xmedi,boxxsize)
15004 if (xmedi.lt.0) xmedi=xmedi+boxxsize
15005 ymedi=dmod(ymedi,boxysize)
15006 if (ymedi.lt.0) ymedi=ymedi+boxysize
15007 zmedi=dmod(zmedi,boxzsize)
15008 if (zmedi.lt.0) zmedi=zmedi+boxzsize
15010 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
15011 ! & ' ielend',ielend_vdw(i)
15013 do j=ielstart_vdw(i),ielend_vdw(i)
15014 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
15018 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
15019 aaa=app(iteli,itelj)
15020 bbb=bpp(iteli,itelj)
15024 dx_normj=dc_norm(1,j)
15025 dy_normj=dc_norm(2,j)
15026 dz_normj=dc_norm(3,j)
15027 ! xj=c(1,j)+0.5D0*dxj-xmedi
15028 ! yj=c(2,j)+0.5D0*dyj-ymedi
15029 ! zj=c(3,j)+0.5D0*dzj-zmedi
15030 xj=c(1,j)+0.5D0*dxj
15031 yj=c(2,j)+0.5D0*dyj
15032 zj=c(3,j)+0.5D0*dzj
15033 xj=mod(xj,boxxsize)
15034 if (xj.lt.0) xj=xj+boxxsize
15035 yj=mod(yj,boxysize)
15036 if (yj.lt.0) yj=yj+boxysize
15037 zj=mod(zj,boxzsize)
15038 if (zj.lt.0) zj=zj+boxzsize
15040 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15047 xj=xj_safe+xshift*boxxsize
15048 yj=yj_safe+yshift*boxysize
15049 zj=zj_safe+zshift*boxzsize
15050 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15051 if(dist_temp.lt.dist_init) then
15052 dist_init=dist_temp
15061 if (isubchap.eq.1) then
15072 rij=xj*xj+yj*yj+zj*zj
15075 sss=sscale(rij/rpp(iteli,itelj))
15076 sss_ele_cut=sscale_ele(rij)
15077 sss_ele_grad=sscagrad_ele(rij)
15078 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
15079 if (sss_ele_cut.le.0.0) cycle
15080 if (sss.gt.0.0d0) then
15085 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
15086 if (j.eq.i+2) ev1=scal_el*ev1
15089 if (energy_dec) then
15090 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
15092 evdw1=evdw1+evdwij*sss*sss_ele_cut
15094 ! Calculate contributions to the Cartesian gradient.
15096 facvdw=-6*rrmij*(ev1+evdwij)*sss*sss_ele_cut
15100 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*sss &
15101 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
15102 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*sss &
15103 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
15104 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*sss &
15105 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
15108 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
15109 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
15115 end subroutine evdwpp_short
15116 !-----------------------------------------------------------------------------
15117 subroutine escp_long(evdw2,evdw2_14)
15119 ! This subroutine calculates the excluded-volume interaction energy between
15120 ! peptide-group centers and side chains and its gradient in virtual-bond and
15121 ! side-chain vectors.
15123 ! implicit real*8 (a-h,o-z)
15124 ! include 'DIMENSIONS'
15125 ! include 'COMMON.GEO'
15126 ! include 'COMMON.VAR'
15127 ! include 'COMMON.LOCAL'
15128 ! include 'COMMON.CHAIN'
15129 ! include 'COMMON.DERIV'
15130 ! include 'COMMON.INTERACT'
15131 ! include 'COMMON.FFIELD'
15132 ! include 'COMMON.IOUNITS'
15133 ! include 'COMMON.CONTROL'
15134 real(kind=8),dimension(3) :: ggg
15135 !el local variables
15136 integer :: i,iint,j,k,iteli,itypj,subchap
15137 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
15138 real(kind=8) :: evdw2,evdw2_14,evdwij
15139 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15140 dist_temp, dist_init
15144 !d print '(a)','Enter ESCP'
15145 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
15146 do i=iatscp_s,iatscp_e
15147 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
15149 xi=0.5D0*(c(1,i)+c(1,i+1))
15150 yi=0.5D0*(c(2,i)+c(2,i+1))
15151 zi=0.5D0*(c(3,i)+c(3,i+1))
15152 xi=mod(xi,boxxsize)
15153 if (xi.lt.0) xi=xi+boxxsize
15154 yi=mod(yi,boxysize)
15155 if (yi.lt.0) yi=yi+boxysize
15156 zi=mod(zi,boxzsize)
15157 if (zi.lt.0) zi=zi+boxzsize
15159 do iint=1,nscp_gr(i)
15161 do j=iscpstart(i,iint),iscpend(i,iint)
15163 if (itypj.eq.ntyp1) cycle
15164 ! Uncomment following three lines for SC-p interactions
15165 ! xj=c(1,nres+j)-xi
15166 ! yj=c(2,nres+j)-yi
15167 ! zj=c(3,nres+j)-zi
15168 ! Uncomment following three lines for Ca-p interactions
15172 xj=mod(xj,boxxsize)
15173 if (xj.lt.0) xj=xj+boxxsize
15174 yj=mod(yj,boxysize)
15175 if (yj.lt.0) yj=yj+boxysize
15176 zj=mod(zj,boxzsize)
15177 if (zj.lt.0) zj=zj+boxzsize
15178 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15186 xj=xj_safe+xshift*boxxsize
15187 yj=yj_safe+yshift*boxysize
15188 zj=zj_safe+zshift*boxzsize
15189 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15190 if(dist_temp.lt.dist_init) then
15191 dist_init=dist_temp
15200 if (subchap.eq.1) then
15209 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15211 rij=dsqrt(1.0d0/rrij)
15212 sss_ele_cut=sscale_ele(rij)
15213 sss_ele_grad=sscagrad_ele(rij)
15214 ! print *,sss_ele_cut,sss_ele_grad,&
15215 ! (rij),r_cut_ele,rlamb_ele
15216 if (sss_ele_cut.le.0.0) cycle
15217 sss=sscale((rij/rscp(itypj,iteli)))
15218 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
15219 if (sss.lt.1.0d0) then
15222 e1=fac*fac*aad(itypj,iteli)
15223 e2=fac*bad(itypj,iteli)
15224 if (iabs(j-i) .le. 2) then
15227 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)*sss_ele_cut
15230 evdw2=evdw2+evdwij*(1.0d0-sss)*sss_ele_cut
15231 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15232 'evdw2',i,j,sss,evdwij
15234 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15236 fac=-(evdwij+e1)*rrij*(1.0d0-sss)*sss_ele_cut
15237 fac=fac+evdwij*sss_ele_grad/rij/expon*(1.0d0-sss)&
15238 -evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15242 ! Uncomment following three lines for SC-p interactions
15244 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15246 ! Uncomment following line for SC-p interactions
15247 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15249 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15250 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15259 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15260 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15261 gradx_scp(j,i)=expon*gradx_scp(j,i)
15264 !******************************************************************************
15268 ! To save time the factor EXPON has been extracted from ALL components
15269 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15272 !******************************************************************************
15274 end subroutine escp_long
15275 !-----------------------------------------------------------------------------
15276 subroutine escp_short(evdw2,evdw2_14)
15278 ! This subroutine calculates the excluded-volume interaction energy between
15279 ! peptide-group centers and side chains and its gradient in virtual-bond and
15280 ! side-chain vectors.
15282 ! implicit real*8 (a-h,o-z)
15283 ! include 'DIMENSIONS'
15284 ! include 'COMMON.GEO'
15285 ! include 'COMMON.VAR'
15286 ! include 'COMMON.LOCAL'
15287 ! include 'COMMON.CHAIN'
15288 ! include 'COMMON.DERIV'
15289 ! include 'COMMON.INTERACT'
15290 ! include 'COMMON.FFIELD'
15291 ! include 'COMMON.IOUNITS'
15292 ! include 'COMMON.CONTROL'
15293 real(kind=8),dimension(3) :: ggg
15294 !el local variables
15295 integer :: i,iint,j,k,iteli,itypj,subchap
15296 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
15297 real(kind=8) :: evdw2,evdw2_14,evdwij
15298 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15299 dist_temp, dist_init
15303 !d print '(a)','Enter ESCP'
15304 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
15305 do i=iatscp_s,iatscp_e
15306 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
15308 xi=0.5D0*(c(1,i)+c(1,i+1))
15309 yi=0.5D0*(c(2,i)+c(2,i+1))
15310 zi=0.5D0*(c(3,i)+c(3,i+1))
15311 xi=mod(xi,boxxsize)
15312 if (xi.lt.0) xi=xi+boxxsize
15313 yi=mod(yi,boxysize)
15314 if (yi.lt.0) yi=yi+boxysize
15315 zi=mod(zi,boxzsize)
15316 if (zi.lt.0) zi=zi+boxzsize
15318 do iint=1,nscp_gr(i)
15320 do j=iscpstart(i,iint),iscpend(i,iint)
15322 if (itypj.eq.ntyp1) cycle
15323 ! Uncomment following three lines for SC-p interactions
15324 ! xj=c(1,nres+j)-xi
15325 ! yj=c(2,nres+j)-yi
15326 ! zj=c(3,nres+j)-zi
15327 ! Uncomment following three lines for Ca-p interactions
15334 xj=mod(xj,boxxsize)
15335 if (xj.lt.0) xj=xj+boxxsize
15336 yj=mod(yj,boxysize)
15337 if (yj.lt.0) yj=yj+boxysize
15338 zj=mod(zj,boxzsize)
15339 if (zj.lt.0) zj=zj+boxzsize
15340 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15348 xj=xj_safe+xshift*boxxsize
15349 yj=yj_safe+yshift*boxysize
15350 zj=zj_safe+zshift*boxzsize
15351 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15352 if(dist_temp.lt.dist_init) then
15353 dist_init=dist_temp
15362 if (subchap.eq.1) then
15372 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15373 rij=dsqrt(1.0d0/rrij)
15374 sss_ele_cut=sscale_ele(rij)
15375 sss_ele_grad=sscagrad_ele(rij)
15376 ! print *,sss_ele_cut,sss_ele_grad,&
15377 ! (rij),r_cut_ele,rlamb_ele
15378 if (sss_ele_cut.le.0.0) cycle
15379 sss=sscale(rij/rscp(itypj,iteli))
15380 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
15381 if (sss.gt.0.0d0) then
15384 e1=fac*fac*aad(itypj,iteli)
15385 e2=fac*bad(itypj,iteli)
15386 if (iabs(j-i) .le. 2) then
15389 evdw2_14=evdw2_14+(e1+e2)*sss*sss_ele_cut
15392 evdw2=evdw2+evdwij*sss*sss_ele_cut
15393 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15394 'evdw2',i,j,sss,evdwij
15396 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15398 fac=-(evdwij+e1)*rrij*sss*sss_ele_cut
15399 fac=fac+evdwij*sss_ele_grad/rij/expon*sss &
15400 +evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15405 ! Uncomment following three lines for SC-p interactions
15407 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15409 ! Uncomment following line for SC-p interactions
15410 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15412 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15413 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15422 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15423 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15424 gradx_scp(j,i)=expon*gradx_scp(j,i)
15427 !******************************************************************************
15431 ! To save time the factor EXPON has been extracted from ALL components
15432 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15435 !******************************************************************************
15437 end subroutine escp_short
15438 !-----------------------------------------------------------------------------
15439 ! energy_p_new-sep_barrier.F
15440 !-----------------------------------------------------------------------------
15441 subroutine sc_grad_scale(scalfac)
15442 ! implicit real*8 (a-h,o-z)
15444 ! include 'DIMENSIONS'
15445 ! include 'COMMON.CHAIN'
15446 ! include 'COMMON.DERIV'
15447 ! include 'COMMON.CALC'
15448 ! include 'COMMON.IOUNITS'
15449 real(kind=8),dimension(3) :: dcosom1,dcosom2
15450 real(kind=8) :: scalfac
15451 !el local variables
15452 ! integer :: i,j,k,l
15454 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
15455 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
15456 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
15457 -2.0D0*alf12*eps3der+sigder*sigsq_om12
15461 ! eom12=evdwij*eps1_om12
15463 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
15464 ! & " sigder",sigder
15465 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
15466 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
15468 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
15469 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
15472 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac&
15475 ! write (iout,*) "gg",(gg(k),k=1,3)
15477 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
15478 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
15479 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
15481 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
15482 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
15483 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac&
15485 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
15486 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
15487 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
15488 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
15491 ! Calculate the components of the gradient in DC and X
15494 gvdwc(l,i)=gvdwc(l,i)-gg(l)
15495 gvdwc(l,j)=gvdwc(l,j)+gg(l)
15498 end subroutine sc_grad_scale
15499 !-----------------------------------------------------------------------------
15500 ! energy_split-sep.F
15501 !-----------------------------------------------------------------------------
15502 subroutine etotal_long(energia)
15504 ! Compute the long-range slow-varying contributions to the energy
15506 ! implicit real*8 (a-h,o-z)
15507 ! include 'DIMENSIONS'
15508 use MD_data, only: totT,usampl,eq_time
15512 !MS$ATTRIBUTES C :: proc_proc
15517 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
15519 ! include 'COMMON.SETUP'
15520 ! include 'COMMON.IOUNITS'
15521 ! include 'COMMON.FFIELD'
15522 ! include 'COMMON.DERIV'
15523 ! include 'COMMON.INTERACT'
15524 ! include 'COMMON.SBRIDGE'
15525 ! include 'COMMON.CHAIN'
15526 ! include 'COMMON.VAR'
15527 ! include 'COMMON.LOCAL'
15528 ! include 'COMMON.MD'
15529 real(kind=8),dimension(0:n_ene) :: energia
15530 !el local variables
15531 integer :: i,n_corr,n_corr1,ierror,ierr
15532 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
15533 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
15534 ecorr,ecorr5,ecorr6,eturn6,time00
15535 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
15536 !elwrite(iout,*)"in etotal long"
15538 if (modecalc.eq.12.or.modecalc.eq.14) then
15540 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
15542 call int_from_cart1(.false.)
15545 !elwrite(iout,*)"in etotal long"
15548 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
15549 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15551 if (nfgtasks.gt.1) then
15553 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15554 if (fg_rank.eq.0) then
15555 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
15556 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15558 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15559 ! FG slaves as WEIGHTS array.
15566 weights_(7)=wel_loc
15569 weights_(10)=wturn6
15571 weights_(12)=wscloc
15573 weights_(14)=wtor_d
15574 weights_(15)=wstrain
15575 weights_(16)=wvdwpp
15577 weights_(18)=scal14
15578 weights_(21)=wsccor
15579 ! FG Master broadcasts the WEIGHTS_ array
15580 call MPI_Bcast(weights_(1),n_ene,&
15581 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15583 ! FG slaves receive the WEIGHTS array
15584 call MPI_Bcast(weights(1),n_ene,&
15585 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15600 wstrain=weights(15)
15606 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
15608 time_Bcast=time_Bcast+MPI_Wtime()-time00
15609 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
15610 ! call chainbuild_cart
15611 ! call int_from_cart1(.false.)
15613 ! write (iout,*) 'Processor',myrank,
15614 ! & ' calling etotal_short ipot=',ipot
15616 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15618 !d print *,'nnt=',nnt,' nct=',nct
15620 !elwrite(iout,*)"in etotal long"
15621 ! Compute the side-chain and electrostatic interaction energy
15623 goto (101,102,103,104,105,106) ipot
15624 ! Lennard-Jones potential.
15625 101 call elj_long(evdw)
15626 !d print '(a)','Exit ELJ'
15628 ! Lennard-Jones-Kihara potential (shifted).
15629 102 call eljk_long(evdw)
15631 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15632 103 call ebp_long(evdw)
15634 ! Gay-Berne potential (shifted LJ, angular dependence).
15635 104 call egb_long(evdw)
15637 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15638 105 call egbv_long(evdw)
15640 ! Soft-sphere potential
15641 106 call e_softsphere(evdw)
15643 ! Calculate electrostatic (H-bonding) energy of the main chain.
15647 if (ipot.lt.6) then
15649 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
15650 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15651 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15652 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15654 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
15655 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15656 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15657 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15659 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
15668 ! write (iout,*) "Soft-spheer ELEC potential"
15669 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
15673 ! Calculate excluded-volume interaction energy between peptide groups
15676 if (ipot.lt.6) then
15677 if(wscp.gt.0d0) then
15678 call escp_long(evdw2,evdw2_14)
15684 call escp_soft_sphere(evdw2,evdw2_14)
15687 ! 12/1/95 Multi-body terms
15691 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
15692 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
15693 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
15694 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
15695 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
15702 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
15703 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
15706 ! If performing constraint dynamics, call the constraint energy
15707 ! after the equilibration time
15708 if(usampl.and.totT.gt.eq_time) then
15723 energia(2)=evdw2-evdw2_14
15724 energia(18)=evdw2_14
15733 energia(3)=ees+evdw1
15740 energia(8)=eello_turn3
15741 energia(9)=eello_turn4
15743 energia(20)=Uconst+Uconst_back
15744 call sum_energy(energia,.true.)
15745 ! write (iout,*) "Exit ETOTAL_LONG"
15748 end subroutine etotal_long
15749 !-----------------------------------------------------------------------------
15750 subroutine etotal_short(energia)
15752 ! Compute the short-range fast-varying contributions to the energy
15754 ! implicit real*8 (a-h,o-z)
15755 ! include 'DIMENSIONS'
15759 !MS$ATTRIBUTES C :: proc_proc
15764 integer :: ierror,ierr
15765 real(kind=8),dimension(n_ene) :: weights_
15766 real(kind=8) :: time00
15768 ! include 'COMMON.SETUP'
15769 ! include 'COMMON.IOUNITS'
15770 ! include 'COMMON.FFIELD'
15771 ! include 'COMMON.DERIV'
15772 ! include 'COMMON.INTERACT'
15773 ! include 'COMMON.SBRIDGE'
15774 ! include 'COMMON.CHAIN'
15775 ! include 'COMMON.VAR'
15776 ! include 'COMMON.LOCAL'
15777 real(kind=8),dimension(0:n_ene) :: energia
15778 !el local variables
15780 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
15781 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr
15784 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
15786 if (modecalc.eq.12.or.modecalc.eq.14) then
15788 if (fg_rank.eq.0) call int_from_cart1(.false.)
15790 call int_from_cart1(.false.)
15794 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
15795 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15797 if (nfgtasks.gt.1) then
15799 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15800 if (fg_rank.eq.0) then
15801 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
15802 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15804 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15805 ! FG slaves as WEIGHTS array.
15812 weights_(7)=wel_loc
15815 weights_(10)=wturn6
15817 weights_(12)=wscloc
15819 weights_(14)=wtor_d
15820 weights_(15)=wstrain
15821 weights_(16)=wvdwpp
15823 weights_(18)=scal14
15824 weights_(21)=wsccor
15825 ! FG Master broadcasts the WEIGHTS_ array
15826 call MPI_Bcast(weights_(1),n_ene,&
15827 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15829 ! FG slaves receive the WEIGHTS array
15830 call MPI_Bcast(weights(1),n_ene,&
15831 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15846 wstrain=weights(15)
15852 ! write (iout,*),"Processor",myrank," BROADCAST weights"
15853 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
15855 ! write (iout,*) "Processor",myrank," BROADCAST c"
15856 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
15858 ! write (iout,*) "Processor",myrank," BROADCAST dc"
15859 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
15861 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
15862 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
15864 ! write (iout,*) "Processor",myrank," BROADCAST theta"
15865 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
15867 ! write (iout,*) "Processor",myrank," BROADCAST phi"
15868 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
15870 ! write (iout,*) "Processor",myrank," BROADCAST alph"
15871 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
15873 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
15874 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
15876 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
15877 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
15879 time_Bcast=time_Bcast+MPI_Wtime()-time00
15880 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
15882 ! write (iout,*) 'Processor',myrank,
15883 ! & ' calling etotal_short ipot=',ipot
15885 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15887 ! call int_from_cart1(.false.)
15889 ! Compute the side-chain and electrostatic interaction energy
15891 goto (101,102,103,104,105,106) ipot
15892 ! Lennard-Jones potential.
15893 101 call elj_short(evdw)
15894 !d print '(a)','Exit ELJ'
15896 ! Lennard-Jones-Kihara potential (shifted).
15897 102 call eljk_short(evdw)
15899 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15900 103 call ebp_short(evdw)
15902 ! Gay-Berne potential (shifted LJ, angular dependence).
15903 104 call egb_short(evdw)
15905 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15906 105 call egbv_short(evdw)
15908 ! Soft-sphere potential - already dealt with in the long-range part
15910 ! 106 call e_softsphere_short(evdw)
15912 ! Calculate electrostatic (H-bonding) energy of the main chain.
15916 ! Calculate the short-range part of Evdwpp
15918 call evdwpp_short(evdw1)
15920 ! Calculate the short-range part of ESCp
15922 if (ipot.lt.6) then
15923 call escp_short(evdw2,evdw2_14)
15926 ! Calculate the bond-stretching energy
15930 ! Calculate the disulfide-bridge and other energy and the contributions
15931 ! from other distance constraints.
15934 ! Calculate the virtual-bond-angle energy.
15936 call ebend(ebe,ethetacnstr)
15938 ! Calculate the SC local energy.
15943 ! Calculate the virtual-bond torsional energy.
15945 call etor(etors,edihcnstr)
15947 ! 6/23/01 Calculate double-torsional energy
15949 call etor_d(etors_d)
15951 ! 21/5/07 Calculate local sicdechain correlation energy
15953 if (wsccor.gt.0.0d0) then
15954 call eback_sc_corr(esccor)
15959 ! Put energy components into an array
15966 energia(2)=evdw2-evdw2_14
15967 energia(18)=evdw2_14
15980 energia(14)=etors_d
15983 energia(19)=edihcnstr
15985 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
15987 call sum_energy(energia,.true.)
15988 ! write (iout,*) "Exit ETOTAL_SHORT"
15991 end subroutine etotal_short
15992 !-----------------------------------------------------------------------------
15994 !-----------------------------------------------------------------------------
15995 real(kind=8) function gnmr1(y,ymin,ymax)
15997 real(kind=8) :: y,ymin,ymax
15998 real(kind=8) :: wykl=4.0d0
15999 if (y.lt.ymin) then
16000 gnmr1=(ymin-y)**wykl/wykl
16001 else if (y.gt.ymax) then
16002 gnmr1=(y-ymax)**wykl/wykl
16008 !-----------------------------------------------------------------------------
16009 real(kind=8) function gnmr1prim(y,ymin,ymax)
16011 real(kind=8) :: y,ymin,ymax
16012 real(kind=8) :: wykl=4.0d0
16013 if (y.lt.ymin) then
16014 gnmr1prim=-(ymin-y)**(wykl-1)
16015 else if (y.gt.ymax) then
16016 gnmr1prim=(y-ymax)**(wykl-1)
16021 end function gnmr1prim
16022 !----------------------------------------------------------------------------
16023 real(kind=8) function rlornmr1(y,ymin,ymax,sigma)
16024 real(kind=8) y,ymin,ymax,sigma
16025 real(kind=8) wykl /4.0d0/
16026 if (y.lt.ymin) then
16027 rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl)
16028 else if (y.gt.ymax) then
16029 rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
16034 end function rlornmr1
16035 !------------------------------------------------------------------------------
16036 real(kind=8) function rlornmr1prim(y,ymin,ymax,sigma)
16037 real(kind=8) y,ymin,ymax,sigma
16038 real(kind=8) wykl /4.0d0/
16039 if (y.lt.ymin) then
16040 rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ &
16041 ((ymin-y)**wykl+sigma**wykl)**2
16042 else if (y.gt.ymax) then
16043 rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ &
16044 ((y-ymax)**wykl+sigma**wykl)**2
16049 end function rlornmr1prim
16051 real(kind=8) function harmonic(y,ymax)
16053 real(kind=8) :: y,ymax
16054 real(kind=8) :: wykl=2.0d0
16055 harmonic=(y-ymax)**wykl
16057 end function harmonic
16058 !-----------------------------------------------------------------------------
16059 real(kind=8) function harmonicprim(y,ymax)
16060 real(kind=8) :: y,ymin,ymax
16061 real(kind=8) :: wykl=2.0d0
16062 harmonicprim=(y-ymax)*wykl
16064 end function harmonicprim
16065 !-----------------------------------------------------------------------------
16067 !-----------------------------------------------------------------------------
16068 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
16070 use io_base, only:intout,briefout
16071 ! implicit real*8 (a-h,o-z)
16072 ! include 'DIMENSIONS'
16073 ! include 'COMMON.CHAIN'
16074 ! include 'COMMON.DERIV'
16075 ! include 'COMMON.VAR'
16076 ! include 'COMMON.INTERACT'
16077 ! include 'COMMON.FFIELD'
16078 ! include 'COMMON.MD'
16079 ! include 'COMMON.IOUNITS'
16080 real(kind=8),external :: ufparm
16081 integer :: uiparm(1)
16082 real(kind=8) :: urparm(1)
16083 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
16084 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
16085 integer :: n,nf,ind,ind1,i,k,j
16087 ! This subroutine calculates total internal coordinate gradient.
16088 ! Depending on the number of function evaluations, either whole energy
16089 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
16090 ! internal coordinates are reevaluated or only the cartesian-in-internal
16091 ! coordinate derivatives are evaluated. The subroutine was designed to work
16097 !d print *,'grad',nf,icg
16098 if (nf-nfl+1) 20,30,40
16099 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
16100 ! write (iout,*) 'grad 20'
16101 if (nf.eq.0) return
16103 30 call var_to_geom(n,x)
16105 ! write (iout,*) 'grad 30'
16107 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
16110 ! write (iout,*) 'grad 40'
16111 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
16113 ! Convert the Cartesian gradient into internal-coordinate gradient.
16123 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
16125 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
16128 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
16134 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
16136 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
16137 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
16140 if (i.gt.1) g(i-1)=gphii
16141 if (n.gt.nphi) g(nphi+i)=gthetai
16143 if (n.le.nphi+ntheta) goto 10
16145 if (itype(i,1).ne.10) then
16149 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
16152 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
16154 g(ialph(i,1))=galphai
16155 g(ialph(i,1)+nside)=gomegai
16159 ! Add the components corresponding to local energy terms.
16163 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
16164 g(i)=g(i)+gloc(i,icg)
16166 ! Uncomment following three lines for diagnostics.
16168 !elwrite(iout,*) "in gradient after calling intout"
16169 !d call briefout(0,0.0d0)
16170 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
16172 end subroutine gradient
16173 !-----------------------------------------------------------------------------
16174 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
16177 ! implicit real*8 (a-h,o-z)
16178 ! include 'DIMENSIONS'
16179 ! include 'COMMON.DERIV'
16180 ! include 'COMMON.IOUNITS'
16181 ! include 'COMMON.GEO'
16184 !el common /chuju/ jjj
16185 real(kind=8) :: energia(0:n_ene)
16186 integer :: uiparm(1)
16187 real(kind=8) :: urparm(1)
16189 real(kind=8),external :: ufparm
16190 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
16191 ! if (jjj.gt.0) then
16192 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
16196 !d print *,'func',nf,nfl,icg
16197 call var_to_geom(n,x)
16200 !d write (iout,*) 'ETOTAL called from FUNC'
16201 call etotal(energia)
16204 ! if (jjj.gt.0) then
16205 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
16206 ! write (iout,*) 'f=',etot
16210 end subroutine func
16211 !-----------------------------------------------------------------------------
16212 subroutine cartgrad
16213 ! implicit real*8 (a-h,o-z)
16214 ! include 'DIMENSIONS'
16216 use MD_data, only: totT,usampl,eq_time
16220 ! include 'COMMON.CHAIN'
16221 ! include 'COMMON.DERIV'
16222 ! include 'COMMON.VAR'
16223 ! include 'COMMON.INTERACT'
16224 ! include 'COMMON.FFIELD'
16225 ! include 'COMMON.MD'
16226 ! include 'COMMON.IOUNITS'
16227 ! include 'COMMON.TIME1'
16231 ! This subrouting calculates total Cartesian coordinate gradient.
16232 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
16242 !el write (iout,*) "After sum_gradient"
16244 !el write (iout,*) "After sum_gradient"
16246 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
16247 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
16250 ! If performing constraint dynamics, add the gradients of the constraint energy
16251 if(usampl.and.totT.gt.eq_time) then
16254 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
16255 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
16259 gloc(i,icg)=gloc(i,icg)+dugamma(i)
16262 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
16265 !elwrite (iout,*) "After sum_gradient"
16270 !elwrite (iout,*) "After sum_gradient"
16272 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
16274 ! call checkintcartgrad
16275 ! write(iout,*) 'calling int_to_cart'
16277 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
16281 gcart(j,i)=gradc(j,i,icg)
16282 gxcart(j,i)=gradx(j,i,icg)
16283 ! if (i.le.2) print *,"gcart_one",gcart(j,i),gradc(j,i,icg)
16286 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
16287 (gxcart(j,i),j=1,3),gloc(i,icg)
16293 ! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
16295 ! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
16298 time_inttocart=time_inttocart+MPI_Wtime()-time01
16301 write (iout,*) "gcart and gxcart after int_to_cart"
16303 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
16304 (gxcart(j,i),j=1,3)
16309 write (iout,*) "CARGRAD"
16313 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
16314 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
16316 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
16317 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
16319 ! Correction: dummy residues
16322 ! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
16323 gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
16326 if (nct.lt.nres) then
16328 ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
16329 gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
16334 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
16338 end subroutine cartgrad
16339 !-----------------------------------------------------------------------------
16340 subroutine zerograd
16341 ! implicit real*8 (a-h,o-z)
16342 ! include 'DIMENSIONS'
16343 ! include 'COMMON.DERIV'
16344 ! include 'COMMON.CHAIN'
16345 ! include 'COMMON.VAR'
16346 ! include 'COMMON.MD'
16347 ! include 'COMMON.SCCOR'
16349 !el local variables
16350 integer :: i,j,intertyp,k
16351 ! Initialize Cartesian-coordinate gradient
16353 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
16354 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
16356 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
16357 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
16358 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
16359 ! allocate(gradcorr_long(3,nres))
16360 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
16361 ! allocate(gcorr6_turn_long(3,nres))
16362 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
16364 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
16366 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
16367 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
16369 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
16370 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
16372 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
16373 ! allocate(gscloc(3,nres)) !(3,maxres)
16374 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
16378 ! common /deriv_scloc/
16379 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
16380 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
16381 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
16383 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
16387 ! gradc(j,i,icg)=0.0d0
16388 ! gradx(j,i,icg)=0.0d0
16390 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
16391 !elwrite(iout,*) "icg",icg
16395 gradx_scp(j,i)=0.0D0
16397 gvdwc_scp(j,i)=0.0D0
16398 gvdwc_scpp(j,i)=0.0d0
16400 gelc_long(j,i)=0.0D0
16405 gel_loc_long(j,i)=0.0d0
16408 gcorr3_turn(j,i)=0.0d0
16409 gcorr4_turn(j,i)=0.0d0
16410 gradcorr(j,i)=0.0d0
16411 gradcorr_long(j,i)=0.0d0
16412 gradcorr5_long(j,i)=0.0d0
16413 gradcorr6_long(j,i)=0.0d0
16414 gcorr6_turn_long(j,i)=0.0d0
16415 gradcorr5(j,i)=0.0d0
16416 gradcorr6(j,i)=0.0d0
16417 gcorr6_turn(j,i)=0.0d0
16420 gradc(j,i,icg)=0.0d0
16421 gradx(j,i,icg)=0.0d0
16424 gliptran(j,i)=0.0d0
16425 gliptranx(j,i)=0.0d0
16426 gliptranc(j,i)=0.0d0
16427 gshieldx(j,i)=0.0d0
16428 gshieldc(j,i)=0.0d0
16429 gshieldc_loc(j,i)=0.0d0
16430 gshieldx_ec(j,i)=0.0d0
16431 gshieldc_ec(j,i)=0.0d0
16432 gshieldc_loc_ec(j,i)=0.0d0
16433 gshieldx_t3(j,i)=0.0d0
16434 gshieldc_t3(j,i)=0.0d0
16435 gshieldc_loc_t3(j,i)=0.0d0
16436 gshieldx_t4(j,i)=0.0d0
16437 gshieldc_t4(j,i)=0.0d0
16438 gshieldc_loc_t4(j,i)=0.0d0
16439 gshieldx_ll(j,i)=0.0d0
16440 gshieldc_ll(j,i)=0.0d0
16441 gshieldc_loc_ll(j,i)=0.0d0
16443 gg_tube_sc(j,i)=0.0d0
16445 gradb_nucl(j,i)=0.0d0
16446 gradbx_nucl(j,i)=0.0d0
16447 gvdwpp_nucl(j,i)=0.0d0
16451 gvdwpsb1(j,i)=0.0d0
16455 gradcorr_nucl(j,i)=0.0d0
16456 gradcorr3_nucl(j,i)=0.0d0
16457 gradxorr_nucl(j,i)=0.0d0
16458 gradxorr3_nucl(j,i)=0.0d0
16462 gradpepcat(j,i)=0.0d0
16463 gradpepcatx(j,i)=0.0d0
16464 gradcatcat(j,i)=0.0d0
16465 gvdwx_scbase(j,i)=0.0d0
16466 gvdwc_scbase(j,i)=0.0d0
16467 gvdwx_pepbase(j,i)=0.0d0
16468 gvdwc_pepbase(j,i)=0.0d0
16469 gvdwx_scpho(j,i)=0.0d0
16470 gvdwc_scpho(j,i)=0.0d0
16471 gvdwc_peppho(j,i)=0.0d0
16477 gloc_sc(intertyp,i,icg)=0.0d0
16486 grad_shield_side(k,j,i)=0.0d0
16487 grad_shield_loc(k,j,i)=0.0d0
16494 ! Initialize the gradient of local energy terms.
16496 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
16497 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
16498 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
16499 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
16500 ! allocate(gel_loc_turn3(nres))
16501 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
16502 ! allocate(gsccor_loc(nres)) !(maxres)
16508 gel_loc_loc(i)=0.0d0
16510 g_corr5_loc(i)=0.0d0
16511 g_corr6_loc(i)=0.0d0
16512 gel_loc_turn3(i)=0.0d0
16513 gel_loc_turn4(i)=0.0d0
16514 gel_loc_turn6(i)=0.0d0
16515 gsccor_loc(i)=0.0d0
16517 ! initialize gcart and gxcart
16518 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
16526 end subroutine zerograd
16527 !-----------------------------------------------------------------------------
16528 real(kind=8) function fdum()
16532 !-----------------------------------------------------------------------------
16534 !-----------------------------------------------------------------------------
16535 subroutine intcartderiv
16536 ! implicit real*8 (a-h,o-z)
16537 ! include 'DIMENSIONS'
16541 ! include 'COMMON.SETUP'
16542 ! include 'COMMON.CHAIN'
16543 ! include 'COMMON.VAR'
16544 ! include 'COMMON.GEO'
16545 ! include 'COMMON.INTERACT'
16546 ! include 'COMMON.DERIV'
16547 ! include 'COMMON.IOUNITS'
16548 ! include 'COMMON.LOCAL'
16549 ! include 'COMMON.SCCOR'
16550 real(kind=8) :: pi4,pi34
16551 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
16552 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
16553 dcosomega,dsinomega !(3,3,maxres)
16554 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
16557 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
16558 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
16559 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
16560 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
16564 !el from module energy-------------
16565 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
16566 !el allocate(dsintau(3,3,3,itau_start:itau_end))
16567 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
16569 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
16570 !el allocate(dsintau(3,3,3,0:nres2))
16571 !el allocate(dtauangle(3,3,3,0:nres2))
16572 !el allocate(domicron(3,2,2,0:nres2))
16573 !el allocate(dcosomicron(3,2,2,0:nres2))
16577 #if defined(MPI) && defined(PARINTDER)
16578 if (nfgtasks.gt.1 .and. me.eq.king) &
16579 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
16584 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
16585 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
16587 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
16590 dtheta(j,1,i)=0.0d0
16591 dtheta(j,2,i)=0.0d0
16597 ! Derivatives of theta's
16598 #if defined(MPI) && defined(PARINTDER)
16599 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16600 do i=max0(ithet_start-1,3),ithet_end
16604 cost=dcos(theta(i))
16605 sint=sqrt(1-cost*cost)
16607 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
16609 if (itype(i-1,1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
16610 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
16612 if (itype(i-1,1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
16615 #if defined(MPI) && defined(PARINTDER)
16616 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16617 do i=max0(ithet_start-1,3),ithet_end
16621 if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1)) then
16622 cost1=dcos(omicron(1,i))
16623 sint1=sqrt(1-cost1*cost1)
16624 cost2=dcos(omicron(2,i))
16625 sint2=sqrt(1-cost2*cost2)
16627 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
16628 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
16629 cost1*dc_norm(j,i-2))/ &
16631 domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i)
16632 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
16633 +cost1*(dc_norm(j,i-1+nres)))/ &
16635 domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i)
16636 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
16637 !C Looks messy but better than if in loop
16638 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
16639 +cost2*dc_norm(j,i-1))/ &
16641 domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i)
16642 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
16643 +cost2*(-dc_norm(j,i-1+nres)))/ &
16645 ! write(iout,*) "vbld", i,itype(i,1),vbld(i-1+nres)
16646 domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i)
16650 !elwrite(iout,*) "after vbld write"
16651 ! Derivatives of phi:
16652 ! If phi is 0 or 180 degrees, then the formulas
16653 ! have to be derived by power series expansion of the
16654 ! conventional formulas around 0 and 180.
16656 do i=iphi1_start,iphi1_end
16660 ! if (itype(i-1,1).eq.21 .or. itype(i-2,1).eq.21 ) cycle
16661 ! the conventional case
16662 sint=dsin(theta(i))
16663 sint1=dsin(theta(i-1))
16665 cost=dcos(theta(i))
16666 cost1=dcos(theta(i-1))
16668 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
16669 fac0=1.0d0/(sint1*sint)
16672 fac3=cosg*cost1/(sint1*sint1)
16673 fac4=cosg*cost/(sint*sint)
16674 ! Obtaining the gamma derivatives from sine derivative
16675 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
16676 phi(i).gt.pi34.and.phi(i).le.pi.or. &
16677 phi(i).ge.-pi.and.phi(i).le.-pi34) then
16678 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16679 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
16680 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16684 cosg_inv=1.0d0/cosg
16685 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
16686 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16687 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
16688 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
16690 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
16691 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16692 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
16693 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
16694 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16695 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16696 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
16698 ! Bug fixed 3/24/05 (AL)
16700 ! Obtaining the gamma derivatives from cosine derivative
16703 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
16704 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16705 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16706 dc_norm(j,i-3))/vbld(i-2)
16707 dphi(j,1,i)=-1/sing*dcosphi(j,1,i)
16708 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16709 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16711 dphi(j,2,i)=-1/sing*dcosphi(j,2,i)
16712 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16713 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16714 dc_norm(j,i-1))/vbld(i)
16715 dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
16720 !alculate derivative of Tauangle
16722 do i=itau_start,itau_end
16725 !elwrite(iout,*) " vecpr",i,nres
16727 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
16728 ! if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10).or.
16729 ! & (itype(i-1,1).eq.ntyp1).or.(itype(i,1).eq.ntyp1)) cycle
16730 !c dtauangle(j,intertyp,dervityp,residue number)
16731 !c INTERTYP=1 SC...Ca...Ca..Ca
16732 ! the conventional case
16733 sint=dsin(theta(i))
16734 sint1=dsin(omicron(2,i-1))
16735 sing=dsin(tauangle(1,i))
16736 cost=dcos(theta(i))
16737 cost1=dcos(omicron(2,i-1))
16738 cosg=dcos(tauangle(1,i))
16739 !elwrite(iout,*) " vecpr5",i,nres
16741 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
16742 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
16743 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16744 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
16746 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
16747 fac0=1.0d0/(sint1*sint)
16750 fac3=cosg*cost1/(sint1*sint1)
16751 fac4=cosg*cost/(sint*sint)
16752 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
16753 ! Obtaining the gamma derivatives from sine derivative
16754 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
16755 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
16756 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
16757 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16758 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
16759 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16763 cosg_inv=1.0d0/cosg
16764 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16765 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
16766 *vbld_inv(i-2+nres)
16767 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
16768 dsintau(j,1,2,i)= &
16769 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
16770 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16771 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
16772 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
16773 ! Bug fixed 3/24/05 (AL)
16774 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
16775 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16776 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16777 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
16779 ! Obtaining the gamma derivatives from cosine derivative
16782 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16783 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16784 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
16785 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
16786 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16787 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16789 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
16790 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16791 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
16792 dc_norm(j,i-1))/vbld(i)
16793 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
16794 ! write (iout,*) "else",i
16798 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
16801 !C Second case Ca...Ca...Ca...SC
16803 do i=itau_start,itau_end
16807 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
16808 (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle
16809 ! the conventional case
16810 sint=dsin(omicron(1,i))
16811 sint1=dsin(theta(i-1))
16812 sing=dsin(tauangle(2,i))
16813 cost=dcos(omicron(1,i))
16814 cost1=dcos(theta(i-1))
16815 cosg=dcos(tauangle(2,i))
16817 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16819 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
16820 fac0=1.0d0/(sint1*sint)
16823 fac3=cosg*cost1/(sint1*sint1)
16824 fac4=cosg*cost/(sint*sint)
16825 ! Obtaining the gamma derivatives from sine derivative
16826 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
16827 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
16828 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
16829 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
16830 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
16831 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16835 cosg_inv=1.0d0/cosg
16836 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16837 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
16838 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
16839 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
16840 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
16841 dsintau(j,2,2,i)= &
16842 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
16843 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16844 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
16845 ! & sing*ctgt*domicron(j,1,2,i),
16846 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16847 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
16848 ! Bug fixed 3/24/05 (AL)
16849 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16850 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
16851 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16852 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
16854 ! Obtaining the gamma derivatives from cosine derivative
16857 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16858 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16859 dc_norm(j,i-3))/vbld(i-2)
16860 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
16861 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16862 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16863 dcosomicron(j,1,1,i)
16864 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
16865 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16866 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16867 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16868 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
16869 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
16874 !CC third case SC...Ca...Ca...SC
16877 do i=itau_start,itau_end
16881 ! the conventional case
16882 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
16883 (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
16884 sint=dsin(omicron(1,i))
16885 sint1=dsin(omicron(2,i-1))
16886 sing=dsin(tauangle(3,i))
16887 cost=dcos(omicron(1,i))
16888 cost1=dcos(omicron(2,i-1))
16889 cosg=dcos(tauangle(3,i))
16891 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16892 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16894 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
16895 fac0=1.0d0/(sint1*sint)
16898 fac3=cosg*cost1/(sint1*sint1)
16899 fac4=cosg*cost/(sint*sint)
16900 ! Obtaining the gamma derivatives from sine derivative
16901 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
16902 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
16903 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
16904 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
16905 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
16906 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16910 cosg_inv=1.0d0/cosg
16911 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16912 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
16913 *vbld_inv(i-2+nres)
16914 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
16915 dsintau(j,3,2,i)= &
16916 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
16917 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16918 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
16919 ! Bug fixed 3/24/05 (AL)
16920 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16921 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
16922 *vbld_inv(i-1+nres)
16923 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16924 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
16926 ! Obtaining the gamma derivatives from cosine derivative
16929 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16930 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16931 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
16932 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
16933 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16934 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16935 dcosomicron(j,1,1,i)
16936 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
16937 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16938 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
16939 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16940 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
16941 ! write(iout,*) "else",i
16947 ! Derivatives of side-chain angles alpha and omega
16948 #if defined(MPI) && defined(PARINTDER)
16949 do i=ibond_start,ibond_end
16953 if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
16954 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
16957 fac8=fac5/vbld(i+1)
16958 fac9=fac5/vbld(i+nres)
16959 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
16960 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
16961 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
16962 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
16963 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
16964 sina=sqrt(1-cosa*cosa)
16966 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
16968 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
16969 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
16970 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
16971 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
16972 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
16973 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
16974 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
16975 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
16977 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
16979 ! obtaining the derivatives of omega from sines
16980 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
16981 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
16982 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
16983 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
16985 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
16986 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
16987 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
16988 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
16989 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
16990 coso_inv=1.0d0/dcos(omeg(i))
16992 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
16993 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
16994 (sino*dc_norm(j,i-1))/vbld(i)
16995 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
16996 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
16997 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
16998 -sino*dc_norm(j,i)/vbld(i+1)
16999 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
17000 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
17001 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
17003 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
17006 ! obtaining the derivatives of omega from cosines
17007 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
17008 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
17013 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
17014 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
17015 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
17016 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
17017 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
17018 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
17019 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
17020 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
17021 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
17022 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
17023 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
17024 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
17025 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
17026 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
17027 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
17033 dalpha(k,j,i)=0.0d0
17034 domega(k,j,i)=0.0d0
17040 #if defined(MPI) && defined(PARINTDER)
17041 if (nfgtasks.gt.1) then
17043 !d write (iout,*) "Gather dtheta"
17044 !d call flush(iout)
17045 write (iout,*) "dtheta before gather"
17047 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
17050 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
17051 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
17052 king,FG_COMM,IERROR)
17054 !d write (iout,*) "Gather dphi"
17055 !d call flush(iout)
17056 write (iout,*) "dphi before gather"
17058 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
17061 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
17062 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
17063 king,FG_COMM,IERROR)
17064 !d write (iout,*) "Gather dalpha"
17065 !d call flush(iout)
17067 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
17068 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
17069 king,FG_COMM,IERROR)
17070 !d write (iout,*) "Gather domega"
17071 !d call flush(iout)
17072 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
17073 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
17074 king,FG_COMM,IERROR)
17079 write (iout,*) "dtheta after gather"
17081 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
17083 write (iout,*) "dphi after gather"
17085 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
17087 write (iout,*) "dalpha after gather"
17089 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
17091 write (iout,*) "domega after gather"
17093 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
17097 end subroutine intcartderiv
17098 !-----------------------------------------------------------------------------
17099 subroutine checkintcartgrad
17100 ! implicit real*8 (a-h,o-z)
17101 ! include 'DIMENSIONS'
17105 ! include 'COMMON.CHAIN'
17106 ! include 'COMMON.VAR'
17107 ! include 'COMMON.GEO'
17108 ! include 'COMMON.INTERACT'
17109 ! include 'COMMON.DERIV'
17110 ! include 'COMMON.IOUNITS'
17111 ! include 'COMMON.SETUP'
17112 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
17113 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
17114 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
17115 real(kind=8),dimension(3) :: dc_norm_s
17116 real(kind=8) :: aincr=1.0d-5
17118 real(kind=8) :: dcji
17121 theta_s(i)=theta(i)
17125 ! Check theta gradient
17127 "Analytical (upper) and numerical (lower) gradient of theta"
17132 dc(j,i-2)=dcji+aincr
17133 call chainbuild_cart
17134 call int_from_cart1(.false.)
17135 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
17138 dc(j,i-1)=dc(j,i-1)+aincr
17139 call chainbuild_cart
17140 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
17143 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
17144 !el (dtheta(j,2,i),j=1,3)
17145 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
17146 !el (dthetanum(j,2,i),j=1,3)
17147 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
17148 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
17149 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
17152 ! Check gamma gradient
17154 "Analytical (upper) and numerical (lower) gradient of gamma"
17158 dc(j,i-3)=dcji+aincr
17159 call chainbuild_cart
17160 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
17163 dc(j,i-2)=dcji+aincr
17164 call chainbuild_cart
17165 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
17168 dc(j,i-1)=dc(j,i-1)+aincr
17169 call chainbuild_cart
17170 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
17173 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
17174 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
17175 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
17176 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
17177 !el write (iout,'(5x,3(3f10.5,5x))') &
17178 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
17179 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
17180 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
17183 ! Check alpha gradient
17185 "Analytical (upper) and numerical (lower) gradient of alpha"
17187 if(itype(i,1).ne.10) then
17190 dc(j,i-1)=dcji+aincr
17191 call chainbuild_cart
17192 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
17197 call chainbuild_cart
17198 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
17202 dc(j,i+nres)=dc(j,i+nres)+aincr
17203 call chainbuild_cart
17204 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
17209 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
17210 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
17211 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
17212 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
17213 !el write (iout,'(5x,3(3f10.5,5x))') &
17214 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
17215 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
17216 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
17219 ! Check omega gradient
17221 "Analytical (upper) and numerical (lower) gradient of omega"
17223 if(itype(i,1).ne.10) then
17226 dc(j,i-1)=dcji+aincr
17227 call chainbuild_cart
17228 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
17233 call chainbuild_cart
17234 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
17238 dc(j,i+nres)=dc(j,i+nres)+aincr
17239 call chainbuild_cart
17240 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
17245 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
17246 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
17247 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
17248 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
17249 !el write (iout,'(5x,3(3f10.5,5x))') &
17250 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
17251 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
17252 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
17256 end subroutine checkintcartgrad
17257 !-----------------------------------------------------------------------------
17259 !-----------------------------------------------------------------------------
17260 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
17261 ! implicit real*8 (a-h,o-z)
17262 ! include 'DIMENSIONS'
17263 ! include 'COMMON.IOUNITS'
17264 ! include 'COMMON.CHAIN'
17265 ! include 'COMMON.INTERACT'
17266 ! include 'COMMON.VAR'
17267 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
17268 integer :: kkk,nsep=3
17269 real(kind=8) :: qm !dist,
17270 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
17271 logical :: lprn=.false.
17273 ! real(kind=8) :: sigm,x
17275 !el sigm(x)=0.25d0*x ! local function
17281 do il=seg1+nsep,seg2
17284 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
17285 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
17286 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17288 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
17289 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17292 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17293 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17294 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17295 dijCM=dist(il+nres,jl+nres)
17296 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
17298 qq = qq+qqij+qqijCM
17304 if((seg3-il).lt.3) then
17311 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17312 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17313 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17315 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
17316 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17319 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17320 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17321 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17322 dijCM=dist(il+nres,jl+nres)
17323 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
17325 qq = qq+qqij+qqijCM
17330 if (qqmax.le.qq) qqmax=qq
17332 qwolynes=1.0d0-qqmax
17334 end function qwolynes
17335 !-----------------------------------------------------------------------------
17336 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
17337 ! implicit real*8 (a-h,o-z)
17338 ! include 'DIMENSIONS'
17339 ! include 'COMMON.IOUNITS'
17340 ! include 'COMMON.CHAIN'
17341 ! include 'COMMON.INTERACT'
17342 ! include 'COMMON.VAR'
17343 ! include 'COMMON.MD'
17344 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
17345 integer :: nsep=3, kkk
17346 !el real(kind=8) :: dist
17347 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
17348 logical :: lprn=.false.
17350 real(kind=8) :: sim,dd0,fac,ddqij
17351 !el sigm(x)=0.25d0*x ! local function
17361 do il=seg1+nsep,seg2
17364 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17365 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17366 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17368 sim = 1.0d0/sigm(d0ij)
17371 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
17373 ddqij = (c(k,il)-c(k,jl))*fac
17374 dqwol(k,il)=dqwol(k,il)+ddqij
17375 dqwol(k,jl)=dqwol(k,jl)-ddqij
17378 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17381 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17382 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17383 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17384 dijCM=dist(il+nres,jl+nres)
17385 sim = 1.0d0/sigm(d0ijCM)
17388 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17390 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17391 dxqwol(k,il)=dxqwol(k,il)+ddqij
17392 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17399 if((seg3-il).lt.3) then
17406 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17407 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17408 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17410 sim = 1.0d0/sigm(d0ij)
17413 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
17415 ddqij = (c(k,il)-c(k,jl))*fac
17416 dqwol(k,il)=dqwol(k,il)+ddqij
17417 dqwol(k,jl)=dqwol(k,jl)-ddqij
17419 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17422 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17423 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17424 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17425 dijCM=dist(il+nres,jl+nres)
17426 sim = 1.0d0/sigm(d0ijCM)
17429 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17431 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17432 dxqwol(k,il)=dxqwol(k,il)+ddqij
17433 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17442 dqwol(j,i)=dqwol(j,i)/nl
17443 dxqwol(j,i)=dxqwol(j,i)/nl
17447 end subroutine qwolynes_prim
17448 !-----------------------------------------------------------------------------
17449 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
17450 ! implicit real*8 (a-h,o-z)
17451 ! include 'DIMENSIONS'
17452 ! include 'COMMON.IOUNITS'
17453 ! include 'COMMON.CHAIN'
17454 ! include 'COMMON.INTERACT'
17455 ! include 'COMMON.VAR'
17456 integer :: seg1,seg2,seg3,seg4
17458 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
17459 real(kind=8),dimension(3,0:2*nres) :: cdummy
17460 real(kind=8) :: q1,q2
17461 real(kind=8) :: delta=1.0d-10
17466 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
17468 c(j,i)=c(j,i)+delta
17469 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
17470 qwolan(j,i)=(q2-q1)/delta
17476 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
17477 cdummy(j,i+nres)=c(j,i+nres)
17478 c(j,i+nres)=c(j,i+nres)+delta
17479 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
17480 qwolxan(j,i)=(q2-q1)/delta
17481 c(j,i+nres)=cdummy(j,i+nres)
17484 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
17486 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
17488 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
17490 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
17493 end subroutine qwol_num
17494 !-----------------------------------------------------------------------------
17495 subroutine EconstrQ
17496 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
17497 ! implicit real*8 (a-h,o-z)
17498 ! include 'DIMENSIONS'
17499 ! include 'COMMON.CONTROL'
17500 ! include 'COMMON.VAR'
17501 ! include 'COMMON.MD'
17504 ! include 'COMMON.LANGEVIN'
17506 ! include 'COMMON.LANGEVIN.lang0'
17508 ! include 'COMMON.CHAIN'
17509 ! include 'COMMON.DERIV'
17510 ! include 'COMMON.GEO'
17511 ! include 'COMMON.LOCAL'
17512 ! include 'COMMON.INTERACT'
17513 ! include 'COMMON.IOUNITS'
17514 ! include 'COMMON.NAMES'
17515 ! include 'COMMON.TIME1'
17516 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
17517 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
17519 integer :: kstart,kend,lstart,lend,idummy
17520 real(kind=8) :: delta=1.0d-7
17521 integer :: i,j,k,ii
17525 dudconst(j,i)=0.0d0
17526 duxconst(j,i)=0.0d0
17527 dudxconst(j,i)=0.0d0
17532 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
17534 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
17535 ! Calculating the derivatives of Constraint energy with respect to Q
17536 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
17538 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
17539 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
17540 ! hmnum=(hm2-hm1)/delta
17541 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
17542 ! & qinfrag(i,iset))
17543 ! write(iout,*) "harmonicnum frag", hmnum
17544 ! Calculating the derivatives of Q with respect to cartesian coordinates
17545 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
17547 ! write(iout,*) "dqwol "
17549 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17551 ! write(iout,*) "dxqwol "
17553 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17555 ! Calculating numerical gradients of dU/dQi and dQi/dxi
17556 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
17557 ! & ,idummy,idummy)
17558 ! The gradients of Uconst in Cs
17561 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
17562 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
17567 kstart=ifrag(1,ipair(1,i,iset),iset)
17568 kend=ifrag(2,ipair(1,i,iset),iset)
17569 lstart=ifrag(1,ipair(2,i,iset),iset)
17570 lend=ifrag(2,ipair(2,i,iset),iset)
17571 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
17572 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
17573 ! Calculating dU/dQ
17574 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
17575 ! hm1=harmonic(qpair(i),qinpair(i,iset))
17576 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
17577 ! hmnum=(hm2-hm1)/delta
17578 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
17579 ! & qinpair(i,iset))
17580 ! write(iout,*) "harmonicnum pair ", hmnum
17581 ! Calculating dQ/dXi
17582 call qwolynes_prim(kstart,kend,.false.,&
17584 ! write(iout,*) "dqwol "
17586 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17588 ! write(iout,*) "dxqwol "
17590 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17592 ! Calculating numerical gradients
17593 ! call qwol_num(kstart,kend,.false.
17595 ! The gradients of Uconst in Cs
17598 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
17599 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
17603 ! write(iout,*) "Uconst inside subroutine ", Uconst
17604 ! Transforming the gradients from Cs to dCs for the backbone
17608 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
17612 ! Transforming the gradients from Cs to dCs for the side chains
17615 dudxconst(j,i)=duxconst(j,i)
17618 ! write(iout,*) "dU/ddc backbone "
17620 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
17622 ! write(iout,*) "dU/ddX side chain "
17624 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
17626 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
17627 ! call dEconstrQ_num
17629 end subroutine EconstrQ
17630 !-----------------------------------------------------------------------------
17631 subroutine dEconstrQ_num
17632 ! Calculating numerical dUconst/ddc and dUconst/ddx
17633 ! implicit real*8 (a-h,o-z)
17634 ! include 'DIMENSIONS'
17635 ! include 'COMMON.CONTROL'
17636 ! include 'COMMON.VAR'
17637 ! include 'COMMON.MD'
17640 ! include 'COMMON.LANGEVIN'
17642 ! include 'COMMON.LANGEVIN.lang0'
17644 ! include 'COMMON.CHAIN'
17645 ! include 'COMMON.DERIV'
17646 ! include 'COMMON.GEO'
17647 ! include 'COMMON.LOCAL'
17648 ! include 'COMMON.INTERACT'
17649 ! include 'COMMON.IOUNITS'
17650 ! include 'COMMON.NAMES'
17651 ! include 'COMMON.TIME1'
17652 real(kind=8) :: uzap1,uzap2
17653 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
17654 integer :: kstart,kend,lstart,lend,idummy
17655 real(kind=8) :: delta=1.0d-7
17656 !el local variables
17662 dUcartan(j,i)=0.0d0
17663 cdummy(j,i)=dc(j,i)
17664 dc(j,i)=dc(j,i)+delta
17665 call chainbuild_cart
17668 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17670 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17674 kstart=ifrag(1,ipair(1,ii,iset),iset)
17675 kend=ifrag(2,ipair(1,ii,iset),iset)
17676 lstart=ifrag(1,ipair(2,ii,iset),iset)
17677 lend=ifrag(2,ipair(2,ii,iset),iset)
17678 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17679 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17682 dc(j,i)=cdummy(j,i)
17683 call chainbuild_cart
17686 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17688 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17692 kstart=ifrag(1,ipair(1,ii,iset),iset)
17693 kend=ifrag(2,ipair(1,ii,iset),iset)
17694 lstart=ifrag(1,ipair(2,ii,iset),iset)
17695 lend=ifrag(2,ipair(2,ii,iset),iset)
17696 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17697 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17700 ducartan(j,i)=(uzap2-uzap1)/(delta)
17703 ! Calculating numerical gradients for dU/ddx
17705 duxcartan(j,i)=0.0d0
17707 cdummy(j,i)=dc(j,i+nres)
17708 dc(j,i+nres)=dc(j,i+nres)+delta
17709 call chainbuild_cart
17712 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17714 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17718 kstart=ifrag(1,ipair(1,ii,iset),iset)
17719 kend=ifrag(2,ipair(1,ii,iset),iset)
17720 lstart=ifrag(1,ipair(2,ii,iset),iset)
17721 lend=ifrag(2,ipair(2,ii,iset),iset)
17722 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17723 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17726 dc(j,i+nres)=cdummy(j,i)
17727 call chainbuild_cart
17730 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
17731 ifrag(2,ii,iset),.true.,idummy,idummy)
17732 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17736 kstart=ifrag(1,ipair(1,ii,iset),iset)
17737 kend=ifrag(2,ipair(1,ii,iset),iset)
17738 lstart=ifrag(1,ipair(2,ii,iset),iset)
17739 lend=ifrag(2,ipair(2,ii,iset),iset)
17740 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17741 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17744 duxcartan(j,i)=(uzap2-uzap1)/(delta)
17747 write(iout,*) "Numerical dUconst/ddc backbone "
17749 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
17751 ! write(iout,*) "Numerical dUconst/ddx side-chain "
17753 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
17756 end subroutine dEconstrQ_num
17757 !-----------------------------------------------------------------------------
17759 !-----------------------------------------------------------------------------
17760 subroutine check_energies
17762 ! use random, only: ran_number
17766 ! include 'DIMENSIONS'
17767 ! include 'COMMON.CHAIN'
17768 ! include 'COMMON.VAR'
17769 ! include 'COMMON.IOUNITS'
17770 ! include 'COMMON.SBRIDGE'
17771 ! include 'COMMON.LOCAL'
17772 ! include 'COMMON.GEO'
17774 ! External functions
17775 !EL double precision ran_number
17776 !EL external ran_number
17779 integer :: i,j,k,l,lmax,p,pmax
17780 real(kind=8) :: rmin,rmax
17781 real(kind=8) :: eij
17784 real(kind=8) :: wi,rij,tj,pj
17806 !t wi=ran_number(0.0D0,pi)
17807 ! wi=ran_number(0.0D0,pi/6.0D0)
17809 !t tj=ran_number(0.0D0,pi)
17810 !t pj=ran_number(0.0D0,pi)
17811 ! pj=ran_number(0.0D0,pi/6.0D0)
17815 !t rij=ran_number(rmin,rmax)
17817 c(1,j)=d*sin(pj)*cos(tj)
17818 c(2,j)=d*sin(pj)*sin(tj)
17824 c(3,i)=-rij-d*cos(wi)
17827 dc(k,nres+i)=c(k,nres+i)-c(k,i)
17828 dc_norm(k,nres+i)=dc(k,nres+i)/d
17829 dc(k,nres+j)=c(k,nres+j)-c(k,j)
17830 dc_norm(k,nres+j)=dc(k,nres+j)/d
17833 call dyn_ssbond_ene(i,j,eij)
17838 end subroutine check_energies
17839 !-----------------------------------------------------------------------------
17840 subroutine dyn_ssbond_ene(resi,resj,eij)
17845 ! include 'DIMENSIONS'
17846 ! include 'COMMON.SBRIDGE'
17847 ! include 'COMMON.CHAIN'
17848 ! include 'COMMON.DERIV'
17849 ! include 'COMMON.LOCAL'
17850 ! include 'COMMON.INTERACT'
17851 ! include 'COMMON.VAR'
17852 ! include 'COMMON.IOUNITS'
17853 ! include 'COMMON.CALC'
17857 ! include 'COMMON.MD'
17858 ! use MD, only: totT,t_bath
17861 ! External functions
17862 !EL double precision h_base
17863 !EL external h_base
17866 integer :: resi,resj
17869 real(kind=8) :: eij
17872 logical :: havebond
17873 integer itypi,itypj
17874 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
17875 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
17876 real(kind=8),dimension(3) :: dcosom1,dcosom2
17878 real(kind=8) :: pom1,pom2
17879 real(kind=8) :: ljA,ljB,ljXs
17880 real(kind=8),dimension(1:3) :: d_ljB
17881 real(kind=8) :: ssA,ssB,ssC,ssXs
17882 real(kind=8) :: ssxm,ljxm,ssm,ljm
17883 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
17884 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
17885 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
17886 !-------FIRST METHOD
17888 real(kind=8),dimension(1:3) :: d_xm
17889 !-------END FIRST METHOD
17890 !-------SECOND METHOD
17891 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
17892 !-------END SECOND METHOD
17894 !-------TESTING CODE
17895 !el logical :: checkstop,transgrad
17896 !el common /sschecks/ checkstop,transgrad
17898 integer :: icheck,nicheck,jcheck,njcheck
17899 real(kind=8),dimension(-1:1) :: echeck
17900 real(kind=8) :: deps,ssx0,ljx0
17901 !-------END TESTING CODE
17907 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
17908 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
17911 dxi=dc_norm(1,nres+i)
17912 dyi=dc_norm(2,nres+i)
17913 dzi=dc_norm(3,nres+i)
17914 dsci_inv=vbld_inv(i+nres)
17917 xj=c(1,nres+j)-c(1,nres+i)
17918 yj=c(2,nres+j)-c(2,nres+i)
17919 zj=c(3,nres+j)-c(3,nres+i)
17920 dxj=dc_norm(1,nres+j)
17921 dyj=dc_norm(2,nres+j)
17922 dzj=dc_norm(3,nres+j)
17923 dscj_inv=vbld_inv(j+nres)
17925 chi1=chi(itypi,itypj)
17926 chi2=chi(itypj,itypi)
17933 alf12=0.5D0*(alf1+alf2)
17935 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
17936 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
17937 ! The following are set in sc_angular
17941 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
17942 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
17943 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
17945 rij=1.0D0/rij ! Reset this so it makes sense
17947 sig0ij=sigma(itypi,itypj)
17948 sig=sig0ij*dsqrt(1.0D0/sigsq)
17951 ljA=eps1*eps2rt**2*eps3rt**2
17952 ljB=ljA*bb_aq(itypi,itypj)
17953 ljA=ljA*aa_aq(itypi,itypj)
17954 ljxm=ljXs+(-2.0D0*aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
17959 deltat12=om2-om1+2.0d0
17960 cosphi=om12-om1*om2
17964 +akth*(deltat1*deltat1+deltat2*deltat2) &
17965 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
17966 ssxm=ssXs-0.5D0*ssB/ssA
17968 !-------TESTING CODE
17969 !$$$c Some extra output
17970 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
17971 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
17972 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
17973 !$$$ if (ssx0.gt.0.0d0) then
17974 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
17978 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
17979 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
17980 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
17982 !-------END TESTING CODE
17984 !-------TESTING CODE
17985 ! Stop and plot energy and derivative as a function of distance
17986 if (checkstop) then
17987 ssm=ssC-0.25D0*ssB*ssB/ssA
17988 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
17989 if (ssm.lt.ljm .and. &
17990 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
17998 if (.not.checkstop) then
18003 do icheck=0,nicheck
18004 do jcheck=-1,njcheck
18005 if (checkstop) rij=(ssxm-1.0d0)+ &
18006 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
18007 !-------END TESTING CODE
18009 if (rij.gt.ljxm) then
18012 fac=(1.0D0/ljd)**expon
18013 e1=fac*fac*aa_aq(itypi,itypj)
18014 e2=fac*bb_aq(itypi,itypj)
18015 eij=eps1*eps2rt*eps3rt*(e1+e2)
18018 eij=eij*eps2rt*eps3rt
18021 e1=e1*eps1*eps2rt**2*eps3rt**2
18022 ed=-expon*(e1+eij)/ljd
18024 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
18025 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
18026 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
18027 -2.0D0*alf12*eps3der+sigder*sigsq_om12
18028 else if (rij.lt.ssxm) then
18031 eij=ssA*ssd*ssd+ssB*ssd+ssC
18033 ed=2*akcm*ssd+akct*deltat12
18035 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
18036 eom1=-2*akth*deltat1-pom1-om2*pom2
18037 eom2= 2*akth*deltat2+pom1-om1*pom2
18040 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
18042 d_ssxm(1)=0.5D0*akct/ssA
18043 d_ssxm(2)=-d_ssxm(1)
18046 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
18047 d_ljxm(2)=d_ljxm(1)*sigsq_om2
18048 d_ljxm(3)=d_ljxm(1)*sigsq_om12
18049 d_ljxm(1)=d_ljxm(1)*sigsq_om1
18051 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
18052 xm=0.5d0*(ssxm+ljxm)
18054 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
18056 if (rij.lt.xm) then
18058 ssm=ssC-0.25D0*ssB*ssB/ssA
18059 d_ssm(1)=0.5D0*akct*ssB/ssA
18060 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
18061 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
18063 f1=(rij-xm)/(ssxm-xm)
18064 f2=(rij-ssxm)/(xm-ssxm)
18068 delta_inv=1.0d0/(xm-ssxm)
18069 deltasq_inv=delta_inv*delta_inv
18071 fac1=deltasq_inv*fac*(xm-rij)
18072 fac2=deltasq_inv*fac*(rij-ssxm)
18073 ed=delta_inv*(Ht*hd2-ssm*hd1)
18074 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
18075 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
18076 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
18079 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
18080 d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
18081 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
18082 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
18084 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
18085 f1=(rij-ljxm)/(xm-ljxm)
18086 f2=(rij-xm)/(ljxm-xm)
18090 delta_inv=1.0d0/(ljxm-xm)
18091 deltasq_inv=delta_inv*delta_inv
18093 fac1=deltasq_inv*fac*(ljxm-rij)
18094 fac2=deltasq_inv*fac*(rij-xm)
18095 ed=delta_inv*(ljm*hd2-Ht*hd1)
18096 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
18097 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
18098 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
18100 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
18102 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
18108 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
18109 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
18110 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
18112 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
18113 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
18114 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
18115 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
18116 !$$$ d_ssm(3)=omega
18118 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
18120 !$$$ d_ljm(k)=ljm*d_ljB(k)
18124 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
18125 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
18126 !$$$ d_ss(2)=akct*ssd
18127 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
18128 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
18131 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
18132 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
18133 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
18135 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
18136 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
18138 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
18140 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
18141 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
18142 !$$$ h1=h_base(f1,hd1)
18143 !$$$ h2=h_base(f2,hd2)
18144 !$$$ eij=ss*h1+ljf*h2
18145 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
18146 !$$$ deltasq_inv=delta_inv*delta_inv
18147 !$$$ fac=ljf*hd2-ss*hd1
18148 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
18149 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
18150 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
18151 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
18152 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
18153 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
18154 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
18156 !$$$ havebond=.false.
18157 !$$$ if (ed.gt.0.0d0) havebond=.true.
18158 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
18165 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
18166 ! write(iout,'(a15,f12.2,f8.1,2i5)')
18167 ! & "SSBOND_E_FORM",totT,t_bath,i,j
18171 dyn_ssbond_ij(i,j)=eij
18172 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
18173 dyn_ssbond_ij(i,j)=1.0d300
18176 ! write(iout,'(a15,f12.2,f8.1,2i5)')
18177 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
18182 !-------TESTING CODE
18183 !el if (checkstop) then
18184 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
18185 "CHECKSTOP",rij,eij,ed
18189 if (checkstop) then
18190 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
18193 if (checkstop) then
18197 !-------END TESTING CODE
18200 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
18201 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
18204 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
18207 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
18208 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
18209 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
18210 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
18211 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
18212 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
18216 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
18221 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18222 gvdwc(l,j)=gvdwc(l,j)+gg(l)
18226 end subroutine dyn_ssbond_ene
18227 !--------------------------------------------------------------------------
18228 subroutine triple_ssbond_ene(resi,resj,resk,eij)
18233 ! include 'DIMENSIONS'
18234 ! include 'COMMON.SBRIDGE'
18235 ! include 'COMMON.CHAIN'
18236 ! include 'COMMON.DERIV'
18237 ! include 'COMMON.LOCAL'
18238 ! include 'COMMON.INTERACT'
18239 ! include 'COMMON.VAR'
18240 ! include 'COMMON.IOUNITS'
18241 ! include 'COMMON.CALC'
18245 ! include 'COMMON.MD'
18246 ! use MD, only: totT,t_bath
18249 double precision h_base
18253 integer resi,resj,resk,m,itypi,itypj,itypk
18255 !c Output arguments
18256 double precision eij,eij1,eij2,eij3
18260 !c integer itypi,itypj,k,l
18261 double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi
18262 double precision rrik,rrjk,rik,rjk,xi,xk,yi,yk,zi,zk,xij,yij,zij
18263 double precision xik,yik,zik,xjk,yjk,zjk,dxk,dyk,dzk
18264 double precision sig0ij,ljd,sig,fac,e1,e2
18265 double precision dcosom1(3),dcosom2(3),ed
18266 double precision pom1,pom2
18267 double precision ljA,ljB,ljXs
18268 double precision d_ljB(1:3)
18269 double precision ssA,ssB,ssC,ssXs
18270 double precision ssxm,ljxm,ssm,ljm
18271 double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3)
18273 if (dtriss.eq.0) return
18277 !C write(iout,*) resi,resj,resk
18279 dxi=dc_norm(1,nres+i)
18280 dyi=dc_norm(2,nres+i)
18281 dzi=dc_norm(3,nres+i)
18282 dsci_inv=vbld_inv(i+nres)
18291 dxj=dc_norm(1,nres+j)
18292 dyj=dc_norm(2,nres+j)
18293 dzj=dc_norm(3,nres+j)
18294 dscj_inv=vbld_inv(j+nres)
18300 dxk=dc_norm(1,nres+k)
18301 dyk=dc_norm(2,nres+k)
18302 dzk=dc_norm(3,nres+k)
18303 dscj_inv=vbld_inv(k+nres)
18313 rrij=(xij*xij+yij*yij+zij*zij)
18314 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
18315 rrik=(xik*xik+yik*yik+zik*zik)
18317 rrjk=(xjk*xjk+yjk*yjk+zjk*zjk)
18319 !C there are three combination of distances for each trisulfide bonds
18320 !C The first case the ith atom is the center
18321 !C Energy function is E=d/(a*(x-y)**2+b*(x+y)**2+c) where x is first
18322 !C distance y is second distance the a,b,c,d are parameters derived for
18323 !C this problem d parameter was set as a penalty currenlty set to 1.
18324 if ((iabs(j-i).le.2).or.(iabs(i-k).le.2)) then
18327 eij1=dtriss/(atriss*(rij-rik)**2+btriss*(rij+rik)**6+ctriss)
18329 !C second case jth atom is center
18330 if ((iabs(j-i).le.2).or.(iabs(j-k).le.2)) then
18333 eij2=dtriss/(atriss*(rij-rjk)**2+btriss*(rij+rjk)**6+ctriss)
18335 !C the third case kth atom is the center
18336 if ((iabs(i-k).le.2).or.(iabs(j-k).le.2)) then
18339 eij3=dtriss/(atriss*(rik-rjk)**2+btriss*(rik+rjk)**6+ctriss)
18345 !C write(iout,*)i,j,k,eij
18346 !C The energy penalty calculated now time for the gradient part
18347 !C derivative over rij
18348 fac=-eij1**2/dtriss*(2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
18349 -eij2**2/dtriss*(2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)
18354 gvdwx(m,i)=gvdwx(m,i)-gg(m)
18355 gvdwx(m,j)=gvdwx(m,j)+gg(m)
18359 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18360 gvdwc(l,j)=gvdwc(l,j)+gg(l)
18362 !C now derivative over rik
18363 fac=-eij1**2/dtriss* &
18364 (-2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
18365 -eij3**2/dtriss*(2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
18370 gvdwx(m,i)=gvdwx(m,i)-gg(m)
18371 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18374 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18375 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18377 !C now derivative over rjk
18378 fac=-eij2**2/dtriss* &
18379 (-2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)- &
18380 eij3**2/dtriss*(-2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
18385 gvdwx(m,j)=gvdwx(m,j)-gg(m)
18386 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18389 gvdwc(l,j)=gvdwc(l,j)-gg(l)
18390 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18393 end subroutine triple_ssbond_ene
18397 !-----------------------------------------------------------------------------
18398 real(kind=8) function h_base(x,deriv)
18399 ! A smooth function going 0->1 in range [0,1]
18400 ! It should NOT be called outside range [0,1], it will not work there.
18407 real(kind=8) :: deriv
18410 real(kind=8) :: xsq
18413 ! Two parabolas put together. First derivative zero at extrema
18414 !$$$ if (x.lt.0.5D0) then
18415 !$$$ h_base=2.0D0*x*x
18419 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
18420 !$$$ deriv=4.0D0*deriv
18423 ! Third degree polynomial. First derivative zero at extrema
18424 h_base=x*x*(3.0d0-2.0d0*x)
18425 deriv=6.0d0*x*(1.0d0-x)
18427 ! Fifth degree polynomial. First and second derivatives zero at extrema
18429 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
18431 !$$$ deriv=deriv*deriv
18432 !$$$ deriv=30.0d0*xsq*deriv
18435 end function h_base
18436 !-----------------------------------------------------------------------------
18437 subroutine dyn_set_nss
18438 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
18440 use MD_data, only: totT,t_bath
18442 ! include 'DIMENSIONS'
18446 ! include 'COMMON.SBRIDGE'
18447 ! include 'COMMON.CHAIN'
18448 ! include 'COMMON.IOUNITS'
18449 ! include 'COMMON.SETUP'
18450 ! include 'COMMON.MD'
18452 real(kind=8) :: emin
18453 integer :: i,j,imin,ierr
18454 integer :: diff,allnss,newnss
18455 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
18458 integer,dimension(0:nfgtasks) :: i_newnss
18459 integer,dimension(0:nfgtasks) :: displ
18460 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
18461 integer :: g_newnss
18466 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
18475 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
18479 if (allflag(i).eq.0 .and. &
18480 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
18481 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
18485 if (emin.lt.1.0d300) then
18488 if (allflag(i).eq.0 .and. &
18489 (allihpb(i).eq.allihpb(imin) .or. &
18490 alljhpb(i).eq.allihpb(imin) .or. &
18491 allihpb(i).eq.alljhpb(imin) .or. &
18492 alljhpb(i).eq.alljhpb(imin))) then
18499 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
18503 if (allflag(i).eq.1) then
18505 newihpb(newnss)=allihpb(i)
18506 newjhpb(newnss)=alljhpb(i)
18511 if (nfgtasks.gt.1)then
18513 call MPI_Reduce(newnss,g_newnss,1,&
18514 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
18515 call MPI_Gather(newnss,1,MPI_INTEGER,&
18516 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
18518 do i=1,nfgtasks-1,1
18519 displ(i)=i_newnss(i-1)+displ(i-1)
18521 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
18522 g_newihpb,i_newnss,displ,MPI_INTEGER,&
18524 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
18525 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
18527 if(fg_rank.eq.0) then
18528 ! print *,'g_newnss',g_newnss
18529 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
18530 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
18533 newihpb(i)=g_newihpb(i)
18534 newjhpb(i)=g_newjhpb(i)
18542 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
18543 ! print *,newnss,nss,maxdim
18549 if (idssb(i).eq.newihpb(j) .and. &
18550 jdssb(i).eq.newjhpb(j)) found=.true.
18554 ! write(iout,*) "found",found,i,j
18555 if (.not.found.and.fg_rank.eq.0) &
18556 write(iout,'(a15,f12.2,f8.1,2i5)') &
18557 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
18566 if (newihpb(i).eq.idssb(j) .and. &
18567 newjhpb(i).eq.jdssb(j)) found=.true.
18571 ! write(iout,*) "found",found,i,j
18572 if (.not.found.and.fg_rank.eq.0) &
18573 write(iout,'(a15,f12.2,f8.1,2i5)') &
18574 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
18581 idssb(i)=newihpb(i)
18582 jdssb(i)=newjhpb(i)
18586 end subroutine dyn_set_nss
18587 ! Lipid transfer energy function
18588 subroutine Eliptransfer(eliptran)
18589 !C this is done by Adasko
18590 !C print *,"wchodze"
18591 !C structure of box:
18593 !C--bordliptop-- buffore starts
18594 !C--bufliptop--- here true lipid starts
18596 !C--buflipbot--- lipid ends buffore starts
18597 !C--bordlipbot--buffore ends
18598 real(kind=8) :: fracinbuf,eliptran,sslip,positi,ssgradlip
18601 ! print *, "I am in eliptran"
18602 do i=ilip_start,ilip_end
18604 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))&
18607 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
18608 if (positi.le.0.0) positi=positi+boxzsize
18610 !C first for peptide groups
18611 !c for each residue check if it is in lipid or lipid water border area
18612 if ((positi.gt.bordlipbot) &
18613 .and.(positi.lt.bordliptop)) then
18614 !C the energy transfer exist
18615 if (positi.lt.buflipbot) then
18616 !C what fraction I am in
18618 ((positi-bordlipbot)/lipbufthick)
18619 !C lipbufthick is thickenes of lipid buffore
18620 sslip=sscalelip(fracinbuf)
18621 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
18622 eliptran=eliptran+sslip*pepliptran
18623 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
18624 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
18625 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
18627 !C print *,"doing sccale for lower part"
18628 !C print *,i,sslip,fracinbuf,ssgradlip
18629 elseif (positi.gt.bufliptop) then
18630 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
18631 sslip=sscalelip(fracinbuf)
18632 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
18633 eliptran=eliptran+sslip*pepliptran
18634 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
18635 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
18636 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
18637 !C print *, "doing sscalefor top part"
18638 !C print *,i,sslip,fracinbuf,ssgradlip
18640 eliptran=eliptran+pepliptran
18641 !C print *,"I am in true lipid"
18644 !C eliptran=elpitran+0.0 ! I am in water
18646 if (energy_dec) write(iout,*) i,"eliptran=",eliptran,positi,sslip
18648 ! here starts the side chain transfer
18649 do i=ilip_start,ilip_end
18650 if (itype(i,1).eq.ntyp1) cycle
18651 positi=(mod(c(3,i+nres),boxzsize))
18652 if (positi.le.0) positi=positi+boxzsize
18653 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18654 !c for each residue check if it is in lipid or lipid water border area
18655 !C respos=mod(c(3,i+nres),boxzsize)
18656 !C print *,positi,bordlipbot,buflipbot
18657 if ((positi.gt.bordlipbot) &
18658 .and.(positi.lt.bordliptop)) then
18659 !C the energy transfer exist
18660 if (positi.lt.buflipbot) then
18662 ((positi-bordlipbot)/lipbufthick)
18663 !C lipbufthick is thickenes of lipid buffore
18664 sslip=sscalelip(fracinbuf)
18665 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
18666 eliptran=eliptran+sslip*liptranene(itype(i,1))
18667 gliptranx(3,i)=gliptranx(3,i) &
18668 +ssgradlip*liptranene(itype(i,1))
18669 gliptranc(3,i-1)= gliptranc(3,i-1) &
18670 +ssgradlip*liptranene(itype(i,1))
18671 !C print *,"doing sccale for lower part"
18672 elseif (positi.gt.bufliptop) then
18674 ((bordliptop-positi)/lipbufthick)
18675 sslip=sscalelip(fracinbuf)
18676 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
18677 eliptran=eliptran+sslip*liptranene(itype(i,1))
18678 gliptranx(3,i)=gliptranx(3,i) &
18679 +ssgradlip*liptranene(itype(i,1))
18680 gliptranc(3,i-1)= gliptranc(3,i-1) &
18681 +ssgradlip*liptranene(itype(i,1))
18682 !C print *, "doing sscalefor top part",sslip,fracinbuf
18684 eliptran=eliptran+liptranene(itype(i,1))
18685 !C print *,"I am in true lipid"
18687 endif ! if in lipid or buffor
18689 !C eliptran=elpitran+0.0 ! I am in water
18690 if (energy_dec) write(iout,*) i,"eliptran=",eliptran
18693 end subroutine Eliptransfer
18694 !----------------------------------NANO FUNCTIONS
18695 !C-----------------------------------------------------------------------
18696 !C-----------------------------------------------------------
18697 !C This subroutine is to mimic the histone like structure but as well can be
18698 !C utilizet to nanostructures (infinit) small modification has to be used to
18699 !C make it finite (z gradient at the ends has to be changes as well as the x,y
18700 !C gradient has to be modified at the ends
18701 !C The energy function is Kihara potential
18702 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
18703 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
18704 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
18705 !C simple Kihara potential
18706 subroutine calctube(Etube)
18707 real(kind=8),dimension(3) :: vectube
18708 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18709 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi, &
18710 sc_aa_tube,sc_bb_tube
18713 do i=itube_start,itube_end
18715 enetube(i+nres)=0.0d0
18717 !C first we calculate the distance from tube center
18719 do i=itube_start,itube_end
18720 !C lets ommit dummy atoms for now
18721 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18722 !C now calculate distance from center of tube and direction vectors
18725 ! Find minimum distance in periodic box
18727 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18728 vectube(1)=vectube(1)+boxxsize*j
18729 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18730 vectube(2)=vectube(2)+boxysize*j
18731 xminact=abs(vectube(1)-tubecenter(1))
18732 yminact=abs(vectube(2)-tubecenter(2))
18733 if (xmin.gt.xminact) then
18737 if (ymin.gt.yminact) then
18744 vectube(1)=vectube(1)-tubecenter(1)
18745 vectube(2)=vectube(2)-tubecenter(2)
18747 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18748 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18750 !C as the tube is infinity we do not calculate the Z-vector use of Z
18753 !C now calculte the distance
18754 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18755 !C now normalize vector
18756 vectube(1)=vectube(1)/tub_r
18757 vectube(2)=vectube(2)/tub_r
18758 !C calculte rdiffrence between r and r0
18761 rdiff6=rdiff**6.0d0
18762 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18763 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
18764 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18765 !C print *,rdiff,rdiff6,pep_aa_tube
18766 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18767 !C now we calculate gradient
18768 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18769 6.0d0*pep_bb_tube)/rdiff6/rdiff
18770 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18772 !C now direction of gg_tube vector
18774 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18775 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18778 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18779 !C print *,gg_tube(1,0),"TU"
18782 do i=itube_start,itube_end
18783 !C Lets not jump over memory as we use many times iti
18785 !C lets ommit dummy atoms for now
18786 if ((iti.eq.ntyp1) &
18787 !C in UNRES uncomment the line below as GLY has no side-chain...
18793 vectube(1)=mod((c(1,i+nres)),boxxsize)
18794 vectube(1)=vectube(1)+boxxsize*j
18795 vectube(2)=mod((c(2,i+nres)),boxysize)
18796 vectube(2)=vectube(2)+boxysize*j
18798 xminact=abs(vectube(1)-tubecenter(1))
18799 yminact=abs(vectube(2)-tubecenter(2))
18800 if (xmin.gt.xminact) then
18804 if (ymin.gt.yminact) then
18811 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
18813 vectube(1)=vectube(1)-tubecenter(1)
18814 vectube(2)=vectube(2)-tubecenter(2)
18816 !C as the tube is infinity we do not calculate the Z-vector use of Z
18819 !C now calculte the distance
18820 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18821 !C now normalize vector
18822 vectube(1)=vectube(1)/tub_r
18823 vectube(2)=vectube(2)/tub_r
18825 !C calculte rdiffrence between r and r0
18828 rdiff6=rdiff**6.0d0
18829 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18830 sc_aa_tube=sc_aa_tube_par(iti)
18831 sc_bb_tube=sc_bb_tube_par(iti)
18832 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
18833 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
18834 6.0d0*sc_bb_tube/rdiff6/rdiff
18835 !C now direction of gg_tube vector
18837 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
18838 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
18841 do i=itube_start,itube_end
18842 Etube=Etube+enetube(i)+enetube(i+nres)
18844 !C print *,"ETUBE", etube
18846 end subroutine calctube
18847 !C TO DO 1) add to total energy
18848 !C 2) add to gradient summation
18849 !C 3) add reading parameters (AND of course oppening of PARAM file)
18850 !C 4) add reading the center of tube
18852 !C 6) add to zerograd
18853 !C 7) allocate matrices
18856 !C-----------------------------------------------------------------------
18857 !C-----------------------------------------------------------
18858 !C This subroutine is to mimic the histone like structure but as well can be
18859 !C utilizet to nanostructures (infinit) small modification has to be used to
18860 !C make it finite (z gradient at the ends has to be changes as well as the x,y
18861 !C gradient has to be modified at the ends
18862 !C The energy function is Kihara potential
18863 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
18864 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
18865 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
18866 !C simple Kihara potential
18867 subroutine calctube2(Etube)
18868 real(kind=8),dimension(3) :: vectube
18869 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18870 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi,fracinbuf,&
18871 sstube,ssgradtube,sc_aa_tube,sc_bb_tube
18874 do i=itube_start,itube_end
18876 enetube(i+nres)=0.0d0
18878 !C first we calculate the distance from tube center
18879 !C first sugare-phosphate group for NARES this would be peptide group
18881 do i=itube_start,itube_end
18882 !C lets ommit dummy atoms for now
18884 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18885 !C now calculate distance from center of tube and direction vectors
18886 !C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18887 !C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
18888 !C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18889 !C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
18893 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18894 vectube(1)=vectube(1)+boxxsize*j
18895 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18896 vectube(2)=vectube(2)+boxysize*j
18898 xminact=abs(vectube(1)-tubecenter(1))
18899 yminact=abs(vectube(2)-tubecenter(2))
18900 if (xmin.gt.xminact) then
18904 if (ymin.gt.yminact) then
18911 vectube(1)=vectube(1)-tubecenter(1)
18912 vectube(2)=vectube(2)-tubecenter(2)
18914 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18915 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18917 !C as the tube is infinity we do not calculate the Z-vector use of Z
18920 !C now calculte the distance
18921 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18922 !C now normalize vector
18923 vectube(1)=vectube(1)/tub_r
18924 vectube(2)=vectube(2)/tub_r
18925 !C calculte rdiffrence between r and r0
18928 rdiff6=rdiff**6.0d0
18929 !C THIS FRAGMENT MAKES TUBE FINITE
18930 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
18931 if (positi.le.0) positi=positi+boxzsize
18932 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18933 !c for each residue check if it is in lipid or lipid water border area
18934 !C respos=mod(c(3,i+nres),boxzsize)
18935 !C print *,positi,bordtubebot,buftubebot,bordtubetop
18936 if ((positi.gt.bordtubebot) &
18937 .and.(positi.lt.bordtubetop)) then
18938 !C the energy transfer exist
18939 if (positi.lt.buftubebot) then
18941 ((positi-bordtubebot)/tubebufthick)
18942 !C lipbufthick is thickenes of lipid buffore
18943 sstube=sscalelip(fracinbuf)
18944 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
18945 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
18946 enetube(i)=enetube(i)+sstube*tubetranenepep
18947 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18948 !C &+ssgradtube*tubetranene(itype(i,1))
18949 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18950 !C &+ssgradtube*tubetranene(itype(i,1))
18951 !C print *,"doing sccale for lower part"
18952 elseif (positi.gt.buftubetop) then
18954 ((bordtubetop-positi)/tubebufthick)
18955 sstube=sscalelip(fracinbuf)
18956 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
18957 enetube(i)=enetube(i)+sstube*tubetranenepep
18958 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18959 !C &+ssgradtube*tubetranene(itype(i,1))
18960 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18961 !C &+ssgradtube*tubetranene(itype(i,1))
18962 !C print *, "doing sscalefor top part",sslip,fracinbuf
18966 enetube(i)=enetube(i)+sstube*tubetranenepep
18967 !C print *,"I am in true lipid"
18971 !C ssgradtube=0.0d0
18973 endif ! if in lipid or buffor
18975 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18976 enetube(i)=enetube(i)+sstube* &
18977 (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
18978 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18979 !C print *,rdiff,rdiff6,pep_aa_tube
18980 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18981 !C now we calculate gradient
18982 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18983 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
18984 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18987 !C now direction of gg_tube vector
18989 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18990 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18992 gg_tube(3,i)=gg_tube(3,i) &
18993 +ssgradtube*enetube(i)/sstube/2.0d0
18994 gg_tube(3,i-1)= gg_tube(3,i-1) &
18995 +ssgradtube*enetube(i)/sstube/2.0d0
18998 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18999 !C print *,gg_tube(1,0),"TU"
19000 do i=itube_start,itube_end
19001 !C Lets not jump over memory as we use many times iti
19003 !C lets ommit dummy atoms for now
19004 if ((iti.eq.ntyp1) &
19005 !!C in UNRES uncomment the line below as GLY has no side-chain...
19008 vectube(1)=c(1,i+nres)
19009 vectube(1)=mod(vectube(1),boxxsize)
19010 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
19011 vectube(2)=c(2,i+nres)
19012 vectube(2)=mod(vectube(2),boxysize)
19013 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
19015 vectube(1)=vectube(1)-tubecenter(1)
19016 vectube(2)=vectube(2)-tubecenter(2)
19017 !C THIS FRAGMENT MAKES TUBE FINITE
19018 positi=(mod(c(3,i+nres),boxzsize))
19019 if (positi.le.0) positi=positi+boxzsize
19020 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
19021 !c for each residue check if it is in lipid or lipid water border area
19022 !C respos=mod(c(3,i+nres),boxzsize)
19023 !C print *,positi,bordtubebot,buftubebot,bordtubetop
19025 if ((positi.gt.bordtubebot) &
19026 .and.(positi.lt.bordtubetop)) then
19027 !C the energy transfer exist
19028 if (positi.lt.buftubebot) then
19030 ((positi-bordtubebot)/tubebufthick)
19031 !C lipbufthick is thickenes of lipid buffore
19032 sstube=sscalelip(fracinbuf)
19033 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
19034 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
19035 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19036 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19037 !C &+ssgradtube*tubetranene(itype(i,1))
19038 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19039 !C &+ssgradtube*tubetranene(itype(i,1))
19040 !C print *,"doing sccale for lower part"
19041 elseif (positi.gt.buftubetop) then
19043 ((bordtubetop-positi)/tubebufthick)
19045 sstube=sscalelip(fracinbuf)
19046 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
19047 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19048 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19049 !C &+ssgradtube*tubetranene(itype(i,1))
19050 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19051 !C &+ssgradtube*tubetranene(itype(i,1))
19052 !C print *, "doing sscalefor top part",sslip,fracinbuf
19056 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19057 !C print *,"I am in true lipid"
19061 !C ssgradtube=0.0d0
19063 endif ! if in lipid or buffor
19064 !CEND OF FINITE FRAGMENT
19065 !C as the tube is infinity we do not calculate the Z-vector use of Z
19068 !C now calculte the distance
19069 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19070 !C now normalize vector
19071 vectube(1)=vectube(1)/tub_r
19072 vectube(2)=vectube(2)/tub_r
19073 !C calculte rdiffrence between r and r0
19076 rdiff6=rdiff**6.0d0
19077 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19078 sc_aa_tube=sc_aa_tube_par(iti)
19079 sc_bb_tube=sc_bb_tube_par(iti)
19080 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)&
19081 *sstube+enetube(i+nres)
19082 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19083 !C now we calculate gradient
19084 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-&
19085 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
19086 !C now direction of gg_tube vector
19088 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19089 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19091 gg_tube_SC(3,i)=gg_tube_SC(3,i) &
19092 +ssgradtube*enetube(i+nres)/sstube
19093 gg_tube(3,i-1)= gg_tube(3,i-1) &
19094 +ssgradtube*enetube(i+nres)/sstube
19097 do i=itube_start,itube_end
19098 Etube=Etube+enetube(i)+enetube(i+nres)
19100 !C print *,"ETUBE", etube
19102 end subroutine calctube2
19103 !=====================================================================================================================================
19104 subroutine calcnano(Etube)
19105 real(kind=8),dimension(3) :: vectube
19107 real(kind=8) :: Etube,xtemp,xminact,yminact,&
19108 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,denominator,faccav,&
19109 sc_aa_tube,sc_bb_tube,zmin,ztemp,zminact
19110 integer:: i,j,iti,r
19113 ! print *,itube_start,itube_end,"poczatek"
19114 do i=itube_start,itube_end
19116 enetube(i+nres)=0.0d0
19118 !C first we calculate the distance from tube center
19119 !C first sugare-phosphate group for NARES this would be peptide group
19121 do i=itube_start,itube_end
19122 !C lets ommit dummy atoms for now
19123 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
19124 !C now calculate distance from center of tube and direction vectors
19130 vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19131 vectube(1)=vectube(1)+boxxsize*j
19132 vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19133 vectube(2)=vectube(2)+boxysize*j
19134 vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
19135 vectube(3)=vectube(3)+boxzsize*j
19138 xminact=dabs(vectube(1)-tubecenter(1))
19139 yminact=dabs(vectube(2)-tubecenter(2))
19140 zminact=dabs(vectube(3)-tubecenter(3))
19142 if (xmin.gt.xminact) then
19146 if (ymin.gt.yminact) then
19150 if (zmin.gt.zminact) then
19159 vectube(1)=vectube(1)-tubecenter(1)
19160 vectube(2)=vectube(2)-tubecenter(2)
19161 vectube(3)=vectube(3)-tubecenter(3)
19163 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
19164 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
19165 !C as the tube is infinity we do not calculate the Z-vector use of Z
19167 !C vectube(3)=0.0d0
19168 !C now calculte the distance
19169 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19170 !C now normalize vector
19171 vectube(1)=vectube(1)/tub_r
19172 vectube(2)=vectube(2)/tub_r
19173 vectube(3)=vectube(3)/tub_r
19174 !C calculte rdiffrence between r and r0
19177 rdiff6=rdiff**6.0d0
19178 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19179 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
19180 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
19181 !C print *,rdiff,rdiff6,pep_aa_tube
19182 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19183 !C now we calculate gradient
19184 fac=(-12.0d0*pep_aa_tube/rdiff6- &
19185 6.0d0*pep_bb_tube)/rdiff6/rdiff
19186 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
19188 if (acavtubpep.eq.0.0d0) then
19193 denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
19195 (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
19198 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
19199 *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
19200 +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
19201 /denominator**2.0d0
19206 if (energy_dec) write(iout,*),i,rdiff,enetube(i),enecavtube(i)
19208 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
19209 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
19213 do i=itube_start,itube_end
19214 enecavtube(i)=0.0d0
19215 !C Lets not jump over memory as we use many times iti
19217 !C lets ommit dummy atoms for now
19218 if ((iti.eq.ntyp1) &
19219 !C in UNRES uncomment the line below as GLY has no side-chain...
19226 vectube(1)=dmod((c(1,i+nres)),boxxsize)
19227 vectube(1)=vectube(1)+boxxsize*j
19228 vectube(2)=dmod((c(2,i+nres)),boxysize)
19229 vectube(2)=vectube(2)+boxysize*j
19230 vectube(3)=dmod((c(3,i+nres)),boxzsize)
19231 vectube(3)=vectube(3)+boxzsize*j
19234 xminact=dabs(vectube(1)-tubecenter(1))
19235 yminact=dabs(vectube(2)-tubecenter(2))
19236 zminact=dabs(vectube(3)-tubecenter(3))
19238 if (xmin.gt.xminact) then
19242 if (ymin.gt.yminact) then
19246 if (zmin.gt.zminact) then
19255 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
19257 vectube(1)=vectube(1)-tubecenter(1)
19258 vectube(2)=vectube(2)-tubecenter(2)
19259 vectube(3)=vectube(3)-tubecenter(3)
19260 !C now calculte the distance
19261 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19262 !C now normalize vector
19263 vectube(1)=vectube(1)/tub_r
19264 vectube(2)=vectube(2)/tub_r
19265 vectube(3)=vectube(3)/tub_r
19267 !C calculte rdiffrence between r and r0
19270 rdiff6=rdiff**6.0d0
19271 sc_aa_tube=sc_aa_tube_par(iti)
19272 sc_bb_tube=sc_bb_tube_par(iti)
19273 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19274 !C enetube(i+nres)=0.0d0
19275 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19276 !C now we calculate gradient
19277 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
19278 6.0d0*sc_bb_tube/rdiff6/rdiff
19280 !C now direction of gg_tube vector
19281 !C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
19282 if (acavtub(iti).eq.0.0d0) then
19284 enecavtube(i+nres)=0.0d0
19287 denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
19288 enecavtube(i+nres)= &
19289 (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
19291 !C enecavtube(i)=0.0
19292 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
19293 *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
19294 +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
19295 /denominator**2.0d0
19300 !C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
19301 !C & enecavtube(i),faccav
19302 !C print *,"licz=",
19303 !C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
19304 !C print *,"finene=",enetube(i+nres)+enecavtube(i)
19306 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19307 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19309 if (energy_dec) write(iout,*),i,rdiff,enetube(i+nres),enecavtube(i+nres)
19314 do i=itube_start,itube_end
19315 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) &
19316 +enecavtube(i+nres)
19319 ! print *,"begin", i,"a"
19322 ! rdiff6=rdiff**6.0d0
19323 ! sc_aa_tube=sc_aa_tube_par(i)
19324 ! sc_bb_tube=sc_bb_tube_par(i)
19325 ! enetube(i)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19326 ! denominator=(1.0d0+dcavtub(i)*rdiff6*rdiff6)
19328 ! (bcavtub(i)*rdiff+acavtub(i)*dsqrt(rdiff)+ccavtub(i)) &
19331 ! print '(5(f10.3,1x))',rdiff,enetube(i),enecavtube(i),enecavtube(i)+enetube(i)
19333 ! print *,"end",i,"a"
19335 !C print *,"ETUBE", etube
19337 end subroutine calcnano
19339 !===============================================
19340 !--------------------------------------------------------------------------------
19341 !C first for shielding is setting of function of side-chains
19343 subroutine set_shield_fac2
19344 real(kind=8) :: div77_81=0.974996043d0, &
19345 div4_81=0.2222222222d0
19346 real (kind=8) :: dist_pep_side,dist_side_calf,dist_pept_group, &
19347 scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
19348 short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
19349 sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
19350 !C the vector between center of side_chain and peptide group
19351 real(kind=8),dimension(3) :: pep_side_long,side_calf, &
19352 pept_group,costhet_grad,cosphi_grad_long, &
19353 cosphi_grad_loc,pep_side_norm,side_calf_norm, &
19354 sh_frac_dist_grad,pep_side
19356 !C write(2,*) "ivec",ivec_start,ivec_end
19358 fac_shield(i)=0.0d0
19360 grad_shield(j,i)=0.0d0
19363 do i=ivec_start,ivec_end
19365 !C if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
19367 if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
19368 !Cif there two consequtive dummy atoms there is no peptide group between them
19369 !C the line below has to be changed for FGPROC>1
19372 if ((itype(k,1).eq.ntyp1).or.(itype(k,1).eq.10)) cycle
19376 !C first lets set vector conecting the ithe side-chain with kth side-chain
19377 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
19378 !C pep_side(j)=2.0d0
19379 !C and vector conecting the side-chain with its proper calfa
19380 side_calf(j)=c(j,k+nres)-c(j,k)
19381 !C side_calf(j)=2.0d0
19382 pept_group(j)=c(j,i)-c(j,i+1)
19383 !C lets have their lenght
19384 dist_pep_side=pep_side(j)**2+dist_pep_side
19385 dist_side_calf=dist_side_calf+side_calf(j)**2
19386 dist_pept_group=dist_pept_group+pept_group(j)**2
19388 dist_pep_side=sqrt(dist_pep_side)
19389 dist_pept_group=sqrt(dist_pept_group)
19390 dist_side_calf=sqrt(dist_side_calf)
19392 pep_side_norm(j)=pep_side(j)/dist_pep_side
19393 side_calf_norm(j)=dist_side_calf
19395 !C now sscale fraction
19396 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
19397 !C print *,buff_shield,"buff"
19399 if (sh_frac_dist.le.0.0) cycle
19400 !C print *,ishield_list(i),i
19401 !C If we reach here it means that this side chain reaches the shielding sphere
19402 !C Lets add him to the list for gradient
19403 ishield_list(i)=ishield_list(i)+1
19404 !C ishield_list is a list of non 0 side-chain that contribute to factor gradient
19405 !C this list is essential otherwise problem would be O3
19406 shield_list(ishield_list(i),i)=k
19407 !C Lets have the sscale value
19408 if (sh_frac_dist.gt.1.0) then
19409 scale_fac_dist=1.0d0
19411 sh_frac_dist_grad(j)=0.0d0
19414 scale_fac_dist=-sh_frac_dist*sh_frac_dist &
19415 *(2.0d0*sh_frac_dist-3.0d0)
19416 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
19417 /dist_pep_side/buff_shield*0.5d0
19419 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
19420 !C sh_frac_dist_grad(j)=0.0d0
19421 !C scale_fac_dist=1.0d0
19422 !C print *,"jestem",scale_fac_dist,fac_help_scale,
19423 !C & sh_frac_dist_grad(j)
19426 !C this is what is now we have the distance scaling now volume...
19427 short=short_r_sidechain(itype(k,1))
19428 long=long_r_sidechain(itype(k,1))
19429 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
19430 sinthet=short/dist_pep_side*costhet
19431 !C now costhet_grad
19434 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
19435 !C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
19436 !C & -short/dist_pep_side**2/costhet)
19437 !C costhet_fac=0.0d0
19439 costhet_grad(j)=costhet_fac*pep_side(j)
19441 !C remember for the final gradient multiply costhet_grad(j)
19442 !C for side_chain by factor -2 !
19443 !C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
19444 !C pep_side0pept_group is vector multiplication
19445 pep_side0pept_group=0.0d0
19447 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
19449 cosalfa=(pep_side0pept_group/ &
19450 (dist_pep_side*dist_side_calf))
19451 fac_alfa_sin=1.0d0-cosalfa**2
19452 fac_alfa_sin=dsqrt(fac_alfa_sin)
19453 rkprim=fac_alfa_sin*(long-short)+short
19456 !C now costhet_grad
19457 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
19459 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
19460 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ &
19464 cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
19465 +cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
19466 *(long-short)/fac_alfa_sin*cosalfa/ &
19467 ((dist_pep_side*dist_side_calf))* &
19468 ((side_calf(j))-cosalfa* &
19469 ((pep_side(j)/dist_pep_side)*dist_side_calf))
19470 !C cosphi_grad_long(j)=0.0d0
19471 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
19472 *(long-short)/fac_alfa_sin*cosalfa &
19473 /((dist_pep_side*dist_side_calf))* &
19475 cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
19476 !C cosphi_grad_loc(j)=0.0d0
19478 !C print *,sinphi,sinthet
19479 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) &
19482 !C now the gradient...
19484 grad_shield(j,i)=grad_shield(j,i) &
19485 !C gradient po skalowaniu
19486 +(sh_frac_dist_grad(j)*VofOverlap &
19487 !C gradient po costhet
19488 +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
19489 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
19490 sinphi/sinthet*costhet*costhet_grad(j) &
19491 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
19493 !C grad_shield_side is Cbeta sidechain gradient
19494 grad_shield_side(j,ishield_list(i),i)=&
19495 (sh_frac_dist_grad(j)*-2.0d0&
19497 -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
19498 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(&
19499 sinphi/sinthet*costhet*costhet_grad(j)&
19500 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
19503 grad_shield_loc(j,ishield_list(i),i)= &
19504 scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
19505 (1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(&
19506 sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
19510 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
19512 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
19514 !C write(2,*) "TOTAL VOLUME",i,itype(i,1),fac_shield(i)
19517 end subroutine set_shield_fac2
19518 !----------------------------------------------------------------------------
19519 ! SOUBROUTINE FOR AFM
19520 subroutine AFMvel(Eafmforce)
19521 use MD_data, only:totTafm
19522 real(kind=8),dimension(3) :: diffafm
19523 real(kind=8) :: afmdist,Eafmforce
19525 !C Only for check grad COMMENT if not used for checkgrad
19527 !C--------------------------------------------------------
19528 !C print *,"wchodze"
19532 diffafm(i)=c(i,afmend)-c(i,afmbeg)
19533 afmdist=afmdist+diffafm(i)**2
19535 afmdist=dsqrt(afmdist)
19537 Eafmforce=0.5d0*forceAFMconst &
19538 *(distafminit+totTafm*velAFMconst-afmdist)**2
19539 !C Eafmforce=-forceAFMconst*(dist-distafminit)
19541 gradafm(i,afmend-1)=-forceAFMconst* &
19542 (distafminit+totTafm*velAFMconst-afmdist) &
19543 *diffafm(i)/afmdist
19544 gradafm(i,afmbeg-1)=forceAFMconst* &
19545 (distafminit+totTafm*velAFMconst-afmdist) &
19546 *diffafm(i)/afmdist
19548 ! print *,'AFM',Eafmforce,totTafm*velAFMconst,afmdist
19550 end subroutine AFMvel
19551 !---------------------------------------------------------
19552 subroutine AFMforce(Eafmforce)
19554 real(kind=8),dimension(3) :: diffafm
19555 ! real(kind=8) ::afmdist
19556 real(kind=8) :: afmdist,Eafmforce
19561 diffafm(i)=c(i,afmend)-c(i,afmbeg)
19562 afmdist=afmdist+diffafm(i)**2
19564 afmdist=dsqrt(afmdist)
19565 ! print *,afmdist,distafminit
19566 Eafmforce=-forceAFMconst*(afmdist-distafminit)
19568 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/afmdist
19569 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/afmdist
19571 !C print *,'AFM',Eafmforce
19573 end subroutine AFMforce
19575 !-----------------------------------------------------------------------------
19577 subroutine read_ssHist
19580 ! include 'DIMENSIONS'
19581 ! include "DIMENSIONS.FREE"
19582 ! include 'COMMON.FREE'
19585 character(len=80) :: controlcard
19588 call card_concat(controlcard,.true.)
19589 read(controlcard,*) &
19590 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
19594 end subroutine read_ssHist
19596 !-----------------------------------------------------------------------------
19597 integer function indmat(i,j)
19599 ! get the position of the jth ijth fragment of the chain coordinate system
19600 ! in the fromto array.
19603 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
19605 end function indmat
19606 !-----------------------------------------------------------------------------
19607 real(kind=8) function sigm(x)
19613 !-----------------------------------------------------------------------------
19614 !-----------------------------------------------------------------------------
19615 subroutine alloc_ener_arrays
19616 !EL Allocation of arrays used by module energy
19617 use MD_data, only: mset
19618 !el local variables
19621 if(nres.lt.100) then
19623 elseif(nres.lt.200) then
19624 maxconts=0.8*nres ! Max. number of contacts per residue
19626 maxconts=0.6*nres ! (maxconts=maxres/4)
19628 maxcont=12*nres ! Max. number of SC contacts
19629 maxvar=6*nres ! Max. number of variables
19630 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
19631 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
19632 !----------------------
19633 ! arrays in subroutine init_int_table
19635 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
19636 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
19638 allocate(nint_gr(nres))
19639 allocate(nscp_gr(nres))
19640 allocate(ielstart(nres))
19641 allocate(ielend(nres))
19643 allocate(istart(nres,maxint_gr))
19644 allocate(iend(nres,maxint_gr))
19645 !(maxres,maxint_gr)
19646 allocate(iscpstart(nres,maxint_gr))
19647 allocate(iscpend(nres,maxint_gr))
19648 !(maxres,maxint_gr)
19649 allocate(ielstart_vdw(nres))
19650 allocate(ielend_vdw(nres))
19652 allocate(nint_gr_nucl(nres))
19653 allocate(nscp_gr_nucl(nres))
19654 allocate(ielstart_nucl(nres))
19655 allocate(ielend_nucl(nres))
19657 allocate(istart_nucl(nres,maxint_gr))
19658 allocate(iend_nucl(nres,maxint_gr))
19659 !(maxres,maxint_gr)
19660 allocate(iscpstart_nucl(nres,maxint_gr))
19661 allocate(iscpend_nucl(nres,maxint_gr))
19662 !(maxres,maxint_gr)
19663 allocate(ielstart_vdw_nucl(nres))
19664 allocate(ielend_vdw_nucl(nres))
19666 allocate(lentyp(0:nfgtasks-1))
19668 !----------------------
19670 ! common /contacts/
19671 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
19672 allocate(icont(2,maxcont))
19674 ! common /contacts1/
19675 allocate(num_cont(0:nres+4))
19677 allocate(jcont(maxconts,nres))
19679 allocate(facont(maxconts,nres))
19681 allocate(gacont(3,maxconts,nres))
19682 !(3,maxconts,maxres)
19683 ! common /contacts_hb/
19684 allocate(gacontp_hb1(3,maxconts,nres))
19685 allocate(gacontp_hb2(3,maxconts,nres))
19686 allocate(gacontp_hb3(3,maxconts,nres))
19687 allocate(gacontm_hb1(3,maxconts,nres))
19688 allocate(gacontm_hb2(3,maxconts,nres))
19689 allocate(gacontm_hb3(3,maxconts,nres))
19690 allocate(gacont_hbr(3,maxconts,nres))
19691 allocate(grij_hb_cont(3,maxconts,nres))
19692 !(3,maxconts,maxres)
19693 allocate(facont_hb(maxconts,nres))
19695 allocate(ees0p(maxconts,nres))
19696 allocate(ees0m(maxconts,nres))
19697 allocate(d_cont(maxconts,nres))
19698 allocate(ees0plist(maxconts,nres))
19701 allocate(num_cont_hb(nres))
19703 allocate(jcont_hb(maxconts,nres))
19706 allocate(Ug(2,2,nres))
19707 allocate(Ugder(2,2,nres))
19708 allocate(Ug2(2,2,nres))
19709 allocate(Ug2der(2,2,nres))
19711 allocate(obrot(2,nres))
19712 allocate(obrot2(2,nres))
19713 allocate(obrot_der(2,nres))
19714 allocate(obrot2_der(2,nres))
19716 ! common /precomp1/
19717 allocate(mu(2,nres))
19718 allocate(muder(2,nres))
19719 allocate(Ub2(2,nres))
19722 allocate(Ub2der(2,nres))
19723 allocate(Ctobr(2,nres))
19724 allocate(Ctobrder(2,nres))
19725 allocate(Dtobr2(2,nres))
19726 allocate(Dtobr2der(2,nres))
19728 allocate(EUg(2,2,nres))
19729 allocate(EUgder(2,2,nres))
19730 allocate(CUg(2,2,nres))
19731 allocate(CUgder(2,2,nres))
19732 allocate(DUg(2,2,nres))
19733 allocate(Dugder(2,2,nres))
19734 allocate(DtUg2(2,2,nres))
19735 allocate(DtUg2der(2,2,nres))
19737 ! common /precomp2/
19738 allocate(Ug2Db1t(2,nres))
19739 allocate(Ug2Db1tder(2,nres))
19740 allocate(CUgb2(2,nres))
19741 allocate(CUgb2der(2,nres))
19743 allocate(EUgC(2,2,nres))
19744 allocate(EUgCder(2,2,nres))
19745 allocate(EUgD(2,2,nres))
19746 allocate(EUgDder(2,2,nres))
19747 allocate(DtUg2EUg(2,2,nres))
19748 allocate(Ug2DtEUg(2,2,nres))
19750 allocate(Ug2DtEUgder(2,2,2,nres))
19751 allocate(DtUg2EUgder(2,2,2,nres))
19753 ! common /rotat_old/
19754 allocate(costab(nres))
19755 allocate(sintab(nres))
19756 allocate(costab2(nres))
19757 allocate(sintab2(nres))
19760 allocate(a_chuj(2,2,maxconts,nres))
19761 !(2,2,maxconts,maxres)(maxconts=maxres/4)
19762 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
19763 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
19764 ! common /contdistrib/
19765 allocate(ncont_sent(nres))
19766 allocate(ncont_recv(nres))
19768 allocate(iat_sent(nres))
19770 allocate(iint_sent(4,nres,nres))
19771 allocate(iint_sent_local(4,nres,nres))
19773 allocate(iturn3_sent(4,0:nres+4))
19774 allocate(iturn4_sent(4,0:nres+4))
19775 allocate(iturn3_sent_local(4,nres))
19776 allocate(iturn4_sent_local(4,nres))
19778 allocate(itask_cont_from(0:nfgtasks-1))
19779 allocate(itask_cont_to(0:nfgtasks-1))
19780 !(0:max_fg_procs-1)
19784 !----------------------
19787 allocate(dcdv(6,maxdim))
19788 allocate(dxdv(6,maxdim))
19790 allocate(dxds(6,nres))
19792 allocate(gradx(3,-1:nres,0:2))
19793 allocate(gradc(3,-1:nres,0:2))
19795 allocate(gvdwx(3,-1:nres))
19796 allocate(gvdwc(3,-1:nres))
19797 allocate(gelc(3,-1:nres))
19798 allocate(gelc_long(3,-1:nres))
19799 allocate(gvdwpp(3,-1:nres))
19800 allocate(gvdwc_scpp(3,-1:nres))
19801 allocate(gradx_scp(3,-1:nres))
19802 allocate(gvdwc_scp(3,-1:nres))
19803 allocate(ghpbx(3,-1:nres))
19804 allocate(ghpbc(3,-1:nres))
19805 allocate(gradcorr(3,-1:nres))
19806 allocate(gradcorr_long(3,-1:nres))
19807 allocate(gradcorr5_long(3,-1:nres))
19808 allocate(gradcorr6_long(3,-1:nres))
19809 allocate(gcorr6_turn_long(3,-1:nres))
19810 allocate(gradxorr(3,-1:nres))
19811 allocate(gradcorr5(3,-1:nres))
19812 allocate(gradcorr6(3,-1:nres))
19813 allocate(gliptran(3,-1:nres))
19814 allocate(gliptranc(3,-1:nres))
19815 allocate(gliptranx(3,-1:nres))
19816 allocate(gshieldx(3,-1:nres))
19817 allocate(gshieldc(3,-1:nres))
19818 allocate(gshieldc_loc(3,-1:nres))
19819 allocate(gshieldx_ec(3,-1:nres))
19820 allocate(gshieldc_ec(3,-1:nres))
19821 allocate(gshieldc_loc_ec(3,-1:nres))
19822 allocate(gshieldx_t3(3,-1:nres))
19823 allocate(gshieldc_t3(3,-1:nres))
19824 allocate(gshieldc_loc_t3(3,-1:nres))
19825 allocate(gshieldx_t4(3,-1:nres))
19826 allocate(gshieldc_t4(3,-1:nres))
19827 allocate(gshieldc_loc_t4(3,-1:nres))
19828 allocate(gshieldx_ll(3,-1:nres))
19829 allocate(gshieldc_ll(3,-1:nres))
19830 allocate(gshieldc_loc_ll(3,-1:nres))
19831 allocate(grad_shield(3,-1:nres))
19832 allocate(gg_tube_sc(3,-1:nres))
19833 allocate(gg_tube(3,-1:nres))
19834 allocate(gradafm(3,-1:nres))
19835 allocate(gradb_nucl(3,-1:nres))
19836 allocate(gradbx_nucl(3,-1:nres))
19837 allocate(gvdwpsb1(3,-1:nres))
19838 allocate(gelpp(3,-1:nres))
19839 allocate(gvdwpsb(3,-1:nres))
19840 allocate(gelsbc(3,-1:nres))
19841 allocate(gelsbx(3,-1:nres))
19842 allocate(gvdwsbx(3,-1:nres))
19843 allocate(gvdwsbc(3,-1:nres))
19844 allocate(gsbloc(3,-1:nres))
19845 allocate(gsblocx(3,-1:nres))
19846 allocate(gradcorr_nucl(3,-1:nres))
19847 allocate(gradxorr_nucl(3,-1:nres))
19848 allocate(gradcorr3_nucl(3,-1:nres))
19849 allocate(gradxorr3_nucl(3,-1:nres))
19850 allocate(gvdwpp_nucl(3,-1:nres))
19851 allocate(gradpepcat(3,-1:nres))
19852 allocate(gradpepcatx(3,-1:nres))
19853 allocate(gradcatcat(3,-1:nres))
19855 allocate(grad_shield_side(3,50,nres))
19856 allocate(grad_shield_loc(3,50,nres))
19857 ! grad for shielding surroing
19858 allocate(gloc(0:maxvar,0:2))
19859 allocate(gloc_x(0:maxvar,2))
19861 allocate(gel_loc(3,-1:nres))
19862 allocate(gel_loc_long(3,-1:nres))
19863 allocate(gcorr3_turn(3,-1:nres))
19864 allocate(gcorr4_turn(3,-1:nres))
19865 allocate(gcorr6_turn(3,-1:nres))
19866 allocate(gradb(3,-1:nres))
19867 allocate(gradbx(3,-1:nres))
19869 allocate(gel_loc_loc(maxvar))
19870 allocate(gel_loc_turn3(maxvar))
19871 allocate(gel_loc_turn4(maxvar))
19872 allocate(gel_loc_turn6(maxvar))
19873 allocate(gcorr_loc(maxvar))
19874 allocate(g_corr5_loc(maxvar))
19875 allocate(g_corr6_loc(maxvar))
19877 allocate(gsccorc(3,-1:nres))
19878 allocate(gsccorx(3,-1:nres))
19880 allocate(gsccor_loc(-1:nres))
19882 allocate(gvdwx_scbase(3,-1:nres))
19883 allocate(gvdwc_scbase(3,-1:nres))
19884 allocate(gvdwx_pepbase(3,-1:nres))
19885 allocate(gvdwc_pepbase(3,-1:nres))
19886 allocate(gvdwx_scpho(3,-1:nres))
19887 allocate(gvdwc_scpho(3,-1:nres))
19888 allocate(gvdwc_peppho(3,-1:nres))
19890 allocate(dtheta(3,2,-1:nres))
19892 allocate(gscloc(3,-1:nres))
19893 allocate(gsclocx(3,-1:nres))
19895 allocate(dphi(3,3,-1:nres))
19896 allocate(dalpha(3,3,-1:nres))
19897 allocate(domega(3,3,-1:nres))
19899 ! common /deriv_scloc/
19900 allocate(dXX_C1tab(3,nres))
19901 allocate(dYY_C1tab(3,nres))
19902 allocate(dZZ_C1tab(3,nres))
19903 allocate(dXX_Ctab(3,nres))
19904 allocate(dYY_Ctab(3,nres))
19905 allocate(dZZ_Ctab(3,nres))
19906 allocate(dXX_XYZtab(3,nres))
19907 allocate(dYY_XYZtab(3,nres))
19908 allocate(dZZ_XYZtab(3,nres))
19911 allocate(jgrad_start(nres))
19912 allocate(jgrad_end(nres))
19914 !----------------------
19917 allocate(ibond_displ(0:nfgtasks-1))
19918 allocate(ibond_count(0:nfgtasks-1))
19919 allocate(ithet_displ(0:nfgtasks-1))
19920 allocate(ithet_count(0:nfgtasks-1))
19921 allocate(iphi_displ(0:nfgtasks-1))
19922 allocate(iphi_count(0:nfgtasks-1))
19923 allocate(iphi1_displ(0:nfgtasks-1))
19924 allocate(iphi1_count(0:nfgtasks-1))
19925 allocate(ivec_displ(0:nfgtasks-1))
19926 allocate(ivec_count(0:nfgtasks-1))
19927 allocate(iset_displ(0:nfgtasks-1))
19928 allocate(iset_count(0:nfgtasks-1))
19929 allocate(iint_count(0:nfgtasks-1))
19930 allocate(iint_displ(0:nfgtasks-1))
19931 !(0:max_fg_procs-1)
19932 !----------------------
19935 allocate(gcart(3,-1:nres))
19936 allocate(gxcart(3,-1:nres))
19938 allocate(gradcag(3,-1:nres))
19939 allocate(gradxag(3,-1:nres))
19941 ! common /back_constr/
19942 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
19943 allocate(dutheta(nres))
19944 allocate(dugamma(nres))
19946 allocate(duscdiff(3,nres))
19947 allocate(duscdiffx(3,nres))
19949 !el i io:read_fragments
19950 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
19951 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
19953 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
19954 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
19955 allocate(mset(0:nprocs)) !(maxprocs/20)
19957 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
19958 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
19959 allocate(dUdconst(3,0:nres))
19960 allocate(dUdxconst(3,0:nres))
19961 allocate(dqwol(3,0:nres))
19962 allocate(dxqwol(3,0:nres))
19964 !----------------------
19966 ! common /sbridge/ in io_common: read_bridge
19967 !el allocate((:),allocatable :: iss !(maxss)
19968 ! common /links/ in io_common: read_bridge
19969 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
19970 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
19971 ! common /dyn_ssbond/
19972 ! and side-chain vectors in theta or phi.
19973 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
19977 dyn_ssbond_ij(:,:)=1.0d300
19981 ! if (nss.gt.0) then
19982 allocate(idssb(maxdim),jdssb(maxdim))
19983 ! allocate(newihpb(nss),newjhpb(nss))
19986 allocate(ishield_list(nres))
19987 allocate(shield_list(50,nres))
19988 allocate(dyn_ss_mask(nres))
19989 allocate(fac_shield(nres))
19990 allocate(enetube(nres*2))
19991 allocate(enecavtube(nres*2))
19994 dyn_ss_mask(:)=.false.
19995 !----------------------
19997 ! Parameters of the SCCOR term
19999 !el in io_conf: parmread
20000 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
20001 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
20002 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
20003 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
20004 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
20005 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
20006 ! allocate(vlor1sccor(maxterm_sccor,20,20))
20007 ! allocate(vlor2sccor(maxterm_sccor,20,20))
20008 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
20010 allocate(gloc_sc(3,0:2*nres,0:10))
20011 !(3,0:maxres2,10)maxres2=2*maxres
20012 allocate(dcostau(3,3,3,2*nres))
20013 allocate(dsintau(3,3,3,2*nres))
20014 allocate(dtauangle(3,3,3,2*nres))
20015 allocate(dcosomicron(3,3,3,2*nres))
20016 allocate(domicron(3,3,3,2*nres))
20017 !(3,3,3,maxres2)maxres2=2*maxres
20018 !----------------------
20021 allocate(varall(maxvar))
20022 !(maxvar)(maxvar=6*maxres)
20023 allocate(mask_theta(nres))
20024 allocate(mask_phi(nres))
20025 allocate(mask_side(nres))
20027 !----------------------
20030 allocate(uy(3,nres))
20031 allocate(uz(3,nres))
20033 allocate(uygrad(3,3,2,nres))
20034 allocate(uzgrad(3,3,2,nres))
20038 end subroutine alloc_ener_arrays
20039 !-----------------------------------------------------------------
20040 subroutine ebond_nucl(estr_nucl)
20042 !c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
20045 real(kind=8),dimension(3) :: u,ud
20046 real(kind=8) :: usum,uprod,uprod1,uprod2,usumsqder
20047 real(kind=8) :: estr_nucl,diff
20048 integer :: iti,i,j,k,nbi
20050 !C print *,"I enter ebond"
20052 write (iout,*) "ibondp_start,ibondp_end",&
20053 ibondp_nucl_start,ibondp_nucl_end
20054 do i=ibondp_nucl_start,ibondp_nucl_end
20055 if (itype(i-1,2).eq.ntyp1_molec(2) .or. &
20056 itype(i,2).eq.ntyp1_molec(2)) cycle
20057 ! estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
20059 ! gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
20060 ! & *dc(j,i-1)/vbld(i)
20062 ! if (energy_dec) write(iout,*)
20063 ! & "estr1",i,vbld(i),distchainmax,
20064 ! & gnmr1(vbld(i),-1.0d0,distchainmax)
20066 diff = vbld(i)-vbldp0_nucl
20067 if(energy_dec)write(iout,*) "estr_nucl_bb" , i,vbld(i),&
20068 vbldp0_nucl,diff,AKP_nucl*diff*diff
20069 estr_nucl=estr_nucl+diff*diff
20070 ! print *,estr_nucl
20072 gradb_nucl(j,i-1)=AKP_nucl*diff*dc(j,i-1)/vbld(i)
20074 !c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
20076 estr_nucl=0.5d0*AKP_nucl*estr_nucl
20077 ! print *,"partial sum", estr_nucl,AKP_nucl
20080 write (iout,*) "ibondp_start,ibondp_end",&
20081 ibond_nucl_start,ibond_nucl_end
20083 do i=ibond_nucl_start,ibond_nucl_end
20084 !C print *, "I am stuck",i
20086 if (iti.eq.ntyp1_molec(2)) cycle
20087 nbi=nbondterm_nucl(iti)
20090 diff=vbld(i+nres)-vbldsc0_nucl(1,iti)
20093 write (iout,*) "estr_nucl_sc", i,iti,vbld(i+nres),vbldsc0_nucl(1,iti),diff, &
20094 AKSC_nucl(1,iti),AKSC_nucl(1,iti)*diff*diff
20095 estr_nucl=estr_nucl+0.5d0*AKSC_nucl(1,iti)*diff*diff
20096 ! print *,estr_nucl
20098 gradbx_nucl(j,i)=AKSC_nucl(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
20102 diff=vbld(i+nres)-vbldsc0_nucl(j,iti)
20103 ud(j)=aksc_nucl(j,iti)*diff
20104 u(j)=abond0_nucl(j,iti)+0.5d0*ud(j)*diff
20118 uprod2=uprod2*u(k)*u(k)
20122 usumsqder=usumsqder+ud(j)*uprod2
20124 estr_nucl=estr_nucl+uprod/usum
20126 gradbx_nucl(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
20130 !C print *,"I am about to leave ebond"
20132 end subroutine ebond_nucl
20134 !-----------------------------------------------------------------------------
20135 subroutine ebend_nucl(etheta_nucl)
20136 real(kind=8),dimension(nntheterm_nucl+1) :: coskt,sinkt !mmaxtheterm
20137 real(kind=8),dimension(nsingle_nucl+1) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
20138 real(kind=8),dimension(ndouble_nucl+1,ndouble_nucl+1) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
20139 logical :: lprn=.false., lprn1=.false.
20140 !el local variables
20141 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
20142 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
20143 real(kind=8) :: aux,etheta_nucl,ccl,ssl,scl,csl,ethetacnstr
20144 ! local variables for constrains
20145 real(kind=8) :: difi,thetiii
20148 ! print *,"ithet_start",ithet_nucl_start," ithet_end",ithet_nucl_end,nres
20149 do i=ithet_nucl_start,ithet_nucl_end
20150 if ((itype(i-1,2).eq.ntyp1_molec(2)).or.&
20151 (itype(i-2,2).eq.ntyp1_molec(2)).or. &
20152 (itype(i,2).eq.ntyp1_molec(2))) cycle
20156 theti2=0.5d0*theta(i)
20157 ityp2=ithetyp_nucl(itype(i-1,2))
20158 do k=1,nntheterm_nucl
20159 coskt(k)=dcos(k*theti2)
20160 sinkt(k)=dsin(k*theti2)
20162 if (i.gt.3 .and. itype(i-2,2).ne.ntyp1_molec(2)) then
20165 if (phii.ne.phii) phii=150.0
20169 ityp1=ithetyp_nucl(itype(i-2,2))
20170 do k=1,nsingle_nucl
20171 cosph1(k)=dcos(k*phii)
20172 sinph1(k)=dsin(k*phii)
20176 ityp1=nthetyp_nucl+1
20177 do k=1,nsingle_nucl
20183 if (i.lt.nres .and. itype(i,2).ne.ntyp1_molec(2)) then
20186 if (phii1.ne.phii1) phii1=150.0
20187 phii1=pinorm(phii1)
20191 ityp3=ithetyp_nucl(itype(i,2))
20192 do k=1,nsingle_nucl
20193 cosph2(k)=dcos(k*phii1)
20194 sinph2(k)=dsin(k*phii1)
20198 ityp3=nthetyp_nucl+1
20199 do k=1,nsingle_nucl
20204 ethetai=aa0thet_nucl(ityp1,ityp2,ityp3)
20205 do k=1,ndouble_nucl
20207 ccl=cosph1(l)*cosph2(k-l)
20208 ssl=sinph1(l)*sinph2(k-l)
20209 scl=sinph1(l)*cosph2(k-l)
20210 csl=cosph1(l)*sinph2(k-l)
20211 cosph1ph2(l,k)=ccl-ssl
20212 cosph1ph2(k,l)=ccl+ssl
20213 sinph1ph2(l,k)=scl+csl
20214 sinph1ph2(k,l)=scl-csl
20218 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
20219 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
20220 write (iout,*) "coskt and sinkt",nntheterm_nucl
20221 do k=1,nntheterm_nucl
20222 write (iout,*) k,coskt(k),sinkt(k)
20225 do k=1,ntheterm_nucl
20226 ethetai=ethetai+aathet_nucl(k,ityp1,ityp2,ityp3)*sinkt(k)
20227 dethetai=dethetai+0.5d0*k*aathet_nucl(k,ityp1,ityp2,ityp3)&
20230 write (iout,*) "k",k," aathet",aathet_nucl(k,ityp1,ityp2,ityp3),&
20234 write (iout,*) "cosph and sinph"
20235 do k=1,nsingle_nucl
20236 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
20238 write (iout,*) "cosph1ph2 and sinph2ph2"
20239 do k=2,ndouble_nucl
20241 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
20242 sinph1ph2(l,k),sinph1ph2(k,l)
20245 write(iout,*) "ethetai",ethetai
20247 do m=1,ntheterm2_nucl
20248 do k=1,nsingle_nucl
20249 aux=bbthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)&
20250 +ccthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k)&
20251 +ddthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)&
20252 +eethet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k)
20253 ethetai=ethetai+sinkt(m)*aux
20254 dethetai=dethetai+0.5d0*m*aux*coskt(m)
20255 dephii=dephii+k*sinkt(m)*(&
20256 ccthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)-&
20257 bbthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k))
20258 dephii1=dephii1+k*sinkt(m)*(&
20259 eethet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)-&
20260 ddthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k))
20262 write (iout,*) "m",m," k",k," bbthet",&
20263 bbthet_nucl(k,m,ityp1,ityp2,ityp3)," ccthet",&
20264 ccthet_nucl(k,m,ityp1,ityp2,ityp3)," ddthet",&
20265 ddthet_nucl(k,m,ityp1,ityp2,ityp3)," eethet",&
20266 eethet_nucl(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
20270 write(iout,*) "ethetai",ethetai
20271 do m=1,ntheterm3_nucl
20272 do k=2,ndouble_nucl
20274 aux=ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
20275 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+&
20276 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
20277 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
20278 ethetai=ethetai+sinkt(m)*aux
20279 dethetai=dethetai+0.5d0*m*coskt(m)*aux
20280 dephii=dephii+l*sinkt(m)*(&
20281 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-&
20282 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
20283 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
20284 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
20285 dephii1=dephii1+(k-l)*sinkt(m)*( &
20286 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
20287 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
20288 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-&
20289 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
20291 write (iout,*) "m",m," k",k," l",l," ffthet", &
20292 ffthet_nucl(l,k,m,ityp1,ityp2,ityp3), &
20293 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ggthet",&
20294 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3),&
20295 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
20296 write (iout,*) cosph1ph2(l,k)*sinkt(m), &
20297 cosph1ph2(k,l)*sinkt(m),&
20298 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
20304 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
20305 i,theta(i)*rad2deg,phii*rad2deg, &
20306 phii1*rad2deg,ethetai
20307 etheta_nucl=etheta_nucl+ethetai
20308 ! print *,i,"partial sum",etheta_nucl
20309 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang_nucl*dephii
20310 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang_nucl*dephii1
20311 gloc(nphi+i-2,icg)=wang_nucl*dethetai
20314 end subroutine ebend_nucl
20315 !----------------------------------------------------
20316 subroutine etor_nucl(etors_nucl)
20317 ! implicit real*8 (a-h,o-z)
20318 ! include 'DIMENSIONS'
20319 ! include 'COMMON.VAR'
20320 ! include 'COMMON.GEO'
20321 ! include 'COMMON.LOCAL'
20322 ! include 'COMMON.TORSION'
20323 ! include 'COMMON.INTERACT'
20324 ! include 'COMMON.DERIV'
20325 ! include 'COMMON.CHAIN'
20326 ! include 'COMMON.NAMES'
20327 ! include 'COMMON.IOUNITS'
20328 ! include 'COMMON.FFIELD'
20329 ! include 'COMMON.TORCNSTR'
20330 ! include 'COMMON.CONTROL'
20331 real(kind=8) :: etors_nucl,edihcnstr
20333 !el local variables
20334 integer :: i,j,iblock,itori,itori1
20335 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
20336 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
20337 ! Set lprn=.true. for debugging
20341 ! print *,"iphi_nucl_start/end", iphi_nucl_start,iphi_nucl_end
20342 do i=iphi_nucl_start,iphi_nucl_end
20343 if (itype(i-2,2).eq.ntyp1_molec(2) .or. itype(i-1,2).eq.ntyp1_molec(2) &
20344 .or. itype(i-3,2).eq.ntyp1_molec(2) &
20345 .or. itype(i,2).eq.ntyp1_molec(2)) cycle
20347 itori=itortyp_nucl(itype(i-2,2))
20348 itori1=itortyp_nucl(itype(i-1,2))
20350 ! print *,i,itori,itori1
20352 !C Regular cosine and sine terms
20353 do j=1,nterm_nucl(itori,itori1)
20354 v1ij=v1_nucl(j,itori,itori1)
20355 v2ij=v2_nucl(j,itori,itori1)
20356 cosphi=dcos(j*phii)
20357 sinphi=dsin(j*phii)
20358 etors_nucl=etors_nucl+v1ij*cosphi+v2ij*sinphi
20359 if (energy_dec) etors_ii=etors_ii+&
20360 v1ij*cosphi+v2ij*sinphi
20361 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
20365 !C E = SUM ----------------------------------- - v1
20366 !C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
20368 cosphi=dcos(0.5d0*phii)
20369 sinphi=dsin(0.5d0*phii)
20370 do j=1,nlor_nucl(itori,itori1)
20371 vl1ij=vlor1_nucl(j,itori,itori1)
20372 vl2ij=vlor2_nucl(j,itori,itori1)
20373 vl3ij=vlor3_nucl(j,itori,itori1)
20374 pom=vl2ij*cosphi+vl3ij*sinphi
20375 pom1=1.0d0/(pom*pom+1.0d0)
20376 etors_nucl=etors_nucl+vl1ij*pom1
20377 if (energy_dec) etors_ii=etors_ii+ &
20380 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
20382 !C Subtract the constant term
20383 etors_nucl=etors_nucl-v0_nucl(itori,itori1)
20384 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
20385 'etor',i,etors_ii-v0_nucl(itori,itori1)
20387 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
20388 restyp(itype(i-2,2),2),i-2,restyp(itype(i-1,2),2),i-1,itori,itori1, &
20389 (v1_nucl(j,itori,itori1),j=1,6),(v2_nucl(j,itori,itori1),j=1,6)
20390 gloc(i-3,icg)=gloc(i-3,icg)+wtor_nucl*gloci
20391 !c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
20394 end subroutine etor_nucl
20395 !------------------------------------------------------------
20396 subroutine epp_nucl_sub(evdw1,ees)
20398 !C This subroutine calculates the average interaction energy and its gradient
20399 !C in the virtual-bond vectors between non-adjacent peptide groups, based on
20400 !C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
20401 !C The potential depends both on the distance of peptide-group centers and on
20402 !C the orientation of the CA-CA virtual bonds.
20404 integer :: i,j,k,iteli,itelj,num_conti,isubchap,ind
20405 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
20406 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
20407 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
20408 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
20409 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20410 dist_temp, dist_init,sss_grad,fac,evdw1ij
20411 integer xshift,yshift,zshift
20412 real(kind=8),dimension(3):: ggg,gggp,gggm,erij
20413 real(kind=8) :: ees,eesij
20414 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
20415 real(kind=8) scal_el /0.5d0/
20421 !c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
20423 ! print *,"iatel_s_nucl,iatel_e_nucl",iatel_s_nucl,iatel_e_nucl
20424 do i=iatel_s_nucl,iatel_e_nucl
20425 if (itype(i,2).eq.ntyp1_molec(2) .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
20429 dx_normi=dc_norm(1,i)
20430 dy_normi=dc_norm(2,i)
20431 dz_normi=dc_norm(3,i)
20432 xmedi=c(1,i)+0.5d0*dxi
20433 ymedi=c(2,i)+0.5d0*dyi
20434 zmedi=c(3,i)+0.5d0*dzi
20435 xmedi=dmod(xmedi,boxxsize)
20436 if (xmedi.lt.0) xmedi=xmedi+boxxsize
20437 ymedi=dmod(ymedi,boxysize)
20438 if (ymedi.lt.0) ymedi=ymedi+boxysize
20439 zmedi=dmod(zmedi,boxzsize)
20440 if (zmedi.lt.0) zmedi=zmedi+boxzsize
20442 do j=ielstart_nucl(i),ielend_nucl(i)
20443 if (itype(j,2).eq.ntyp1_molec(2) .or. itype(j+1,2).eq.ntyp1_molec(2)) cycle
20448 ! xj=c(1,j)+0.5D0*dxj-xmedi
20449 ! yj=c(2,j)+0.5D0*dyj-ymedi
20450 ! zj=c(3,j)+0.5D0*dzj-zmedi
20451 xj=c(1,j)+0.5D0*dxj
20452 yj=c(2,j)+0.5D0*dyj
20453 zj=c(3,j)+0.5D0*dzj
20454 xj=mod(xj,boxxsize)
20455 if (xj.lt.0) xj=xj+boxxsize
20456 yj=mod(yj,boxysize)
20457 if (yj.lt.0) yj=yj+boxysize
20458 zj=mod(zj,boxzsize)
20459 if (zj.lt.0) zj=zj+boxzsize
20461 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
20468 xj=xj_safe+xshift*boxxsize
20469 yj=yj_safe+yshift*boxysize
20470 zj=zj_safe+zshift*boxzsize
20471 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
20472 if(dist_temp.lt.dist_init) then
20473 dist_init=dist_temp
20482 if (isubchap.eq.1) then
20493 rij=xj*xj+yj*yj+zj*zj
20494 !c write (2,*)"ij",i,j," r0pp",r0pp," rij",rij," epspp",epspp
20495 fac=(r0pp**2/rij)**3
20499 fac=(-ev1-evdw1ij)/rij
20500 ! write (2,*)"fac",fac," ev1",ev1," ev2",ev2," evdw1ij",evdw1ij
20501 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"evdw1ij",evdw1ij
20502 evdw1=evdw1+evdw1ij
20504 !C Calculate contributions to the Cartesian gradient.
20510 gvdwpp_nucl(k,i)=gvdwpp_nucl(k,i)-ggg(k)
20511 gvdwpp_nucl(k,j)=gvdwpp_nucl(k,j)+ggg(k)
20513 !c phoshate-phosphate electrostatic interactions
20516 eesij=dexp(-BEES*rij)*fac
20517 ! write (2,*)"fac",fac," eesijpp",eesij
20518 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"eesijpp",eesij
20521 fac=-(fac+BEES)*eesij*fac
20525 !c write(2,*) "ggg",i,j,ggg(1),ggg(2),ggg(3)
20526 !c write(2,*) "gelpp",i,(gelpp(k,i),k=1,3)
20527 !c write(2,*) "gelpp",j,(gelpp(k,j),k=1,3)
20529 gelpp(k,i)=gelpp(k,i)-ggg(k)
20530 gelpp(k,j)=gelpp(k,j)+ggg(k)
20537 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
20539 gvdwpp_nucl(k,i)=6*gvdwpp_nucl(k,i)
20540 !c gelpp(k,i)=332.0d0*gelpp(k,i)
20541 gelpp(k,i)=AEES*gelpp(k,i)
20543 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
20545 !c write (2,*) "total EES",ees
20547 end subroutine epp_nucl_sub
20548 !---------------------------------------------------------------------
20549 subroutine epsb(evdwpsb,eelpsb)
20552 !C This subroutine calculates the excluded-volume interaction energy between
20553 !C peptide-group centers and side chains and its gradient in virtual-bond and
20554 !C side-chain vectors.
20556 real(kind=8),dimension(3):: ggg
20557 integer :: i,iint,j,k,iteli,itypj,subchap
20558 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
20559 e1,e2,evdwij,rij,evdwpsb,eelpsb
20560 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20561 dist_temp, dist_init
20562 integer xshift,yshift,zshift
20564 !cd print '(a)','Enter ESCP'
20565 !cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
20568 ! print *,"iatscp_s_nucl,iatscp_e_nucl",iatscp_s_nucl,iatscp_e_nucl
20569 do i=iatscp_s_nucl,iatscp_e_nucl
20570 if (itype(i,2).eq.ntyp1_molec(2) &
20571 .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
20572 xi=0.5D0*(c(1,i)+c(1,i+1))
20573 yi=0.5D0*(c(2,i)+c(2,i+1))
20574 zi=0.5D0*(c(3,i)+c(3,i+1))
20575 xi=mod(xi,boxxsize)
20576 if (xi.lt.0) xi=xi+boxxsize
20577 yi=mod(yi,boxysize)
20578 if (yi.lt.0) yi=yi+boxysize
20579 zi=mod(zi,boxzsize)
20580 if (zi.lt.0) zi=zi+boxzsize
20582 do iint=1,nscp_gr_nucl(i)
20584 do j=iscpstart_nucl(i,iint),iscpend_nucl(i,iint)
20586 if (itypj.eq.ntyp1_molec(2)) cycle
20587 !C Uncomment following three lines for SC-p interactions
20588 !c xj=c(1,nres+j)-xi
20589 !c yj=c(2,nres+j)-yi
20590 !c zj=c(3,nres+j)-zi
20591 !C Uncomment following three lines for Ca-p interactions
20598 xj=mod(xj,boxxsize)
20599 if (xj.lt.0) xj=xj+boxxsize
20600 yj=mod(yj,boxysize)
20601 if (yj.lt.0) yj=yj+boxysize
20602 zj=mod(zj,boxzsize)
20603 if (zj.lt.0) zj=zj+boxzsize
20604 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20612 xj=xj_safe+xshift*boxxsize
20613 yj=yj_safe+yshift*boxysize
20614 zj=zj_safe+zshift*boxzsize
20615 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20616 if(dist_temp.lt.dist_init) then
20617 dist_init=dist_temp
20626 if (subchap.eq.1) then
20636 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
20638 e1=fac*fac*aad_nucl(itypj)
20639 e2=fac*bad_nucl(itypj)
20640 if (iabs(j-i) .le. 2) then
20645 evdwpsb=evdwpsb+evdwij
20646 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a4)') &
20647 'evdw2',i,j,evdwij,"tu4"
20649 !C Calculate contributions to the gradient in the virtual-bond and SC vectors.
20651 fac=-(evdwij+e1)*rrij
20656 gvdwpsb1(k,i)=gvdwpsb1(k,i)-ggg(k)
20657 gvdwpsb(k,j)=gvdwpsb(k,j)+ggg(k)
20665 gvdwpsb(j,i)=expon*gvdwpsb(j,i)
20666 gvdwpsb1(j,i)=expon*gvdwpsb1(j,i)
20670 end subroutine epsb
20672 !------------------------------------------------------
20673 subroutine esb_gb(evdwsb,eelsb)
20676 integer :: iint,itypi,itypi1,itypj,subchap,num_conti2
20677 real(kind=8) :: xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
20678 real(kind=8) :: evdw,sig0iji,evdwsb,eelsb,ecorr,eelij
20679 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20680 dist_temp, dist_init,aa,bb,faclip,sig0ij
20689 ! print *,"iastsc_nucl",iatsc_s_nucl,iatsc_e_nucl
20690 do i=iatsc_s_nucl,iatsc_e_nucl
20694 ! PRINT *,"I=",i,itypi
20695 if (itypi.eq.ntyp1_molec(2)) cycle
20696 itypi1=itype(i+1,2)
20700 xi=dmod(xi,boxxsize)
20701 if (xi.lt.0) xi=xi+boxxsize
20702 yi=dmod(yi,boxysize)
20703 if (yi.lt.0) yi=yi+boxysize
20704 zi=dmod(zi,boxzsize)
20705 if (zi.lt.0) zi=zi+boxzsize
20707 dxi=dc_norm(1,nres+i)
20708 dyi=dc_norm(2,nres+i)
20709 dzi=dc_norm(3,nres+i)
20710 dsci_inv=vbld_inv(i+nres)
20712 !C Calculate SC interaction energy.
20714 do iint=1,nint_gr_nucl(i)
20715 ! print *,"tu?",i,istart_nucl(i,iint),iend_nucl(i,iint)
20716 do j=istart_nucl(i,iint),iend_nucl(i,iint)
20720 if (itypj.eq.ntyp1_molec(2)) cycle
20721 dscj_inv=vbld_inv(j+nres)
20722 sig0ij=sigma_nucl(itypi,itypj)
20723 chi1=chi_nucl(itypi,itypj)
20724 chi2=chi_nucl(itypj,itypi)
20726 chip1=chip_nucl(itypi,itypj)
20727 chip2=chip_nucl(itypj,itypi)
20729 ! xj=c(1,nres+j)-xi
20730 ! yj=c(2,nres+j)-yi
20731 ! zj=c(3,nres+j)-zi
20735 xj=dmod(xj,boxxsize)
20736 if (xj.lt.0) xj=xj+boxxsize
20737 yj=dmod(yj,boxysize)
20738 if (yj.lt.0) yj=yj+boxysize
20739 zj=dmod(zj,boxzsize)
20740 if (zj.lt.0) zj=zj+boxzsize
20741 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20749 xj=xj_safe+xshift*boxxsize
20750 yj=yj_safe+yshift*boxysize
20751 zj=zj_safe+zshift*boxzsize
20752 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20753 if(dist_temp.lt.dist_init) then
20754 dist_init=dist_temp
20763 if (subchap.eq.1) then
20773 dxj=dc_norm(1,nres+j)
20774 dyj=dc_norm(2,nres+j)
20775 dzj=dc_norm(3,nres+j)
20776 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
20778 !C Calculate angle-dependent terms of energy and contributions to their
20783 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
20784 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
20785 om12=dxi*dxj+dyi*dyj+dzi*dzj
20786 call sc_angular_nucl
20788 sig=sig0ij*dsqrt(sigsq)
20789 rij_shift=1.0D0/rij-sig+sig0ij
20790 ! print *,rij_shift,"rij_shift"
20791 !c write (2,*) " rij",1.0D0/rij," sig",sig," sig0ij",sig0ij,
20792 !c & " rij_shift",rij_shift
20793 if (rij_shift.le.0.0D0) then
20798 !c---------------------------------------------------------------
20799 rij_shift=1.0D0/rij_shift
20800 fac=rij_shift**expon
20801 e1=fac*fac*aa_nucl(itypi,itypj)
20802 e2=fac*bb_nucl(itypi,itypj)
20803 evdwij=eps1*eps2rt*(e1+e2)
20804 !c write (2,*) "eps1",eps1," eps2rt",eps2rt,
20805 !c & " e1",e1," e2",e2," evdwij",evdwij
20807 evdwij=evdwij*eps2rt
20808 evdwsb=evdwsb+evdwij
20810 sigm=dabs(aa_nucl(itypi,itypj)/bb_nucl(itypi,itypj))**(1.0D0/6.0D0)
20811 epsi=bb_nucl(itypi,itypj)**2/aa_nucl(itypi,itypj)
20812 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
20813 restyp(itypi,2),i,restyp(itypj,2),j, &
20814 epsi,sigm,chi1,chi2,chip1,chip2, &
20815 eps1,eps2rt**2,sig,sig0ij, &
20816 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
20818 write (iout,*) "aa",aa_nucl(itypi,itypj)," bb",bb_nucl(itypi,itypj)
20821 if (energy_dec) write (iout,'(a6,2i5,e15.3,a4)') &
20822 'evdw',i,j,evdwij,"tu3"
20825 !C Calculate gradient components.
20826 e1=e1*eps1*eps2rt**2
20827 fac=-expon*(e1+evdwij)*rij_shift
20831 !C Calculate the radial part of the gradient
20835 !C Calculate angular part of the gradient.
20837 call eelsbij(eelij,num_conti2)
20838 if (energy_dec .and. &
20839 (j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2)) &
20840 write (istat,'(e14.5)') evdwij
20844 num_cont_hb(i)=num_conti2
20846 !c write (iout,*) "Number of loop steps in EGB:",ind
20847 !cccc energy_dec=.false.
20849 end subroutine esb_gb
20850 !-------------------------------------------------------------------------------
20851 subroutine eelsbij(eesij,num_conti2)
20854 real(kind=8),dimension(3) :: ggg,gggp,gggm,dcosb,dcosg
20855 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
20856 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20857 dist_temp, dist_init,rlocshield,fracinbuf
20858 integer xshift,yshift,zshift,ilist,iresshield,num_conti2
20860 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
20861 real(kind=8) scal_el /0.5d0/
20862 integer :: iteli,itelj,kkk,kkll,m,isubchap
20863 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp,facfac
20864 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i,ael63i,ael32i
20865 real(kind=8) :: dx_normj,dy_normj,dz_normj,&
20866 r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,fac5,fac6,&
20867 el1,el2,el3,el4,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
20868 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
20869 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
20870 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
20871 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
20872 ecosgp,ecosam,ecosbm,ecosgm,ghalf,itypi,itypj
20876 ! print *,i,j,itypi,itypj,istype(i),istype(j),"????"
20877 ael6i=ael6_nucl(itypi,itypj)
20878 ael3i=ael3_nucl(itypi,itypj)
20879 ael63i=ael63_nucl(itypi,itypj)
20880 ael32i=ael32_nucl(itypi,itypj)
20881 !c write (iout,*) "eelecij",i,j,itype(i),itype(j),
20882 !c & ael6i,ael3i,ael63i,al32i,rij,rrij
20886 dx_normi=dc_norm(1,i+nres)
20887 dy_normi=dc_norm(2,i+nres)
20888 dz_normi=dc_norm(3,i+nres)
20889 dx_normj=dc_norm(1,j+nres)
20890 dy_normj=dc_norm(2,j+nres)
20891 dz_normj=dc_norm(3,j+nres)
20892 !c xj=c(1,j)+0.5D0*dxj-xmedi
20893 !c yj=c(2,j)+0.5D0*dyj-ymedi
20894 !c zj=c(3,j)+0.5D0*dzj-zmedi
20895 if (ipot_nucl.ne.2) then
20896 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
20897 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
20898 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
20906 fac=cosa-3.0D0*cosb*cosg
20908 fac1=3.0d0*(cosb*cosb+cosg*cosg)
20913 !c write (iout,*) "r3ij",r3ij," r6ij",r6ij," fac",fac," fac1",fac1,
20914 !c & " fac2",fac2," fac3",fac3," fac4",fac4," fac5",fac5," fac6",fac6
20915 el1=fac3*(4.0D0+facfac-fac1)
20917 el3=fac5*(2.0d0-2.0d0*facfac+fac1)
20919 eesij=el1+el2+el3+el4
20920 !C 12/26/95 - for the evaluation of multi-body H-bonding interactions
20921 ees0ij=4.0D0+facfac-fac1
20923 if (energy_dec) then
20924 if(j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2) &
20925 write (istat,'(2a1,i4,1x,2a1,i4,4f10.5,3e12.5,$)') &
20926 sugartyp(istype(i)),restyp(itypi,2),i,sugartyp(istype(j)),&
20927 restyp(itypj,2),j,1.0d0/rij,cosa,cosb,cosg,fac*r3ij, &
20928 (4.0D0+facfac-fac1)*r6ij,(2.0d0-2.0d0*facfac+fac1)*r6ij
20929 write (iout,'(a6,2i5,e15.3)') 'ees',i,j,eesij
20933 !C Calculate contributions to the Cartesian gradient.
20935 facel=-3.0d0*rrij*(eesij+el1+el3+el4)
20941 !* Radial derivatives. First process both termini of the fragment (i,j)
20947 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
20948 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
20949 gelsbx(k,j)=gelsbx(k,j)+ggg(k)
20950 gelsbx(k,i)=gelsbx(k,i)-ggg(k)
20955 ecosa=2.0D0*fac3*fac1+fac4+(-4.0d0*fac5+2.0d0*fac6)*fac1
20960 ecosb=fac3*(fac1*cosg+cosb)+cosg*fac4+(cosb+2*fac1*cosg)*fac5+&
20962 ecosg=fac3*(fac1*cosb+cosg)+cosb*fac4+(cosg+2*fac1*cosb)*fac5+&
20965 dcosb(k)=rij*(dc_norm(k,i+nres)-erij(k)*cosb)
20966 dcosg(k)=rij*(dc_norm(k,j+nres)-erij(k)*cosg)
20969 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
20972 gelsbx(k,i)=gelsbx(k,i)-ggg(k) &
20973 +(ecosa*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres))&
20974 + ecosb*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
20975 gelsbx(k,j)=gelsbx(k,j)+ggg(k) &
20976 +(ecosa*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
20977 + ecosg*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
20978 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
20979 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
20981 ! IF ( (wcorr_nucl.gt.0.0d0.or.wcorr3_nucl.gt.0.0d0) .and.
20982 IF ( j.gt.i+1 .and.&
20983 num_conti.le.maxconts) THEN
20985 !C Calculate the contact function. The ith column of the array JCONT will
20986 !C contain the numbers of atoms that make contacts with the atom I (of numbers
20987 !C greater than I). The arrays FACONT and GACONT will contain the values of
20988 !C the contact function and its derivative.
20989 r0ij=2.20D0*sigma(itypi,itypj)
20990 !c write (2,*) "ij",i,j," rij",1.0d0/rij," r0ij",r0ij
20991 call gcont(rij,r0ij,1.0D0,0.2d0/r0ij,fcont,fprimcont)
20992 !c write (2,*) "fcont",fcont
20993 if (fcont.gt.0.0D0) then
20994 num_conti=num_conti+1
20995 num_conti2=num_conti2+1
20997 if (num_conti.gt.maxconts) then
20998 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
20999 ' will skip next contacts for this conf.'
21001 jcont_hb(num_conti,i)=j
21002 !c write (iout,*) "num_conti",num_conti,
21003 !c & " jcont_hb",jcont_hb(num_conti,i)
21004 !C Calculate contact energies
21006 wij=cosa-3.0D0*cosb*cosg
21009 fac3=dsqrt(-ael6i)*r3ij
21010 !c write (2,*) "ael6i",ael6i," r3ij",r3ij," fac3",fac3
21011 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
21012 if (ees0tmp.gt.0) then
21013 ees0pij=dsqrt(ees0tmp)
21017 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
21018 if (ees0tmp.gt.0) then
21019 ees0mij=dsqrt(ees0tmp)
21023 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
21024 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
21025 !c write (iout,*) "i",i," j",j,
21026 !c & " ees0m",ees0m(num_conti,i)," ees0p",ees0p(num_conti,i)
21027 ees0pij1=fac3/ees0pij
21028 ees0mij1=fac3/ees0mij
21029 fac3p=-3.0D0*fac3*rrij
21030 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
21031 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
21032 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
21033 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
21034 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
21035 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
21036 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
21037 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
21038 ecosap=ecosa1+ecosa2
21039 ecosbp=ecosb1+ecosb2
21040 ecosgp=ecosg1+ecosg2
21041 ecosam=ecosa1-ecosa2
21042 ecosbm=ecosb1-ecosb2
21043 ecosgm=ecosg1-ecosg2
21045 facont_hb(num_conti,i)=fcont
21046 fprimcont=fprimcont/rij
21048 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
21049 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
21051 gggp(1)=gggp(1)+ees0pijp*xj
21052 gggp(2)=gggp(2)+ees0pijp*yj
21053 gggp(3)=gggp(3)+ees0pijp*zj
21054 gggm(1)=gggm(1)+ees0mijp*xj
21055 gggm(2)=gggm(2)+ees0mijp*yj
21056 gggm(3)=gggm(3)+ees0mijp*zj
21057 !C Derivatives due to the contact function
21058 gacont_hbr(1,num_conti,i)=fprimcont*xj
21059 gacont_hbr(2,num_conti,i)=fprimcont*yj
21060 gacont_hbr(3,num_conti,i)=fprimcont*zj
21063 !c Gradient of the correlation terms
21065 gacontp_hb1(k,num_conti,i)= &
21066 (ecosap*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
21067 + ecosbp*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21068 gacontp_hb2(k,num_conti,i)= &
21069 (ecosap*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres)) &
21070 + ecosgp*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21071 gacontp_hb3(k,num_conti,i)=gggp(k)
21072 gacontm_hb1(k,num_conti,i)= &
21073 (ecosam*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
21074 + ecosbm*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21075 gacontm_hb2(k,num_conti,i)= &
21076 (ecosam*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
21077 + ecosgm*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21078 gacontm_hb3(k,num_conti,i)=gggm(k)
21084 end subroutine eelsbij
21085 !------------------------------------------------------------------
21086 subroutine sc_grad_nucl
21089 real(kind=8),dimension(3) :: dcosom1,dcosom2
21090 eom1=eps2der*eps2rt_om1+sigder*sigsq_om1
21091 eom2=eps2der*eps2rt_om2+sigder*sigsq_om2
21092 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12+sigder*sigsq_om12
21094 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
21095 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
21098 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
21101 gvdwsbx(k,i)=gvdwsbx(k,i)-gg(k) &
21102 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
21103 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
21104 gvdwsbx(k,j)=gvdwsbx(k,j)+gg(k) &
21105 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
21106 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
21109 !C Calculate the components of the gradient in DC and X
21112 gvdwsbc(l,i)=gvdwsbc(l,i)-gg(l)
21113 gvdwsbc(l,j)=gvdwsbc(l,j)+gg(l)
21116 end subroutine sc_grad_nucl
21117 !-----------------------------------------------------------------------
21118 subroutine esb(esbloc)
21119 !C Calculate the local energy of a side chain and its derivatives in the
21120 !C corresponding virtual-bond valence angles THETA and the spherical angles
21121 !C ALPHA and OMEGA derived from AM1 all-atom calculations.
21122 !C added by Urszula Kozlowska. 07/11/2007
21124 real(kind=8),dimension(3):: x_prime,y_prime,z_prime
21125 real(kind=8),dimension(9):: x
21126 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1, &
21127 sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,&
21128 de_dxx,de_dyy,de_dzz,de_dt,s1_t,s1_6_t,s2_t,s2_6_t
21129 real(kind=8),dimension(3):: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,&
21130 dYY_Ci,dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
21131 real(kind=8) :: esbloc,delta,cosfac2,cosfac,sinfac2,sinfac,de_dtt,&
21132 cossc,cossc1,cosfac2xx,sinfac2yy,pom1,pom
21133 integer::it,nlobit,i,j,k
21134 ! common /sccalc/ time11,time12,time112,theti,it,nlobit
21137 do i=loc_start_nucl,loc_end_nucl
21138 if (itype(i,2).eq.ntyp1_molec(2)) cycle
21139 costtab(i+1) =dcos(theta(i+1))
21140 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
21141 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
21142 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
21143 cosfac2=0.5d0/(1.0d0+costtab(i+1))
21144 cosfac=dsqrt(cosfac2)
21145 sinfac2=0.5d0/(1.0d0-costtab(i+1))
21146 sinfac=dsqrt(sinfac2)
21148 if (it.eq.10) goto 1
21151 !C Compute the axes of tghe local cartesian coordinates system; store in
21152 !c x_prime, y_prime and z_prime
21159 !C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
21160 !C & dc_norm(3,i+nres)
21162 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
21163 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
21166 z_prime(j) = -uz(j,i-1)
21174 xx = xx + x_prime(j)*dc_norm(j,i+nres)
21175 yy = yy + y_prime(j)*dc_norm(j,i+nres)
21176 zz = zz + z_prime(j)*dc_norm(j,i+nres)
21184 x(j) = sc_parmin_nucl(j,it)
21187 !Cc diagnostics - remove later
21188 xx1 = dcos(alph(2))
21189 yy1 = dsin(alph(2))*dcos(omeg(2))
21190 zz1 = -dsin(alph(2))*dsin(omeg(2))
21191 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
21192 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
21194 !C," --- ", xx_w,yy_w,zz_w
21197 sumene = enesc_nucl(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21198 esbloc = esbloc + sumene
21199 sumene2= enesc_nucl(x,xx,yy,0.0d0,cost2tab(i+1),sint2tab(i+1))
21200 ! print *,"enecomp",sumene,sumene2
21201 ! if (energy_dec) write(iout,*) "i",i," esbloc",sumene,esbloc,xx,yy,zz
21202 ! if (energy_dec) write(iout,*) "x",(x(k),k=1,9)
21204 write (2,*) "x",(x(k),k=1,9)
21206 !C This section to check the numerical derivatives of the energy of ith side
21207 !C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
21208 !C #define DEBUG in the code to turn it on.
21210 write (2,*) "sumene =",sumene
21214 write (2,*) xx,yy,zz
21215 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21216 de_dxx_num=(sumenep-sumene)/aincr
21218 write (2,*) "xx+ sumene from enesc=",sumenep,sumene
21221 write (2,*) xx,yy,zz
21222 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21223 de_dyy_num=(sumenep-sumene)/aincr
21225 write (2,*) "yy+ sumene from enesc=",sumenep,sumene
21228 write (2,*) xx,yy,zz
21229 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21230 de_dzz_num=(sumenep-sumene)/aincr
21232 write (2,*) "zz+ sumene from enesc=",sumenep,sumene
21233 costsave=cost2tab(i+1)
21234 sintsave=sint2tab(i+1)
21235 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
21236 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
21237 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21238 de_dt_num=(sumenep-sumene)/aincr
21239 write (2,*) " t+ sumene from enesc=",sumenep,sumene
21240 cost2tab(i+1)=costsave
21241 sint2tab(i+1)=sintsave
21242 !C End of diagnostics section.
21245 !C Compute the gradient of esc
21247 de_dxx=x(1)+2*x(4)*xx+x(7)*zz+x(8)*yy
21248 de_dyy=x(2)+2*x(5)*yy+x(8)*xx+x(9)*zz
21249 de_dzz=x(3)+2*x(6)*zz+x(7)*xx+x(9)*yy
21252 write (2,*) "x",(x(k),k=1,9)
21253 write (2,*) "xx",xx," yy",yy," zz",zz
21254 write (2,*) "de_xx ",de_xx," de_yy ",de_yy,&
21255 " de_zz ",de_zz," de_tt ",de_tt
21256 write (2,*) "de_xx_num",de_dxx_num," de_yy_num",de_dyy_num,&
21257 " de_zz_num",de_dzz_num," de_dt_num",de_dt_num
21260 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
21261 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
21262 cosfac2xx=cosfac2*xx
21263 sinfac2yy=sinfac2*yy
21265 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*&
21267 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*&
21269 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
21270 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
21271 !c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
21272 !c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
21273 !c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
21274 !c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
21275 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
21276 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
21277 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
21278 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
21282 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
21283 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
21286 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
21287 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
21288 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
21290 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
21291 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
21295 dXX_Ctab(k,i)=dXX_Ci(k)
21296 dXX_C1tab(k,i)=dXX_Ci1(k)
21297 dYY_Ctab(k,i)=dYY_Ci(k)
21298 dYY_C1tab(k,i)=dYY_Ci1(k)
21299 dZZ_Ctab(k,i)=dZZ_Ci(k)
21300 dZZ_C1tab(k,i)=dZZ_Ci1(k)
21301 dXX_XYZtab(k,i)=dXX_XYZ(k)
21302 dYY_XYZtab(k,i)=dYY_XYZ(k)
21303 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
21306 !c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
21307 !c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
21308 !c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
21309 !c & dyy_ci(k)," dzz_ci",dzz_ci(k)
21310 !c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
21312 !c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
21313 !c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
21314 gsbloc(k,i-1)=gsbloc(k,i-1)+(de_dxx*dxx_ci1(k) &
21315 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k))
21316 gsbloc(k,i)=gsbloc(k,i)+(de_dxx*dxx_Ci(k) &
21317 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k))
21318 gsblocx(k,i)= de_dxx*dxx_XYZ(k)&
21319 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
21320 ! print *,i,de_dxx*dxx_ci1(k)+de_dyy*dyy_ci1(k),de_dzz*dzz_ci1(k)*2
21322 !c write(iout,*) "ENERGY GRAD = ", (gsbloc(k,i-1),k=1,3),
21323 !c & (gsbloc(k,i),k=1,3),(gsblocx(k,i),k=1,3)
21325 !C to check gradient call subroutine check_grad
21331 !=-------------------------------------------------------
21332 real(kind=8) function enesc_nucl(x,xx,yy,zz,cost2,sint2)
21334 real(kind=8),dimension(9):: x(9)
21335 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2, &
21336 sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
21338 !c write (2,*) "enesc"
21339 !c write (2,*) "x",(x(i),i=1,9)
21340 !c write(2,*)"xx",xx," yy",yy," zz",zz," cost2",cost2," sint2",sint2
21341 sumene=x(1)*xx+x(2)*yy+x(3)*zz+x(4)*xx**2 &
21342 + x(5)*yy**2+x(6)*zz**2+x(7)*xx*zz+x(8)*xx*yy &
21346 end function enesc_nucl
21347 !-----------------------------------------------------------------------------
21348 subroutine multibody_hb_nucl(ecorr,ecorr3,n_corr,n_corr1)
21351 integer,parameter :: max_cont=2000
21352 integer,parameter:: max_dim=2*(8*3+6)
21353 integer, parameter :: msglen1=max_cont*max_dim
21354 integer,parameter :: msglen2=2*msglen1
21355 integer source,CorrelType,CorrelID,Error
21356 real(kind=8) :: buffer(max_cont,max_dim)
21357 integer status(MPI_STATUS_SIZE)
21358 integer :: ierror,nbytes
21360 real(kind=8),dimension(3):: gx(3),gx1(3)
21361 real(kind=8) :: time00
21363 integer i,j,i1,j1,jj,kk,num_conti,num_conti1,nn
21364 real(kind=8) ecorr,ecorr3
21365 integer :: n_corr,n_corr1,mm,msglen
21366 !C Set lprn=.true. for debugging
21371 if(.not.allocated(zapas2)) allocate(zapas2(3,maxconts,nres,8))
21373 if (nfgtasks.le.1) goto 30
21375 write (iout,'(a)') 'Contact function values:'
21377 write (iout,'(2i3,50(1x,i2,f5.2))') &
21378 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
21379 j=1,num_cont_hb(i))
21382 !C Caution! Following code assumes that electrostatic interactions concerning
21383 !C a given atom are split among at most two processors!
21393 !c write (*,*) 'MyRank',MyRank,' mm',mm
21396 !c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
21397 if (fg_rank.gt.0) then
21398 !C Send correlation contributions to the preceding processor
21400 nn=num_cont_hb(iatel_s_nucl)
21401 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
21402 !c write (*,*) 'The BUFFER array:'
21404 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
21406 if (ielstart_nucl(iatel_s_nucl).gt.iatel_s_nucl+ispp) then
21408 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
21409 !C Clear the contacts of the atom passed to the neighboring processor
21410 nn=num_cont_hb(iatel_s_nucl+1)
21412 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
21414 num_cont_hb(iatel_s_nucl)=0
21416 !cd write (iout,*) 'Processor ',fg_rank,MyRank,
21417 !cd & ' is sending correlation contribution to processor',fg_rank-1,
21418 !cd & ' msglen=',msglen
21419 !c write (*,*) 'Processor ',fg_rank,MyRank,
21420 !c & ' is sending correlation contribution to processor',fg_rank-1,
21421 !c & ' msglen=',msglen,' CorrelType=',CorrelType
21423 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, &
21424 CorrelType,FG_COMM,IERROR)
21425 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
21426 !cd write (iout,*) 'Processor ',fg_rank,
21427 !cd & ' has sent correlation contribution to processor',fg_rank-1,
21428 !cd & ' msglen=',msglen,' CorrelID=',CorrelID
21429 !c write (*,*) 'Processor ',fg_rank,
21430 !c & ' has sent correlation contribution to processor',fg_rank-1,
21431 !c & ' msglen=',msglen,' CorrelID=',CorrelID
21433 endif ! (fg_rank.gt.0)
21437 !c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
21438 if (fg_rank.lt.nfgtasks-1) then
21439 !C Receive correlation contributions from the next processor
21441 if (ielend_nucl(iatel_e_nucl).lt.nct_molec(2)-1) msglen=msglen2
21442 !cd write (iout,*) 'Processor',fg_rank,
21443 !cd & ' is receiving correlation contribution from processor',fg_rank+1,
21444 !cd & ' msglen=',msglen,' CorrelType=',CorrelType
21445 !c write (*,*) 'Processor',fg_rank,
21446 !c &' is receiving correlation contribution from processor',fg_rank+1,
21447 !c & ' msglen=',msglen,' CorrelType=',CorrelType
21450 do while (nbytes.le.0)
21451 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
21452 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
21454 !c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
21455 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, &
21456 fg_rank+1,CorrelType,FG_COMM,status,IERROR)
21457 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
21458 !c write (*,*) 'Processor',fg_rank,
21459 !c &' has received correlation contribution from processor',fg_rank+1,
21460 !c & ' msglen=',msglen,' nbytes=',nbytes
21461 !c write (*,*) 'The received BUFFER array:'
21463 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
21465 if (msglen.eq.msglen1) then
21466 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,0,buffer)
21467 else if (msglen.eq.msglen2) then
21468 call unpack_buffer(max_cont,max_dim,iatel_e_nucl,0,buffer)
21469 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,30,buffer)
21472 'ERROR!!!! message length changed while processing correlations.'
21474 'ERROR!!!! message length changed while processing correlations.'
21475 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
21476 endif ! msglen.eq.msglen1
21477 endif ! fg_rank.lt.nfgtasks-1
21484 write (iout,'(a)') 'Contact function values:'
21485 do i=nnt_molec(2),nct_molec(2)-1
21486 write (iout,'(2i3,50(1x,i2,f5.2))') &
21487 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
21488 j=1,num_cont_hb(i))
21493 !C Remove the loop below after debugging !!!
21494 ! do i=nnt_molec(2),nct_molec(2)
21496 ! gradcorr_nucl(j,i)=0.0D0
21497 ! gradxorr_nucl(j,i)=0.0D0
21498 ! gradcorr3_nucl(j,i)=0.0D0
21499 ! gradxorr3_nucl(j,i)=0.0D0
21502 ! print *,"iatsc_s_nucl,iatsc_e_nucl",iatsc_s_nucl,iatsc_e_nucl
21503 !C Calculate the local-electrostatic correlation terms
21504 do i=iatsc_s_nucl,iatsc_e_nucl
21506 num_conti=num_cont_hb(i)
21507 num_conti1=num_cont_hb(i+1)
21508 ! print *,i,num_conti,num_conti1
21513 !c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
21514 !c & ' jj=',jj,' kk=',kk
21515 if (j1.eq.j+1 .or. j1.eq.j-1) then
21517 !C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
21518 !C The system gains extra energy.
21519 !C Tentative expression & coefficients; assumed d(stacking)=4.5 A,
21520 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
21521 !C Need to implement full formulas 34 and 35 from Liwo et al., 1998.
21523 ecorr=ecorr+ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
21524 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
21525 'ecorrh',i,j,ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
21527 else if (j1.eq.j) then
21529 !C Contacts I-J and I-(J+1) occur simultaneously.
21530 !C The system loses extra energy.
21531 !C Tentative expression & c?oefficients; assumed d(stacking)=4.5 A,
21532 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
21533 !C Need to implement full formulas 32 from Liwo et al., 1998.
21535 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
21536 !c & ' jj=',jj,' kk=',kk
21537 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i+1,j,jj,kk,0.310D0,-0.155D0)
21542 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
21543 !c & ' jj=',jj,' kk=',kk
21544 if (j1.eq.j+1) then
21545 !C Contacts I-J and (I+1)-J occur simultaneously.
21546 !C The system loses extra energy.
21547 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i,j+1,jj,kk,0.310D0,-0.155D0)
21553 end subroutine multibody_hb_nucl
21554 !-----------------------------------------------------------
21555 real(kind=8) function ehbcorr_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
21556 ! implicit real*8 (a-h,o-z)
21557 ! include 'DIMENSIONS'
21558 ! include 'COMMON.IOUNITS'
21559 ! include 'COMMON.DERIV'
21560 ! include 'COMMON.INTERACT'
21561 ! include 'COMMON.CONTACTS'
21562 real(kind=8),dimension(3) :: gx,gx1
21564 !el local variables
21565 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
21566 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
21567 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
21568 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
21572 eij=facont_hb(jj,i)
21573 ekl=facont_hb(kk,k)
21574 ees0pij=ees0p(jj,i)
21575 ees0pkl=ees0p(kk,k)
21576 ees0mij=ees0m(jj,i)
21577 ees0mkl=ees0m(kk,k)
21579 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
21580 ! print *,"ehbcorr_nucl",ekont,ees
21581 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
21582 !C Following 4 lines for diagnostics.
21587 !cd write (iout,*)'Contacts have occurred for nucleic bases',
21588 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
21589 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
21590 !C Calculate the multi-body contribution to energy.
21591 ! ecorr_nucl=ecorr_nucl+ekont*ees
21592 !C Calculate multi-body contributions to the gradient.
21593 coeffpees0pij=coeffp*ees0pij
21594 coeffmees0mij=coeffm*ees0mij
21595 coeffpees0pkl=coeffp*ees0pkl
21596 coeffmees0mkl=coeffm*ees0mkl
21598 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i) &
21599 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
21600 coeffmees0mkl*gacontm_hb1(ll,jj,i))
21601 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j) &
21602 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+&
21603 coeffmees0mkl*gacontm_hb2(ll,jj,i))
21604 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k) &
21605 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
21606 coeffmees0mij*gacontm_hb1(ll,kk,k))
21607 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l) &
21608 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
21609 coeffmees0mij*gacontm_hb2(ll,kk,k))
21610 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
21611 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
21612 coeffmees0mkl*gacontm_hb3(ll,jj,i))
21613 gradcorr_nucl(ll,j)=gradcorr_nucl(ll,j)+gradlongij
21614 gradcorr_nucl(ll,i)=gradcorr_nucl(ll,i)-gradlongij
21615 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
21616 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
21617 coeffmees0mij*gacontm_hb3(ll,kk,k))
21618 gradcorr_nucl(ll,l)=gradcorr_nucl(ll,l)+gradlongkl
21619 gradcorr_nucl(ll,k)=gradcorr_nucl(ll,k)-gradlongkl
21620 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i)-gradlongij
21621 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j)+gradlongij
21622 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k)-gradlongkl
21623 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l)+gradlongkl
21625 ehbcorr_nucl=ekont*ees
21627 end function ehbcorr_nucl
21628 !-------------------------------------------------------------------------
21630 real(kind=8) function ehbcorr3_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
21631 ! implicit real*8 (a-h,o-z)
21632 ! include 'DIMENSIONS'
21633 ! include 'COMMON.IOUNITS'
21634 ! include 'COMMON.DERIV'
21635 ! include 'COMMON.INTERACT'
21636 ! include 'COMMON.CONTACTS'
21637 real(kind=8),dimension(3) :: gx,gx1
21639 !el local variables
21640 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
21641 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
21642 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
21643 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
21647 eij=facont_hb(jj,i)
21648 ekl=facont_hb(kk,k)
21649 ees0pij=ees0p(jj,i)
21650 ees0pkl=ees0p(kk,k)
21651 ees0mij=ees0m(jj,i)
21652 ees0mkl=ees0m(kk,k)
21654 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
21655 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
21656 !C Following 4 lines for diagnostics.
21661 !cd write (iout,*)'Contacts have occurred for nucleic bases',
21662 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
21663 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
21664 !C Calculate the multi-body contribution to energy.
21665 ! ecorr=ecorr+ekont*ees
21666 !C Calculate multi-body contributions to the gradient.
21667 coeffpees0pij=coeffp*ees0pij
21668 coeffmees0mij=coeffm*ees0mij
21669 coeffpees0pkl=coeffp*ees0pkl
21670 coeffmees0mkl=coeffm*ees0mkl
21672 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i) &
21673 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
21674 coeffmees0mkl*gacontm_hb1(ll,jj,i))
21675 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j) &
21676 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
21677 coeffmees0mkl*gacontm_hb2(ll,jj,i))
21678 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k) &
21679 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ &
21680 coeffmees0mij*gacontm_hb1(ll,kk,k))
21681 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l) &
21682 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
21683 coeffmees0mij*gacontm_hb2(ll,kk,k))
21684 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
21685 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
21686 coeffmees0mkl*gacontm_hb3(ll,jj,i))
21687 gradcorr3_nucl(ll,j)=gradcorr3_nucl(ll,j)+gradlongij
21688 gradcorr3_nucl(ll,i)=gradcorr3_nucl(ll,i)-gradlongij
21689 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
21690 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
21691 coeffmees0mij*gacontm_hb3(ll,kk,k))
21692 gradcorr3_nucl(ll,l)=gradcorr3_nucl(ll,l)+gradlongkl
21693 gradcorr3_nucl(ll,k)=gradcorr3_nucl(ll,k)-gradlongkl
21694 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i)-gradlongij
21695 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j)+gradlongij
21696 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k)-gradlongkl
21697 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l)+gradlongkl
21699 ehbcorr3_nucl=ekont*ees
21701 end function ehbcorr3_nucl
21703 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
21704 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
21705 real(kind=8):: buffer(dimen1,dimen2)
21706 num_kont=num_cont_hb(atom)
21710 buffer(i,indx+(k-1)*3+j)=zapas2(j,i,atom,k)
21713 buffer(i,indx+25)=facont_hb(i,atom)
21714 buffer(i,indx+26)=ees0p(i,atom)
21715 buffer(i,indx+27)=ees0m(i,atom)
21716 buffer(i,indx+28)=d_cont(i,atom)
21717 buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
21719 buffer(1,indx+30)=dfloat(num_kont)
21721 end subroutine pack_buffer
21722 !c------------------------------------------------------------------------------
21723 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
21724 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
21725 real(kind=8):: buffer(dimen1,dimen2)
21726 ! double precision zapas
21727 ! common /contacts_hb/ zapas(3,maxconts,maxres,8),
21728 ! & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
21729 ! & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
21730 ! & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
21731 num_kont=buffer(1,indx+30)
21732 num_kont_old=num_cont_hb(atom)
21733 num_cont_hb(atom)=num_kont+num_kont_old
21738 zapas2(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
21741 facont_hb(ii,atom)=buffer(i,indx+25)
21742 ees0p(ii,atom)=buffer(i,indx+26)
21743 ees0m(ii,atom)=buffer(i,indx+27)
21744 d_cont(i,atom)=buffer(i,indx+28)
21745 jcont_hb(ii,atom)=buffer(i,indx+29)
21748 end subroutine unpack_buffer
21749 !c------------------------------------------------------------------------------
21751 subroutine ecatcat(ecationcation)
21752 integer :: i,j,itmp,xshift,yshift,zshift,subchap,k
21753 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
21754 r7,r4,ecationcation,k0,rcal
21755 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
21756 dist_init,dist_temp,Evan1cat,Evan2cat,Eeleccat
21757 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
21760 ecationcation=0.0d0
21761 if (nres_molec(5).eq.0) return
21766 k0 = 332.0*(2.0*2.0)/80.0
21770 itmp=itmp+nres_molec(i)
21772 ! write(iout,*) "itmp",itmp
21773 do i=itmp+1,itmp+nres_molec(5)-1
21779 xi=mod(xi,boxxsize)
21780 if (xi.lt.0) xi=xi+boxxsize
21781 yi=mod(yi,boxysize)
21782 if (yi.lt.0) yi=yi+boxysize
21783 zi=mod(zi,boxzsize)
21784 if (zi.lt.0) zi=zi+boxzsize
21786 do j=i+1,itmp+nres_molec(5)
21787 ! print *,i,j,'catcat'
21791 xj=dmod(xj,boxxsize)
21792 if (xj.lt.0) xj=xj+boxxsize
21793 yj=dmod(yj,boxysize)
21794 if (yj.lt.0) yj=yj+boxysize
21795 zj=dmod(zj,boxzsize)
21796 if (zj.lt.0) zj=zj+boxzsize
21797 ! write(iout,*) c(1,i),xi,xj,"xy",boxxsize
21798 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21806 xj=xj_safe+xshift*boxxsize
21807 yj=yj_safe+yshift*boxysize
21808 zj=zj_safe+zshift*boxzsize
21809 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21810 if(dist_temp.lt.dist_init) then
21811 dist_init=dist_temp
21820 if (subchap.eq.1) then
21829 rcal =xj**2+yj**2+zj**2
21835 ! k0 = 332*(2*2)/80
21836 Evan1cat=epscalc*(r012/rcal**6)
21837 Evan2cat=epscalc*2*(r06/rcal**3)
21845 dEvan1Cmcat(k)=-12*r(k)*epscalc*r012/r7
21846 dEvan2Cmcat(k)=-12*r(k)*epscalc*r06/r4
21847 dEeleccat(k)=-k0*r(k)/ract**3
21850 gg(k) = dEvan1Cmcat(k)+dEvan2Cmcat(k)+dEeleccat(k)
21851 gradcatcat(k,i)=gradcatcat(k,i)-gg(k)
21852 gradcatcat(k,j)=gradcatcat(k,j)+gg(k)
21855 ! write(iout,*) "ecatcat",i,j, ecationcation,xj,yj,zj
21856 ecationcation=ecationcation+Evan1cat+Evan2cat+Eeleccat
21860 end subroutine ecatcat
21861 !---------------------------------------------------------------------------
21862 subroutine ecat_prot(ecation_prot)
21863 integer i,j,k,subchap,itmp,inum
21864 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
21865 r7,r4,ecationcation
21866 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
21867 dist_init,dist_temp,ecation_prot,rcal,rocal, &
21868 Evan1,Evan2,EC,cm1mag,DASGL,delta,r0p,Epepcat, &
21869 catl,cml,calpl, Etotal_p, Etotal_m,rtab,wdip,wmodquad,wquad1, &
21870 wquad2,wvan1,E1,E2,wconst,wvan2,rcpm,dcmag,sin2thet,sinthet, &
21871 costhet,v1m,v2m,wh2o,wc,rsecp,Ir,Irsecp,Irthrp,Irfourp,Irfiftp,&
21872 Irsistp,Irseven,Irtwelv,Irthir,dE1dr,dE2dr,dEdcos,wquad2p,opt, &
21873 rs,rthrp,rfourp,rsixp,reight,Irsixp,Ireight,Irtw,Irfourt, &
21874 opt1,opt2,opt3,opt4,opt5,opt6,opt7,opt8,opt9,opt10,opt11,opt12,&
21875 opt13,opt14,opt15,opt16,opt17,opt18,opt19, &
21876 Equad1,Equad2,dscmag,v1dpv2,dscmag3,constA,constB,Edip
21877 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
21878 gg,r,EtotalCat,dEtotalCm,dEtotalCalp,dEvan1Cm,dEvan2Cm, &
21879 dEtotalpep,dEtotalcat_num,dEddci,dEtotalcm_num,dEtotalcalp_num, &
21880 tab1,tab2,tab3,diff,cm1,sc,p,tcat,talp,cm,drcp,drcp_norm,vcat, &
21881 v1,v2,v3,myd_norm,dx,vcm,valpha,drdpep,dcosdpep,dcosddci,dEdpep,&
21882 dEcCat,dEdipCm,dEdipCalp,dEquad1Cat,dEquad1Cm,dEquad1Calp, &
21883 dEquad2Cat,dEquad2Cm,dEquad2Calpd,Evan1Cat,dEvan1Calp,dEvan2Cat,&
21884 dEvan2Calp,dEtotalCat,dscvec,dEcCm,dEcCalp,dEdipCat,dEquad2Calp,&
21886 real(kind=8),dimension(6) :: vcatprm
21888 ! first lets calculate interaction with peptide groups
21889 if (nres_molec(5).eq.0) return
21891 wdip =1.092777950857032D2
21893 wmodquad=-2.174122713004870D4
21894 wmodquad=wmodquad/wconst
21895 wquad1 = 3.901232068562804D1
21896 wquad1=wquad1/wconst
21898 wquad2=wquad2/wconst
21903 itmp=itmp+nres_molec(i)
21905 ! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
21906 do i=ibond_start,ibond_end
21908 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle ! leave dummy atoms
21909 xi=0.5d0*(c(1,i)+c(1,i+1))
21910 yi=0.5d0*(c(2,i)+c(2,i+1))
21911 zi=0.5d0*(c(3,i)+c(3,i+1))
21912 xi=mod(xi,boxxsize)
21913 if (xi.lt.0) xi=xi+boxxsize
21914 yi=mod(yi,boxysize)
21915 if (yi.lt.0) yi=yi+boxysize
21916 zi=mod(zi,boxzsize)
21917 if (zi.lt.0) zi=zi+boxzsize
21919 do j=itmp+1,itmp+nres_molec(5)
21923 xj=dmod(xj,boxxsize)
21924 if (xj.lt.0) xj=xj+boxxsize
21925 yj=dmod(yj,boxysize)
21926 if (yj.lt.0) yj=yj+boxysize
21927 zj=dmod(zj,boxzsize)
21928 if (zj.lt.0) zj=zj+boxzsize
21929 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21937 xj=xj_safe+xshift*boxxsize
21938 yj=yj_safe+yshift*boxysize
21939 zj=zj_safe+zshift*boxzsize
21940 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21941 if(dist_temp.lt.dist_init) then
21942 dist_init=dist_temp
21951 if (subchap.eq.1) then
21962 rcpm = sqrt(xj**2+yj**2+zj**2)
21963 drcp_norm(1)=xj/rcpm
21964 drcp_norm(2)=yj/rcpm
21965 drcp_norm(3)=zj/rcpm
21968 dcmag=dcmag+dc(k,i)**2
21972 myd_norm(k)=dc(k,i)/dcmag
21974 costhet=drcp_norm(1)*myd_norm(1)+drcp_norm(2)*myd_norm(2)+&
21975 drcp_norm(3)*myd_norm(3)
21978 Irsecp = 1.0d0/rsecp
21979 Irthrp = Irsecp/rcpm
21980 Irfourp = Irthrp/rcpm
21981 Irfiftp = Irfourp/rcpm
21982 Irsistp=Irfiftp/rcpm
21983 Irseven=Irsistp/rcpm
21984 Irtwelv=Irsistp*Irsistp
21985 Irthir=Irtwelv/rcpm
21986 sin2thet = (1-costhet*costhet)
21987 sinthet=sqrt(sin2thet)
21988 E1 = wdip*Irsecp*costhet+(wmodquad*Irfourp+wquad1*Irthrp)&
21990 E2 = -wquad1*Irthrp*wquad2+wvan1*(wvan2**12*Irtwelv-&
21991 2*wvan2**6*Irsistp)
21992 ecation_prot = ecation_prot+E1+E2
21993 dE1dr = -2*costhet*wdip*Irthrp-&
21994 (4*wmodquad*Irfiftp+3*wquad1*Irfourp)*sin2thet
21995 dE2dr = 3*wquad1*wquad2*Irfourp- &
21996 12*wvan1*wvan2**6*(wvan2**6*Irthir-Irseven)
21997 dEdcos = wdip*Irsecp-2*(wmodquad*Irfourp+wquad1*Irthrp)*costhet
21999 drdpep(k) = -drcp_norm(k)
22000 dcosdpep(k) = Ir*(costhet*drcp_norm(k)-myd_norm(k))
22001 dcosddci(k) = drcp_norm(k)/dcmag-costhet*myd_norm(k)/dcmag
22002 dEdpep(k) = (dE1dr+dE2dr)*drdpep(k)+dEdcos*dcosdpep(k)
22003 dEddci(k) = dEdcos*dcosddci(k)
22006 gradpepcat(k,i)=gradpepcat(k,i)+0.5D0*dEdpep(k)-dEddci(k)
22007 gradpepcat(k,i+1)=gradpepcat(k,i+1)+0.5D0*dEdpep(k)+dEddci(k)
22008 gradpepcat(k,j)=gradpepcat(k,j)-dEdpep(k)
22012 !------------------------------------------sidechains
22013 ! do i=1,nres_molec(1)
22014 do i=ibond_start,ibond_end
22015 if ((itype(i,1).eq.ntyp1)) cycle ! leave dummy atoms
22017 ! print *,i,ecation_prot
22021 xi=mod(xi,boxxsize)
22022 if (xi.lt.0) xi=xi+boxxsize
22023 yi=mod(yi,boxysize)
22024 if (yi.lt.0) yi=yi+boxysize
22025 zi=mod(zi,boxzsize)
22026 if (zi.lt.0) zi=zi+boxzsize
22028 cm1(k)=dc(k,i+nres)
22030 cm1mag=sqrt(cm1(1)**2+cm1(2)**2+cm1(3)**2)
22031 do j=itmp+1,itmp+nres_molec(5)
22035 xj=dmod(xj,boxxsize)
22036 if (xj.lt.0) xj=xj+boxxsize
22037 yj=dmod(yj,boxysize)
22038 if (yj.lt.0) yj=yj+boxysize
22039 zj=dmod(zj,boxzsize)
22040 if (zj.lt.0) zj=zj+boxzsize
22041 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22049 xj=xj_safe+xshift*boxxsize
22050 yj=yj_safe+yshift*boxysize
22051 zj=zj_safe+zshift*boxzsize
22052 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22053 if(dist_temp.lt.dist_init) then
22054 dist_init=dist_temp
22063 if (subchap.eq.1) then
22074 if(itype(i,1).eq.15.or.itype(i,1).eq.16) then
22075 if(itype(i,1).eq.16) then
22081 vcatprm(k)=catprm(k,inum)
22083 dASGL=catprm(7,inum)
22085 vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
22090 dx(k) = vcat(k)-vcm(k)
22093 v1(k)=(vcm(k)-valpha(k))
22094 v2(k)=(vcat(k)-valpha(k))
22096 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
22097 v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
22098 v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
22100 ! The weights of the energy function calculated from
22101 !The quantum mechanical GAMESS simulations of calcium with ASP/GLU
22109 wquad2 = vcatprm(4)
22114 opt = dx(1)**2+dx(2)**2
22115 rsecp = opt+dx(3)**2
22119 rsixp = rfourp*rsecp
22124 Irfourp = Irthrp/rs
22130 opt1 = (4*rs*dx(3)*wdip)
22131 opt2 = 6*rsecp*wquad1*opt
22132 opt3 = wquad1*wquad2p*Irsixp
22133 opt4 = (wvan1*wvan2**12)
22134 opt5 = opt4*12*Irfourt
22135 opt6 = 2*wvan1*wvan2**6
22136 opt7 = 6*opt6*Ireight
22139 opt11 = (rsecp*v2m)**2
22140 opt12 = (rsecp*v1m)**2
22141 opt14 = (v1m*v2m*rsecp)**2
22142 opt15 = -wquad1/v2m**2
22143 opt16 = (rthrp*(v1m*v2m)**2)**2
22144 opt17 = (v1m**2*rthrp)**2
22145 opt18 = -wquad1/rthrp
22146 opt19 = (v1m**2*v2m**2)**2
22149 dEcCat(k) = -(dx(k)*wc)*Irthrp
22150 dEcCm(k)=(dx(k)*wc)*Irthrp
22153 Edip=opt8*(v1dpv2)/(rsecp*v2m)
22155 dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m &
22156 *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
22157 dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m &
22158 *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
22159 dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m &
22160 *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp) &
22163 Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
22165 dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp* &
22166 (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2* &
22167 v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
22168 dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp* &
22169 (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2* &
22170 v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
22171 dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
22172 v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)* &
22175 Equad2=wquad1*wquad2p*Irthrp
22177 dEquad2Cat(k)=-3*dx(k)*rs*opt3
22178 dEquad2Cm(k)=3*dx(k)*rs*opt3
22179 dEquad2Calp(k)=0.0d0
22183 dEvan1Cat(k)=-dx(k)*opt5
22184 dEvan1Cm(k)=dx(k)*opt5
22185 dEvan1Calp(k)=0.0d0
22189 dEvan2Cat(k)=dx(k)*opt7
22190 dEvan2Cm(k)=-dx(k)*opt7
22191 dEvan2Calp(k)=0.0d0
22193 ecation_prot=ecation_prot+Ec+Edip+Equad1+Equad2+Evan1+Evan2
22194 ! print *,ecation_prot,Ec+Edip+Equad1+Equad2+Evan1+Evan2
22197 dEtotalCat(k)=dEcCat(k)+dEdipCat(k)+dEquad1Cat(k)+ &
22198 dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
22199 !c write(*,*) 'dEtotalCat inside', (dEtotalCat(l),l=1,3)
22200 dEtotalCm(k)=dEcCm(k)+dEdipCm(k)+dEquad1Cm(k)+ &
22201 dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
22202 dEtotalCalp(k)=dEcCalp(k)+dEdipCalp(k)+dEquad1Calp(k) &
22203 +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
22207 dscvec(k) = dc(k,i+nres)
22208 dscmag = dscmag+dscvec(k)*dscvec(k)
22211 dscmag = sqrt(dscmag)
22212 dscmag3 = dscmag3*dscmag
22213 constA = 1.0d0+dASGL/dscmag
22216 constB = constB+dscvec(k)*dEtotalCm(k)
22218 constB = constB*dASGL/dscmag3
22220 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
22221 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
22222 constA*dEtotalCm(k)-constB*dscvec(k)
22223 ! print *,j,constA,dEtotalCm(k),constB,dscvec(k)
22224 gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
22225 gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
22227 else if (itype(i,1).eq.13.or.itype(i,1).eq.14) then
22228 if(itype(i,1).eq.14) then
22234 vcatprm(k)=catprm(k,inum)
22236 dASGL=catprm(7,inum)
22238 vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
22244 dx(k) = vcat(k)-vcm(k)
22247 v1(k)=(vcm(k)-valpha(k))
22248 v2(k)=(vcat(k)-valpha(k))
22250 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
22251 v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
22252 v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
22253 ! The weights of the energy function calculated from
22254 !The quantum mechanical GAMESS simulations of ASN/GLN with calcium
22260 wquad2 = vcatprm(4)
22265 opt = dx(1)**2+dx(2)**2
22266 rsecp = opt+dx(3)**2
22270 rsixp = rfourp*rsecp
22275 Irfourp = Irthrp/rs
22281 opt1 = (4*rs*dx(3)*wdip)
22282 opt2 = 6*rsecp*wquad1*opt
22283 opt3 = wquad1*wquad2p*Irsixp
22284 opt4 = (wvan1*wvan2**12)
22285 opt5 = opt4*12*Irfourt
22286 opt6 = 2*wvan1*wvan2**6
22287 opt7 = 6*opt6*Ireight
22290 opt11 = (rsecp*v2m)**2
22291 opt12 = (rsecp*v1m)**2
22292 opt14 = (v1m*v2m*rsecp)**2
22293 opt15 = -wquad1/v2m**2
22294 opt16 = (rthrp*(v1m*v2m)**2)**2
22295 opt17 = (v1m**2*rthrp)**2
22296 opt18 = -wquad1/rthrp
22297 opt19 = (v1m**2*v2m**2)**2
22298 Edip=opt8*(v1dpv2)/(rsecp*v2m)
22300 dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m&
22301 *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
22302 dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m&
22303 *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
22304 dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m&
22305 *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp)&
22308 Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
22310 dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp*&
22311 (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2*&
22312 v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
22313 dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp*&
22314 (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2*&
22315 v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
22316 dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
22317 v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)*&
22320 Equad2=wquad1*wquad2p*Irthrp
22322 dEquad2Cat(k)=-3*dx(k)*rs*opt3
22323 dEquad2Cm(k)=3*dx(k)*rs*opt3
22324 dEquad2Calp(k)=0.0d0
22328 dEvan1Cat(k)=-dx(k)*opt5
22329 dEvan1Cm(k)=dx(k)*opt5
22330 dEvan1Calp(k)=0.0d0
22334 dEvan2Cat(k)=dx(k)*opt7
22335 dEvan2Cm(k)=-dx(k)*opt7
22336 dEvan2Calp(k)=0.0d0
22338 ecation_prot = ecation_prot+Edip+Equad1+Equad2+Evan1+Evan2
22340 dEtotalCat(k)=dEdipCat(k)+dEquad1Cat(k)+ &
22341 dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
22342 dEtotalCm(k)=dEdipCm(k)+dEquad1Cm(k)+ &
22343 dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
22344 dEtotalCalp(k)=dEdipCalp(k)+dEquad1Calp(k) &
22345 +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
22349 dscvec(k) = c(k,i+nres)-c(k,i)
22350 dscmag = dscmag+dscvec(k)*dscvec(k)
22353 dscmag = sqrt(dscmag)
22354 dscmag3 = dscmag3*dscmag
22355 constA = 1+dASGL/dscmag
22358 constB = constB+dscvec(k)*dEtotalCm(k)
22360 constB = constB*dASGL/dscmag3
22362 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
22363 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
22364 constA*dEtotalCm(k)-constB*dscvec(k)
22365 gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
22366 gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
22371 r(k) = c(k,j)-c(k,i+nres)
22372 rcal = rcal+r(k)*r(k)
22377 r0p=0.5*(rocal+sig0(itype(i,1)))
22380 Evan1=epscalc*(r012/rcal**6)
22381 Evan2=epscalc*2*(r06/rcal**3)
22385 dEvan1Cm(k) = 12*r(k)*epscalc*r012/r7
22386 dEvan2Cm(k) = 12*r(k)*epscalc*r06/r4
22389 dEtotalCm(k)=dEvan1Cm(k)+dEvan2Cm(k)
22391 ecation_prot = ecation_prot+ Evan1+Evan2
22393 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
22395 gradpepcat(k,i)=gradpepcat(k,i)+dEtotalCm(k)
22396 gradpepcat(k,j)=gradpepcat(k,j)-dEtotalCm(k)
22398 endif ! 13-16 residues
22402 end subroutine ecat_prot
22404 !----------------------------------------------------------------------------
22405 !-----------------------------------------------------------------------------
22406 !-----------------------------------------------------------------------------
22407 subroutine eprot_sc_base(escbase)
22409 ! implicit real*8 (a-h,o-z)
22410 ! include 'DIMENSIONS'
22411 ! include 'COMMON.GEO'
22412 ! include 'COMMON.VAR'
22413 ! include 'COMMON.LOCAL'
22414 ! include 'COMMON.CHAIN'
22415 ! include 'COMMON.DERIV'
22416 ! include 'COMMON.NAMES'
22417 ! include 'COMMON.INTERACT'
22418 ! include 'COMMON.IOUNITS'
22419 ! include 'COMMON.CALC'
22420 ! include 'COMMON.CONTROL'
22421 ! include 'COMMON.SBRIDGE'
22423 !el local variables
22424 integer :: iint,itypi,itypi1,itypj,subchap
22425 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
22426 real(kind=8) :: evdw,sig0ij
22427 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
22428 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
22429 sslipi,sslipj,faclip
22431 real(kind=8) :: fracinbuf
22432 real (kind=8) :: escbase
22433 real (kind=8),dimension(4):: ener
22434 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
22435 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
22436 sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
22437 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
22438 dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
22439 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
22440 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
22441 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
22442 real(kind=8),dimension(3,2)::chead,erhead_tail
22443 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
22447 ! do i=1,nres_molec(1)
22448 do i=ibond_start,ibond_end
22449 if (itype(i,1).eq.ntyp1_molec(1)) cycle
22451 dxi = dc_norm(1,nres+i)
22452 dyi = dc_norm(2,nres+i)
22453 dzi = dc_norm(3,nres+i)
22454 dsci_inv = vbld_inv(i+nres)
22458 xi=mod(xi,boxxsize)
22459 if (xi.lt.0) xi=xi+boxxsize
22460 yi=mod(yi,boxysize)
22461 if (yi.lt.0) yi=yi+boxysize
22462 zi=mod(zi,boxzsize)
22463 if (zi.lt.0) zi=zi+boxzsize
22464 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
22466 if (itype(j,2).eq.ntyp1_molec(2))cycle
22470 xj=dmod(xj,boxxsize)
22471 if (xj.lt.0) xj=xj+boxxsize
22472 yj=dmod(yj,boxysize)
22473 if (yj.lt.0) yj=yj+boxysize
22474 zj=dmod(zj,boxzsize)
22475 if (zj.lt.0) zj=zj+boxzsize
22476 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22485 xj=xj_safe+xshift*boxxsize
22486 yj=yj_safe+yshift*boxysize
22487 zj=zj_safe+zshift*boxzsize
22488 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22489 if(dist_temp.lt.dist_init) then
22490 dist_init=dist_temp
22499 if (subchap.eq.1) then
22508 dxj = dc_norm( 1, nres+j )
22509 dyj = dc_norm( 2, nres+j )
22510 dzj = dc_norm( 3, nres+j )
22511 ! print *,i,j,itypi,itypj
22512 d1i = dhead_scbasei(itypi,itypj) !this is shift of dipole/charge
22513 d1j = dhead_scbasej(itypi,itypj) !this is shift of dipole/charge
22516 ! BetaT = 1.0d0 / (298.0d0 * Rb)
22518 sig0ij = sigma_scbase( itypi,itypj )
22519 chi1 = chi_scbase( itypi, itypj,1 )
22520 chi2 = chi_scbase( itypi, itypj,2 )
22523 chi12 = chi1 * chi2
22524 chip1 = chipp_scbase( itypi, itypj,1 )
22525 chip2 = chipp_scbase( itypi, itypj,2 )
22528 chip12 = chip1 * chip2
22529 ! not used by momo potential, but needed by sc_angular which is shared
22530 ! by all energy_potential subroutines
22534 a12sq = rborn_scbasei(itypi,itypj) * rborn_scbasej(itypi,itypj)
22535 ! a12sq = a12sq * a12sq
22536 ! charge of amino acid itypi is...
22537 chis1 = chis_scbase(itypi,itypj,1)
22538 chis2 = chis_scbase(itypi,itypj,2)
22539 chis12 = chis1 * chis2
22540 sig1 = sigmap1_scbase(itypi,itypj)
22541 sig2 = sigmap2_scbase(itypi,itypj)
22542 ! write (*,*) "sig1 = ", sig1
22543 ! write (*,*) "sig2 = ", sig2
22544 ! alpha factors from Fcav/Gcav
22545 b1 = alphasur_scbase(1,itypi,itypj)
22547 b2 = alphasur_scbase(2,itypi,itypj)
22548 b3 = alphasur_scbase(3,itypi,itypj)
22549 b4 = alphasur_scbase(4,itypi,itypj)
22550 ! used to determine whether we want to do quadrupole calculations
22552 eps_in = epsintab_scbase(itypi,itypj)
22553 if (eps_in.eq.0.0) eps_in=1.0
22554 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
22555 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
22556 !-------------------------------------------------------------------
22557 ! tail location and distance calculations
22559 ! location of polar head is computed by taking hydrophobic centre
22560 ! and moving by a d1 * dc_norm vector
22561 ! see unres publications for very informative images
22562 chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
22563 chead(k,2) = c(k, j+nres) + d1j * dc_norm(k, j+nres)
22565 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
22566 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
22567 Rhead_distance(k) = chead(k,2) - chead(k,1)
22569 ! pitagoras (root of sum of squares)
22571 (Rhead_distance(1)*Rhead_distance(1)) &
22572 + (Rhead_distance(2)*Rhead_distance(2)) &
22573 + (Rhead_distance(3)*Rhead_distance(3)))
22574 !-------------------------------------------------------------------
22575 ! zero everything that should be zero'ed
22593 dscj_inv = vbld_inv(j+nres)
22594 ! print *,i,j,dscj_inv,dsci_inv
22595 ! rij holds 1/(distance of Calpha atoms)
22596 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
22598 !----------------------------
22600 ! this should be in elgrad_init but om's are calculated by sc_angular
22601 ! which in turn is used by older potentials
22602 ! om = omega, sqom = om^2
22605 sqom12 = om12 * om12
22607 ! now we calculate EGB - Gey-Berne
22608 ! It will be summed up in evdwij and saved in evdw
22609 sigsq = 1.0D0 / sigsq
22610 sig = sig0ij * dsqrt(sigsq)
22611 ! rij_shift = 1.0D0 / rij - sig + sig0ij
22612 rij_shift = 1.0/rij - sig + sig0ij
22613 IF (rij_shift.le.0.0D0) THEN
22617 sigder = -sig * sigsq
22618 rij_shift = 1.0D0 / rij_shift
22619 fac = rij_shift**expon
22620 c1 = fac * fac * aa_scbase(itypi,itypj)
22622 c2 = fac * bb_scbase(itypi,itypj)
22624 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
22625 eps2der = eps3rt * evdwij
22626 eps3der = eps2rt * evdwij
22627 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
22628 evdwij = eps2rt * eps3rt * evdwij
22629 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
22630 fac = -expon * (c1 + evdwij) * rij_shift
22631 sigder = fac * sigder
22633 ! Calculate distance derivative
22637 ! if (b2.gt.0.0) then
22638 fac = chis1 * sqom1 + chis2 * sqom2 &
22639 - 2.0d0 * chis12 * om1 * om2 * om12
22640 ! we will use pom later in Gcav, so dont mess with it!
22641 pom = 1.0d0 - chis1 * chis2 * sqom12
22642 Lambf = (1.0d0 - (fac / pom))
22643 Lambf = dsqrt(Lambf)
22644 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
22645 ! write (*,*) "sparrow = ", sparrow
22646 Chif = 1.0d0/rij * sparrow
22647 ChiLambf = Chif * Lambf
22648 eagle = dsqrt(ChiLambf)
22649 bat = ChiLambf ** 11.0d0
22650 top = b1 * ( eagle + b2 * ChiLambf - b3 )
22651 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
22655 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
22656 dbot = 12.0d0 * b4 * bat * Lambf
22657 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
22659 ! write (*,*) "dFcav/dR = ", dFdR
22660 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
22661 dbot = 12.0d0 * b4 * bat * Chif
22662 eagle = Lambf * pom
22663 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
22664 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
22665 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
22666 * (chis2 * om2 * om12 - om1) / (eagle * pom)
22668 dFdL = ((dtop * bot - top * dbot) / botsq)
22670 dCAVdOM1 = dFdL * ( dFdOM1 )
22671 dCAVdOM2 = dFdL * ( dFdOM2 )
22672 dCAVdOM12 = dFdL * ( dFdOM12 )
22677 ! eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
22678 ! eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
22679 ! eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
22680 ! -2.0D0*alf12*eps3der+sigder*sigsq_om12
22681 ! print *,"EOMY",eom1,eom2,eom12
22682 ! erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
22683 ! erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
22685 ! facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
22686 ! facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
22688 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
22689 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
22691 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
22692 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
22693 - (( dFdR + gg(k) ) * pom)
22694 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
22695 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
22696 ! & - ( dFdR * pom )
22698 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
22699 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
22700 + (( dFdR + gg(k) ) * pom)
22701 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
22702 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
22703 !c! & + ( dFdR * pom )
22705 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
22706 - (( dFdR + gg(k) ) * ertail(k))
22707 !c! & - ( dFdR * ertail(k))
22709 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
22710 + (( dFdR + gg(k) ) * ertail(k))
22711 !c! & + ( dFdR * ertail(k))
22714 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
22715 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
22722 if (wdipdip_scbase(2,itypi,itypj).gt.0.0d0) then
22723 w1 = wdipdip_scbase(1,itypi,itypj)
22724 w2 = -wdipdip_scbase(3,itypi,itypj)/2.0
22725 w3 = wdipdip_scbase(2,itypi,itypj)
22726 !c!-------------------------------------------------------------------
22728 fac = (om12 - 3.0d0 * om1 * om2)
22729 c1 = (w1 / (Rhead**3.0d0)) * fac
22730 c2 = (w2 / Rhead ** 6.0d0) &
22731 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
22732 c3= (w3/ Rhead ** 6.0d0) &
22733 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
22735 !c! write (*,*) "w1 = ", w1
22736 !c! write (*,*) "w2 = ", w2
22737 !c! write (*,*) "om1 = ", om1
22738 !c! write (*,*) "om2 = ", om2
22739 !c! write (*,*) "om12 = ", om12
22740 !c! write (*,*) "fac = ", fac
22741 !c! write (*,*) "c1 = ", c1
22742 !c! write (*,*) "c2 = ", c2
22743 !c! write (*,*) "Ecl = ", Ecl
22744 !c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
22745 !c! write (*,*) "c2_2 = ",
22746 !c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
22747 !c!-------------------------------------------------------------------
22748 !c! dervative of ECL is GCL...
22750 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
22751 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
22752 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
22753 c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
22754 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
22755 dGCLdR = c1 - c2 + c3
22757 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
22758 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
22759 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
22760 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
22761 dGCLdOM1 = c1 - c2 + c3
22763 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
22764 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
22765 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
22766 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
22767 dGCLdOM2 = c1 - c2 + c3
22769 c1 = w1 / (Rhead ** 3.0d0)
22770 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
22771 c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
22772 dGCLdOM12 = c1 - c2 + c3
22774 erhead(k) = Rhead_distance(k)/Rhead
22776 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
22777 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
22778 facd1 = d1i * vbld_inv(i+nres)
22779 facd2 = d1j * vbld_inv(j+nres)
22782 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
22783 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
22785 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
22786 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
22789 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
22790 - dGCLdR * erhead(k)
22791 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
22792 + dGCLdR * erhead(k)
22795 !now charge with dipole eg. ARG-dG
22796 if (wqdip_scbase(2,itypi,itypj).gt.0.0d0) then
22797 alphapol1 = alphapol_scbase(itypi,itypj)
22798 w1 = wqdip_scbase(1,itypi,itypj)
22799 w2 = wqdip_scbase(2,itypi,itypj)
22802 ! pis = sig0head_scbase(itypi,itypj)
22803 ! eps_head = epshead_scbase(itypi,itypj)
22804 !c!-------------------------------------------------------------------
22805 !c! R1 - distance between head of ith side chain and tail of jth sidechain
22808 !c! Calculate head-to-tail distances tail is center of side-chain
22809 R1=R1+(c(k,j+nres)-chead(k,1))**2
22814 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
22815 !c! & +dhead(1,1,itypi,itypj))**2))
22816 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
22817 !c! & +dhead(2,1,itypi,itypj))**2))
22819 !c!-------------------------------------------------------------------
22822 hawk = w2 * (1.0d0 - sqom2)
22823 Ecl = sparrow / Rhead**2.0d0 &
22824 - hawk / Rhead**4.0d0
22825 !c!-------------------------------------------------------------------
22826 !c! derivative of ecl is Gcl
22828 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
22829 + 4.0d0 * hawk / Rhead**5.0d0
22831 dGCLdOM1 = (w1) / (Rhead**2.0d0)
22833 dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
22834 !c--------------------------------------------------------------------
22835 !c Polarization energy
22837 MomoFac1 = (1.0d0 - chi1 * sqom2)
22838 RR1 = R1 * R1 / MomoFac1
22839 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
22840 fgb1 = sqrt( RR1 + a12sq * ee1)
22841 ! eps_inout_fac=0.0d0
22842 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
22843 ! derivative of Epol is Gpol...
22844 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
22846 dFGBdR1 = ( (R1 / MomoFac1) &
22847 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
22849 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
22850 * (2.0d0 - 0.5d0 * ee1) ) &
22852 dPOLdR1 = dPOLdFGB1 * dFGBdR1
22855 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
22857 erhead(k) = Rhead_distance(k)/Rhead
22858 erhead_tail(k,1) = ((c(k,j+nres)-chead(k,1))/R1)
22861 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
22862 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
22863 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
22865 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
22866 facd1 = d1i * vbld_inv(i+nres)
22867 facd2 = d1j * vbld_inv(j+nres)
22868 ! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
22871 hawk = (erhead_tail(k,1) + &
22872 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
22875 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
22876 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
22878 - dPOLdR1 * (erhead_tail(k,1))
22881 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
22882 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
22884 + dPOLdR1 * (erhead_tail(k,1))
22888 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
22889 - dGCLdR * erhead(k) &
22890 - dPOLdR1 * erhead_tail(k,1)
22891 ! & - dGLJdR * erhead(k)
22893 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
22894 + dGCLdR * erhead(k) &
22895 + dPOLdR1 * erhead_tail(k,1)
22896 ! & + dGLJdR * erhead(k)
22900 ! print *,i,j,evdwij,epol,Fcav,ECL
22901 escbase=escbase+evdwij+epol+Fcav+ECL
22902 call sc_grad_scbase
22907 end subroutine eprot_sc_base
22908 SUBROUTINE sc_grad_scbase
22911 real (kind=8) :: dcosom1(3),dcosom2(3)
22913 eps2der * eps2rt_om1 &
22914 - 2.0D0 * alf1 * eps3der &
22915 + sigder * sigsq_om1 &
22921 eps2der * eps2rt_om2 &
22922 + 2.0D0 * alf2 * eps3der &
22923 + sigder * sigsq_om2 &
22929 evdwij * eps1_om12 &
22930 + eps2der * eps2rt_om12 &
22931 - 2.0D0 * alf12 * eps3der &
22932 + sigder *sigsq_om12 &
22936 ! print *,eom1,eom2,eom12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
22937 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
22938 ! gg(1),gg(2),"rozne"
22940 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
22941 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
22942 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
22943 gvdwx_scbase(k,i)= gvdwx_scbase(k,i) - gg(k) &
22944 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
22945 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
22946 gvdwx_scbase(k,j)= gvdwx_scbase(k,j) + gg(k) &
22947 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
22948 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
22949 gvdwc_scbase(k,i)=gvdwc_scbase(k,i)-gg(k)
22950 gvdwc_scbase(k,j)=gvdwc_scbase(k,j)+gg(k)
22953 END SUBROUTINE sc_grad_scbase
22956 subroutine epep_sc_base(epepbase)
22959 !el local variables
22960 integer :: iint,itypi,itypi1,itypj,subchap
22961 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
22962 real(kind=8) :: evdw,sig0ij
22963 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
22964 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
22965 sslipi,sslipj,faclip
22967 real(kind=8) :: fracinbuf
22968 real (kind=8) :: epepbase
22969 real (kind=8),dimension(4):: ener
22970 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
22971 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
22972 sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
22973 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
22974 dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
22975 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
22976 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
22977 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
22978 real(kind=8),dimension(3,2)::chead,erhead_tail
22979 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
22983 ! do i=1,nres_molec(1)-1
22984 do i=ibond_start,ibond_end
22985 if (itype(i,1).eq.ntyp1_molec(1).or.itype(i+1,1).eq.ntyp1_molec(1)) cycle
22986 !C itypi = itype(i,1)
22990 ! print *,dxi,(-c(1,i)+c(1,i+1))*vbld_inv(i+1)
22991 dsci_inv = vbld_inv(i+1)/2.0
22992 xi=(c(1,i)+c(1,i+1))/2.0
22993 yi=(c(2,i)+c(2,i+1))/2.0
22994 zi=(c(3,i)+c(3,i+1))/2.0
22995 xi=mod(xi,boxxsize)
22996 if (xi.lt.0) xi=xi+boxxsize
22997 yi=mod(yi,boxysize)
22998 if (yi.lt.0) yi=yi+boxysize
22999 zi=mod(zi,boxzsize)
23000 if (zi.lt.0) zi=zi+boxzsize
23001 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
23003 if (itype(j,2).eq.ntyp1_molec(2))cycle
23007 xj=dmod(xj,boxxsize)
23008 if (xj.lt.0) xj=xj+boxxsize
23009 yj=dmod(yj,boxysize)
23010 if (yj.lt.0) yj=yj+boxysize
23011 zj=dmod(zj,boxzsize)
23012 if (zj.lt.0) zj=zj+boxzsize
23013 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23022 xj=xj_safe+xshift*boxxsize
23023 yj=yj_safe+yshift*boxysize
23024 zj=zj_safe+zshift*boxzsize
23025 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23026 if(dist_temp.lt.dist_init) then
23027 dist_init=dist_temp
23036 if (subchap.eq.1) then
23045 dxj = dc_norm( 1, nres+j )
23046 dyj = dc_norm( 2, nres+j )
23047 dzj = dc_norm( 3, nres+j )
23048 ! d1i = dhead_scbasei(itypi) !this is shift of dipole/charge
23049 ! d1j = dhead_scbasej(itypi) !this is shift of dipole/charge
23052 sig0ij = sigma_pepbase(itypj )
23053 chi1 = chi_pepbase(itypj,1 )
23054 chi2 = chi_pepbase(itypj,2 )
23057 chi12 = chi1 * chi2
23058 chip1 = chipp_pepbase(itypj,1 )
23059 chip2 = chipp_pepbase(itypj,2 )
23062 chip12 = chip1 * chip2
23063 chis1 = chis_pepbase(itypj,1)
23064 chis2 = chis_pepbase(itypj,2)
23065 chis12 = chis1 * chis2
23066 sig1 = sigmap1_pepbase(itypj)
23067 sig2 = sigmap2_pepbase(itypj)
23068 ! write (*,*) "sig1 = ", sig1
23069 ! write (*,*) "sig2 = ", sig2
23071 ! location of polar head is computed by taking hydrophobic centre
23072 ! and moving by a d1 * dc_norm vector
23073 ! see unres publications for very informative images
23074 chead(k,1) = (c(k,i)+c(k,i+1))/2.0
23075 ! + d1i * dc_norm(k, i+nres)
23076 chead(k,2) = c(k, j+nres)
23077 ! + d1j * dc_norm(k, j+nres)
23079 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
23080 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
23081 Rhead_distance(k) = chead(k,2) - chead(k,1)
23082 ! print *,gvdwc_pepbase(k,i)
23086 (Rhead_distance(1)*Rhead_distance(1)) &
23087 + (Rhead_distance(2)*Rhead_distance(2)) &
23088 + (Rhead_distance(3)*Rhead_distance(3)))
23090 ! alpha factors from Fcav/Gcav
23091 b1 = alphasur_pepbase(1,itypj)
23093 b2 = alphasur_pepbase(2,itypj)
23094 b3 = alphasur_pepbase(3,itypj)
23095 b4 = alphasur_pepbase(4,itypj)
23099 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23102 !----------------------------
23120 dscj_inv = vbld_inv(j+nres)
23122 ! this should be in elgrad_init but om's are calculated by sc_angular
23123 ! which in turn is used by older potentials
23124 ! om = omega, sqom = om^2
23127 sqom12 = om12 * om12
23129 ! now we calculate EGB - Gey-Berne
23130 ! It will be summed up in evdwij and saved in evdw
23131 sigsq = 1.0D0 / sigsq
23132 sig = sig0ij * dsqrt(sigsq)
23133 rij_shift = 1.0/rij - sig + sig0ij
23134 IF (rij_shift.le.0.0D0) THEN
23138 sigder = -sig * sigsq
23139 rij_shift = 1.0D0 / rij_shift
23140 fac = rij_shift**expon
23141 c1 = fac * fac * aa_pepbase(itypj)
23143 c2 = fac * bb_pepbase(itypj)
23145 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
23146 eps2der = eps3rt * evdwij
23147 eps3der = eps2rt * evdwij
23148 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
23149 evdwij = eps2rt * eps3rt * evdwij
23150 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
23151 fac = -expon * (c1 + evdwij) * rij_shift
23152 sigder = fac * sigder
23154 ! Calculate distance derivative
23158 fac = chis1 * sqom1 + chis2 * sqom2 &
23159 - 2.0d0 * chis12 * om1 * om2 * om12
23160 ! we will use pom later in Gcav, so dont mess with it!
23161 pom = 1.0d0 - chis1 * chis2 * sqom12
23162 Lambf = (1.0d0 - (fac / pom))
23163 Lambf = dsqrt(Lambf)
23164 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
23165 ! write (*,*) "sparrow = ", sparrow
23166 Chif = 1.0d0/rij * sparrow
23167 ChiLambf = Chif * Lambf
23168 eagle = dsqrt(ChiLambf)
23169 bat = ChiLambf ** 11.0d0
23170 top = b1 * ( eagle + b2 * ChiLambf - b3 )
23171 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
23175 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
23176 dbot = 12.0d0 * b4 * bat * Lambf
23177 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
23179 ! write (*,*) "dFcav/dR = ", dFdR
23180 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
23181 dbot = 12.0d0 * b4 * bat * Chif
23182 eagle = Lambf * pom
23183 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
23184 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
23185 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
23186 * (chis2 * om2 * om12 - om1) / (eagle * pom)
23188 dFdL = ((dtop * bot - top * dbot) / botsq)
23190 dCAVdOM1 = dFdL * ( dFdOM1 )
23191 dCAVdOM2 = dFdL * ( dFdOM2 )
23192 dCAVdOM12 = dFdL * ( dFdOM12 )
23198 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23199 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23201 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
23202 gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
23203 - (( dFdR + gg(k) ) * pom)/2.0
23204 ! print *,gvdwc_pepbase(k,i),i,(( dFdR + gg(k) ) * pom)/2.0
23205 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
23206 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
23207 ! & - ( dFdR * pom )
23209 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
23210 gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
23211 + (( dFdR + gg(k) ) * pom)
23212 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
23213 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23214 !c! & + ( dFdR * pom )
23216 gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
23217 - (( dFdR + gg(k) ) * ertail(k))/2.0
23218 ! print *,gvdwc_pepbase(k,i+1),i+1,(( dFdR + gg(k) ) * pom)/2.0
23220 !c! & - ( dFdR * ertail(k))
23222 gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
23223 + (( dFdR + gg(k) ) * ertail(k))
23224 !c! & + ( dFdR * ertail(k))
23227 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23228 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23232 w1 = wdipdip_pepbase(1,itypj)
23233 w2 = -wdipdip_pepbase(3,itypj)/2.0
23234 w3 = wdipdip_pepbase(2,itypj)
23237 !c!-------------------------------------------------------------------
23240 fac = (om12 - 3.0d0 * om1 * om2)
23241 c1 = (w1 / (Rhead**3.0d0)) * fac
23242 c2 = (w2 / Rhead ** 6.0d0) &
23243 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
23244 c3= (w3/ Rhead ** 6.0d0) &
23245 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
23249 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
23250 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
23251 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
23252 c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
23253 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
23255 dGCLdR = c1 - c2 + c3
23257 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
23258 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
23259 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
23260 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
23261 dGCLdOM1 = c1 - c2 + c3
23263 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
23264 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
23265 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
23266 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
23268 dGCLdOM2 = c1 - c2 + c3
23270 c1 = w1 / (Rhead ** 3.0d0)
23271 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
23272 c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
23273 dGCLdOM12 = c1 - c2 + c3
23275 erhead(k) = Rhead_distance(k)/Rhead
23277 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
23278 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
23279 ! facd1 = d1 * vbld_inv(i+nres)
23280 ! facd2 = d2 * vbld_inv(j+nres)
23284 !+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
23285 ! gvdwx_pepbase(k,i) = gvdwx_scbase(k,i) &
23288 !+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
23289 gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
23292 gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
23293 - dGCLdR * erhead(k)/2.0d0
23294 ! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
23295 gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
23296 - dGCLdR * erhead(k)/2.0d0
23297 ! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
23298 gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
23299 + dGCLdR * erhead(k)
23301 ! print *,i,j,evdwij,Fcav,ECL,"vdw,cav,ecl"
23302 epepbase=epepbase+evdwij+Fcav+ECL
23303 call sc_grad_pepbase
23306 END SUBROUTINE epep_sc_base
23307 SUBROUTINE sc_grad_pepbase
23310 real (kind=8) :: dcosom1(3),dcosom2(3)
23312 eps2der * eps2rt_om1 &
23313 - 2.0D0 * alf1 * eps3der &
23314 + sigder * sigsq_om1 &
23320 eps2der * eps2rt_om2 &
23321 + 2.0D0 * alf2 * eps3der &
23322 + sigder * sigsq_om2 &
23328 evdwij * eps1_om12 &
23329 + eps2der * eps2rt_om12 &
23330 - 2.0D0 * alf12 * eps3der &
23331 + sigder *sigsq_om12 &
23336 ! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
23337 ! if (i.eq.30) print *,gvdwc_pepbase(k,i),- gg(k),&
23338 ! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
23340 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
23341 ! gg(1),gg(2),"rozne"
23343 dcosom1(k) = rij * (dc_norm(k,i) - om1 * erij(k))
23344 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
23345 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
23346 gvdwc_pepbase(k,i)= gvdwc_pepbase(k,i) +0.5*(- gg(k)) &
23347 + (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
23349 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
23350 gvdwc_pepbase(k,i+1)= gvdwc_pepbase(k,i+1) +0.5*(- gg(k)) &
23351 - (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i))) &
23353 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
23354 ! print *,eom12,eom2,om12,om2
23355 !eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
23356 ! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
23357 gvdwx_pepbase(k,j)= gvdwx_pepbase(k,j) + gg(k) &
23358 + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
23359 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23360 gvdwc_pepbase(k,j)=gvdwc_pepbase(k,j)+gg(k)
23363 END SUBROUTINE sc_grad_pepbase
23364 subroutine eprot_sc_phosphate(escpho)
23366 ! implicit real*8 (a-h,o-z)
23367 ! include 'DIMENSIONS'
23368 ! include 'COMMON.GEO'
23369 ! include 'COMMON.VAR'
23370 ! include 'COMMON.LOCAL'
23371 ! include 'COMMON.CHAIN'
23372 ! include 'COMMON.DERIV'
23373 ! include 'COMMON.NAMES'
23374 ! include 'COMMON.INTERACT'
23375 ! include 'COMMON.IOUNITS'
23376 ! include 'COMMON.CALC'
23377 ! include 'COMMON.CONTROL'
23378 ! include 'COMMON.SBRIDGE'
23380 !el local variables
23381 integer :: iint,itypi,itypi1,itypj,subchap
23382 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
23383 real(kind=8) :: evdw,sig0ij
23384 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
23385 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
23386 sslipi,sslipj,faclip,alpha_sco
23388 real(kind=8) :: fracinbuf
23389 real (kind=8) :: escpho
23390 real (kind=8),dimension(4):: ener
23391 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
23392 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
23393 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
23394 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
23395 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
23396 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
23397 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
23398 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
23399 real(kind=8),dimension(3,2)::chead,erhead_tail
23400 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
23404 ! do i=1,nres_molec(1)
23405 do i=ibond_start,ibond_end
23406 if (itype(i,1).eq.ntyp1_molec(1)) cycle
23408 dxi = dc_norm(1,nres+i)
23409 dyi = dc_norm(2,nres+i)
23410 dzi = dc_norm(3,nres+i)
23411 dsci_inv = vbld_inv(i+nres)
23415 xi=mod(xi,boxxsize)
23416 if (xi.lt.0) xi=xi+boxxsize
23417 yi=mod(yi,boxysize)
23418 if (yi.lt.0) yi=yi+boxysize
23419 zi=mod(zi,boxzsize)
23420 if (zi.lt.0) zi=zi+boxzsize
23421 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
23423 if ((itype(j,2).eq.ntyp1_molec(2)).or.&
23424 (itype(j+1,2).eq.ntyp1_molec(2))) cycle
23425 xj=(c(1,j)+c(1,j+1))/2.0
23426 yj=(c(2,j)+c(2,j+1))/2.0
23427 zj=(c(3,j)+c(3,j+1))/2.0
23428 xj=dmod(xj,boxxsize)
23429 if (xj.lt.0) xj=xj+boxxsize
23430 yj=dmod(yj,boxysize)
23431 if (yj.lt.0) yj=yj+boxysize
23432 zj=dmod(zj,boxzsize)
23433 if (zj.lt.0) zj=zj+boxzsize
23434 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23442 xj=xj_safe+xshift*boxxsize
23443 yj=yj_safe+yshift*boxysize
23444 zj=zj_safe+zshift*boxzsize
23445 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23446 if(dist_temp.lt.dist_init) then
23447 dist_init=dist_temp
23456 if (subchap.eq.1) then
23465 dxj = dc_norm( 1,j )
23466 dyj = dc_norm( 2,j )
23467 dzj = dc_norm( 3,j )
23468 dscj_inv = vbld_inv(j+1)
23471 sig0ij = sigma_scpho(itypi )
23472 chi1 = chi_scpho(itypi,1 )
23473 chi2 = chi_scpho(itypi,2 )
23476 chi12 = chi1 * chi2
23477 chip1 = chipp_scpho(itypi,1 )
23478 chip2 = chipp_scpho(itypi,2 )
23481 chip12 = chip1 * chip2
23482 chis1 = chis_scpho(itypi,1)
23483 chis2 = chis_scpho(itypi,2)
23484 chis12 = chis1 * chis2
23485 sig1 = sigmap1_scpho(itypi)
23486 sig2 = sigmap2_scpho(itypi)
23487 ! write (*,*) "sig1 = ", sig1
23488 ! write (*,*) "sig1 = ", sig1
23489 ! write (*,*) "sig2 = ", sig2
23490 ! alpha factors from Fcav/Gcav
23494 a12sq = rborn_scphoi(itypi) * rborn_scphoj(itypi)
23496 b1 = alphasur_scpho(1,itypi)
23498 b2 = alphasur_scpho(2,itypi)
23499 b3 = alphasur_scpho(3,itypi)
23500 b4 = alphasur_scpho(4,itypi)
23501 ! used to determine whether we want to do quadrupole calculations
23503 eps_in = epsintab_scpho(itypi)
23504 if (eps_in.eq.0.0) eps_in=1.0
23505 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
23506 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
23507 !-------------------------------------------------------------------
23508 ! tail location and distance calculations
23509 d1i = dhead_scphoi(itypi) !this is shift of dipole/charge
23512 ! location of polar head is computed by taking hydrophobic centre
23513 ! and moving by a d1 * dc_norm vector
23514 ! see unres publications for very informative images
23515 chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
23516 chead(k,2) = (c(k, j) + c(k, j+1))/2.0
23518 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
23519 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
23520 Rhead_distance(k) = chead(k,2) - chead(k,1)
23522 ! pitagoras (root of sum of squares)
23524 (Rhead_distance(1)*Rhead_distance(1)) &
23525 + (Rhead_distance(2)*Rhead_distance(2)) &
23526 + (Rhead_distance(3)*Rhead_distance(3)))
23527 Rhead_sq=Rhead**2.0
23528 !-------------------------------------------------------------------
23529 ! zero everything that should be zero'ed
23548 dscj_inv = vbld_inv(j+1)/2.0
23549 !dhead_scbasej(itypi,itypj)
23550 ! print *,i,j,dscj_inv,dsci_inv
23551 ! rij holds 1/(distance of Calpha atoms)
23552 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23554 !----------------------------
23556 ! this should be in elgrad_init but om's are calculated by sc_angular
23557 ! which in turn is used by older potentials
23558 ! om = omega, sqom = om^2
23561 sqom12 = om12 * om12
23563 ! now we calculate EGB - Gey-Berne
23564 ! It will be summed up in evdwij and saved in evdw
23565 sigsq = 1.0D0 / sigsq
23566 sig = sig0ij * dsqrt(sigsq)
23567 ! rij_shift = 1.0D0 / rij - sig + sig0ij
23568 rij_shift = 1.0/rij - sig + sig0ij
23569 IF (rij_shift.le.0.0D0) THEN
23573 sigder = -sig * sigsq
23574 rij_shift = 1.0D0 / rij_shift
23575 fac = rij_shift**expon
23576 c1 = fac * fac * aa_scpho(itypi)
23578 c2 = fac * bb_scpho(itypi)
23580 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
23581 eps2der = eps3rt * evdwij
23582 eps3der = eps2rt * evdwij
23583 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
23584 evdwij = eps2rt * eps3rt * evdwij
23585 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
23586 fac = -expon * (c1 + evdwij) * rij_shift
23587 sigder = fac * sigder
23589 ! Calculate distance derivative
23593 fac = chis1 * sqom1 + chis2 * sqom2 &
23594 - 2.0d0 * chis12 * om1 * om2 * om12
23595 ! we will use pom later in Gcav, so dont mess with it!
23596 pom = 1.0d0 - chis1 * chis2 * sqom12
23597 Lambf = (1.0d0 - (fac / pom))
23598 Lambf = dsqrt(Lambf)
23599 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
23600 ! write (*,*) "sparrow = ", sparrow
23601 Chif = 1.0d0/rij * sparrow
23602 ChiLambf = Chif * Lambf
23603 eagle = dsqrt(ChiLambf)
23604 bat = ChiLambf ** 11.0d0
23605 top = b1 * ( eagle + b2 * ChiLambf - b3 )
23606 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
23609 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
23610 dbot = 12.0d0 * b4 * bat * Lambf
23611 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
23613 ! write (*,*) "dFcav/dR = ", dFdR
23614 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
23615 dbot = 12.0d0 * b4 * bat * Chif
23616 eagle = Lambf * pom
23617 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
23618 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
23619 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
23620 * (chis2 * om2 * om12 - om1) / (eagle * pom)
23622 dFdL = ((dtop * bot - top * dbot) / botsq)
23624 dCAVdOM1 = dFdL * ( dFdOM1 )
23625 dCAVdOM2 = dFdL * ( dFdOM2 )
23626 dCAVdOM12 = dFdL * ( dFdOM12 )
23632 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23633 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23634 ! if (i.eq.3) print *,'decl0',gvdwx_scpho(k,i),i
23637 ! print *,pom,gg(k),dFdR
23638 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
23639 gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
23640 - (( dFdR + gg(k) ) * pom)
23641 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
23642 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
23643 ! & - ( dFdR * pom )
23645 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
23646 ! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
23647 ! + (( dFdR + gg(k) ) * pom)
23648 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
23649 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23650 !c! & + ( dFdR * pom )
23652 gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
23653 - (( dFdR + gg(k) ) * ertail(k))
23654 !c! & - ( dFdR * ertail(k))
23656 gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
23657 + (( dFdR + gg(k) ) * ertail(k))/2.0
23659 gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
23660 + (( dFdR + gg(k) ) * ertail(k))/2.0
23662 !c! & + ( dFdR * ertail(k))
23666 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23667 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23668 ! alphapol1 = alphapol_scpho(itypi)
23669 if (wqq_scpho(itypi).ne.0.0) then
23670 Qij=wqq_scpho(itypi)/eps_in
23671 alpha_sco=1.d0/alphi_scpho(itypi)
23673 Ecl = (332.0d0 * Qij*dexp(-Rhead*alpha_sco)) / Rhead
23674 !c! derivative of Ecl is Gcl...
23675 dGCLdR = (-332.0d0 * Qij*dexp(-Rhead*alpha_sco)* &
23676 (Rhead*alpha_sco+1) ) / Rhead_sq
23677 if (energy_dec) write(iout,*) "ECL",ECL,Rhead,1.0/rij
23678 else if (wqdip_scpho(2,itypi).gt.0.0d0) then
23679 w1 = wqdip_scpho(1,itypi)
23680 w2 = wqdip_scpho(2,itypi)
23683 ! pis = sig0head_scbase(itypi,itypj)
23684 ! eps_head = epshead_scbase(itypi,itypj)
23685 !c!-------------------------------------------------------------------
23687 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
23688 !c! & +dhead(1,1,itypi,itypj))**2))
23689 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
23690 !c! & +dhead(2,1,itypi,itypj))**2))
23692 !c!-------------------------------------------------------------------
23695 hawk = w2 * (1.0d0 - sqom2)
23696 Ecl = sparrow / Rhead**2.0d0 &
23697 - hawk / Rhead**4.0d0
23698 !c!-------------------------------------------------------------------
23699 if (energy_dec) write(iout,*) "ECLdipdip",ECL,Rhead,&
23702 !c! derivative of ecl is Gcl
23704 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
23705 + 4.0d0 * hawk / Rhead**5.0d0
23707 dGCLdOM1 = (w1) / (Rhead**2.0d0)
23709 dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
23712 !c--------------------------------------------------------------------
23713 !c Polarization energy
23717 !c! Calculate head-to-tail distances tail is center of side-chain
23718 R1=R1+((c(k,j)+c(k,j+1))/2.0-chead(k,1))**2
23723 alphapol1 = alphapol_scpho(itypi)
23725 MomoFac1 = (1.0d0 - chi2 * sqom1)
23726 RR1 = R1 * R1 / MomoFac1
23727 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
23728 ! print *,"ee1",ee1,a12sq,alphapol1,eps_inout_fac
23729 fgb1 = sqrt( RR1 + a12sq * ee1)
23730 ! eps_inout_fac=0.0d0
23731 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
23732 ! derivative of Epol is Gpol...
23733 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
23735 dFGBdR1 = ( (R1 / MomoFac1) &
23736 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
23738 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
23739 * (2.0d0 - 0.5d0 * ee1) ) &
23741 dPOLdR1 = dPOLdFGB1 * dFGBdR1
23744 dFGBdOM1 = (((R1 * R1 * chi2 * om1) / (MomoFac1 * MomoFac1)) &
23745 * (2.0d0 - 0.5d0 * ee1) ) &
23748 dPOLdOM1 = dPOLdFGB1 * dFGBdOM1
23751 erhead(k) = Rhead_distance(k)/Rhead
23752 erhead_tail(k,1) = (((c(k,j)+c(k,j+1))/2.0-chead(k,1))/R1)
23755 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
23756 erdxj = scalar( erhead(1), dC_norm(1,j) )
23757 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
23759 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j))
23760 facd1 = d1i * vbld_inv(i+nres)
23761 facd2 = d1j * vbld_inv(j)
23762 ! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
23765 hawk = (erhead_tail(k,1) + &
23766 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
23769 ! if (i.eq.3) print *,'decl1',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i,&
23770 ! pom,(erhead_tail(k,1))
23772 ! print *,'decl',dGCLdR,dPOLdR1,gvdwc_scpho(k,i)
23773 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
23774 gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
23776 - dPOLdR1 * (erhead_tail(k,1))
23779 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
23780 ! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
23782 ! + dPOLdR1 * (erhead_tail(k,1))
23786 gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
23787 - dGCLdR * erhead(k) &
23788 - dPOLdR1 * erhead_tail(k,1)
23789 ! & - dGLJdR * erhead(k)
23791 gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
23792 + (dGCLdR * erhead(k) &
23793 + dPOLdR1 * erhead_tail(k,1))/2.0
23794 gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
23795 + (dGCLdR * erhead(k) &
23796 + dPOLdR1 * erhead_tail(k,1))/2.0
23798 ! & + dGLJdR * erhead(k)
23799 ! if (i.eq.3) print *,'decl2',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i
23802 ! if (i.eq.3) print *,i,j,evdwij,epol,Fcav,ECL
23803 if (energy_dec) write (iout,'(a22,2i5,4f8.3,f16.3)'), &
23804 "escpho:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,escpho
23805 escpho=escpho+evdwij+epol+Fcav+ECL
23812 end subroutine eprot_sc_phosphate
23813 SUBROUTINE sc_grad_scpho
23816 real (kind=8) :: dcosom1(3),dcosom2(3)
23818 eps2der * eps2rt_om1 &
23819 - 2.0D0 * alf1 * eps3der &
23820 + sigder * sigsq_om1 &
23826 eps2der * eps2rt_om2 &
23827 + 2.0D0 * alf2 * eps3der &
23828 + sigder * sigsq_om2 &
23834 evdwij * eps1_om12 &
23835 + eps2der * eps2rt_om12 &
23836 - 2.0D0 * alf12 * eps3der &
23837 + sigder *sigsq_om12 &
23842 ! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
23843 ! if (i.eq.30) print *,gvdwc_scpho(k,i),- gg(k),&
23844 ! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
23846 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
23847 ! gg(1),gg(2),"rozne"
23849 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
23850 dcosom2(k) = rij * (dc_norm(k,j) - om2 * erij(k))
23851 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
23852 gvdwc_scpho(k,j)= gvdwc_scpho(k,j) +0.5*( gg(k)) &
23853 + (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)))&
23855 - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
23856 gvdwc_scpho(k,j+1)= gvdwc_scpho(k,j+1) +0.5*( gg(k)) &
23857 - (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j))) &
23859 + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
23860 gvdwx_scpho(k,i)= gvdwx_scpho(k,i) - gg(k) &
23861 + (eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
23862 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
23864 ! print *,eom12,eom2,om12,om2
23865 !eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
23866 ! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
23867 ! gvdwx_scpho(k,j)= gvdwx_scpho(k,j) + gg(k) &
23868 ! + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
23869 ! + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23870 gvdwc_scpho(k,i)=gvdwc_scpho(k,i)-gg(k)
23873 END SUBROUTINE sc_grad_scpho
23874 subroutine eprot_pep_phosphate(epeppho)
23876 ! implicit real*8 (a-h,o-z)
23877 ! include 'DIMENSIONS'
23878 ! include 'COMMON.GEO'
23879 ! include 'COMMON.VAR'
23880 ! include 'COMMON.LOCAL'
23881 ! include 'COMMON.CHAIN'
23882 ! include 'COMMON.DERIV'
23883 ! include 'COMMON.NAMES'
23884 ! include 'COMMON.INTERACT'
23885 ! include 'COMMON.IOUNITS'
23886 ! include 'COMMON.CALC'
23887 ! include 'COMMON.CONTROL'
23888 ! include 'COMMON.SBRIDGE'
23890 !el local variables
23891 integer :: iint,itypi,itypi1,itypj,subchap
23892 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
23893 real(kind=8) :: evdw,sig0ij
23894 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
23895 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
23896 sslipi,sslipj,faclip
23898 real(kind=8) :: fracinbuf
23899 real (kind=8) :: epeppho
23900 real (kind=8),dimension(4):: ener
23901 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
23902 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
23903 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
23904 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
23905 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
23906 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
23907 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
23908 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
23909 real(kind=8),dimension(3,2)::chead,erhead_tail
23910 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
23912 real (kind=8) :: dcosom1(3),dcosom2(3)
23914 ! do i=1,nres_molec(1)
23915 do i=ibond_start,ibond_end
23916 if (itype(i,1).eq.ntyp1_molec(1)) cycle
23918 dsci_inv = vbld_inv(i+1)/2.0
23922 xi=(c(1,i)+c(1,i+1))/2.0
23923 yi=(c(2,i)+c(2,i+1))/2.0
23924 zi=(c(3,i)+c(3,i+1))/2.0
23925 xi=mod(xi,boxxsize)
23926 if (xi.lt.0) xi=xi+boxxsize
23927 yi=mod(yi,boxysize)
23928 if (yi.lt.0) yi=yi+boxysize
23929 zi=mod(zi,boxzsize)
23930 if (zi.lt.0) zi=zi+boxzsize
23931 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
23933 if ((itype(j,2).eq.ntyp1_molec(2)).or.&
23934 (itype(j+1,2).eq.ntyp1_molec(2))) cycle
23935 xj=(c(1,j)+c(1,j+1))/2.0
23936 yj=(c(2,j)+c(2,j+1))/2.0
23937 zj=(c(3,j)+c(3,j+1))/2.0
23938 xj=dmod(xj,boxxsize)
23939 if (xj.lt.0) xj=xj+boxxsize
23940 yj=dmod(yj,boxysize)
23941 if (yj.lt.0) yj=yj+boxysize
23942 zj=dmod(zj,boxzsize)
23943 if (zj.lt.0) zj=zj+boxzsize
23944 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23952 xj=xj_safe+xshift*boxxsize
23953 yj=yj_safe+yshift*boxysize
23954 zj=zj_safe+zshift*boxzsize
23955 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23956 if(dist_temp.lt.dist_init) then
23957 dist_init=dist_temp
23966 if (subchap.eq.1) then
23975 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23977 dxj = dc_norm( 1,j )
23978 dyj = dc_norm( 2,j )
23979 dzj = dc_norm( 3,j )
23980 dscj_inv = vbld_inv(j+1)/2.0
23982 sig0ij = sigma_peppho
23985 chi12 = chi1 * chi2
23988 chip12 = chip1 * chip2
23991 chis12 = chis1 * chis2
23992 sig1 = sigmap1_peppho
23993 sig2 = sigmap2_peppho
23994 ! write (*,*) "sig1 = ", sig1
23995 ! write (*,*) "sig1 = ", sig1
23996 ! write (*,*) "sig2 = ", sig2
23997 ! alpha factors from Fcav/Gcav
24001 b1 = alphasur_peppho(1)
24003 b2 = alphasur_peppho(2)
24004 b3 = alphasur_peppho(3)
24005 b4 = alphasur_peppho(4)
24027 fac = rij_shift**expon
24028 c1 = fac * fac * aa_peppho
24030 c2 = fac * bb_peppho
24033 ! Now cavity....................
24034 eagle = dsqrt(1.0/rij_shift)
24035 top = b1 * ( eagle + b2 * 1.0/rij_shift - b3 )
24036 bot = 1.0d0 + b4 * (1.0/rij_shift ** 12.0d0)
24039 dtop = b1 * ((1.0/ (2.0d0 * eagle)) + (b2))
24040 dbot = 12.0d0 * b4 * (1.0/rij_shift) ** 11.0d0
24041 dFdR = ((dtop * bot - top * dbot) / botsq)
24042 w1 = wqdip_peppho(1)
24043 w2 = wqdip_peppho(2)
24046 ! pis = sig0head_scbase(itypi,itypj)
24047 ! eps_head = epshead_scbase(itypi,itypj)
24048 !c!-------------------------------------------------------------------
24050 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
24051 !c! & +dhead(1,1,itypi,itypj))**2))
24052 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
24053 !c! & +dhead(2,1,itypi,itypj))**2))
24055 !c!-------------------------------------------------------------------
24058 hawk = w2 * (1.0d0 - sqom1)
24059 Ecl = sparrow * rij_shift**2.0d0 &
24060 - hawk * rij_shift**4.0d0
24061 !c!-------------------------------------------------------------------
24062 !c! derivative of ecl is Gcl
24065 dGCLdR = - 2.0d0 * sparrow * rij_shift**3.0d0 &
24066 + 4.0d0 * hawk * rij_shift**5.0d0
24068 dGCLdOM1 = (w1) * (rij_shift**2.0d0)
24070 dGCLdOM2 = (2.0d0 * w2 * om1) * (rij_shift ** 4.0d0)
24071 eom1 = dGCLdOM1+dGCLdOM2
24074 fac = -expon * (c1 + evdwij) * rij_shift+dFdR+dGCLdR
24080 gvdwc_peppho(k,j) = gvdwc_peppho(k,j) +gg(k)/2.0
24081 gvdwc_peppho(k,j+1) = gvdwc_peppho(k,j+1) +gg(k)/2.0
24082 gvdwc_peppho(k,i) = gvdwc_peppho(k,i) -gg(k)/2.0
24083 gvdwc_peppho(k,i+1) = gvdwc_peppho(k,i+1) -gg(k)/2.0
24088 dcosom1(k) = rij* (dc_norm(k,i) - om1 * erij(k))
24089 dcosom2(k) = rij* (dc_norm(k,j) - om2 * erij(k))
24090 gg(k) = gg(k) + eom1 * dcosom1(k)! + eom2 * dcosom2(k)
24091 gvdwc_peppho(k,j)= gvdwc_peppho(k,j) +0.5*( gg(k)) !&
24092 ! - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
24093 gvdwc_peppho(k,j+1)= gvdwc_peppho(k,j+1) +0.5*( gg(k)) !&
24094 ! + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
24095 gvdwc_peppho(k,i)= gvdwc_peppho(k,i) -0.5*( gg(k)) &
24096 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
24097 gvdwc_peppho(k,i+1)= gvdwc_peppho(k,i+1) - 0.5*( gg(k)) &
24098 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
24100 epeppho=epeppho+evdwij+Fcav+ECL
24101 ! print *,i,j,evdwij,Fcav,ECL,rij_shift
24104 end subroutine eprot_pep_phosphate