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(i)*difi**4
6791 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6792 else if (difi.lt.-drange(i)) then
6794 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6795 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*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(i)*difi**4
6902 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6903 else if (difi.lt.-drange(i)) then
6905 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6906 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*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 call geom_to_var(nvar,x)
11798 write (iout,*) "split_ene ",split_ene
11800 if (.not.split_ene) then
11801 call etotal(energia)
11806 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11809 grad_s(j,0)=gcart(j,0)
11813 grad_s(j,i)=gcart(j,i)
11814 grad_s(j+3,i)=gxcart(j,i)
11818 !- split gradient check
11820 call etotal_long(energia)
11821 !el call enerprint(energia)
11825 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11826 (gxcart(j,i),j=1,3)
11829 grad_s(j,0)=gcart(j,0)
11833 grad_s(j,i)=gcart(j,i)
11834 grad_s(j+3,i)=gxcart(j,i)
11838 call etotal_short(energia)
11839 call enerprint(energia)
11843 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11844 (gxcart(j,i),j=1,3)
11847 grad_s1(j,0)=gcart(j,0)
11851 grad_s1(j,i)=gcart(j,i)
11852 grad_s1(j+3,i)=gxcart(j,i)
11856 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11860 if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
11861 if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
11864 dcnorm_safe1(j)=dc_norm(j,i-1)
11865 dcnorm_safe2(j)=dc_norm(j,i)
11866 dxnorm_safe(j)=dc_norm(j,i+nres)
11869 c(j,i)=ddc(j)+aincr
11870 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
11871 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
11872 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11873 dc(j,i)=c(j,i+1)-c(j,i)
11874 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11875 call int_from_cart1(.false.)
11876 if (.not.split_ene) then
11877 call etotal(energia1)
11879 write (iout,*) "ij",i,j," etot1",etot1
11882 call etotal_long(energia1)
11884 call etotal_short(energia1)
11887 !- end split gradient
11888 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11889 c(j,i)=ddc(j)-aincr
11890 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
11891 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
11892 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11893 dc(j,i)=c(j,i+1)-c(j,i)
11894 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11895 call int_from_cart1(.false.)
11896 if (.not.split_ene) then
11897 call etotal(energia1)
11899 write (iout,*) "ij",i,j," etot2",etot2
11900 ggg(j)=(etot1-etot2)/(2*aincr)
11903 call etotal_long(energia1)
11905 ggg(j)=(etot11-etot21)/(2*aincr)
11906 call etotal_short(energia1)
11908 ggg1(j)=(etot12-etot22)/(2*aincr)
11909 !- end split gradient
11910 ! write (iout,*) "etot21",etot21," etot22",etot22
11912 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11914 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
11915 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
11916 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11917 dc(j,i)=c(j,i+1)-c(j,i)
11918 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11919 dc_norm(j,i-1)=dcnorm_safe1(j)
11920 dc_norm(j,i)=dcnorm_safe2(j)
11921 dc_norm(j,i+nres)=dxnorm_safe(j)
11924 c(j,i+nres)=ddx(j)+aincr
11925 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11926 call int_from_cart1(.false.)
11927 if (.not.split_ene) then
11928 call etotal(energia1)
11932 call etotal_long(energia1)
11934 call etotal_short(energia1)
11937 !- end split gradient
11938 c(j,i+nres)=ddx(j)-aincr
11939 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11940 call int_from_cart1(.false.)
11941 if (.not.split_ene) then
11942 call etotal(energia1)
11944 ggg(j+3)=(etot1-etot2)/(2*aincr)
11947 call etotal_long(energia1)
11949 ggg(j+3)=(etot11-etot21)/(2*aincr)
11950 call etotal_short(energia1)
11952 ggg1(j+3)=(etot12-etot22)/(2*aincr)
11953 !- end split gradient
11955 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11957 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11958 dc_norm(j,i+nres)=dxnorm_safe(j)
11959 call int_from_cart1(.false.)
11961 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11962 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
11963 if (split_ene) then
11964 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11965 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
11967 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11968 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
11969 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
11973 end subroutine check_ecartint
11975 !-----------------------------------------------------------------------------
11976 subroutine check_ecartint
11977 ! Check the gradient of the energy in Cartesian coordinates.
11978 use io_base, only: intout
11979 ! implicit real*8 (a-h,o-z)
11980 ! include 'DIMENSIONS'
11981 ! include 'COMMON.CONTROL'
11982 ! include 'COMMON.CHAIN'
11983 ! include 'COMMON.DERIV'
11984 ! include 'COMMON.IOUNITS'
11985 ! include 'COMMON.VAR'
11986 ! include 'COMMON.CONTACTS'
11987 ! include 'COMMON.MD'
11988 ! include 'COMMON.LOCAL'
11989 ! include 'COMMON.SPLITELE'
11991 !el integer :: icall
11992 !el common /srutu/ icall
11993 real(kind=8),dimension(6) :: ggg,ggg1
11994 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
11995 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11996 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
11997 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
11998 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
11999 real(kind=8),dimension(0:n_ene) :: energia,energia1
12000 integer :: uiparm(1)
12001 real(kind=8) :: urparm(1)
12003 integer :: i,j,k,nf
12004 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
12012 ! call intcartderiv
12013 ! call checkintcartgrad
12016 write(iout,*) 'Calling CHECK_ECARTINT.',aincr
12019 call geom_to_var(nvar,x)
12020 if (.not.split_ene) then
12021 call etotal(energia)
12023 !el call enerprint(energia)
12027 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
12030 grad_s(j,0)=gcart(j,0)
12034 grad_s(j,i)=gcart(j,i)
12035 ! if (i.le.2) print *,"tu?!",gcart(j,i),grad_s(j,i),gxcart(j,i)
12036 grad_s(j+3,i)=gxcart(j,i)
12040 !- split gradient check
12042 call etotal_long(energia)
12043 !el call enerprint(energia)
12047 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12048 (gxcart(j,i),j=1,3)
12051 grad_s(j,0)=gcart(j,0)
12055 grad_s(j,i)=gcart(j,i)
12056 grad_s(j+3,i)=gxcart(j,i)
12060 call etotal_short(energia)
12061 !el call enerprint(energia)
12065 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12066 (gxcart(j,i),j=1,3)
12069 grad_s1(j,0)=gcart(j,0)
12073 grad_s1(j,i)=gcart(j,i)
12074 grad_s1(j+3,i)=gxcart(j,i)
12078 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
12083 ddx(j)=dc(j,i+nres)
12085 dcnorm_safe(k)=dc_norm(k,i)
12086 dxnorm_safe(k)=dc_norm(k,i+nres)
12090 dc(j,i)=ddc(j)+aincr
12091 call chainbuild_cart
12093 ! Broadcast the order to compute internal coordinates to the slaves.
12094 ! if (nfgtasks.gt.1)
12095 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
12097 ! call int_from_cart1(.false.)
12098 if (.not.split_ene) then
12099 call etotal(energia1)
12101 ! call enerprint(energia1)
12104 call etotal_long(energia1)
12106 call etotal_short(energia1)
12108 ! write (iout,*) "etot11",etot11," etot12",etot12
12110 !- end split gradient
12111 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12112 dc(j,i)=ddc(j)-aincr
12113 call chainbuild_cart
12114 ! call int_from_cart1(.false.)
12115 if (.not.split_ene) then
12116 call etotal(energia1)
12118 ggg(j)=(etot1-etot2)/(2*aincr)
12121 call etotal_long(energia1)
12123 ggg(j)=(etot11-etot21)/(2*aincr)
12124 call etotal_short(energia1)
12126 ggg1(j)=(etot12-etot22)/(2*aincr)
12127 !- end split gradient
12128 ! write (iout,*) "etot21",etot21," etot22",etot22
12130 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12132 call chainbuild_cart
12135 dc(j,i+nres)=ddx(j)+aincr
12136 call chainbuild_cart
12137 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
12138 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
12139 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
12140 ! write (iout,*) "dxnormnorm",dsqrt(
12141 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
12142 ! write (iout,*) "dxnormnormsafe",dsqrt(
12143 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
12145 if (.not.split_ene) then
12146 call etotal(energia1)
12150 call etotal_long(energia1)
12152 call etotal_short(energia1)
12155 !- end split gradient
12156 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12157 dc(j,i+nres)=ddx(j)-aincr
12158 call chainbuild_cart
12159 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
12160 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
12161 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
12163 ! write (iout,*) "dxnormnorm",dsqrt(
12164 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
12165 ! write (iout,*) "dxnormnormsafe",dsqrt(
12166 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
12167 if (.not.split_ene) then
12168 call etotal(energia1)
12170 ggg(j+3)=(etot1-etot2)/(2*aincr)
12173 call etotal_long(energia1)
12175 ggg(j+3)=(etot11-etot21)/(2*aincr)
12176 call etotal_short(energia1)
12178 ggg1(j+3)=(etot12-etot22)/(2*aincr)
12179 !- end split gradient
12181 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12182 dc(j,i+nres)=ddx(j)
12183 call chainbuild_cart
12185 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12186 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
12187 if (split_ene) then
12188 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12189 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
12191 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12192 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
12193 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
12197 end subroutine check_ecartint
12199 !-----------------------------------------------------------------------------
12200 subroutine check_eint
12201 ! Check the gradient of energy in internal coordinates.
12202 ! implicit real*8 (a-h,o-z)
12203 ! include 'DIMENSIONS'
12204 ! include 'COMMON.CHAIN'
12205 ! include 'COMMON.DERIV'
12206 ! include 'COMMON.IOUNITS'
12207 ! include 'COMMON.VAR'
12208 ! include 'COMMON.GEO'
12210 !el integer :: icall
12211 !el common /srutu/ icall
12212 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
12213 integer :: uiparm(1)
12214 real(kind=8) :: urparm(1)
12215 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
12216 character(len=6) :: key
12219 real(kind=8) :: xi,aincr,etot,etot1,etot2
12222 print '(a)','Calling CHECK_INT.'
12226 call geom_to_var(nvar,x)
12227 call var_to_geom(nvar,x)
12230 ! print *,'ICG=',ICG
12231 call etotal(energia)
12233 !el call enerprint(energia)
12234 ! print *,'ICG=',ICG
12236 if (MyID.ne.BossID) then
12237 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
12245 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
12246 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
12247 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
12251 x(i)=xi-0.5D0*aincr
12252 call var_to_geom(nvar,x)
12254 call etotal(energia1)
12256 x(i)=xi+0.5D0*aincr
12257 call var_to_geom(nvar,x)
12259 call etotal(energia2)
12261 gg(i)=(etot2-etot1)/aincr
12262 write (iout,*) i,etot1,etot2
12265 write (iout,'(/2a)')' Variable Numerical Analytical',&
12268 if (i.le.nphi) then
12271 else if (i.le.nphi+ntheta) then
12274 else if (i.le.nphi+ntheta+nside) then
12278 ii=i-(nphi+ntheta+nside)
12281 write (iout,'(i3,a,i3,3(1pd16.6))') &
12282 i,key,ii,gg(i),gana(i),&
12283 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
12286 end subroutine check_eint
12287 !-----------------------------------------------------------------------------
12289 !-----------------------------------------------------------------------------
12290 subroutine Econstr_back
12291 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
12292 ! implicit real*8 (a-h,o-z)
12293 ! include 'DIMENSIONS'
12294 ! include 'COMMON.CONTROL'
12295 ! include 'COMMON.VAR'
12296 ! include 'COMMON.MD'
12299 ! include 'COMMON.LANGEVIN'
12301 ! include 'COMMON.LANGEVIN.lang0'
12303 ! include 'COMMON.CHAIN'
12304 ! include 'COMMON.DERIV'
12305 ! include 'COMMON.GEO'
12306 ! include 'COMMON.LOCAL'
12307 ! include 'COMMON.INTERACT'
12308 ! include 'COMMON.IOUNITS'
12309 ! include 'COMMON.NAMES'
12310 ! include 'COMMON.TIME1'
12311 integer :: i,j,ii,k
12312 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
12314 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
12315 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
12316 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
12323 duscdiff(j,i)=0.0d0
12324 duscdiffx(j,i)=0.0d0
12328 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
12330 ! Deviations from theta angles
12333 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
12334 dtheta_i=theta(j)-thetaref(j)
12335 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
12336 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
12338 utheta(i)=utheta_i/(ii-1)
12340 ! Deviations from gamma angles
12343 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
12344 dgamma_i=pinorm(phi(j)-phiref(j))
12345 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
12346 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
12347 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
12348 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
12350 ugamma(i)=ugamma_i/(ii-2)
12352 ! Deviations from local SC geometry
12355 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
12356 dxx=xxtab(j)-xxref(j)
12357 dyy=yytab(j)-yyref(j)
12358 dzz=zztab(j)-zzref(j)
12359 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
12361 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
12362 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
12364 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
12365 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
12367 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
12368 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
12371 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
12372 ! & xxref(j),yyref(j),zzref(j)
12374 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
12375 ! write (iout,*) i," uscdiff",uscdiff(i)
12377 ! Put together deviations from local geometry
12379 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
12380 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
12381 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
12382 ! & " uconst_back",uconst_back
12383 utheta(i)=dsqrt(utheta(i))
12384 ugamma(i)=dsqrt(ugamma(i))
12385 uscdiff(i)=dsqrt(uscdiff(i))
12388 end subroutine Econstr_back
12389 !-----------------------------------------------------------------------------
12390 ! energy_p_new-sep_barrier.F
12391 !-----------------------------------------------------------------------------
12392 real(kind=8) function sscale(r)
12393 ! include "COMMON.SPLITELE"
12394 real(kind=8) :: r,gamm
12395 if(r.lt.r_cut-rlamb) then
12397 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
12398 gamm=(r-(r_cut-rlamb))/rlamb
12399 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12404 end function sscale
12405 real(kind=8) function sscale_grad(r)
12406 ! include "COMMON.SPLITELE"
12407 real(kind=8) :: r,gamm
12408 if(r.lt.r_cut-rlamb) then
12410 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
12411 gamm=(r-(r_cut-rlamb))/rlamb
12412 sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
12417 end function sscale_grad
12419 !!!!!!!!!! PBCSCALE
12420 real(kind=8) function sscale_ele(r)
12421 ! include "COMMON.SPLITELE"
12422 real(kind=8) :: r,gamm
12423 if(r.lt.r_cut_ele-rlamb_ele) then
12425 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12426 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12427 sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12432 end function sscale_ele
12434 real(kind=8) function sscagrad_ele(r)
12435 real(kind=8) :: r,gamm
12436 ! include "COMMON.SPLITELE"
12437 if(r.lt.r_cut_ele-rlamb_ele) then
12439 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12440 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12441 sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
12446 end function sscagrad_ele
12447 real(kind=8) function sscalelip(r)
12448 real(kind=8) r,gamm
12449 sscalelip=1.0d0+r*r*(2.0d0*r-3.0d0)
12451 end function sscalelip
12452 !C-----------------------------------------------------------------------
12453 real(kind=8) function sscagradlip(r)
12454 real(kind=8) r,gamm
12455 sscagradlip=r*(6.0d0*r-6.0d0)
12457 end function sscagradlip
12460 !-----------------------------------------------------------------------------
12461 subroutine elj_long(evdw)
12463 ! This subroutine calculates the interaction energy of nonbonded side chains
12464 ! assuming the LJ potential of interaction.
12466 ! implicit real*8 (a-h,o-z)
12467 ! include 'DIMENSIONS'
12468 ! include 'COMMON.GEO'
12469 ! include 'COMMON.VAR'
12470 ! include 'COMMON.LOCAL'
12471 ! include 'COMMON.CHAIN'
12472 ! include 'COMMON.DERIV'
12473 ! include 'COMMON.INTERACT'
12474 ! include 'COMMON.TORSION'
12475 ! include 'COMMON.SBRIDGE'
12476 ! include 'COMMON.NAMES'
12477 ! include 'COMMON.IOUNITS'
12478 ! include 'COMMON.CONTACTS'
12479 real(kind=8),parameter :: accur=1.0d-10
12480 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12481 !el local variables
12482 integer :: i,iint,j,k,itypi,itypi1,itypj
12483 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12484 real(kind=8) :: e1,e2,evdwij,evdw
12485 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12487 do i=iatsc_s,iatsc_e
12489 if (itypi.eq.ntyp1) cycle
12490 itypi1=itype(i+1,1)
12495 ! Calculate SC interaction energy.
12497 do iint=1,nint_gr(i)
12498 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12499 !d & 'iend=',iend(i,iint)
12500 do j=istart(i,iint),iend(i,iint)
12502 if (itypj.eq.ntyp1) cycle
12506 rij=xj*xj+yj*yj+zj*zj
12507 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12508 if (sss.lt.1.0d0) then
12510 eps0ij=eps(itypi,itypj)
12512 e1=fac*fac*aa_aq(itypi,itypj)
12513 e2=fac*bb_aq(itypi,itypj)
12515 evdw=evdw+(1.0d0-sss)*evdwij
12517 ! Calculate the components of the gradient in DC and X
12519 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
12524 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12525 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12526 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12527 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12535 gvdwc(j,i)=expon*gvdwc(j,i)
12536 gvdwx(j,i)=expon*gvdwx(j,i)
12539 !******************************************************************************
12543 ! To save time, the factor of EXPON has been extracted from ALL components
12544 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12547 !******************************************************************************
12549 end subroutine elj_long
12550 !-----------------------------------------------------------------------------
12551 subroutine elj_short(evdw)
12553 ! This subroutine calculates the interaction energy of nonbonded side chains
12554 ! assuming the LJ potential of interaction.
12556 ! implicit real*8 (a-h,o-z)
12557 ! include 'DIMENSIONS'
12558 ! include 'COMMON.GEO'
12559 ! include 'COMMON.VAR'
12560 ! include 'COMMON.LOCAL'
12561 ! include 'COMMON.CHAIN'
12562 ! include 'COMMON.DERIV'
12563 ! include 'COMMON.INTERACT'
12564 ! include 'COMMON.TORSION'
12565 ! include 'COMMON.SBRIDGE'
12566 ! include 'COMMON.NAMES'
12567 ! include 'COMMON.IOUNITS'
12568 ! include 'COMMON.CONTACTS'
12569 real(kind=8),parameter :: accur=1.0d-10
12570 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12571 !el local variables
12572 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
12573 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12574 real(kind=8) :: e1,e2,evdwij,evdw
12575 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12577 do i=iatsc_s,iatsc_e
12579 if (itypi.eq.ntyp1) cycle
12580 itypi1=itype(i+1,1)
12587 ! Calculate SC interaction energy.
12589 do iint=1,nint_gr(i)
12590 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12591 !d & 'iend=',iend(i,iint)
12592 do j=istart(i,iint),iend(i,iint)
12594 if (itypj.eq.ntyp1) cycle
12598 ! Change 12/1/95 to calculate four-body interactions
12599 rij=xj*xj+yj*yj+zj*zj
12600 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12601 if (sss.gt.0.0d0) then
12603 eps0ij=eps(itypi,itypj)
12605 e1=fac*fac*aa_aq(itypi,itypj)
12606 e2=fac*bb_aq(itypi,itypj)
12608 evdw=evdw+sss*evdwij
12610 ! Calculate the components of the gradient in DC and X
12612 fac=-rrij*(e1+evdwij)*sss
12617 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12618 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12619 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12620 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12628 gvdwc(j,i)=expon*gvdwc(j,i)
12629 gvdwx(j,i)=expon*gvdwx(j,i)
12632 !******************************************************************************
12636 ! To save time, the factor of EXPON has been extracted from ALL components
12637 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12640 !******************************************************************************
12642 end subroutine elj_short
12643 !-----------------------------------------------------------------------------
12644 subroutine eljk_long(evdw)
12646 ! This subroutine calculates the interaction energy of nonbonded side chains
12647 ! assuming the LJK potential of interaction.
12649 ! implicit real*8 (a-h,o-z)
12650 ! include 'DIMENSIONS'
12651 ! include 'COMMON.GEO'
12652 ! include 'COMMON.VAR'
12653 ! include 'COMMON.LOCAL'
12654 ! include 'COMMON.CHAIN'
12655 ! include 'COMMON.DERIV'
12656 ! include 'COMMON.INTERACT'
12657 ! include 'COMMON.IOUNITS'
12658 ! include 'COMMON.NAMES'
12659 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12661 !el local variables
12662 integer :: i,iint,j,k,itypi,itypi1,itypj
12663 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12664 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12665 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12667 do i=iatsc_s,iatsc_e
12669 if (itypi.eq.ntyp1) cycle
12670 itypi1=itype(i+1,1)
12675 ! Calculate SC interaction energy.
12677 do iint=1,nint_gr(i)
12678 do j=istart(i,iint),iend(i,iint)
12680 if (itypj.eq.ntyp1) cycle
12684 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12685 fac_augm=rrij**expon
12686 e_augm=augm(itypi,itypj)*fac_augm
12687 r_inv_ij=dsqrt(rrij)
12689 sss=sscale(rij/sigma(itypi,itypj))
12690 if (sss.lt.1.0d0) then
12691 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12692 fac=r_shift_inv**expon
12693 e1=fac*fac*aa_aq(itypi,itypj)
12694 e2=fac*bb_aq(itypi,itypj)
12695 evdwij=e_augm+e1+e2
12696 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12697 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12698 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12699 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
12700 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12701 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12702 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12703 evdw=evdw+(1.0d0-sss)*evdwij
12705 ! Calculate the components of the gradient in DC and X
12707 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12708 fac=fac*(1.0d0-sss)
12713 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12714 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12715 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12716 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12724 gvdwc(j,i)=expon*gvdwc(j,i)
12725 gvdwx(j,i)=expon*gvdwx(j,i)
12729 end subroutine eljk_long
12730 !-----------------------------------------------------------------------------
12731 subroutine eljk_short(evdw)
12733 ! This subroutine calculates the interaction energy of nonbonded side chains
12734 ! assuming the LJK potential of interaction.
12736 ! implicit real*8 (a-h,o-z)
12737 ! include 'DIMENSIONS'
12738 ! include 'COMMON.GEO'
12739 ! include 'COMMON.VAR'
12740 ! include 'COMMON.LOCAL'
12741 ! include 'COMMON.CHAIN'
12742 ! include 'COMMON.DERIV'
12743 ! include 'COMMON.INTERACT'
12744 ! include 'COMMON.IOUNITS'
12745 ! include 'COMMON.NAMES'
12746 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12748 !el local variables
12749 integer :: i,iint,j,k,itypi,itypi1,itypj
12750 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12751 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12752 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12754 do i=iatsc_s,iatsc_e
12756 if (itypi.eq.ntyp1) cycle
12757 itypi1=itype(i+1,1)
12762 ! Calculate SC interaction energy.
12764 do iint=1,nint_gr(i)
12765 do j=istart(i,iint),iend(i,iint)
12767 if (itypj.eq.ntyp1) cycle
12771 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12772 fac_augm=rrij**expon
12773 e_augm=augm(itypi,itypj)*fac_augm
12774 r_inv_ij=dsqrt(rrij)
12776 sss=sscale(rij/sigma(itypi,itypj))
12777 if (sss.gt.0.0d0) then
12778 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12779 fac=r_shift_inv**expon
12780 e1=fac*fac*aa_aq(itypi,itypj)
12781 e2=fac*bb_aq(itypi,itypj)
12782 evdwij=e_augm+e1+e2
12783 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12784 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12785 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12786 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
12787 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12788 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12789 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12790 evdw=evdw+sss*evdwij
12792 ! Calculate the components of the gradient in DC and X
12794 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12800 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12801 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12802 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12803 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12811 gvdwc(j,i)=expon*gvdwc(j,i)
12812 gvdwx(j,i)=expon*gvdwx(j,i)
12816 end subroutine eljk_short
12817 !-----------------------------------------------------------------------------
12818 subroutine ebp_long(evdw)
12820 ! This subroutine calculates the interaction energy of nonbonded side chains
12821 ! assuming the Berne-Pechukas potential of interaction.
12824 ! implicit real*8 (a-h,o-z)
12825 ! include 'DIMENSIONS'
12826 ! include 'COMMON.GEO'
12827 ! include 'COMMON.VAR'
12828 ! include 'COMMON.LOCAL'
12829 ! include 'COMMON.CHAIN'
12830 ! include 'COMMON.DERIV'
12831 ! include 'COMMON.NAMES'
12832 ! include 'COMMON.INTERACT'
12833 ! include 'COMMON.IOUNITS'
12834 ! include 'COMMON.CALC'
12836 !el integer :: icall
12837 !el common /srutu/ icall
12838 ! double precision rrsave(maxdim)
12840 !el local variables
12841 integer :: iint,itypi,itypi1,itypj
12842 real(kind=8) :: rrij,xi,yi,zi,fac
12843 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
12845 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
12847 ! if (icall.eq.0) then
12853 do i=iatsc_s,iatsc_e
12855 if (itypi.eq.ntyp1) cycle
12856 itypi1=itype(i+1,1)
12860 dxi=dc_norm(1,nres+i)
12861 dyi=dc_norm(2,nres+i)
12862 dzi=dc_norm(3,nres+i)
12863 ! dsci_inv=dsc_inv(itypi)
12864 dsci_inv=vbld_inv(i+nres)
12866 ! Calculate SC interaction energy.
12868 do iint=1,nint_gr(i)
12869 do j=istart(i,iint),iend(i,iint)
12872 if (itypj.eq.ntyp1) cycle
12873 ! dscj_inv=dsc_inv(itypj)
12874 dscj_inv=vbld_inv(j+nres)
12875 chi1=chi(itypi,itypj)
12876 chi2=chi(itypj,itypi)
12883 alf12=0.5D0*(alf1+alf2)
12887 dxj=dc_norm(1,nres+j)
12888 dyj=dc_norm(2,nres+j)
12889 dzj=dc_norm(3,nres+j)
12890 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12892 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12894 if (sss.lt.1.0d0) then
12896 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
12898 ! Calculate whole angle-dependent part of epsilon and contributions
12899 ! to its derivatives
12900 fac=(rrij*sigsq)**expon2
12901 e1=fac*fac*aa_aq(itypi,itypj)
12902 e2=fac*bb_aq(itypi,itypj)
12903 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12904 eps2der=evdwij*eps3rt
12905 eps3der=evdwij*eps2rt
12906 evdwij=evdwij*eps2rt*eps3rt
12907 evdw=evdw+evdwij*(1.0d0-sss)
12909 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
12910 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
12911 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
12912 !d & restyp(itypi,1),i,restyp(itypj,1),j,
12913 !d & epsi,sigm,chi1,chi2,chip1,chip2,
12914 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
12915 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
12918 ! Calculate gradient components.
12919 e1=e1*eps1*eps2rt**2*eps3rt**2
12920 fac=-expon*(e1+evdwij)
12923 ! Calculate radial part of the gradient
12927 ! Calculate the angular part of the gradient and sum add the contributions
12928 ! to the appropriate components of the Cartesian gradient.
12929 call sc_grad_scale(1.0d0-sss)
12936 end subroutine ebp_long
12937 !-----------------------------------------------------------------------------
12938 subroutine ebp_short(evdw)
12940 ! This subroutine calculates the interaction energy of nonbonded side chains
12941 ! assuming the Berne-Pechukas potential of interaction.
12944 ! implicit real*8 (a-h,o-z)
12945 ! include 'DIMENSIONS'
12946 ! include 'COMMON.GEO'
12947 ! include 'COMMON.VAR'
12948 ! include 'COMMON.LOCAL'
12949 ! include 'COMMON.CHAIN'
12950 ! include 'COMMON.DERIV'
12951 ! include 'COMMON.NAMES'
12952 ! include 'COMMON.INTERACT'
12953 ! include 'COMMON.IOUNITS'
12954 ! include 'COMMON.CALC'
12956 !el integer :: icall
12957 !el common /srutu/ icall
12958 ! double precision rrsave(maxdim)
12960 !el local variables
12961 integer :: iint,itypi,itypi1,itypj
12962 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
12963 real(kind=8) :: sss,e1,e2,evdw
12965 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
12967 ! if (icall.eq.0) then
12973 do i=iatsc_s,iatsc_e
12975 if (itypi.eq.ntyp1) cycle
12976 itypi1=itype(i+1,1)
12980 dxi=dc_norm(1,nres+i)
12981 dyi=dc_norm(2,nres+i)
12982 dzi=dc_norm(3,nres+i)
12983 ! dsci_inv=dsc_inv(itypi)
12984 dsci_inv=vbld_inv(i+nres)
12986 ! Calculate SC interaction energy.
12988 do iint=1,nint_gr(i)
12989 do j=istart(i,iint),iend(i,iint)
12992 if (itypj.eq.ntyp1) cycle
12993 ! dscj_inv=dsc_inv(itypj)
12994 dscj_inv=vbld_inv(j+nres)
12995 chi1=chi(itypi,itypj)
12996 chi2=chi(itypj,itypi)
13003 alf12=0.5D0*(alf1+alf2)
13007 dxj=dc_norm(1,nres+j)
13008 dyj=dc_norm(2,nres+j)
13009 dzj=dc_norm(3,nres+j)
13010 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13012 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13014 if (sss.gt.0.0d0) then
13016 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
13018 ! Calculate whole angle-dependent part of epsilon and contributions
13019 ! to its derivatives
13020 fac=(rrij*sigsq)**expon2
13021 e1=fac*fac*aa_aq(itypi,itypj)
13022 e2=fac*bb_aq(itypi,itypj)
13023 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13024 eps2der=evdwij*eps3rt
13025 eps3der=evdwij*eps2rt
13026 evdwij=evdwij*eps2rt*eps3rt
13027 evdw=evdw+evdwij*sss
13029 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13030 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13031 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
13032 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13033 !d & epsi,sigm,chi1,chi2,chip1,chip2,
13034 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
13035 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
13038 ! Calculate gradient components.
13039 e1=e1*eps1*eps2rt**2*eps3rt**2
13040 fac=-expon*(e1+evdwij)
13043 ! Calculate radial part of the gradient
13047 ! Calculate the angular part of the gradient and sum add the contributions
13048 ! to the appropriate components of the Cartesian gradient.
13049 call sc_grad_scale(sss)
13056 end subroutine ebp_short
13057 !-----------------------------------------------------------------------------
13058 subroutine egb_long(evdw)
13060 ! This subroutine calculates the interaction energy of nonbonded side chains
13061 ! assuming the Gay-Berne potential of interaction.
13064 ! implicit real*8 (a-h,o-z)
13065 ! include 'DIMENSIONS'
13066 ! include 'COMMON.GEO'
13067 ! include 'COMMON.VAR'
13068 ! include 'COMMON.LOCAL'
13069 ! include 'COMMON.CHAIN'
13070 ! include 'COMMON.DERIV'
13071 ! include 'COMMON.NAMES'
13072 ! include 'COMMON.INTERACT'
13073 ! include 'COMMON.IOUNITS'
13074 ! include 'COMMON.CALC'
13075 ! include 'COMMON.CONTROL'
13077 !el local variables
13078 integer :: iint,itypi,itypi1,itypj,subchap
13079 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
13080 real(kind=8) :: sss,e1,e2,evdw,sss_grad
13081 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13082 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13083 ssgradlipi,ssgradlipj
13087 !cccc energy_dec=.false.
13088 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13091 ! if (icall.eq.0) lprn=.false.
13093 do i=iatsc_s,iatsc_e
13095 if (itypi.eq.ntyp1) cycle
13096 itypi1=itype(i+1,1)
13100 xi=mod(xi,boxxsize)
13101 if (xi.lt.0) xi=xi+boxxsize
13102 yi=mod(yi,boxysize)
13103 if (yi.lt.0) yi=yi+boxysize
13104 zi=mod(zi,boxzsize)
13105 if (zi.lt.0) zi=zi+boxzsize
13106 if ((zi.gt.bordlipbot) &
13107 .and.(zi.lt.bordliptop)) then
13108 !C the energy transfer exist
13109 if (zi.lt.buflipbot) then
13110 !C what fraction I am in
13112 ((zi-bordlipbot)/lipbufthick)
13113 !C lipbufthick is thickenes of lipid buffore
13114 sslipi=sscalelip(fracinbuf)
13115 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
13116 elseif (zi.gt.bufliptop) then
13117 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
13118 sslipi=sscalelip(fracinbuf)
13119 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
13129 dxi=dc_norm(1,nres+i)
13130 dyi=dc_norm(2,nres+i)
13131 dzi=dc_norm(3,nres+i)
13132 ! dsci_inv=dsc_inv(itypi)
13133 dsci_inv=vbld_inv(i+nres)
13134 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
13135 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
13137 ! Calculate SC interaction energy.
13139 do iint=1,nint_gr(i)
13140 do j=istart(i,iint),iend(i,iint)
13141 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
13142 ! call dyn_ssbond_ene(i,j,evdwij)
13144 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13145 ! 'evdw',i,j,evdwij,' ss'
13146 ! if (energy_dec) write (iout,*) &
13147 ! 'evdw',i,j,evdwij,' ss'
13148 ! do k=j+1,iend(i,iint)
13149 !C search over all next residues
13150 ! if (dyn_ss_mask(k)) then
13151 !C check if they are cysteins
13152 !C write(iout,*) 'k=',k
13154 !c write(iout,*) "PRZED TRI", evdwij
13155 ! evdwij_przed_tri=evdwij
13156 ! call triple_ssbond_ene(i,j,k,evdwij)
13157 !c if(evdwij_przed_tri.ne.evdwij) then
13158 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
13161 !c write(iout,*) "PO TRI", evdwij
13162 !C call the energy function that removes the artifical triple disulfide
13163 !C bond the soubroutine is located in ssMD.F
13165 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13166 'evdw',i,j,evdwij,'tss'
13167 ! endif!dyn_ss_mask(k)
13173 if (itypj.eq.ntyp1) cycle
13174 ! dscj_inv=dsc_inv(itypj)
13175 dscj_inv=vbld_inv(j+nres)
13176 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
13177 ! & 1.0d0/vbld(j+nres)
13178 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
13179 sig0ij=sigma(itypi,itypj)
13180 chi1=chi(itypi,itypj)
13181 chi2=chi(itypj,itypi)
13188 alf12=0.5D0*(alf1+alf2)
13192 ! Searching for nearest neighbour
13193 xj=mod(xj,boxxsize)
13194 if (xj.lt.0) xj=xj+boxxsize
13195 yj=mod(yj,boxysize)
13196 if (yj.lt.0) yj=yj+boxysize
13197 zj=mod(zj,boxzsize)
13198 if (zj.lt.0) zj=zj+boxzsize
13199 if ((zj.gt.bordlipbot) &
13200 .and.(zj.lt.bordliptop)) then
13201 !C the energy transfer exist
13202 if (zj.lt.buflipbot) then
13203 !C what fraction I am in
13205 ((zj-bordlipbot)/lipbufthick)
13206 !C lipbufthick is thickenes of lipid buffore
13207 sslipj=sscalelip(fracinbuf)
13208 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
13209 elseif (zj.gt.bufliptop) then
13210 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
13211 sslipj=sscalelip(fracinbuf)
13212 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13221 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13222 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13223 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13224 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13226 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13234 xj=xj_safe+xshift*boxxsize
13235 yj=yj_safe+yshift*boxysize
13236 zj=zj_safe+zshift*boxzsize
13237 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13238 if(dist_temp.lt.dist_init) then
13239 dist_init=dist_temp
13248 if (subchap.eq.1) then
13258 dxj=dc_norm(1,nres+j)
13259 dyj=dc_norm(2,nres+j)
13260 dzj=dc_norm(3,nres+j)
13261 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13263 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13264 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
13265 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
13266 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13267 if (sss_ele_cut.le.0.0) cycle
13268 if (sss.lt.1.0d0) then
13270 ! Calculate angle-dependent terms of energy and contributions to their
13274 sig=sig0ij*dsqrt(sigsq)
13275 rij_shift=1.0D0/rij-sig+sig0ij
13276 ! for diagnostics; uncomment
13277 ! rij_shift=1.2*sig0ij
13278 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13279 if (rij_shift.le.0.0D0) then
13281 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13282 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13283 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13287 !---------------------------------------------------------------
13288 rij_shift=1.0D0/rij_shift
13289 fac=rij_shift**expon
13292 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13293 eps2der=evdwij*eps3rt
13294 eps3der=evdwij*eps2rt
13295 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13296 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13297 evdwij=evdwij*eps2rt*eps3rt
13298 evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
13300 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13301 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13302 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13303 restyp(itypi,1),i,restyp(itypj,1),j,&
13304 epsi,sigm,chi1,chi2,chip1,chip2,&
13305 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13306 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13310 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13312 ! if (energy_dec) write (iout,*) &
13313 ! 'evdw',i,j,evdwij,"egb_long"
13315 ! Calculate gradient components.
13316 e1=e1*eps1*eps2rt**2*eps3rt**2
13317 fac=-expon*(e1+evdwij)*rij_shift
13320 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13321 /sigma(itypi,itypj)*rij-sss_grad/(1.0-sss)*rij &
13322 /sigmaii(itypi,itypj))
13324 ! Calculate the radial part of the gradient
13328 ! Calculate angular part of the gradient.
13329 call sc_grad_scale(1.0d0-sss)
13335 ! write (iout,*) "Number of loop steps in EGB:",ind
13336 !ccc energy_dec=.false.
13338 end subroutine egb_long
13339 !-----------------------------------------------------------------------------
13340 subroutine egb_short(evdw)
13342 ! This subroutine calculates the interaction energy of nonbonded side chains
13343 ! assuming the Gay-Berne potential of interaction.
13346 ! implicit real*8 (a-h,o-z)
13347 ! include 'DIMENSIONS'
13348 ! include 'COMMON.GEO'
13349 ! include 'COMMON.VAR'
13350 ! include 'COMMON.LOCAL'
13351 ! include 'COMMON.CHAIN'
13352 ! include 'COMMON.DERIV'
13353 ! include 'COMMON.NAMES'
13354 ! include 'COMMON.INTERACT'
13355 ! include 'COMMON.IOUNITS'
13356 ! include 'COMMON.CALC'
13357 ! include 'COMMON.CONTROL'
13359 !el local variables
13360 integer :: iint,itypi,itypi1,itypj,subchap
13361 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
13362 real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad
13363 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13364 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13365 ssgradlipi,ssgradlipj
13367 !cccc energy_dec=.false.
13368 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13371 ! if (icall.eq.0) lprn=.false.
13373 do i=iatsc_s,iatsc_e
13375 if (itypi.eq.ntyp1) cycle
13376 itypi1=itype(i+1,1)
13380 xi=mod(xi,boxxsize)
13381 if (xi.lt.0) xi=xi+boxxsize
13382 yi=mod(yi,boxysize)
13383 if (yi.lt.0) yi=yi+boxysize
13384 zi=mod(zi,boxzsize)
13385 if (zi.lt.0) zi=zi+boxzsize
13386 if ((zi.gt.bordlipbot) &
13387 .and.(zi.lt.bordliptop)) then
13388 !C the energy transfer exist
13389 if (zi.lt.buflipbot) then
13390 !C what fraction I am in
13392 ((zi-bordlipbot)/lipbufthick)
13393 !C lipbufthick is thickenes of lipid buffore
13394 sslipi=sscalelip(fracinbuf)
13395 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
13396 elseif (zi.gt.bufliptop) then
13397 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
13398 sslipi=sscalelip(fracinbuf)
13399 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
13409 dxi=dc_norm(1,nres+i)
13410 dyi=dc_norm(2,nres+i)
13411 dzi=dc_norm(3,nres+i)
13412 ! dsci_inv=dsc_inv(itypi)
13413 dsci_inv=vbld_inv(i+nres)
13415 dxi=dc_norm(1,nres+i)
13416 dyi=dc_norm(2,nres+i)
13417 dzi=dc_norm(3,nres+i)
13418 ! dsci_inv=dsc_inv(itypi)
13419 dsci_inv=vbld_inv(i+nres)
13420 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
13421 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
13423 ! Calculate SC interaction energy.
13425 do iint=1,nint_gr(i)
13426 do j=istart(i,iint),iend(i,iint)
13427 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
13428 call dyn_ssbond_ene(i,j,evdwij)
13430 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13431 'evdw',i,j,evdwij,' ss'
13432 do k=j+1,iend(i,iint)
13433 !C search over all next residues
13434 if (dyn_ss_mask(k)) then
13435 !C check if they are cysteins
13436 !C write(iout,*) 'k=',k
13438 !c write(iout,*) "PRZED TRI", evdwij
13439 ! evdwij_przed_tri=evdwij
13440 call triple_ssbond_ene(i,j,k,evdwij)
13441 !c if(evdwij_przed_tri.ne.evdwij) then
13442 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
13445 !c write(iout,*) "PO TRI", evdwij
13446 !C call the energy function that removes the artifical triple disulfide
13447 !C bond the soubroutine is located in ssMD.F
13449 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13450 'evdw',i,j,evdwij,'tss'
13451 endif!dyn_ss_mask(k)
13454 ! if (energy_dec) write (iout,*) &
13455 ! 'evdw',i,j,evdwij,' ss'
13459 if (itypj.eq.ntyp1) cycle
13460 ! dscj_inv=dsc_inv(itypj)
13461 dscj_inv=vbld_inv(j+nres)
13462 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
13463 ! & 1.0d0/vbld(j+nres)
13464 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
13465 sig0ij=sigma(itypi,itypj)
13466 chi1=chi(itypi,itypj)
13467 chi2=chi(itypj,itypi)
13474 alf12=0.5D0*(alf1+alf2)
13475 ! xj=c(1,nres+j)-xi
13476 ! yj=c(2,nres+j)-yi
13477 ! zj=c(3,nres+j)-zi
13481 ! Searching for nearest neighbour
13482 xj=mod(xj,boxxsize)
13483 if (xj.lt.0) xj=xj+boxxsize
13484 yj=mod(yj,boxysize)
13485 if (yj.lt.0) yj=yj+boxysize
13486 zj=mod(zj,boxzsize)
13487 if (zj.lt.0) zj=zj+boxzsize
13488 if ((zj.gt.bordlipbot) &
13489 .and.(zj.lt.bordliptop)) then
13490 !C the energy transfer exist
13491 if (zj.lt.buflipbot) then
13492 !C what fraction I am in
13494 ((zj-bordlipbot)/lipbufthick)
13495 !C lipbufthick is thickenes of lipid buffore
13496 sslipj=sscalelip(fracinbuf)
13497 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
13498 elseif (zj.gt.bufliptop) then
13499 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
13500 sslipj=sscalelip(fracinbuf)
13501 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13510 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13511 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13512 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13513 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13515 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13524 xj=xj_safe+xshift*boxxsize
13525 yj=yj_safe+yshift*boxysize
13526 zj=zj_safe+zshift*boxzsize
13527 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13528 if(dist_temp.lt.dist_init) then
13529 dist_init=dist_temp
13538 if (subchap.eq.1) then
13548 dxj=dc_norm(1,nres+j)
13549 dyj=dc_norm(2,nres+j)
13550 dzj=dc_norm(3,nres+j)
13551 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13553 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13554 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13555 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
13556 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
13557 if (sss_ele_cut.le.0.0) cycle
13559 if (sss.gt.0.0d0) then
13561 ! Calculate angle-dependent terms of energy and contributions to their
13565 sig=sig0ij*dsqrt(sigsq)
13566 rij_shift=1.0D0/rij-sig+sig0ij
13567 ! for diagnostics; uncomment
13568 ! rij_shift=1.2*sig0ij
13569 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13570 if (rij_shift.le.0.0D0) then
13572 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13573 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13574 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13578 !---------------------------------------------------------------
13579 rij_shift=1.0D0/rij_shift
13580 fac=rij_shift**expon
13583 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13584 eps2der=evdwij*eps3rt
13585 eps3der=evdwij*eps2rt
13586 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13587 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13588 evdwij=evdwij*eps2rt*eps3rt
13589 evdw=evdw+evdwij*sss*sss_ele_cut
13591 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13592 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13593 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13594 restyp(itypi,1),i,restyp(itypj,1),j,&
13595 epsi,sigm,chi1,chi2,chip1,chip2,&
13596 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13597 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13601 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13603 ! if (energy_dec) write (iout,*) &
13604 ! 'evdw',i,j,evdwij,"egb_short"
13606 ! Calculate gradient components.
13607 e1=e1*eps1*eps2rt**2*eps3rt**2
13608 fac=-expon*(e1+evdwij)*rij_shift
13611 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13612 /sigma(itypi,itypj)*rij+sss_grad/sss*rij &
13613 /sigmaii(itypi,itypj))
13616 ! Calculate the radial part of the gradient
13620 ! Calculate angular part of the gradient.
13621 call sc_grad_scale(sss)
13627 ! write (iout,*) "Number of loop steps in EGB:",ind
13628 !ccc energy_dec=.false.
13630 end subroutine egb_short
13631 !-----------------------------------------------------------------------------
13632 subroutine egbv_long(evdw)
13634 ! This subroutine calculates the interaction energy of nonbonded side chains
13635 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13638 ! implicit real*8 (a-h,o-z)
13639 ! include 'DIMENSIONS'
13640 ! include 'COMMON.GEO'
13641 ! include 'COMMON.VAR'
13642 ! include 'COMMON.LOCAL'
13643 ! include 'COMMON.CHAIN'
13644 ! include 'COMMON.DERIV'
13645 ! include 'COMMON.NAMES'
13646 ! include 'COMMON.INTERACT'
13647 ! include 'COMMON.IOUNITS'
13648 ! include 'COMMON.CALC'
13650 !el integer :: icall
13651 !el common /srutu/ icall
13653 !el local variables
13654 integer :: iint,itypi,itypi1,itypj
13655 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
13656 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
13658 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13661 ! if (icall.eq.0) lprn=.true.
13663 do i=iatsc_s,iatsc_e
13665 if (itypi.eq.ntyp1) cycle
13666 itypi1=itype(i+1,1)
13670 dxi=dc_norm(1,nres+i)
13671 dyi=dc_norm(2,nres+i)
13672 dzi=dc_norm(3,nres+i)
13673 ! dsci_inv=dsc_inv(itypi)
13674 dsci_inv=vbld_inv(i+nres)
13676 ! Calculate SC interaction energy.
13678 do iint=1,nint_gr(i)
13679 do j=istart(i,iint),iend(i,iint)
13682 if (itypj.eq.ntyp1) cycle
13683 ! dscj_inv=dsc_inv(itypj)
13684 dscj_inv=vbld_inv(j+nres)
13685 sig0ij=sigma(itypi,itypj)
13686 r0ij=r0(itypi,itypj)
13687 chi1=chi(itypi,itypj)
13688 chi2=chi(itypj,itypi)
13695 alf12=0.5D0*(alf1+alf2)
13699 dxj=dc_norm(1,nres+j)
13700 dyj=dc_norm(2,nres+j)
13701 dzj=dc_norm(3,nres+j)
13702 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13705 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13707 if (sss.lt.1.0d0) then
13709 ! Calculate angle-dependent terms of energy and contributions to their
13713 sig=sig0ij*dsqrt(sigsq)
13714 rij_shift=1.0D0/rij-sig+r0ij
13715 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13716 if (rij_shift.le.0.0D0) then
13721 !---------------------------------------------------------------
13722 rij_shift=1.0D0/rij_shift
13723 fac=rij_shift**expon
13724 e1=fac*fac*aa_aq(itypi,itypj)
13725 e2=fac*bb_aq(itypi,itypj)
13726 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13727 eps2der=evdwij*eps3rt
13728 eps3der=evdwij*eps2rt
13729 fac_augm=rrij**expon
13730 e_augm=augm(itypi,itypj)*fac_augm
13731 evdwij=evdwij*eps2rt*eps3rt
13732 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
13734 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13735 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13736 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13737 restyp(itypi,1),i,restyp(itypj,1),j,&
13738 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13739 chi1,chi2,chip1,chip2,&
13740 eps1,eps2rt**2,eps3rt**2,&
13741 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13744 ! Calculate gradient components.
13745 e1=e1*eps1*eps2rt**2*eps3rt**2
13746 fac=-expon*(e1+evdwij)*rij_shift
13748 fac=rij*fac-2*expon*rrij*e_augm
13749 ! Calculate the radial part of the gradient
13753 ! Calculate angular part of the gradient.
13754 call sc_grad_scale(1.0d0-sss)
13759 end subroutine egbv_long
13760 !-----------------------------------------------------------------------------
13761 subroutine egbv_short(evdw)
13763 ! This subroutine calculates the interaction energy of nonbonded side chains
13764 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13767 ! implicit real*8 (a-h,o-z)
13768 ! include 'DIMENSIONS'
13769 ! include 'COMMON.GEO'
13770 ! include 'COMMON.VAR'
13771 ! include 'COMMON.LOCAL'
13772 ! include 'COMMON.CHAIN'
13773 ! include 'COMMON.DERIV'
13774 ! include 'COMMON.NAMES'
13775 ! include 'COMMON.INTERACT'
13776 ! include 'COMMON.IOUNITS'
13777 ! include 'COMMON.CALC'
13779 !el integer :: icall
13780 !el common /srutu/ icall
13782 !el local variables
13783 integer :: iint,itypi,itypi1,itypj
13784 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
13785 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
13787 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13790 ! if (icall.eq.0) lprn=.true.
13792 do i=iatsc_s,iatsc_e
13794 if (itypi.eq.ntyp1) cycle
13795 itypi1=itype(i+1,1)
13799 dxi=dc_norm(1,nres+i)
13800 dyi=dc_norm(2,nres+i)
13801 dzi=dc_norm(3,nres+i)
13802 ! dsci_inv=dsc_inv(itypi)
13803 dsci_inv=vbld_inv(i+nres)
13805 ! Calculate SC interaction energy.
13807 do iint=1,nint_gr(i)
13808 do j=istart(i,iint),iend(i,iint)
13811 if (itypj.eq.ntyp1) cycle
13812 ! dscj_inv=dsc_inv(itypj)
13813 dscj_inv=vbld_inv(j+nres)
13814 sig0ij=sigma(itypi,itypj)
13815 r0ij=r0(itypi,itypj)
13816 chi1=chi(itypi,itypj)
13817 chi2=chi(itypj,itypi)
13824 alf12=0.5D0*(alf1+alf2)
13828 dxj=dc_norm(1,nres+j)
13829 dyj=dc_norm(2,nres+j)
13830 dzj=dc_norm(3,nres+j)
13831 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13834 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13836 if (sss.gt.0.0d0) then
13838 ! Calculate angle-dependent terms of energy and contributions to their
13842 sig=sig0ij*dsqrt(sigsq)
13843 rij_shift=1.0D0/rij-sig+r0ij
13844 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13845 if (rij_shift.le.0.0D0) then
13850 !---------------------------------------------------------------
13851 rij_shift=1.0D0/rij_shift
13852 fac=rij_shift**expon
13853 e1=fac*fac*aa_aq(itypi,itypj)
13854 e2=fac*bb_aq(itypi,itypj)
13855 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13856 eps2der=evdwij*eps3rt
13857 eps3der=evdwij*eps2rt
13858 fac_augm=rrij**expon
13859 e_augm=augm(itypi,itypj)*fac_augm
13860 evdwij=evdwij*eps2rt*eps3rt
13861 evdw=evdw+(evdwij+e_augm)*sss
13863 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13864 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13865 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13866 restyp(itypi,1),i,restyp(itypj,1),j,&
13867 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13868 chi1,chi2,chip1,chip2,&
13869 eps1,eps2rt**2,eps3rt**2,&
13870 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13873 ! Calculate gradient components.
13874 e1=e1*eps1*eps2rt**2*eps3rt**2
13875 fac=-expon*(e1+evdwij)*rij_shift
13877 fac=rij*fac-2*expon*rrij*e_augm
13878 ! Calculate the radial part of the gradient
13882 ! Calculate angular part of the gradient.
13883 call sc_grad_scale(sss)
13888 end subroutine egbv_short
13889 !-----------------------------------------------------------------------------
13890 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
13892 ! This subroutine calculates the average interaction energy and its gradient
13893 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
13894 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
13895 ! The potential depends both on the distance of peptide-group centers and on
13896 ! the orientation of the CA-CA virtual bonds.
13898 ! implicit real*8 (a-h,o-z)
13904 ! include 'DIMENSIONS'
13905 ! include 'COMMON.CONTROL'
13906 ! include 'COMMON.SETUP'
13907 ! include 'COMMON.IOUNITS'
13908 ! include 'COMMON.GEO'
13909 ! include 'COMMON.VAR'
13910 ! include 'COMMON.LOCAL'
13911 ! include 'COMMON.CHAIN'
13912 ! include 'COMMON.DERIV'
13913 ! include 'COMMON.INTERACT'
13914 ! include 'COMMON.CONTACTS'
13915 ! include 'COMMON.TORSION'
13916 ! include 'COMMON.VECTORS'
13917 ! include 'COMMON.FFIELD'
13918 ! include 'COMMON.TIME1'
13919 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
13920 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
13921 real(kind=8),dimension(2,2) :: acipa !el,a_temp
13922 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
13923 real(kind=8),dimension(4) :: muij
13924 !el integer :: num_conti,j1,j2
13925 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
13926 !el dz_normi,xmedi,ymedi,zmedi
13927 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
13928 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
13929 !el num_conti,j1,j2
13930 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
13932 real(kind=8) :: scal_el=1.0d0
13934 real(kind=8) :: scal_el=0.5d0
13937 ! 13-go grudnia roku pamietnego...
13938 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
13939 0.0d0,1.0d0,0.0d0,&
13940 0.0d0,0.0d0,1.0d0/),shape(unmat))
13941 !el local variables
13943 real(kind=8) :: fac
13944 real(kind=8) :: dxj,dyj,dzj
13945 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
13947 ! allocate(num_cont_hb(nres)) !(maxres)
13948 !d write(iout,*) 'In EELEC'
13950 !d write(iout,*) 'Type',i
13951 !d write(iout,*) 'B1',B1(:,i)
13952 !d write(iout,*) 'B2',B2(:,i)
13953 !d write(iout,*) 'CC',CC(:,:,i)
13954 !d write(iout,*) 'DD',DD(:,:,i)
13955 !d write(iout,*) 'EE',EE(:,:,i)
13957 !d call check_vecgrad
13959 if (icheckgrad.eq.1) then
13961 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
13963 dc_norm(k,i)=dc(k,i)*fac
13965 ! write (iout,*) 'i',i,' fac',fac
13968 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
13969 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
13970 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
13971 ! call vec_and_deriv
13975 ! print *, "before set matrices"
13977 ! print *,"after set martices"
13979 time_mat=time_mat+MPI_Wtime()-time01
13983 !d write (iout,*) 'i=',i
13985 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
13988 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
13989 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
14002 !d print '(a)','Enter EELEC'
14003 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
14004 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
14005 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
14007 gel_loc_loc(i)=0.0d0
14012 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
14014 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
14016 do i=iturn3_start,iturn3_end
14017 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1 &
14018 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
14022 dx_normi=dc_norm(1,i)
14023 dy_normi=dc_norm(2,i)
14024 dz_normi=dc_norm(3,i)
14025 xmedi=c(1,i)+0.5d0*dxi
14026 ymedi=c(2,i)+0.5d0*dyi
14027 zmedi=c(3,i)+0.5d0*dzi
14028 xmedi=dmod(xmedi,boxxsize)
14029 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14030 ymedi=dmod(ymedi,boxysize)
14031 if (ymedi.lt.0) ymedi=ymedi+boxysize
14032 zmedi=dmod(zmedi,boxzsize)
14033 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14035 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
14036 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
14037 num_cont_hb(i)=num_conti
14039 do i=iturn4_start,iturn4_end
14040 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
14041 .or. itype(i+3,1).eq.ntyp1 &
14042 .or. itype(i+4,1).eq.ntyp1) cycle
14046 dx_normi=dc_norm(1,i)
14047 dy_normi=dc_norm(2,i)
14048 dz_normi=dc_norm(3,i)
14049 xmedi=c(1,i)+0.5d0*dxi
14050 ymedi=c(2,i)+0.5d0*dyi
14051 zmedi=c(3,i)+0.5d0*dzi
14052 xmedi=dmod(xmedi,boxxsize)
14053 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14054 ymedi=dmod(ymedi,boxysize)
14055 if (ymedi.lt.0) ymedi=ymedi+boxysize
14056 zmedi=dmod(zmedi,boxzsize)
14057 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14058 num_conti=num_cont_hb(i)
14059 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
14060 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
14061 call eturn4(i,eello_turn4)
14062 num_cont_hb(i)=num_conti
14065 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
14067 do i=iatel_s,iatel_e
14068 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
14072 dx_normi=dc_norm(1,i)
14073 dy_normi=dc_norm(2,i)
14074 dz_normi=dc_norm(3,i)
14075 xmedi=c(1,i)+0.5d0*dxi
14076 ymedi=c(2,i)+0.5d0*dyi
14077 zmedi=c(3,i)+0.5d0*dzi
14078 xmedi=dmod(xmedi,boxxsize)
14079 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14080 ymedi=dmod(ymedi,boxysize)
14081 if (ymedi.lt.0) ymedi=ymedi+boxysize
14082 zmedi=dmod(zmedi,boxzsize)
14083 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14084 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
14085 num_conti=num_cont_hb(i)
14086 do j=ielstart(i),ielend(i)
14087 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
14088 call eelecij_scale(i,j,ees,evdw1,eel_loc)
14090 num_cont_hb(i)=num_conti
14092 ! write (iout,*) "Number of loop steps in EELEC:",ind
14094 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
14095 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
14097 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
14098 !cc eel_loc=eel_loc+eello_turn3
14099 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
14101 end subroutine eelec_scale
14102 !-----------------------------------------------------------------------------
14103 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
14104 ! implicit real*8 (a-h,o-z)
14107 ! include 'DIMENSIONS'
14111 ! include 'COMMON.CONTROL'
14112 ! include 'COMMON.IOUNITS'
14113 ! include 'COMMON.GEO'
14114 ! include 'COMMON.VAR'
14115 ! include 'COMMON.LOCAL'
14116 ! include 'COMMON.CHAIN'
14117 ! include 'COMMON.DERIV'
14118 ! include 'COMMON.INTERACT'
14119 ! include 'COMMON.CONTACTS'
14120 ! include 'COMMON.TORSION'
14121 ! include 'COMMON.VECTORS'
14122 ! include 'COMMON.FFIELD'
14123 ! include 'COMMON.TIME1'
14124 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
14125 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
14126 real(kind=8),dimension(2,2) :: acipa !el,a_temp
14127 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
14128 real(kind=8),dimension(4) :: muij
14129 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14130 dist_temp, dist_init,sss_grad
14131 integer xshift,yshift,zshift
14133 !el integer :: num_conti,j1,j2
14134 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
14135 !el dz_normi,xmedi,ymedi,zmedi
14136 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
14137 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14138 !el num_conti,j1,j2
14139 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14141 real(kind=8) :: scal_el=1.0d0
14143 real(kind=8) :: scal_el=0.5d0
14146 ! 13-go grudnia roku pamietnego...
14147 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
14148 0.0d0,1.0d0,0.0d0,&
14149 0.0d0,0.0d0,1.0d0/),shape(unmat))
14150 !el local variables
14151 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m,isubchap
14152 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
14153 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
14154 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
14155 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
14156 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
14157 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
14158 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
14159 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
14160 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
14161 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
14162 ecosam,ecosbm,ecosgm,ghalf,time00
14163 ! integer :: maxconts
14164 ! maxconts = nres/4
14165 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14166 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14167 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14168 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14169 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14170 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14171 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14172 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14173 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
14174 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
14175 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
14176 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
14177 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
14179 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
14180 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
14185 !d write (iout,*) "eelecij",i,j
14189 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
14190 aaa=app(iteli,itelj)
14191 bbb=bpp(iteli,itelj)
14192 ael6i=ael6(iteli,itelj)
14193 ael3i=ael3(iteli,itelj)
14197 dx_normj=dc_norm(1,j)
14198 dy_normj=dc_norm(2,j)
14199 dz_normj=dc_norm(3,j)
14200 ! xj=c(1,j)+0.5D0*dxj-xmedi
14201 ! yj=c(2,j)+0.5D0*dyj-ymedi
14202 ! zj=c(3,j)+0.5D0*dzj-zmedi
14203 xj=c(1,j)+0.5D0*dxj
14204 yj=c(2,j)+0.5D0*dyj
14205 zj=c(3,j)+0.5D0*dzj
14206 xj=mod(xj,boxxsize)
14207 if (xj.lt.0) xj=xj+boxxsize
14208 yj=mod(yj,boxysize)
14209 if (yj.lt.0) yj=yj+boxysize
14210 zj=mod(zj,boxzsize)
14211 if (zj.lt.0) zj=zj+boxzsize
14213 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14220 xj=xj_safe+xshift*boxxsize
14221 yj=yj_safe+yshift*boxysize
14222 zj=zj_safe+zshift*boxzsize
14223 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14224 if(dist_temp.lt.dist_init) then
14225 dist_init=dist_temp
14234 if (isubchap.eq.1) then
14245 rij=xj*xj+yj*yj+zj*zj
14249 ! For extracting the short-range part of Evdwpp
14250 sss=sscale(rij/rpp(iteli,itelj))
14251 sss_ele_cut=sscale_ele(rij)
14252 sss_ele_grad=sscagrad_ele(rij)
14253 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
14254 ! sss_ele_cut=1.0d0
14255 ! sss_ele_grad=0.0d0
14256 if (sss_ele_cut.le.0.0) go to 128
14260 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
14261 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
14262 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
14263 fac=cosa-3.0D0*cosb*cosg
14265 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
14266 if (j.eq.i+2) ev1=scal_el*ev1
14271 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
14274 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
14275 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
14276 ees=ees+eesij*sss_ele_cut
14277 evdw1=evdw1+evdwij*(1.0d0-sss)*sss_ele_cut
14278 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
14279 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
14280 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
14281 !d & xmedi,ymedi,zmedi,xj,yj,zj
14283 if (energy_dec) then
14284 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
14285 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
14289 ! Calculate contributions to the Cartesian gradient.
14292 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
14293 facel=-3*rrmij*(el1+eesij)*sss_ele_cut
14299 ! Radial derivatives. First process both termini of the fragment (i,j)
14301 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj
14302 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj
14303 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj
14305 ! ghalf=0.5D0*ggg(k)
14306 ! gelc(k,i)=gelc(k,i)+ghalf
14307 ! gelc(k,j)=gelc(k,j)+ghalf
14309 ! 9/28/08 AL Gradient compotents will be summed only at the end
14311 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14312 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14315 ! Loop over residues i+1 thru j-1.
14319 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14322 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*(1.0d0-sss) &
14323 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
14324 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*(1.0d0-sss) &
14325 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
14326 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*(1.0d0-sss) &
14327 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
14329 ! ghalf=0.5D0*ggg(k)
14330 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
14331 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
14333 ! 9/28/08 AL Gradient compotents will be summed only at the end
14335 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14336 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14339 ! Loop over residues i+1 thru j-1.
14343 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
14347 facvdw=(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
14348 facel=(el1+eesij)*sss_ele_cut
14350 fac=-3*rrmij*(facvdw+facvdw+facel)
14355 ! Radial derivatives. First process both termini of the fragment (i,j)
14361 ! ghalf=0.5D0*ggg(k)
14362 ! gelc(k,i)=gelc(k,i)+ghalf
14363 ! gelc(k,j)=gelc(k,j)+ghalf
14365 ! 9/28/08 AL Gradient compotents will be summed only at the end
14367 gelc_long(k,j)=gelc(k,j)+ggg(k)
14368 gelc_long(k,i)=gelc(k,i)-ggg(k)
14371 ! Loop over residues i+1 thru j-1.
14375 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14378 ! 9/28/08 AL Gradient compotents will be summed only at the end
14383 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14384 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14390 ecosa=2.0D0*fac3*fac1+fac4
14393 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
14394 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
14396 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14397 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14399 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
14400 !d & (dcosg(k),k=1,3)
14402 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k) )*sss_ele_cut
14405 ! ghalf=0.5D0*ggg(k)
14406 ! gelc(k,i)=gelc(k,i)+ghalf
14407 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
14408 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14409 ! gelc(k,j)=gelc(k,j)+ghalf
14410 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
14411 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14415 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14419 gelc(k,i)=gelc(k,i) &
14420 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14421 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
14423 gelc(k,j)=gelc(k,j) &
14424 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14425 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14427 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14428 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14430 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
14431 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
14432 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14434 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
14435 ! energy of a peptide unit is assumed in the form of a second-order
14436 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
14437 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
14438 ! are computed for EVERY pair of non-contiguous peptide groups.
14440 if (j.lt.nres-1) then
14451 muij(kkk)=mu(k,i)*mu(l,j)
14454 !d write (iout,*) 'EELEC: i',i,' j',j
14455 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
14456 !d write(iout,*) 'muij',muij
14457 ury=scalar(uy(1,i),erij)
14458 urz=scalar(uz(1,i),erij)
14459 vry=scalar(uy(1,j),erij)
14460 vrz=scalar(uz(1,j),erij)
14461 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
14462 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
14463 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
14464 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
14465 fac=dsqrt(-ael6i)*r3ij
14470 !d write (iout,'(4i5,4f10.5)')
14471 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
14472 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
14473 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
14474 !d & uy(:,j),uz(:,j)
14475 !d write (iout,'(4f10.5)')
14476 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
14477 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
14478 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
14479 !d write (iout,'(9f10.5/)')
14480 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
14481 ! Derivatives of the elements of A in virtual-bond vectors
14482 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
14484 uryg(k,1)=scalar(erder(1,k),uy(1,i))
14485 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
14486 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
14487 urzg(k,1)=scalar(erder(1,k),uz(1,i))
14488 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
14489 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
14490 vryg(k,1)=scalar(erder(1,k),uy(1,j))
14491 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
14492 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
14493 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
14494 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
14495 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
14497 ! Compute radial contributions to the gradient
14515 ! Add the contributions coming from er
14518 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
14519 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
14520 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
14521 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
14524 ! Derivatives in DC(i)
14525 !grad ghalf1=0.5d0*agg(k,1)
14526 !grad ghalf2=0.5d0*agg(k,2)
14527 !grad ghalf3=0.5d0*agg(k,3)
14528 !grad ghalf4=0.5d0*agg(k,4)
14529 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
14530 -3.0d0*uryg(k,2)*vry)!+ghalf1
14531 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
14532 -3.0d0*uryg(k,2)*vrz)!+ghalf2
14533 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
14534 -3.0d0*urzg(k,2)*vry)!+ghalf3
14535 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
14536 -3.0d0*urzg(k,2)*vrz)!+ghalf4
14537 ! Derivatives in DC(i+1)
14538 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
14539 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
14540 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
14541 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
14542 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
14543 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
14544 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
14545 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
14546 ! Derivatives in DC(j)
14547 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
14548 -3.0d0*vryg(k,2)*ury)!+ghalf1
14549 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
14550 -3.0d0*vrzg(k,2)*ury)!+ghalf2
14551 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
14552 -3.0d0*vryg(k,2)*urz)!+ghalf3
14553 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
14554 -3.0d0*vrzg(k,2)*urz)!+ghalf4
14555 ! Derivatives in DC(j+1) or DC(nres-1)
14556 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
14557 -3.0d0*vryg(k,3)*ury)
14558 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
14559 -3.0d0*vrzg(k,3)*ury)
14560 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
14561 -3.0d0*vryg(k,3)*urz)
14562 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
14563 -3.0d0*vrzg(k,3)*urz)
14564 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
14566 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
14579 aggi(k,l)=-aggi(k,l)
14580 aggi1(k,l)=-aggi1(k,l)
14581 aggj(k,l)=-aggj(k,l)
14582 aggj1(k,l)=-aggj1(k,l)
14585 if (j.lt.nres-1) then
14591 aggi(k,l)=-aggi(k,l)
14592 aggi1(k,l)=-aggi1(k,l)
14593 aggj(k,l)=-aggj(k,l)
14594 aggj1(k,l)=-aggj1(k,l)
14605 aggi(k,l)=-aggi(k,l)
14606 aggi1(k,l)=-aggi1(k,l)
14607 aggj(k,l)=-aggj(k,l)
14608 aggj1(k,l)=-aggj1(k,l)
14613 IF (wel_loc.gt.0.0d0) THEN
14614 ! Contribution to the local-electrostatic energy coming from the i-j pair
14615 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
14617 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
14619 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
14620 'eelloc',i,j,eel_loc_ij
14621 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
14623 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
14624 ! Partial derivatives in virtual-bond dihedral angles gamma
14626 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
14627 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
14628 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
14630 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
14631 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
14632 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
14638 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
14640 ggg(l)=(agg(l,1)*muij(1)+ &
14641 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
14643 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
14645 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
14646 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
14647 !grad ghalf=0.5d0*ggg(l)
14648 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
14649 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
14653 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
14656 ! Remaining derivatives of eello
14658 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
14659 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
14662 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
14663 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))&
14666 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
14667 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
14670 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
14671 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))&
14676 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
14677 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
14678 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
14679 .and. num_conti.le.maxconts) then
14680 ! write (iout,*) i,j," entered corr"
14682 ! Calculate the contact function. The ith column of the array JCONT will
14683 ! contain the numbers of atoms that make contacts with the atom I (of numbers
14684 ! greater than I). The arrays FACONT and GACONT will contain the values of
14685 ! the contact function and its derivative.
14686 ! r0ij=1.02D0*rpp(iteli,itelj)
14687 ! r0ij=1.11D0*rpp(iteli,itelj)
14688 r0ij=2.20D0*rpp(iteli,itelj)
14689 ! r0ij=1.55D0*rpp(iteli,itelj)
14690 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
14691 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14692 if (fcont.gt.0.0D0) then
14693 num_conti=num_conti+1
14694 if (num_conti.gt.maxconts) then
14695 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14696 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
14697 ' will skip next contacts for this conf.',num_conti
14699 jcont_hb(num_conti,i)=j
14700 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
14701 !d & " jcont_hb",jcont_hb(num_conti,i)
14702 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
14703 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14704 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
14706 d_cont(num_conti,i)=rij
14707 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
14708 ! --- Electrostatic-interaction matrix ---
14709 a_chuj(1,1,num_conti,i)=a22
14710 a_chuj(1,2,num_conti,i)=a23
14711 a_chuj(2,1,num_conti,i)=a32
14712 a_chuj(2,2,num_conti,i)=a33
14713 ! --- Gradient of rij
14715 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
14722 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
14723 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
14724 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
14725 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
14726 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
14731 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
14732 ! Calculate contact energies
14734 wij=cosa-3.0D0*cosb*cosg
14737 ! fac3=dsqrt(-ael6i)/r0ij**3
14738 fac3=dsqrt(-ael6i)*r3ij
14739 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
14740 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
14741 if (ees0tmp.gt.0) then
14742 ees0pij=dsqrt(ees0tmp)
14746 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
14747 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
14748 if (ees0tmp.gt.0) then
14749 ees0mij=dsqrt(ees0tmp)
14754 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
14757 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
14760 ! Diagnostics. Comment out or remove after debugging!
14761 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
14762 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
14763 ! ees0m(num_conti,i)=0.0D0
14765 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
14766 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
14767 ! Angular derivatives of the contact function
14768 ees0pij1=fac3/ees0pij
14769 ees0mij1=fac3/ees0mij
14770 fac3p=-3.0D0*fac3*rrmij
14771 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
14772 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
14774 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
14775 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
14776 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
14777 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
14778 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
14779 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
14780 ecosap=ecosa1+ecosa2
14781 ecosbp=ecosb1+ecosb2
14782 ecosgp=ecosg1+ecosg2
14783 ecosam=ecosa1-ecosa2
14784 ecosbm=ecosb1-ecosb2
14785 ecosgm=ecosg1-ecosg2
14794 facont_hb(num_conti,i)=fcont
14795 fprimcont=fprimcont/rij
14796 !d facont_hb(num_conti,i)=1.0D0
14797 ! Following line is for diagnostics.
14800 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14801 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14804 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
14805 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
14807 ! gggp(1)=gggp(1)+ees0pijp*xj
14808 ! gggp(2)=gggp(2)+ees0pijp*yj
14809 ! gggp(3)=gggp(3)+ees0pijp*zj
14810 ! gggm(1)=gggm(1)+ees0mijp*xj
14811 ! gggm(2)=gggm(2)+ees0mijp*yj
14812 ! gggm(3)=gggm(3)+ees0mijp*zj
14813 gggp(1)=gggp(1)+ees0pijp*xj &
14814 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14815 gggp(2)=gggp(2)+ees0pijp*yj &
14816 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14817 gggp(3)=gggp(3)+ees0pijp*zj &
14818 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14820 gggm(1)=gggm(1)+ees0mijp*xj &
14821 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14823 gggm(2)=gggm(2)+ees0mijp*yj &
14824 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14826 gggm(3)=gggm(3)+ees0mijp*zj &
14827 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14829 ! Derivatives due to the contact function
14830 gacont_hbr(1,num_conti,i)=fprimcont*xj
14831 gacont_hbr(2,num_conti,i)=fprimcont*yj
14832 gacont_hbr(3,num_conti,i)=fprimcont*zj
14835 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
14836 ! following the change of gradient-summation algorithm.
14838 !grad ghalfp=0.5D0*gggp(k)
14839 !grad ghalfm=0.5D0*gggm(k)
14840 ! gacontp_hb1(k,num_conti,i)= & !ghalfp
14841 ! +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14842 ! + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14843 ! gacontp_hb2(k,num_conti,i)= & !ghalfp
14844 ! +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14845 ! + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14846 ! gacontp_hb3(k,num_conti,i)=gggp(k)
14847 ! gacontm_hb1(k,num_conti,i)= &!ghalfm
14848 ! +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14849 ! + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14850 ! gacontm_hb2(k,num_conti,i)= & !ghalfm
14851 ! +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14852 ! + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14853 ! gacontm_hb3(k,num_conti,i)=gggm(k)
14854 gacontp_hb1(k,num_conti,i)= & !ghalfp+
14855 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14856 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14859 gacontp_hb2(k,num_conti,i)= & !ghalfp+
14860 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14861 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14864 gacontp_hb3(k,num_conti,i)=gggp(k) &
14867 gacontm_hb1(k,num_conti,i)= & !ghalfm+
14868 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14869 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14872 gacontm_hb2(k,num_conti,i)= & !ghalfm+
14873 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14874 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
14877 gacontm_hb3(k,num_conti,i)=gggm(k) &
14882 endif ! num_conti.le.maxconts
14885 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
14888 ghalf=0.5d0*agg(l,k)
14889 aggi(l,k)=aggi(l,k)+ghalf
14890 aggi1(l,k)=aggi1(l,k)+agg(l,k)
14891 aggj(l,k)=aggj(l,k)+ghalf
14894 if (j.eq.nres-1 .and. i.lt.j-2) then
14897 aggj1(l,k)=aggj1(l,k)+agg(l,k)
14903 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
14905 end subroutine eelecij_scale
14906 !-----------------------------------------------------------------------------
14907 subroutine evdwpp_short(evdw1)
14911 ! implicit real*8 (a-h,o-z)
14912 ! include 'DIMENSIONS'
14913 ! include 'COMMON.CONTROL'
14914 ! include 'COMMON.IOUNITS'
14915 ! include 'COMMON.GEO'
14916 ! include 'COMMON.VAR'
14917 ! include 'COMMON.LOCAL'
14918 ! include 'COMMON.CHAIN'
14919 ! include 'COMMON.DERIV'
14920 ! include 'COMMON.INTERACT'
14921 ! include 'COMMON.CONTACTS'
14922 ! include 'COMMON.TORSION'
14923 ! include 'COMMON.VECTORS'
14924 ! include 'COMMON.FFIELD'
14925 real(kind=8),dimension(3) :: ggg
14926 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14928 real(kind=8) :: scal_el=1.0d0
14930 real(kind=8) :: scal_el=0.5d0
14932 !el local variables
14933 integer :: i,j,k,iteli,itelj,num_conti,isubchap
14934 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
14935 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
14936 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14937 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
14938 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14939 dist_temp, dist_init,sss_grad
14940 integer xshift,yshift,zshift
14944 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
14945 ! & " iatel_e_vdw",iatel_e_vdw
14947 do i=iatel_s_vdw,iatel_e_vdw
14948 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1) cycle
14952 dx_normi=dc_norm(1,i)
14953 dy_normi=dc_norm(2,i)
14954 dz_normi=dc_norm(3,i)
14955 xmedi=c(1,i)+0.5d0*dxi
14956 ymedi=c(2,i)+0.5d0*dyi
14957 zmedi=c(3,i)+0.5d0*dzi
14958 xmedi=dmod(xmedi,boxxsize)
14959 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14960 ymedi=dmod(ymedi,boxysize)
14961 if (ymedi.lt.0) ymedi=ymedi+boxysize
14962 zmedi=dmod(zmedi,boxzsize)
14963 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14965 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
14966 ! & ' ielend',ielend_vdw(i)
14968 do j=ielstart_vdw(i),ielend_vdw(i)
14969 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
14973 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
14974 aaa=app(iteli,itelj)
14975 bbb=bpp(iteli,itelj)
14979 dx_normj=dc_norm(1,j)
14980 dy_normj=dc_norm(2,j)
14981 dz_normj=dc_norm(3,j)
14982 ! xj=c(1,j)+0.5D0*dxj-xmedi
14983 ! yj=c(2,j)+0.5D0*dyj-ymedi
14984 ! zj=c(3,j)+0.5D0*dzj-zmedi
14985 xj=c(1,j)+0.5D0*dxj
14986 yj=c(2,j)+0.5D0*dyj
14987 zj=c(3,j)+0.5D0*dzj
14988 xj=mod(xj,boxxsize)
14989 if (xj.lt.0) xj=xj+boxxsize
14990 yj=mod(yj,boxysize)
14991 if (yj.lt.0) yj=yj+boxysize
14992 zj=mod(zj,boxzsize)
14993 if (zj.lt.0) zj=zj+boxzsize
14995 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15002 xj=xj_safe+xshift*boxxsize
15003 yj=yj_safe+yshift*boxysize
15004 zj=zj_safe+zshift*boxzsize
15005 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15006 if(dist_temp.lt.dist_init) then
15007 dist_init=dist_temp
15016 if (isubchap.eq.1) then
15027 rij=xj*xj+yj*yj+zj*zj
15030 sss=sscale(rij/rpp(iteli,itelj))
15031 sss_ele_cut=sscale_ele(rij)
15032 sss_ele_grad=sscagrad_ele(rij)
15033 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
15034 if (sss_ele_cut.le.0.0) cycle
15035 if (sss.gt.0.0d0) then
15040 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
15041 if (j.eq.i+2) ev1=scal_el*ev1
15044 if (energy_dec) then
15045 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
15047 evdw1=evdw1+evdwij*sss*sss_ele_cut
15049 ! Calculate contributions to the Cartesian gradient.
15051 facvdw=-6*rrmij*(ev1+evdwij)*sss*sss_ele_cut
15055 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*sss &
15056 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
15057 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*sss &
15058 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
15059 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*sss &
15060 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
15063 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
15064 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
15070 end subroutine evdwpp_short
15071 !-----------------------------------------------------------------------------
15072 subroutine escp_long(evdw2,evdw2_14)
15074 ! This subroutine calculates the excluded-volume interaction energy between
15075 ! peptide-group centers and side chains and its gradient in virtual-bond and
15076 ! side-chain vectors.
15078 ! implicit real*8 (a-h,o-z)
15079 ! include 'DIMENSIONS'
15080 ! include 'COMMON.GEO'
15081 ! include 'COMMON.VAR'
15082 ! include 'COMMON.LOCAL'
15083 ! include 'COMMON.CHAIN'
15084 ! include 'COMMON.DERIV'
15085 ! include 'COMMON.INTERACT'
15086 ! include 'COMMON.FFIELD'
15087 ! include 'COMMON.IOUNITS'
15088 ! include 'COMMON.CONTROL'
15089 real(kind=8),dimension(3) :: ggg
15090 !el local variables
15091 integer :: i,iint,j,k,iteli,itypj,subchap
15092 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
15093 real(kind=8) :: evdw2,evdw2_14,evdwij
15094 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15095 dist_temp, dist_init
15099 !d print '(a)','Enter ESCP'
15100 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
15101 do i=iatscp_s,iatscp_e
15102 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
15104 xi=0.5D0*(c(1,i)+c(1,i+1))
15105 yi=0.5D0*(c(2,i)+c(2,i+1))
15106 zi=0.5D0*(c(3,i)+c(3,i+1))
15107 xi=mod(xi,boxxsize)
15108 if (xi.lt.0) xi=xi+boxxsize
15109 yi=mod(yi,boxysize)
15110 if (yi.lt.0) yi=yi+boxysize
15111 zi=mod(zi,boxzsize)
15112 if (zi.lt.0) zi=zi+boxzsize
15114 do iint=1,nscp_gr(i)
15116 do j=iscpstart(i,iint),iscpend(i,iint)
15118 if (itypj.eq.ntyp1) cycle
15119 ! Uncomment following three lines for SC-p interactions
15120 ! xj=c(1,nres+j)-xi
15121 ! yj=c(2,nres+j)-yi
15122 ! zj=c(3,nres+j)-zi
15123 ! Uncomment following three lines for Ca-p interactions
15127 xj=mod(xj,boxxsize)
15128 if (xj.lt.0) xj=xj+boxxsize
15129 yj=mod(yj,boxysize)
15130 if (yj.lt.0) yj=yj+boxysize
15131 zj=mod(zj,boxzsize)
15132 if (zj.lt.0) zj=zj+boxzsize
15133 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15141 xj=xj_safe+xshift*boxxsize
15142 yj=yj_safe+yshift*boxysize
15143 zj=zj_safe+zshift*boxzsize
15144 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15145 if(dist_temp.lt.dist_init) then
15146 dist_init=dist_temp
15155 if (subchap.eq.1) then
15164 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15166 rij=dsqrt(1.0d0/rrij)
15167 sss_ele_cut=sscale_ele(rij)
15168 sss_ele_grad=sscagrad_ele(rij)
15169 ! print *,sss_ele_cut,sss_ele_grad,&
15170 ! (rij),r_cut_ele,rlamb_ele
15171 if (sss_ele_cut.le.0.0) cycle
15172 sss=sscale((rij/rscp(itypj,iteli)))
15173 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
15174 if (sss.lt.1.0d0) then
15177 e1=fac*fac*aad(itypj,iteli)
15178 e2=fac*bad(itypj,iteli)
15179 if (iabs(j-i) .le. 2) then
15182 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)*sss_ele_cut
15185 evdw2=evdw2+evdwij*(1.0d0-sss)*sss_ele_cut
15186 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15187 'evdw2',i,j,sss,evdwij
15189 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15191 fac=-(evdwij+e1)*rrij*(1.0d0-sss)*sss_ele_cut
15192 fac=fac+evdwij*sss_ele_grad/rij/expon*(1.0d0-sss)&
15193 -evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15197 ! Uncomment following three lines for SC-p interactions
15199 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15201 ! Uncomment following line for SC-p interactions
15202 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15204 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15205 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15214 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15215 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15216 gradx_scp(j,i)=expon*gradx_scp(j,i)
15219 !******************************************************************************
15223 ! To save time the factor EXPON has been extracted from ALL components
15224 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15227 !******************************************************************************
15229 end subroutine escp_long
15230 !-----------------------------------------------------------------------------
15231 subroutine escp_short(evdw2,evdw2_14)
15233 ! This subroutine calculates the excluded-volume interaction energy between
15234 ! peptide-group centers and side chains and its gradient in virtual-bond and
15235 ! side-chain vectors.
15237 ! implicit real*8 (a-h,o-z)
15238 ! include 'DIMENSIONS'
15239 ! include 'COMMON.GEO'
15240 ! include 'COMMON.VAR'
15241 ! include 'COMMON.LOCAL'
15242 ! include 'COMMON.CHAIN'
15243 ! include 'COMMON.DERIV'
15244 ! include 'COMMON.INTERACT'
15245 ! include 'COMMON.FFIELD'
15246 ! include 'COMMON.IOUNITS'
15247 ! include 'COMMON.CONTROL'
15248 real(kind=8),dimension(3) :: ggg
15249 !el local variables
15250 integer :: i,iint,j,k,iteli,itypj,subchap
15251 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
15252 real(kind=8) :: evdw2,evdw2_14,evdwij
15253 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15254 dist_temp, dist_init
15258 !d print '(a)','Enter ESCP'
15259 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
15260 do i=iatscp_s,iatscp_e
15261 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
15263 xi=0.5D0*(c(1,i)+c(1,i+1))
15264 yi=0.5D0*(c(2,i)+c(2,i+1))
15265 zi=0.5D0*(c(3,i)+c(3,i+1))
15266 xi=mod(xi,boxxsize)
15267 if (xi.lt.0) xi=xi+boxxsize
15268 yi=mod(yi,boxysize)
15269 if (yi.lt.0) yi=yi+boxysize
15270 zi=mod(zi,boxzsize)
15271 if (zi.lt.0) zi=zi+boxzsize
15273 do iint=1,nscp_gr(i)
15275 do j=iscpstart(i,iint),iscpend(i,iint)
15277 if (itypj.eq.ntyp1) cycle
15278 ! Uncomment following three lines for SC-p interactions
15279 ! xj=c(1,nres+j)-xi
15280 ! yj=c(2,nres+j)-yi
15281 ! zj=c(3,nres+j)-zi
15282 ! Uncomment following three lines for Ca-p interactions
15289 xj=mod(xj,boxxsize)
15290 if (xj.lt.0) xj=xj+boxxsize
15291 yj=mod(yj,boxysize)
15292 if (yj.lt.0) yj=yj+boxysize
15293 zj=mod(zj,boxzsize)
15294 if (zj.lt.0) zj=zj+boxzsize
15295 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15303 xj=xj_safe+xshift*boxxsize
15304 yj=yj_safe+yshift*boxysize
15305 zj=zj_safe+zshift*boxzsize
15306 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15307 if(dist_temp.lt.dist_init) then
15308 dist_init=dist_temp
15317 if (subchap.eq.1) then
15327 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15328 rij=dsqrt(1.0d0/rrij)
15329 sss_ele_cut=sscale_ele(rij)
15330 sss_ele_grad=sscagrad_ele(rij)
15331 ! print *,sss_ele_cut,sss_ele_grad,&
15332 ! (rij),r_cut_ele,rlamb_ele
15333 if (sss_ele_cut.le.0.0) cycle
15334 sss=sscale(rij/rscp(itypj,iteli))
15335 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
15336 if (sss.gt.0.0d0) then
15339 e1=fac*fac*aad(itypj,iteli)
15340 e2=fac*bad(itypj,iteli)
15341 if (iabs(j-i) .le. 2) then
15344 evdw2_14=evdw2_14+(e1+e2)*sss*sss_ele_cut
15347 evdw2=evdw2+evdwij*sss*sss_ele_cut
15348 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15349 'evdw2',i,j,sss,evdwij
15351 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15353 fac=-(evdwij+e1)*rrij*sss*sss_ele_cut
15354 fac=fac+evdwij*sss_ele_grad/rij/expon*sss &
15355 +evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15360 ! Uncomment following three lines for SC-p interactions
15362 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15364 ! Uncomment following line for SC-p interactions
15365 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15367 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15368 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15377 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15378 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15379 gradx_scp(j,i)=expon*gradx_scp(j,i)
15382 !******************************************************************************
15386 ! To save time the factor EXPON has been extracted from ALL components
15387 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15390 !******************************************************************************
15392 end subroutine escp_short
15393 !-----------------------------------------------------------------------------
15394 ! energy_p_new-sep_barrier.F
15395 !-----------------------------------------------------------------------------
15396 subroutine sc_grad_scale(scalfac)
15397 ! implicit real*8 (a-h,o-z)
15399 ! include 'DIMENSIONS'
15400 ! include 'COMMON.CHAIN'
15401 ! include 'COMMON.DERIV'
15402 ! include 'COMMON.CALC'
15403 ! include 'COMMON.IOUNITS'
15404 real(kind=8),dimension(3) :: dcosom1,dcosom2
15405 real(kind=8) :: scalfac
15406 !el local variables
15407 ! integer :: i,j,k,l
15409 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
15410 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
15411 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
15412 -2.0D0*alf12*eps3der+sigder*sigsq_om12
15416 ! eom12=evdwij*eps1_om12
15418 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
15419 ! & " sigder",sigder
15420 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
15421 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
15423 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
15424 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
15427 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac&
15430 ! write (iout,*) "gg",(gg(k),k=1,3)
15432 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
15433 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
15434 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
15436 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
15437 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
15438 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac&
15440 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
15441 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
15442 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
15443 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
15446 ! Calculate the components of the gradient in DC and X
15449 gvdwc(l,i)=gvdwc(l,i)-gg(l)
15450 gvdwc(l,j)=gvdwc(l,j)+gg(l)
15453 end subroutine sc_grad_scale
15454 !-----------------------------------------------------------------------------
15455 ! energy_split-sep.F
15456 !-----------------------------------------------------------------------------
15457 subroutine etotal_long(energia)
15459 ! Compute the long-range slow-varying contributions to the energy
15461 ! implicit real*8 (a-h,o-z)
15462 ! include 'DIMENSIONS'
15463 use MD_data, only: totT,usampl,eq_time
15467 !MS$ATTRIBUTES C :: proc_proc
15472 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
15474 ! include 'COMMON.SETUP'
15475 ! include 'COMMON.IOUNITS'
15476 ! include 'COMMON.FFIELD'
15477 ! include 'COMMON.DERIV'
15478 ! include 'COMMON.INTERACT'
15479 ! include 'COMMON.SBRIDGE'
15480 ! include 'COMMON.CHAIN'
15481 ! include 'COMMON.VAR'
15482 ! include 'COMMON.LOCAL'
15483 ! include 'COMMON.MD'
15484 real(kind=8),dimension(0:n_ene) :: energia
15485 !el local variables
15486 integer :: i,n_corr,n_corr1,ierror,ierr
15487 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
15488 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
15489 ecorr,ecorr5,ecorr6,eturn6,time00
15490 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
15491 !elwrite(iout,*)"in etotal long"
15493 if (modecalc.eq.12.or.modecalc.eq.14) then
15495 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
15497 call int_from_cart1(.false.)
15500 !elwrite(iout,*)"in etotal long"
15503 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
15504 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15506 if (nfgtasks.gt.1) then
15508 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15509 if (fg_rank.eq.0) then
15510 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
15511 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15513 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15514 ! FG slaves as WEIGHTS array.
15521 weights_(7)=wel_loc
15524 weights_(10)=wturn6
15526 weights_(12)=wscloc
15528 weights_(14)=wtor_d
15529 weights_(15)=wstrain
15530 weights_(16)=wvdwpp
15532 weights_(18)=scal14
15533 weights_(21)=wsccor
15534 ! FG Master broadcasts the WEIGHTS_ array
15535 call MPI_Bcast(weights_(1),n_ene,&
15536 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15538 ! FG slaves receive the WEIGHTS array
15539 call MPI_Bcast(weights(1),n_ene,&
15540 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15555 wstrain=weights(15)
15561 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
15563 time_Bcast=time_Bcast+MPI_Wtime()-time00
15564 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
15565 ! call chainbuild_cart
15566 ! call int_from_cart1(.false.)
15568 ! write (iout,*) 'Processor',myrank,
15569 ! & ' calling etotal_short ipot=',ipot
15571 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15573 !d print *,'nnt=',nnt,' nct=',nct
15575 !elwrite(iout,*)"in etotal long"
15576 ! Compute the side-chain and electrostatic interaction energy
15578 goto (101,102,103,104,105,106) ipot
15579 ! Lennard-Jones potential.
15580 101 call elj_long(evdw)
15581 !d print '(a)','Exit ELJ'
15583 ! Lennard-Jones-Kihara potential (shifted).
15584 102 call eljk_long(evdw)
15586 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15587 103 call ebp_long(evdw)
15589 ! Gay-Berne potential (shifted LJ, angular dependence).
15590 104 call egb_long(evdw)
15592 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15593 105 call egbv_long(evdw)
15595 ! Soft-sphere potential
15596 106 call e_softsphere(evdw)
15598 ! Calculate electrostatic (H-bonding) energy of the main chain.
15602 if (ipot.lt.6) then
15604 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
15605 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15606 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15607 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15609 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
15610 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15611 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15612 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15614 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
15623 ! write (iout,*) "Soft-spheer ELEC potential"
15624 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
15628 ! Calculate excluded-volume interaction energy between peptide groups
15631 if (ipot.lt.6) then
15632 if(wscp.gt.0d0) then
15633 call escp_long(evdw2,evdw2_14)
15639 call escp_soft_sphere(evdw2,evdw2_14)
15642 ! 12/1/95 Multi-body terms
15646 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
15647 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
15648 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
15649 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
15650 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
15657 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
15658 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
15661 ! If performing constraint dynamics, call the constraint energy
15662 ! after the equilibration time
15663 if(usampl.and.totT.gt.eq_time) then
15678 energia(2)=evdw2-evdw2_14
15679 energia(18)=evdw2_14
15688 energia(3)=ees+evdw1
15695 energia(8)=eello_turn3
15696 energia(9)=eello_turn4
15698 energia(20)=Uconst+Uconst_back
15699 call sum_energy(energia,.true.)
15700 ! write (iout,*) "Exit ETOTAL_LONG"
15703 end subroutine etotal_long
15704 !-----------------------------------------------------------------------------
15705 subroutine etotal_short(energia)
15707 ! Compute the short-range fast-varying contributions to the energy
15709 ! implicit real*8 (a-h,o-z)
15710 ! include 'DIMENSIONS'
15714 !MS$ATTRIBUTES C :: proc_proc
15719 integer :: ierror,ierr
15720 real(kind=8),dimension(n_ene) :: weights_
15721 real(kind=8) :: time00
15723 ! include 'COMMON.SETUP'
15724 ! include 'COMMON.IOUNITS'
15725 ! include 'COMMON.FFIELD'
15726 ! include 'COMMON.DERIV'
15727 ! include 'COMMON.INTERACT'
15728 ! include 'COMMON.SBRIDGE'
15729 ! include 'COMMON.CHAIN'
15730 ! include 'COMMON.VAR'
15731 ! include 'COMMON.LOCAL'
15732 real(kind=8),dimension(0:n_ene) :: energia
15733 !el local variables
15735 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
15736 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr
15739 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
15741 if (modecalc.eq.12.or.modecalc.eq.14) then
15743 if (fg_rank.eq.0) call int_from_cart1(.false.)
15745 call int_from_cart1(.false.)
15749 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
15750 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15752 if (nfgtasks.gt.1) then
15754 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15755 if (fg_rank.eq.0) then
15756 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
15757 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15759 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15760 ! FG slaves as WEIGHTS array.
15767 weights_(7)=wel_loc
15770 weights_(10)=wturn6
15772 weights_(12)=wscloc
15774 weights_(14)=wtor_d
15775 weights_(15)=wstrain
15776 weights_(16)=wvdwpp
15778 weights_(18)=scal14
15779 weights_(21)=wsccor
15780 ! FG Master broadcasts the WEIGHTS_ array
15781 call MPI_Bcast(weights_(1),n_ene,&
15782 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15784 ! FG slaves receive the WEIGHTS array
15785 call MPI_Bcast(weights(1),n_ene,&
15786 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15801 wstrain=weights(15)
15807 ! write (iout,*),"Processor",myrank," BROADCAST weights"
15808 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
15810 ! write (iout,*) "Processor",myrank," BROADCAST c"
15811 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
15813 ! write (iout,*) "Processor",myrank," BROADCAST dc"
15814 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
15816 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
15817 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
15819 ! write (iout,*) "Processor",myrank," BROADCAST theta"
15820 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
15822 ! write (iout,*) "Processor",myrank," BROADCAST phi"
15823 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
15825 ! write (iout,*) "Processor",myrank," BROADCAST alph"
15826 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
15828 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
15829 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
15831 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
15832 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
15834 time_Bcast=time_Bcast+MPI_Wtime()-time00
15835 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
15837 ! write (iout,*) 'Processor',myrank,
15838 ! & ' calling etotal_short ipot=',ipot
15840 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15842 ! call int_from_cart1(.false.)
15844 ! Compute the side-chain and electrostatic interaction energy
15846 goto (101,102,103,104,105,106) ipot
15847 ! Lennard-Jones potential.
15848 101 call elj_short(evdw)
15849 !d print '(a)','Exit ELJ'
15851 ! Lennard-Jones-Kihara potential (shifted).
15852 102 call eljk_short(evdw)
15854 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15855 103 call ebp_short(evdw)
15857 ! Gay-Berne potential (shifted LJ, angular dependence).
15858 104 call egb_short(evdw)
15860 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15861 105 call egbv_short(evdw)
15863 ! Soft-sphere potential - already dealt with in the long-range part
15865 ! 106 call e_softsphere_short(evdw)
15867 ! Calculate electrostatic (H-bonding) energy of the main chain.
15871 ! Calculate the short-range part of Evdwpp
15873 call evdwpp_short(evdw1)
15875 ! Calculate the short-range part of ESCp
15877 if (ipot.lt.6) then
15878 call escp_short(evdw2,evdw2_14)
15881 ! Calculate the bond-stretching energy
15885 ! Calculate the disulfide-bridge and other energy and the contributions
15886 ! from other distance constraints.
15889 ! Calculate the virtual-bond-angle energy.
15891 call ebend(ebe,ethetacnstr)
15893 ! Calculate the SC local energy.
15898 ! Calculate the virtual-bond torsional energy.
15900 call etor(etors,edihcnstr)
15902 ! 6/23/01 Calculate double-torsional energy
15904 call etor_d(etors_d)
15906 ! 21/5/07 Calculate local sicdechain correlation energy
15908 if (wsccor.gt.0.0d0) then
15909 call eback_sc_corr(esccor)
15914 ! Put energy components into an array
15921 energia(2)=evdw2-evdw2_14
15922 energia(18)=evdw2_14
15935 energia(14)=etors_d
15938 energia(19)=edihcnstr
15940 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
15942 call sum_energy(energia,.true.)
15943 ! write (iout,*) "Exit ETOTAL_SHORT"
15946 end subroutine etotal_short
15947 !-----------------------------------------------------------------------------
15949 !-----------------------------------------------------------------------------
15950 real(kind=8) function gnmr1(y,ymin,ymax)
15952 real(kind=8) :: y,ymin,ymax
15953 real(kind=8) :: wykl=4.0d0
15954 if (y.lt.ymin) then
15955 gnmr1=(ymin-y)**wykl/wykl
15956 else if (y.gt.ymax) then
15957 gnmr1=(y-ymax)**wykl/wykl
15963 !-----------------------------------------------------------------------------
15964 real(kind=8) function gnmr1prim(y,ymin,ymax)
15966 real(kind=8) :: y,ymin,ymax
15967 real(kind=8) :: wykl=4.0d0
15968 if (y.lt.ymin) then
15969 gnmr1prim=-(ymin-y)**(wykl-1)
15970 else if (y.gt.ymax) then
15971 gnmr1prim=(y-ymax)**(wykl-1)
15976 end function gnmr1prim
15977 !----------------------------------------------------------------------------
15978 real(kind=8) function rlornmr1(y,ymin,ymax,sigma)
15979 real(kind=8) y,ymin,ymax,sigma
15980 real(kind=8) wykl /4.0d0/
15981 if (y.lt.ymin) then
15982 rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl)
15983 else if (y.gt.ymax) then
15984 rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
15989 end function rlornmr1
15990 !------------------------------------------------------------------------------
15991 real(kind=8) function rlornmr1prim(y,ymin,ymax,sigma)
15992 real(kind=8) y,ymin,ymax,sigma
15993 real(kind=8) wykl /4.0d0/
15994 if (y.lt.ymin) then
15995 rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ &
15996 ((ymin-y)**wykl+sigma**wykl)**2
15997 else if (y.gt.ymax) then
15998 rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ &
15999 ((y-ymax)**wykl+sigma**wykl)**2
16004 end function rlornmr1prim
16006 real(kind=8) function harmonic(y,ymax)
16008 real(kind=8) :: y,ymax
16009 real(kind=8) :: wykl=2.0d0
16010 harmonic=(y-ymax)**wykl
16012 end function harmonic
16013 !-----------------------------------------------------------------------------
16014 real(kind=8) function harmonicprim(y,ymax)
16015 real(kind=8) :: y,ymin,ymax
16016 real(kind=8) :: wykl=2.0d0
16017 harmonicprim=(y-ymax)*wykl
16019 end function harmonicprim
16020 !-----------------------------------------------------------------------------
16022 !-----------------------------------------------------------------------------
16023 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
16025 use io_base, only:intout,briefout
16026 ! implicit real*8 (a-h,o-z)
16027 ! include 'DIMENSIONS'
16028 ! include 'COMMON.CHAIN'
16029 ! include 'COMMON.DERIV'
16030 ! include 'COMMON.VAR'
16031 ! include 'COMMON.INTERACT'
16032 ! include 'COMMON.FFIELD'
16033 ! include 'COMMON.MD'
16034 ! include 'COMMON.IOUNITS'
16035 real(kind=8),external :: ufparm
16036 integer :: uiparm(1)
16037 real(kind=8) :: urparm(1)
16038 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
16039 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
16040 integer :: n,nf,ind,ind1,i,k,j
16042 ! This subroutine calculates total internal coordinate gradient.
16043 ! Depending on the number of function evaluations, either whole energy
16044 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
16045 ! internal coordinates are reevaluated or only the cartesian-in-internal
16046 ! coordinate derivatives are evaluated. The subroutine was designed to work
16052 !d print *,'grad',nf,icg
16053 if (nf-nfl+1) 20,30,40
16054 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
16055 ! write (iout,*) 'grad 20'
16056 if (nf.eq.0) return
16058 30 call var_to_geom(n,x)
16060 ! write (iout,*) 'grad 30'
16062 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
16065 ! write (iout,*) 'grad 40'
16066 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
16068 ! Convert the Cartesian gradient into internal-coordinate gradient.
16078 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
16080 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
16083 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
16089 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
16091 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
16092 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
16095 if (i.gt.1) g(i-1)=gphii
16096 if (n.gt.nphi) g(nphi+i)=gthetai
16098 if (n.le.nphi+ntheta) goto 10
16100 if (itype(i,1).ne.10) then
16104 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
16107 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
16109 g(ialph(i,1))=galphai
16110 g(ialph(i,1)+nside)=gomegai
16114 ! Add the components corresponding to local energy terms.
16118 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
16119 g(i)=g(i)+gloc(i,icg)
16121 ! Uncomment following three lines for diagnostics.
16123 !elwrite(iout,*) "in gradient after calling intout"
16124 !d call briefout(0,0.0d0)
16125 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
16127 end subroutine gradient
16128 !-----------------------------------------------------------------------------
16129 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
16132 ! implicit real*8 (a-h,o-z)
16133 ! include 'DIMENSIONS'
16134 ! include 'COMMON.DERIV'
16135 ! include 'COMMON.IOUNITS'
16136 ! include 'COMMON.GEO'
16139 !el common /chuju/ jjj
16140 real(kind=8) :: energia(0:n_ene)
16141 integer :: uiparm(1)
16142 real(kind=8) :: urparm(1)
16144 real(kind=8),external :: ufparm
16145 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
16146 ! if (jjj.gt.0) then
16147 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
16151 !d print *,'func',nf,nfl,icg
16152 call var_to_geom(n,x)
16155 !d write (iout,*) 'ETOTAL called from FUNC'
16156 call etotal(energia)
16159 ! if (jjj.gt.0) then
16160 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
16161 ! write (iout,*) 'f=',etot
16165 end subroutine func
16166 !-----------------------------------------------------------------------------
16167 subroutine cartgrad
16168 ! implicit real*8 (a-h,o-z)
16169 ! include 'DIMENSIONS'
16171 use MD_data, only: totT,usampl,eq_time
16175 ! include 'COMMON.CHAIN'
16176 ! include 'COMMON.DERIV'
16177 ! include 'COMMON.VAR'
16178 ! include 'COMMON.INTERACT'
16179 ! include 'COMMON.FFIELD'
16180 ! include 'COMMON.MD'
16181 ! include 'COMMON.IOUNITS'
16182 ! include 'COMMON.TIME1'
16186 ! This subrouting calculates total Cartesian coordinate gradient.
16187 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
16197 !el write (iout,*) "After sum_gradient"
16199 !el write (iout,*) "After sum_gradient"
16201 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
16202 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
16205 ! If performing constraint dynamics, add the gradients of the constraint energy
16206 if(usampl.and.totT.gt.eq_time) then
16209 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
16210 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
16214 gloc(i,icg)=gloc(i,icg)+dugamma(i)
16217 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
16220 !elwrite (iout,*) "After sum_gradient"
16225 !elwrite (iout,*) "After sum_gradient"
16227 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
16229 ! call checkintcartgrad
16230 ! write(iout,*) 'calling int_to_cart'
16232 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
16236 gcart(j,i)=gradc(j,i,icg)
16237 gxcart(j,i)=gradx(j,i,icg)
16238 ! if (i.le.2) print *,"gcart_one",gcart(j,i),gradc(j,i,icg)
16241 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
16242 (gxcart(j,i),j=1,3),gloc(i,icg)
16248 ! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
16250 ! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
16253 time_inttocart=time_inttocart+MPI_Wtime()-time01
16256 write (iout,*) "gcart and gxcart after int_to_cart"
16258 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
16259 (gxcart(j,i),j=1,3)
16264 write (iout,*) "CARGRAD"
16268 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
16269 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
16271 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
16272 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
16274 ! Correction: dummy residues
16277 ! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
16278 gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
16281 if (nct.lt.nres) then
16283 ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
16284 gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
16289 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
16293 end subroutine cartgrad
16294 !-----------------------------------------------------------------------------
16295 subroutine zerograd
16296 ! implicit real*8 (a-h,o-z)
16297 ! include 'DIMENSIONS'
16298 ! include 'COMMON.DERIV'
16299 ! include 'COMMON.CHAIN'
16300 ! include 'COMMON.VAR'
16301 ! include 'COMMON.MD'
16302 ! include 'COMMON.SCCOR'
16304 !el local variables
16305 integer :: i,j,intertyp,k
16306 ! Initialize Cartesian-coordinate gradient
16308 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
16309 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
16311 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
16312 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
16313 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
16314 ! allocate(gradcorr_long(3,nres))
16315 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
16316 ! allocate(gcorr6_turn_long(3,nres))
16317 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
16319 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
16321 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
16322 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
16324 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
16325 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
16327 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
16328 ! allocate(gscloc(3,nres)) !(3,maxres)
16329 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
16333 ! common /deriv_scloc/
16334 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
16335 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
16336 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
16338 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
16342 ! gradc(j,i,icg)=0.0d0
16343 ! gradx(j,i,icg)=0.0d0
16345 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
16346 !elwrite(iout,*) "icg",icg
16350 gradx_scp(j,i)=0.0D0
16352 gvdwc_scp(j,i)=0.0D0
16353 gvdwc_scpp(j,i)=0.0d0
16355 gelc_long(j,i)=0.0D0
16360 gel_loc_long(j,i)=0.0d0
16363 gcorr3_turn(j,i)=0.0d0
16364 gcorr4_turn(j,i)=0.0d0
16365 gradcorr(j,i)=0.0d0
16366 gradcorr_long(j,i)=0.0d0
16367 gradcorr5_long(j,i)=0.0d0
16368 gradcorr6_long(j,i)=0.0d0
16369 gcorr6_turn_long(j,i)=0.0d0
16370 gradcorr5(j,i)=0.0d0
16371 gradcorr6(j,i)=0.0d0
16372 gcorr6_turn(j,i)=0.0d0
16375 gradc(j,i,icg)=0.0d0
16376 gradx(j,i,icg)=0.0d0
16379 gliptran(j,i)=0.0d0
16380 gliptranx(j,i)=0.0d0
16381 gliptranc(j,i)=0.0d0
16382 gshieldx(j,i)=0.0d0
16383 gshieldc(j,i)=0.0d0
16384 gshieldc_loc(j,i)=0.0d0
16385 gshieldx_ec(j,i)=0.0d0
16386 gshieldc_ec(j,i)=0.0d0
16387 gshieldc_loc_ec(j,i)=0.0d0
16388 gshieldx_t3(j,i)=0.0d0
16389 gshieldc_t3(j,i)=0.0d0
16390 gshieldc_loc_t3(j,i)=0.0d0
16391 gshieldx_t4(j,i)=0.0d0
16392 gshieldc_t4(j,i)=0.0d0
16393 gshieldc_loc_t4(j,i)=0.0d0
16394 gshieldx_ll(j,i)=0.0d0
16395 gshieldc_ll(j,i)=0.0d0
16396 gshieldc_loc_ll(j,i)=0.0d0
16398 gg_tube_sc(j,i)=0.0d0
16400 gradb_nucl(j,i)=0.0d0
16401 gradbx_nucl(j,i)=0.0d0
16402 gvdwpp_nucl(j,i)=0.0d0
16406 gvdwpsb1(j,i)=0.0d0
16410 gradcorr_nucl(j,i)=0.0d0
16411 gradcorr3_nucl(j,i)=0.0d0
16412 gradxorr_nucl(j,i)=0.0d0
16413 gradxorr3_nucl(j,i)=0.0d0
16417 gradpepcat(j,i)=0.0d0
16418 gradpepcatx(j,i)=0.0d0
16419 gradcatcat(j,i)=0.0d0
16420 gvdwx_scbase(j,i)=0.0d0
16421 gvdwc_scbase(j,i)=0.0d0
16422 gvdwx_pepbase(j,i)=0.0d0
16423 gvdwc_pepbase(j,i)=0.0d0
16424 gvdwx_scpho(j,i)=0.0d0
16425 gvdwc_scpho(j,i)=0.0d0
16426 gvdwc_peppho(j,i)=0.0d0
16432 gloc_sc(intertyp,i,icg)=0.0d0
16441 grad_shield_side(k,j,i)=0.0d0
16442 grad_shield_loc(k,j,i)=0.0d0
16449 ! Initialize the gradient of local energy terms.
16451 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
16452 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
16453 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
16454 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
16455 ! allocate(gel_loc_turn3(nres))
16456 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
16457 ! allocate(gsccor_loc(nres)) !(maxres)
16463 gel_loc_loc(i)=0.0d0
16465 g_corr5_loc(i)=0.0d0
16466 g_corr6_loc(i)=0.0d0
16467 gel_loc_turn3(i)=0.0d0
16468 gel_loc_turn4(i)=0.0d0
16469 gel_loc_turn6(i)=0.0d0
16470 gsccor_loc(i)=0.0d0
16472 ! initialize gcart and gxcart
16473 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
16481 end subroutine zerograd
16482 !-----------------------------------------------------------------------------
16483 real(kind=8) function fdum()
16487 !-----------------------------------------------------------------------------
16489 !-----------------------------------------------------------------------------
16490 subroutine intcartderiv
16491 ! implicit real*8 (a-h,o-z)
16492 ! include 'DIMENSIONS'
16496 ! include 'COMMON.SETUP'
16497 ! include 'COMMON.CHAIN'
16498 ! include 'COMMON.VAR'
16499 ! include 'COMMON.GEO'
16500 ! include 'COMMON.INTERACT'
16501 ! include 'COMMON.DERIV'
16502 ! include 'COMMON.IOUNITS'
16503 ! include 'COMMON.LOCAL'
16504 ! include 'COMMON.SCCOR'
16505 real(kind=8) :: pi4,pi34
16506 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
16507 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
16508 dcosomega,dsinomega !(3,3,maxres)
16509 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
16512 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
16513 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
16514 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
16515 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
16519 !el from module energy-------------
16520 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
16521 !el allocate(dsintau(3,3,3,itau_start:itau_end))
16522 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
16524 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
16525 !el allocate(dsintau(3,3,3,0:nres2))
16526 !el allocate(dtauangle(3,3,3,0:nres2))
16527 !el allocate(domicron(3,2,2,0:nres2))
16528 !el allocate(dcosomicron(3,2,2,0:nres2))
16532 #if defined(MPI) && defined(PARINTDER)
16533 if (nfgtasks.gt.1 .and. me.eq.king) &
16534 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
16539 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
16540 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
16542 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
16545 dtheta(j,1,i)=0.0d0
16546 dtheta(j,2,i)=0.0d0
16552 ! Derivatives of theta's
16553 #if defined(MPI) && defined(PARINTDER)
16554 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16555 do i=max0(ithet_start-1,3),ithet_end
16559 cost=dcos(theta(i))
16560 sint=sqrt(1-cost*cost)
16562 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
16564 if (itype(i-1,1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
16565 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
16567 if (itype(i-1,1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
16570 #if defined(MPI) && defined(PARINTDER)
16571 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16572 do i=max0(ithet_start-1,3),ithet_end
16576 if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1)) then
16577 cost1=dcos(omicron(1,i))
16578 sint1=sqrt(1-cost1*cost1)
16579 cost2=dcos(omicron(2,i))
16580 sint2=sqrt(1-cost2*cost2)
16582 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
16583 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
16584 cost1*dc_norm(j,i-2))/ &
16586 domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i)
16587 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
16588 +cost1*(dc_norm(j,i-1+nres)))/ &
16590 domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i)
16591 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
16592 !C Looks messy but better than if in loop
16593 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
16594 +cost2*dc_norm(j,i-1))/ &
16596 domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i)
16597 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
16598 +cost2*(-dc_norm(j,i-1+nres)))/ &
16600 ! write(iout,*) "vbld", i,itype(i,1),vbld(i-1+nres)
16601 domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i)
16605 !elwrite(iout,*) "after vbld write"
16606 ! Derivatives of phi:
16607 ! If phi is 0 or 180 degrees, then the formulas
16608 ! have to be derived by power series expansion of the
16609 ! conventional formulas around 0 and 180.
16611 do i=iphi1_start,iphi1_end
16615 ! if (itype(i-1,1).eq.21 .or. itype(i-2,1).eq.21 ) cycle
16616 ! the conventional case
16617 sint=dsin(theta(i))
16618 sint1=dsin(theta(i-1))
16620 cost=dcos(theta(i))
16621 cost1=dcos(theta(i-1))
16623 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
16624 fac0=1.0d0/(sint1*sint)
16627 fac3=cosg*cost1/(sint1*sint1)
16628 fac4=cosg*cost/(sint*sint)
16629 ! Obtaining the gamma derivatives from sine derivative
16630 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
16631 phi(i).gt.pi34.and.phi(i).le.pi.or. &
16632 phi(i).ge.-pi.and.phi(i).le.-pi34) then
16633 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16634 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
16635 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16639 cosg_inv=1.0d0/cosg
16640 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
16641 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16642 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
16643 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
16645 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
16646 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16647 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
16648 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
16649 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16650 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16651 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
16653 ! Bug fixed 3/24/05 (AL)
16655 ! Obtaining the gamma derivatives from cosine derivative
16658 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
16659 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16660 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16661 dc_norm(j,i-3))/vbld(i-2)
16662 dphi(j,1,i)=-1/sing*dcosphi(j,1,i)
16663 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16664 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16666 dphi(j,2,i)=-1/sing*dcosphi(j,2,i)
16667 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16668 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16669 dc_norm(j,i-1))/vbld(i)
16670 dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
16675 !alculate derivative of Tauangle
16677 do i=itau_start,itau_end
16680 !elwrite(iout,*) " vecpr",i,nres
16682 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
16683 ! if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10).or.
16684 ! & (itype(i-1,1).eq.ntyp1).or.(itype(i,1).eq.ntyp1)) cycle
16685 !c dtauangle(j,intertyp,dervityp,residue number)
16686 !c INTERTYP=1 SC...Ca...Ca..Ca
16687 ! the conventional case
16688 sint=dsin(theta(i))
16689 sint1=dsin(omicron(2,i-1))
16690 sing=dsin(tauangle(1,i))
16691 cost=dcos(theta(i))
16692 cost1=dcos(omicron(2,i-1))
16693 cosg=dcos(tauangle(1,i))
16694 !elwrite(iout,*) " vecpr5",i,nres
16696 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
16697 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
16698 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16699 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
16701 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
16702 fac0=1.0d0/(sint1*sint)
16705 fac3=cosg*cost1/(sint1*sint1)
16706 fac4=cosg*cost/(sint*sint)
16707 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
16708 ! Obtaining the gamma derivatives from sine derivative
16709 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
16710 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
16711 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
16712 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16713 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
16714 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16718 cosg_inv=1.0d0/cosg
16719 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16720 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
16721 *vbld_inv(i-2+nres)
16722 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
16723 dsintau(j,1,2,i)= &
16724 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
16725 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16726 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
16727 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
16728 ! Bug fixed 3/24/05 (AL)
16729 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
16730 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16731 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16732 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
16734 ! Obtaining the gamma derivatives from cosine derivative
16737 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16738 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16739 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
16740 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
16741 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16742 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16744 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
16745 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16746 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
16747 dc_norm(j,i-1))/vbld(i)
16748 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
16749 ! write (iout,*) "else",i
16753 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
16756 !C Second case Ca...Ca...Ca...SC
16758 do i=itau_start,itau_end
16762 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
16763 (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle
16764 ! the conventional case
16765 sint=dsin(omicron(1,i))
16766 sint1=dsin(theta(i-1))
16767 sing=dsin(tauangle(2,i))
16768 cost=dcos(omicron(1,i))
16769 cost1=dcos(theta(i-1))
16770 cosg=dcos(tauangle(2,i))
16772 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16774 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
16775 fac0=1.0d0/(sint1*sint)
16778 fac3=cosg*cost1/(sint1*sint1)
16779 fac4=cosg*cost/(sint*sint)
16780 ! Obtaining the gamma derivatives from sine derivative
16781 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
16782 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
16783 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
16784 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
16785 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
16786 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16790 cosg_inv=1.0d0/cosg
16791 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16792 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
16793 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
16794 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
16795 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
16796 dsintau(j,2,2,i)= &
16797 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
16798 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16799 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
16800 ! & sing*ctgt*domicron(j,1,2,i),
16801 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16802 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
16803 ! Bug fixed 3/24/05 (AL)
16804 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16805 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
16806 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16807 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
16809 ! Obtaining the gamma derivatives from cosine derivative
16812 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16813 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16814 dc_norm(j,i-3))/vbld(i-2)
16815 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
16816 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16817 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16818 dcosomicron(j,1,1,i)
16819 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
16820 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16821 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16822 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16823 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
16824 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
16829 !CC third case SC...Ca...Ca...SC
16832 do i=itau_start,itau_end
16836 ! the conventional case
16837 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
16838 (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
16839 sint=dsin(omicron(1,i))
16840 sint1=dsin(omicron(2,i-1))
16841 sing=dsin(tauangle(3,i))
16842 cost=dcos(omicron(1,i))
16843 cost1=dcos(omicron(2,i-1))
16844 cosg=dcos(tauangle(3,i))
16846 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16847 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16849 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
16850 fac0=1.0d0/(sint1*sint)
16853 fac3=cosg*cost1/(sint1*sint1)
16854 fac4=cosg*cost/(sint*sint)
16855 ! Obtaining the gamma derivatives from sine derivative
16856 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
16857 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
16858 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
16859 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
16860 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
16861 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16865 cosg_inv=1.0d0/cosg
16866 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16867 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
16868 *vbld_inv(i-2+nres)
16869 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
16870 dsintau(j,3,2,i)= &
16871 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
16872 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16873 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
16874 ! Bug fixed 3/24/05 (AL)
16875 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16876 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
16877 *vbld_inv(i-1+nres)
16878 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16879 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
16881 ! Obtaining the gamma derivatives from cosine derivative
16884 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16885 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16886 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
16887 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
16888 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16889 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16890 dcosomicron(j,1,1,i)
16891 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
16892 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16893 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
16894 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16895 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
16896 ! write(iout,*) "else",i
16902 ! Derivatives of side-chain angles alpha and omega
16903 #if defined(MPI) && defined(PARINTDER)
16904 do i=ibond_start,ibond_end
16908 if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
16909 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
16912 fac8=fac5/vbld(i+1)
16913 fac9=fac5/vbld(i+nres)
16914 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
16915 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
16916 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
16917 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
16918 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
16919 sina=sqrt(1-cosa*cosa)
16921 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
16923 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
16924 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
16925 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
16926 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
16927 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
16928 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
16929 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
16930 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
16932 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
16934 ! obtaining the derivatives of omega from sines
16935 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
16936 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
16937 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
16938 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
16940 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
16941 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
16942 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
16943 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
16944 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
16945 coso_inv=1.0d0/dcos(omeg(i))
16947 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
16948 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
16949 (sino*dc_norm(j,i-1))/vbld(i)
16950 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
16951 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
16952 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
16953 -sino*dc_norm(j,i)/vbld(i+1)
16954 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
16955 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
16956 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
16958 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
16961 ! obtaining the derivatives of omega from cosines
16962 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
16963 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
16968 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
16969 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
16970 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
16971 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
16972 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
16973 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
16974 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
16975 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
16976 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
16977 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
16978 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
16979 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
16980 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
16981 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
16982 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
16988 dalpha(k,j,i)=0.0d0
16989 domega(k,j,i)=0.0d0
16995 #if defined(MPI) && defined(PARINTDER)
16996 if (nfgtasks.gt.1) then
16998 !d write (iout,*) "Gather dtheta"
16999 !d call flush(iout)
17000 write (iout,*) "dtheta before gather"
17002 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
17005 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
17006 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
17007 king,FG_COMM,IERROR)
17009 !d write (iout,*) "Gather dphi"
17010 !d call flush(iout)
17011 write (iout,*) "dphi before gather"
17013 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
17016 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
17017 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
17018 king,FG_COMM,IERROR)
17019 !d write (iout,*) "Gather dalpha"
17020 !d call flush(iout)
17022 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
17023 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
17024 king,FG_COMM,IERROR)
17025 !d write (iout,*) "Gather domega"
17026 !d call flush(iout)
17027 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
17028 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
17029 king,FG_COMM,IERROR)
17034 write (iout,*) "dtheta after gather"
17036 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
17038 write (iout,*) "dphi after gather"
17040 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
17042 write (iout,*) "dalpha after gather"
17044 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
17046 write (iout,*) "domega after gather"
17048 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
17052 end subroutine intcartderiv
17053 !-----------------------------------------------------------------------------
17054 subroutine checkintcartgrad
17055 ! implicit real*8 (a-h,o-z)
17056 ! include 'DIMENSIONS'
17060 ! include 'COMMON.CHAIN'
17061 ! include 'COMMON.VAR'
17062 ! include 'COMMON.GEO'
17063 ! include 'COMMON.INTERACT'
17064 ! include 'COMMON.DERIV'
17065 ! include 'COMMON.IOUNITS'
17066 ! include 'COMMON.SETUP'
17067 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
17068 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
17069 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
17070 real(kind=8),dimension(3) :: dc_norm_s
17071 real(kind=8) :: aincr=1.0d-5
17073 real(kind=8) :: dcji
17076 theta_s(i)=theta(i)
17080 ! Check theta gradient
17082 "Analytical (upper) and numerical (lower) gradient of theta"
17087 dc(j,i-2)=dcji+aincr
17088 call chainbuild_cart
17089 call int_from_cart1(.false.)
17090 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
17093 dc(j,i-1)=dc(j,i-1)+aincr
17094 call chainbuild_cart
17095 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
17098 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
17099 !el (dtheta(j,2,i),j=1,3)
17100 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
17101 !el (dthetanum(j,2,i),j=1,3)
17102 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
17103 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
17104 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
17107 ! Check gamma gradient
17109 "Analytical (upper) and numerical (lower) gradient of gamma"
17113 dc(j,i-3)=dcji+aincr
17114 call chainbuild_cart
17115 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
17118 dc(j,i-2)=dcji+aincr
17119 call chainbuild_cart
17120 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
17123 dc(j,i-1)=dc(j,i-1)+aincr
17124 call chainbuild_cart
17125 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
17128 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
17129 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
17130 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
17131 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
17132 !el write (iout,'(5x,3(3f10.5,5x))') &
17133 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
17134 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
17135 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
17138 ! Check alpha gradient
17140 "Analytical (upper) and numerical (lower) gradient of alpha"
17142 if(itype(i,1).ne.10) then
17145 dc(j,i-1)=dcji+aincr
17146 call chainbuild_cart
17147 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
17152 call chainbuild_cart
17153 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
17157 dc(j,i+nres)=dc(j,i+nres)+aincr
17158 call chainbuild_cart
17159 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
17164 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
17165 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
17166 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
17167 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
17168 !el write (iout,'(5x,3(3f10.5,5x))') &
17169 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
17170 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
17171 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
17174 ! Check omega gradient
17176 "Analytical (upper) and numerical (lower) gradient of omega"
17178 if(itype(i,1).ne.10) then
17181 dc(j,i-1)=dcji+aincr
17182 call chainbuild_cart
17183 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
17188 call chainbuild_cart
17189 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
17193 dc(j,i+nres)=dc(j,i+nres)+aincr
17194 call chainbuild_cart
17195 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
17200 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
17201 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
17202 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
17203 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
17204 !el write (iout,'(5x,3(3f10.5,5x))') &
17205 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
17206 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
17207 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
17211 end subroutine checkintcartgrad
17212 !-----------------------------------------------------------------------------
17214 !-----------------------------------------------------------------------------
17215 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
17216 ! implicit real*8 (a-h,o-z)
17217 ! include 'DIMENSIONS'
17218 ! include 'COMMON.IOUNITS'
17219 ! include 'COMMON.CHAIN'
17220 ! include 'COMMON.INTERACT'
17221 ! include 'COMMON.VAR'
17222 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
17223 integer :: kkk,nsep=3
17224 real(kind=8) :: qm !dist,
17225 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
17226 logical :: lprn=.false.
17228 ! real(kind=8) :: sigm,x
17230 !el sigm(x)=0.25d0*x ! local function
17236 do il=seg1+nsep,seg2
17239 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
17240 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
17241 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17243 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
17244 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17247 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17248 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17249 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17250 dijCM=dist(il+nres,jl+nres)
17251 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
17253 qq = qq+qqij+qqijCM
17259 if((seg3-il).lt.3) then
17266 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17267 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17268 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17270 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
17271 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17274 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17275 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17276 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17277 dijCM=dist(il+nres,jl+nres)
17278 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
17280 qq = qq+qqij+qqijCM
17285 if (qqmax.le.qq) qqmax=qq
17287 qwolynes=1.0d0-qqmax
17289 end function qwolynes
17290 !-----------------------------------------------------------------------------
17291 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
17292 ! implicit real*8 (a-h,o-z)
17293 ! include 'DIMENSIONS'
17294 ! include 'COMMON.IOUNITS'
17295 ! include 'COMMON.CHAIN'
17296 ! include 'COMMON.INTERACT'
17297 ! include 'COMMON.VAR'
17298 ! include 'COMMON.MD'
17299 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
17300 integer :: nsep=3, kkk
17301 !el real(kind=8) :: dist
17302 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
17303 logical :: lprn=.false.
17305 real(kind=8) :: sim,dd0,fac,ddqij
17306 !el sigm(x)=0.25d0*x ! local function
17316 do il=seg1+nsep,seg2
17319 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17320 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17321 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17323 sim = 1.0d0/sigm(d0ij)
17326 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
17328 ddqij = (c(k,il)-c(k,jl))*fac
17329 dqwol(k,il)=dqwol(k,il)+ddqij
17330 dqwol(k,jl)=dqwol(k,jl)-ddqij
17333 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17336 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17337 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17338 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17339 dijCM=dist(il+nres,jl+nres)
17340 sim = 1.0d0/sigm(d0ijCM)
17343 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17345 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17346 dxqwol(k,il)=dxqwol(k,il)+ddqij
17347 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17354 if((seg3-il).lt.3) then
17361 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17362 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17363 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17365 sim = 1.0d0/sigm(d0ij)
17368 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
17370 ddqij = (c(k,il)-c(k,jl))*fac
17371 dqwol(k,il)=dqwol(k,il)+ddqij
17372 dqwol(k,jl)=dqwol(k,jl)-ddqij
17374 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17377 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17378 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17379 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17380 dijCM=dist(il+nres,jl+nres)
17381 sim = 1.0d0/sigm(d0ijCM)
17384 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17386 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17387 dxqwol(k,il)=dxqwol(k,il)+ddqij
17388 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17397 dqwol(j,i)=dqwol(j,i)/nl
17398 dxqwol(j,i)=dxqwol(j,i)/nl
17402 end subroutine qwolynes_prim
17403 !-----------------------------------------------------------------------------
17404 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
17405 ! implicit real*8 (a-h,o-z)
17406 ! include 'DIMENSIONS'
17407 ! include 'COMMON.IOUNITS'
17408 ! include 'COMMON.CHAIN'
17409 ! include 'COMMON.INTERACT'
17410 ! include 'COMMON.VAR'
17411 integer :: seg1,seg2,seg3,seg4
17413 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
17414 real(kind=8),dimension(3,0:2*nres) :: cdummy
17415 real(kind=8) :: q1,q2
17416 real(kind=8) :: delta=1.0d-10
17421 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
17423 c(j,i)=c(j,i)+delta
17424 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
17425 qwolan(j,i)=(q2-q1)/delta
17431 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
17432 cdummy(j,i+nres)=c(j,i+nres)
17433 c(j,i+nres)=c(j,i+nres)+delta
17434 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
17435 qwolxan(j,i)=(q2-q1)/delta
17436 c(j,i+nres)=cdummy(j,i+nres)
17439 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
17441 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
17443 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
17445 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
17448 end subroutine qwol_num
17449 !-----------------------------------------------------------------------------
17450 subroutine EconstrQ
17451 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
17452 ! implicit real*8 (a-h,o-z)
17453 ! include 'DIMENSIONS'
17454 ! include 'COMMON.CONTROL'
17455 ! include 'COMMON.VAR'
17456 ! include 'COMMON.MD'
17459 ! include 'COMMON.LANGEVIN'
17461 ! include 'COMMON.LANGEVIN.lang0'
17463 ! include 'COMMON.CHAIN'
17464 ! include 'COMMON.DERIV'
17465 ! include 'COMMON.GEO'
17466 ! include 'COMMON.LOCAL'
17467 ! include 'COMMON.INTERACT'
17468 ! include 'COMMON.IOUNITS'
17469 ! include 'COMMON.NAMES'
17470 ! include 'COMMON.TIME1'
17471 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
17472 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
17474 integer :: kstart,kend,lstart,lend,idummy
17475 real(kind=8) :: delta=1.0d-7
17476 integer :: i,j,k,ii
17480 dudconst(j,i)=0.0d0
17481 duxconst(j,i)=0.0d0
17482 dudxconst(j,i)=0.0d0
17487 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
17489 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
17490 ! Calculating the derivatives of Constraint energy with respect to Q
17491 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
17493 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
17494 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
17495 ! hmnum=(hm2-hm1)/delta
17496 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
17497 ! & qinfrag(i,iset))
17498 ! write(iout,*) "harmonicnum frag", hmnum
17499 ! Calculating the derivatives of Q with respect to cartesian coordinates
17500 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
17502 ! write(iout,*) "dqwol "
17504 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17506 ! write(iout,*) "dxqwol "
17508 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17510 ! Calculating numerical gradients of dU/dQi and dQi/dxi
17511 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
17512 ! & ,idummy,idummy)
17513 ! The gradients of Uconst in Cs
17516 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
17517 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
17522 kstart=ifrag(1,ipair(1,i,iset),iset)
17523 kend=ifrag(2,ipair(1,i,iset),iset)
17524 lstart=ifrag(1,ipair(2,i,iset),iset)
17525 lend=ifrag(2,ipair(2,i,iset),iset)
17526 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
17527 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
17528 ! Calculating dU/dQ
17529 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
17530 ! hm1=harmonic(qpair(i),qinpair(i,iset))
17531 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
17532 ! hmnum=(hm2-hm1)/delta
17533 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
17534 ! & qinpair(i,iset))
17535 ! write(iout,*) "harmonicnum pair ", hmnum
17536 ! Calculating dQ/dXi
17537 call qwolynes_prim(kstart,kend,.false.,&
17539 ! write(iout,*) "dqwol "
17541 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17543 ! write(iout,*) "dxqwol "
17545 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17547 ! Calculating numerical gradients
17548 ! call qwol_num(kstart,kend,.false.
17550 ! The gradients of Uconst in Cs
17553 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
17554 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
17558 ! write(iout,*) "Uconst inside subroutine ", Uconst
17559 ! Transforming the gradients from Cs to dCs for the backbone
17563 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
17567 ! Transforming the gradients from Cs to dCs for the side chains
17570 dudxconst(j,i)=duxconst(j,i)
17573 ! write(iout,*) "dU/ddc backbone "
17575 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
17577 ! write(iout,*) "dU/ddX side chain "
17579 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
17581 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
17582 ! call dEconstrQ_num
17584 end subroutine EconstrQ
17585 !-----------------------------------------------------------------------------
17586 subroutine dEconstrQ_num
17587 ! Calculating numerical dUconst/ddc and dUconst/ddx
17588 ! implicit real*8 (a-h,o-z)
17589 ! include 'DIMENSIONS'
17590 ! include 'COMMON.CONTROL'
17591 ! include 'COMMON.VAR'
17592 ! include 'COMMON.MD'
17595 ! include 'COMMON.LANGEVIN'
17597 ! include 'COMMON.LANGEVIN.lang0'
17599 ! include 'COMMON.CHAIN'
17600 ! include 'COMMON.DERIV'
17601 ! include 'COMMON.GEO'
17602 ! include 'COMMON.LOCAL'
17603 ! include 'COMMON.INTERACT'
17604 ! include 'COMMON.IOUNITS'
17605 ! include 'COMMON.NAMES'
17606 ! include 'COMMON.TIME1'
17607 real(kind=8) :: uzap1,uzap2
17608 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
17609 integer :: kstart,kend,lstart,lend,idummy
17610 real(kind=8) :: delta=1.0d-7
17611 !el local variables
17617 dUcartan(j,i)=0.0d0
17618 cdummy(j,i)=dc(j,i)
17619 dc(j,i)=dc(j,i)+delta
17620 call chainbuild_cart
17623 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17625 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17629 kstart=ifrag(1,ipair(1,ii,iset),iset)
17630 kend=ifrag(2,ipair(1,ii,iset),iset)
17631 lstart=ifrag(1,ipair(2,ii,iset),iset)
17632 lend=ifrag(2,ipair(2,ii,iset),iset)
17633 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17634 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17637 dc(j,i)=cdummy(j,i)
17638 call chainbuild_cart
17641 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17643 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17647 kstart=ifrag(1,ipair(1,ii,iset),iset)
17648 kend=ifrag(2,ipair(1,ii,iset),iset)
17649 lstart=ifrag(1,ipair(2,ii,iset),iset)
17650 lend=ifrag(2,ipair(2,ii,iset),iset)
17651 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17652 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17655 ducartan(j,i)=(uzap2-uzap1)/(delta)
17658 ! Calculating numerical gradients for dU/ddx
17660 duxcartan(j,i)=0.0d0
17662 cdummy(j,i)=dc(j,i+nres)
17663 dc(j,i+nres)=dc(j,i+nres)+delta
17664 call chainbuild_cart
17667 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17669 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17673 kstart=ifrag(1,ipair(1,ii,iset),iset)
17674 kend=ifrag(2,ipair(1,ii,iset),iset)
17675 lstart=ifrag(1,ipair(2,ii,iset),iset)
17676 lend=ifrag(2,ipair(2,ii,iset),iset)
17677 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17678 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17681 dc(j,i+nres)=cdummy(j,i)
17682 call chainbuild_cart
17685 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
17686 ifrag(2,ii,iset),.true.,idummy,idummy)
17687 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17691 kstart=ifrag(1,ipair(1,ii,iset),iset)
17692 kend=ifrag(2,ipair(1,ii,iset),iset)
17693 lstart=ifrag(1,ipair(2,ii,iset),iset)
17694 lend=ifrag(2,ipair(2,ii,iset),iset)
17695 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17696 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17699 duxcartan(j,i)=(uzap2-uzap1)/(delta)
17702 write(iout,*) "Numerical dUconst/ddc backbone "
17704 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
17706 ! write(iout,*) "Numerical dUconst/ddx side-chain "
17708 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
17711 end subroutine dEconstrQ_num
17712 !-----------------------------------------------------------------------------
17714 !-----------------------------------------------------------------------------
17715 subroutine check_energies
17717 ! use random, only: ran_number
17721 ! include 'DIMENSIONS'
17722 ! include 'COMMON.CHAIN'
17723 ! include 'COMMON.VAR'
17724 ! include 'COMMON.IOUNITS'
17725 ! include 'COMMON.SBRIDGE'
17726 ! include 'COMMON.LOCAL'
17727 ! include 'COMMON.GEO'
17729 ! External functions
17730 !EL double precision ran_number
17731 !EL external ran_number
17734 integer :: i,j,k,l,lmax,p,pmax
17735 real(kind=8) :: rmin,rmax
17736 real(kind=8) :: eij
17739 real(kind=8) :: wi,rij,tj,pj
17761 !t wi=ran_number(0.0D0,pi)
17762 ! wi=ran_number(0.0D0,pi/6.0D0)
17764 !t tj=ran_number(0.0D0,pi)
17765 !t pj=ran_number(0.0D0,pi)
17766 ! pj=ran_number(0.0D0,pi/6.0D0)
17770 !t rij=ran_number(rmin,rmax)
17772 c(1,j)=d*sin(pj)*cos(tj)
17773 c(2,j)=d*sin(pj)*sin(tj)
17779 c(3,i)=-rij-d*cos(wi)
17782 dc(k,nres+i)=c(k,nres+i)-c(k,i)
17783 dc_norm(k,nres+i)=dc(k,nres+i)/d
17784 dc(k,nres+j)=c(k,nres+j)-c(k,j)
17785 dc_norm(k,nres+j)=dc(k,nres+j)/d
17788 call dyn_ssbond_ene(i,j,eij)
17793 end subroutine check_energies
17794 !-----------------------------------------------------------------------------
17795 subroutine dyn_ssbond_ene(resi,resj,eij)
17800 ! include 'DIMENSIONS'
17801 ! include 'COMMON.SBRIDGE'
17802 ! include 'COMMON.CHAIN'
17803 ! include 'COMMON.DERIV'
17804 ! include 'COMMON.LOCAL'
17805 ! include 'COMMON.INTERACT'
17806 ! include 'COMMON.VAR'
17807 ! include 'COMMON.IOUNITS'
17808 ! include 'COMMON.CALC'
17812 ! include 'COMMON.MD'
17813 ! use MD, only: totT,t_bath
17816 ! External functions
17817 !EL double precision h_base
17818 !EL external h_base
17821 integer :: resi,resj
17824 real(kind=8) :: eij
17827 logical :: havebond
17828 integer itypi,itypj
17829 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
17830 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
17831 real(kind=8),dimension(3) :: dcosom1,dcosom2
17833 real(kind=8) :: pom1,pom2
17834 real(kind=8) :: ljA,ljB,ljXs
17835 real(kind=8),dimension(1:3) :: d_ljB
17836 real(kind=8) :: ssA,ssB,ssC,ssXs
17837 real(kind=8) :: ssxm,ljxm,ssm,ljm
17838 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
17839 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
17840 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
17841 !-------FIRST METHOD
17843 real(kind=8),dimension(1:3) :: d_xm
17844 !-------END FIRST METHOD
17845 !-------SECOND METHOD
17846 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
17847 !-------END SECOND METHOD
17849 !-------TESTING CODE
17850 !el logical :: checkstop,transgrad
17851 !el common /sschecks/ checkstop,transgrad
17853 integer :: icheck,nicheck,jcheck,njcheck
17854 real(kind=8),dimension(-1:1) :: echeck
17855 real(kind=8) :: deps,ssx0,ljx0
17856 !-------END TESTING CODE
17862 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
17863 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
17866 dxi=dc_norm(1,nres+i)
17867 dyi=dc_norm(2,nres+i)
17868 dzi=dc_norm(3,nres+i)
17869 dsci_inv=vbld_inv(i+nres)
17872 xj=c(1,nres+j)-c(1,nres+i)
17873 yj=c(2,nres+j)-c(2,nres+i)
17874 zj=c(3,nres+j)-c(3,nres+i)
17875 dxj=dc_norm(1,nres+j)
17876 dyj=dc_norm(2,nres+j)
17877 dzj=dc_norm(3,nres+j)
17878 dscj_inv=vbld_inv(j+nres)
17880 chi1=chi(itypi,itypj)
17881 chi2=chi(itypj,itypi)
17888 alf12=0.5D0*(alf1+alf2)
17890 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
17891 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
17892 ! The following are set in sc_angular
17896 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
17897 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
17898 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
17900 rij=1.0D0/rij ! Reset this so it makes sense
17902 sig0ij=sigma(itypi,itypj)
17903 sig=sig0ij*dsqrt(1.0D0/sigsq)
17906 ljA=eps1*eps2rt**2*eps3rt**2
17907 ljB=ljA*bb_aq(itypi,itypj)
17908 ljA=ljA*aa_aq(itypi,itypj)
17909 ljxm=ljXs+(-2.0D0*aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
17914 deltat12=om2-om1+2.0d0
17915 cosphi=om12-om1*om2
17919 +akth*(deltat1*deltat1+deltat2*deltat2) &
17920 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
17921 ssxm=ssXs-0.5D0*ssB/ssA
17923 !-------TESTING CODE
17924 !$$$c Some extra output
17925 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
17926 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
17927 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
17928 !$$$ if (ssx0.gt.0.0d0) then
17929 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
17933 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
17934 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
17935 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
17937 !-------END TESTING CODE
17939 !-------TESTING CODE
17940 ! Stop and plot energy and derivative as a function of distance
17941 if (checkstop) then
17942 ssm=ssC-0.25D0*ssB*ssB/ssA
17943 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
17944 if (ssm.lt.ljm .and. &
17945 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
17953 if (.not.checkstop) then
17958 do icheck=0,nicheck
17959 do jcheck=-1,njcheck
17960 if (checkstop) rij=(ssxm-1.0d0)+ &
17961 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
17962 !-------END TESTING CODE
17964 if (rij.gt.ljxm) then
17967 fac=(1.0D0/ljd)**expon
17968 e1=fac*fac*aa_aq(itypi,itypj)
17969 e2=fac*bb_aq(itypi,itypj)
17970 eij=eps1*eps2rt*eps3rt*(e1+e2)
17973 eij=eij*eps2rt*eps3rt
17976 e1=e1*eps1*eps2rt**2*eps3rt**2
17977 ed=-expon*(e1+eij)/ljd
17979 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
17980 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
17981 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
17982 -2.0D0*alf12*eps3der+sigder*sigsq_om12
17983 else if (rij.lt.ssxm) then
17986 eij=ssA*ssd*ssd+ssB*ssd+ssC
17988 ed=2*akcm*ssd+akct*deltat12
17990 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
17991 eom1=-2*akth*deltat1-pom1-om2*pom2
17992 eom2= 2*akth*deltat2+pom1-om1*pom2
17995 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
17997 d_ssxm(1)=0.5D0*akct/ssA
17998 d_ssxm(2)=-d_ssxm(1)
18001 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
18002 d_ljxm(2)=d_ljxm(1)*sigsq_om2
18003 d_ljxm(3)=d_ljxm(1)*sigsq_om12
18004 d_ljxm(1)=d_ljxm(1)*sigsq_om1
18006 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
18007 xm=0.5d0*(ssxm+ljxm)
18009 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
18011 if (rij.lt.xm) then
18013 ssm=ssC-0.25D0*ssB*ssB/ssA
18014 d_ssm(1)=0.5D0*akct*ssB/ssA
18015 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
18016 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
18018 f1=(rij-xm)/(ssxm-xm)
18019 f2=(rij-ssxm)/(xm-ssxm)
18023 delta_inv=1.0d0/(xm-ssxm)
18024 deltasq_inv=delta_inv*delta_inv
18026 fac1=deltasq_inv*fac*(xm-rij)
18027 fac2=deltasq_inv*fac*(rij-ssxm)
18028 ed=delta_inv*(Ht*hd2-ssm*hd1)
18029 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
18030 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
18031 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
18034 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
18035 d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
18036 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
18037 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
18039 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
18040 f1=(rij-ljxm)/(xm-ljxm)
18041 f2=(rij-xm)/(ljxm-xm)
18045 delta_inv=1.0d0/(ljxm-xm)
18046 deltasq_inv=delta_inv*delta_inv
18048 fac1=deltasq_inv*fac*(ljxm-rij)
18049 fac2=deltasq_inv*fac*(rij-xm)
18050 ed=delta_inv*(ljm*hd2-Ht*hd1)
18051 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
18052 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
18053 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
18055 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
18057 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
18063 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
18064 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
18065 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
18067 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
18068 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
18069 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
18070 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
18071 !$$$ d_ssm(3)=omega
18073 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
18075 !$$$ d_ljm(k)=ljm*d_ljB(k)
18079 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
18080 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
18081 !$$$ d_ss(2)=akct*ssd
18082 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
18083 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
18086 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
18087 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
18088 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
18090 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
18091 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
18093 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
18095 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
18096 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
18097 !$$$ h1=h_base(f1,hd1)
18098 !$$$ h2=h_base(f2,hd2)
18099 !$$$ eij=ss*h1+ljf*h2
18100 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
18101 !$$$ deltasq_inv=delta_inv*delta_inv
18102 !$$$ fac=ljf*hd2-ss*hd1
18103 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
18104 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
18105 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
18106 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
18107 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
18108 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
18109 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
18111 !$$$ havebond=.false.
18112 !$$$ if (ed.gt.0.0d0) havebond=.true.
18113 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
18120 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
18121 ! write(iout,'(a15,f12.2,f8.1,2i5)')
18122 ! & "SSBOND_E_FORM",totT,t_bath,i,j
18126 dyn_ssbond_ij(i,j)=eij
18127 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
18128 dyn_ssbond_ij(i,j)=1.0d300
18131 ! write(iout,'(a15,f12.2,f8.1,2i5)')
18132 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
18137 !-------TESTING CODE
18138 !el if (checkstop) then
18139 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
18140 "CHECKSTOP",rij,eij,ed
18144 if (checkstop) then
18145 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
18148 if (checkstop) then
18152 !-------END TESTING CODE
18155 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
18156 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
18159 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
18162 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
18163 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
18164 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
18165 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
18166 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
18167 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
18171 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
18176 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18177 gvdwc(l,j)=gvdwc(l,j)+gg(l)
18181 end subroutine dyn_ssbond_ene
18182 !--------------------------------------------------------------------------
18183 subroutine triple_ssbond_ene(resi,resj,resk,eij)
18188 ! include 'DIMENSIONS'
18189 ! include 'COMMON.SBRIDGE'
18190 ! include 'COMMON.CHAIN'
18191 ! include 'COMMON.DERIV'
18192 ! include 'COMMON.LOCAL'
18193 ! include 'COMMON.INTERACT'
18194 ! include 'COMMON.VAR'
18195 ! include 'COMMON.IOUNITS'
18196 ! include 'COMMON.CALC'
18200 ! include 'COMMON.MD'
18201 ! use MD, only: totT,t_bath
18204 double precision h_base
18208 integer resi,resj,resk,m,itypi,itypj,itypk
18210 !c Output arguments
18211 double precision eij,eij1,eij2,eij3
18215 !c integer itypi,itypj,k,l
18216 double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi
18217 double precision rrik,rrjk,rik,rjk,xi,xk,yi,yk,zi,zk,xij,yij,zij
18218 double precision xik,yik,zik,xjk,yjk,zjk,dxk,dyk,dzk
18219 double precision sig0ij,ljd,sig,fac,e1,e2
18220 double precision dcosom1(3),dcosom2(3),ed
18221 double precision pom1,pom2
18222 double precision ljA,ljB,ljXs
18223 double precision d_ljB(1:3)
18224 double precision ssA,ssB,ssC,ssXs
18225 double precision ssxm,ljxm,ssm,ljm
18226 double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3)
18228 if (dtriss.eq.0) return
18232 !C write(iout,*) resi,resj,resk
18234 dxi=dc_norm(1,nres+i)
18235 dyi=dc_norm(2,nres+i)
18236 dzi=dc_norm(3,nres+i)
18237 dsci_inv=vbld_inv(i+nres)
18246 dxj=dc_norm(1,nres+j)
18247 dyj=dc_norm(2,nres+j)
18248 dzj=dc_norm(3,nres+j)
18249 dscj_inv=vbld_inv(j+nres)
18255 dxk=dc_norm(1,nres+k)
18256 dyk=dc_norm(2,nres+k)
18257 dzk=dc_norm(3,nres+k)
18258 dscj_inv=vbld_inv(k+nres)
18268 rrij=(xij*xij+yij*yij+zij*zij)
18269 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
18270 rrik=(xik*xik+yik*yik+zik*zik)
18272 rrjk=(xjk*xjk+yjk*yjk+zjk*zjk)
18274 !C there are three combination of distances for each trisulfide bonds
18275 !C The first case the ith atom is the center
18276 !C Energy function is E=d/(a*(x-y)**2+b*(x+y)**2+c) where x is first
18277 !C distance y is second distance the a,b,c,d are parameters derived for
18278 !C this problem d parameter was set as a penalty currenlty set to 1.
18279 if ((iabs(j-i).le.2).or.(iabs(i-k).le.2)) then
18282 eij1=dtriss/(atriss*(rij-rik)**2+btriss*(rij+rik)**6+ctriss)
18284 !C second case jth atom is center
18285 if ((iabs(j-i).le.2).or.(iabs(j-k).le.2)) then
18288 eij2=dtriss/(atriss*(rij-rjk)**2+btriss*(rij+rjk)**6+ctriss)
18290 !C the third case kth atom is the center
18291 if ((iabs(i-k).le.2).or.(iabs(j-k).le.2)) then
18294 eij3=dtriss/(atriss*(rik-rjk)**2+btriss*(rik+rjk)**6+ctriss)
18300 !C write(iout,*)i,j,k,eij
18301 !C The energy penalty calculated now time for the gradient part
18302 !C derivative over rij
18303 fac=-eij1**2/dtriss*(2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
18304 -eij2**2/dtriss*(2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)
18309 gvdwx(m,i)=gvdwx(m,i)-gg(m)
18310 gvdwx(m,j)=gvdwx(m,j)+gg(m)
18314 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18315 gvdwc(l,j)=gvdwc(l,j)+gg(l)
18317 !C now derivative over rik
18318 fac=-eij1**2/dtriss* &
18319 (-2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
18320 -eij3**2/dtriss*(2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
18325 gvdwx(m,i)=gvdwx(m,i)-gg(m)
18326 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18329 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18330 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18332 !C now derivative over rjk
18333 fac=-eij2**2/dtriss* &
18334 (-2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)- &
18335 eij3**2/dtriss*(-2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
18340 gvdwx(m,j)=gvdwx(m,j)-gg(m)
18341 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18344 gvdwc(l,j)=gvdwc(l,j)-gg(l)
18345 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18348 end subroutine triple_ssbond_ene
18352 !-----------------------------------------------------------------------------
18353 real(kind=8) function h_base(x,deriv)
18354 ! A smooth function going 0->1 in range [0,1]
18355 ! It should NOT be called outside range [0,1], it will not work there.
18362 real(kind=8) :: deriv
18365 real(kind=8) :: xsq
18368 ! Two parabolas put together. First derivative zero at extrema
18369 !$$$ if (x.lt.0.5D0) then
18370 !$$$ h_base=2.0D0*x*x
18374 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
18375 !$$$ deriv=4.0D0*deriv
18378 ! Third degree polynomial. First derivative zero at extrema
18379 h_base=x*x*(3.0d0-2.0d0*x)
18380 deriv=6.0d0*x*(1.0d0-x)
18382 ! Fifth degree polynomial. First and second derivatives zero at extrema
18384 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
18386 !$$$ deriv=deriv*deriv
18387 !$$$ deriv=30.0d0*xsq*deriv
18390 end function h_base
18391 !-----------------------------------------------------------------------------
18392 subroutine dyn_set_nss
18393 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
18395 use MD_data, only: totT,t_bath
18397 ! include 'DIMENSIONS'
18401 ! include 'COMMON.SBRIDGE'
18402 ! include 'COMMON.CHAIN'
18403 ! include 'COMMON.IOUNITS'
18404 ! include 'COMMON.SETUP'
18405 ! include 'COMMON.MD'
18407 real(kind=8) :: emin
18408 integer :: i,j,imin,ierr
18409 integer :: diff,allnss,newnss
18410 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
18413 integer,dimension(0:nfgtasks) :: i_newnss
18414 integer,dimension(0:nfgtasks) :: displ
18415 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
18416 integer :: g_newnss
18421 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
18430 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
18434 if (allflag(i).eq.0 .and. &
18435 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
18436 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
18440 if (emin.lt.1.0d300) then
18443 if (allflag(i).eq.0 .and. &
18444 (allihpb(i).eq.allihpb(imin) .or. &
18445 alljhpb(i).eq.allihpb(imin) .or. &
18446 allihpb(i).eq.alljhpb(imin) .or. &
18447 alljhpb(i).eq.alljhpb(imin))) then
18454 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
18458 if (allflag(i).eq.1) then
18460 newihpb(newnss)=allihpb(i)
18461 newjhpb(newnss)=alljhpb(i)
18466 if (nfgtasks.gt.1)then
18468 call MPI_Reduce(newnss,g_newnss,1,&
18469 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
18470 call MPI_Gather(newnss,1,MPI_INTEGER,&
18471 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
18473 do i=1,nfgtasks-1,1
18474 displ(i)=i_newnss(i-1)+displ(i-1)
18476 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
18477 g_newihpb,i_newnss,displ,MPI_INTEGER,&
18479 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
18480 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
18482 if(fg_rank.eq.0) then
18483 ! print *,'g_newnss',g_newnss
18484 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
18485 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
18488 newihpb(i)=g_newihpb(i)
18489 newjhpb(i)=g_newjhpb(i)
18497 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
18498 ! print *,newnss,nss,maxdim
18504 if (idssb(i).eq.newihpb(j) .and. &
18505 jdssb(i).eq.newjhpb(j)) found=.true.
18509 ! write(iout,*) "found",found,i,j
18510 if (.not.found.and.fg_rank.eq.0) &
18511 write(iout,'(a15,f12.2,f8.1,2i5)') &
18512 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
18521 if (newihpb(i).eq.idssb(j) .and. &
18522 newjhpb(i).eq.jdssb(j)) found=.true.
18526 ! write(iout,*) "found",found,i,j
18527 if (.not.found.and.fg_rank.eq.0) &
18528 write(iout,'(a15,f12.2,f8.1,2i5)') &
18529 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
18536 idssb(i)=newihpb(i)
18537 jdssb(i)=newjhpb(i)
18541 end subroutine dyn_set_nss
18542 ! Lipid transfer energy function
18543 subroutine Eliptransfer(eliptran)
18544 !C this is done by Adasko
18545 !C print *,"wchodze"
18546 !C structure of box:
18548 !C--bordliptop-- buffore starts
18549 !C--bufliptop--- here true lipid starts
18551 !C--buflipbot--- lipid ends buffore starts
18552 !C--bordlipbot--buffore ends
18553 real(kind=8) :: fracinbuf,eliptran,sslip,positi,ssgradlip
18556 ! print *, "I am in eliptran"
18557 do i=ilip_start,ilip_end
18559 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))&
18562 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
18563 if (positi.le.0.0) positi=positi+boxzsize
18565 !C first for peptide groups
18566 !c for each residue check if it is in lipid or lipid water border area
18567 if ((positi.gt.bordlipbot) &
18568 .and.(positi.lt.bordliptop)) then
18569 !C the energy transfer exist
18570 if (positi.lt.buflipbot) then
18571 !C what fraction I am in
18573 ((positi-bordlipbot)/lipbufthick)
18574 !C lipbufthick is thickenes of lipid buffore
18575 sslip=sscalelip(fracinbuf)
18576 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
18577 eliptran=eliptran+sslip*pepliptran
18578 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
18579 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
18580 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
18582 !C print *,"doing sccale for lower part"
18583 !C print *,i,sslip,fracinbuf,ssgradlip
18584 elseif (positi.gt.bufliptop) then
18585 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
18586 sslip=sscalelip(fracinbuf)
18587 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
18588 eliptran=eliptran+sslip*pepliptran
18589 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
18590 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
18591 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
18592 !C print *, "doing sscalefor top part"
18593 !C print *,i,sslip,fracinbuf,ssgradlip
18595 eliptran=eliptran+pepliptran
18596 !C print *,"I am in true lipid"
18599 !C eliptran=elpitran+0.0 ! I am in water
18601 if (energy_dec) write(iout,*) i,"eliptran=",eliptran,positi,sslip
18603 ! here starts the side chain transfer
18604 do i=ilip_start,ilip_end
18605 if (itype(i,1).eq.ntyp1) cycle
18606 positi=(mod(c(3,i+nres),boxzsize))
18607 if (positi.le.0) positi=positi+boxzsize
18608 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18609 !c for each residue check if it is in lipid or lipid water border area
18610 !C respos=mod(c(3,i+nres),boxzsize)
18611 !C print *,positi,bordlipbot,buflipbot
18612 if ((positi.gt.bordlipbot) &
18613 .and.(positi.lt.bordliptop)) then
18614 !C the energy transfer exist
18615 if (positi.lt.buflipbot) then
18617 ((positi-bordlipbot)/lipbufthick)
18618 !C lipbufthick is thickenes of lipid buffore
18619 sslip=sscalelip(fracinbuf)
18620 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
18621 eliptran=eliptran+sslip*liptranene(itype(i,1))
18622 gliptranx(3,i)=gliptranx(3,i) &
18623 +ssgradlip*liptranene(itype(i,1))
18624 gliptranc(3,i-1)= gliptranc(3,i-1) &
18625 +ssgradlip*liptranene(itype(i,1))
18626 !C print *,"doing sccale for lower part"
18627 elseif (positi.gt.bufliptop) then
18629 ((bordliptop-positi)/lipbufthick)
18630 sslip=sscalelip(fracinbuf)
18631 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
18632 eliptran=eliptran+sslip*liptranene(itype(i,1))
18633 gliptranx(3,i)=gliptranx(3,i) &
18634 +ssgradlip*liptranene(itype(i,1))
18635 gliptranc(3,i-1)= gliptranc(3,i-1) &
18636 +ssgradlip*liptranene(itype(i,1))
18637 !C print *, "doing sscalefor top part",sslip,fracinbuf
18639 eliptran=eliptran+liptranene(itype(i,1))
18640 !C print *,"I am in true lipid"
18642 endif ! if in lipid or buffor
18644 !C eliptran=elpitran+0.0 ! I am in water
18645 if (energy_dec) write(iout,*) i,"eliptran=",eliptran
18648 end subroutine Eliptransfer
18649 !----------------------------------NANO FUNCTIONS
18650 !C-----------------------------------------------------------------------
18651 !C-----------------------------------------------------------
18652 !C This subroutine is to mimic the histone like structure but as well can be
18653 !C utilizet to nanostructures (infinit) small modification has to be used to
18654 !C make it finite (z gradient at the ends has to be changes as well as the x,y
18655 !C gradient has to be modified at the ends
18656 !C The energy function is Kihara potential
18657 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
18658 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
18659 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
18660 !C simple Kihara potential
18661 subroutine calctube(Etube)
18662 real(kind=8),dimension(3) :: vectube
18663 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18664 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi, &
18665 sc_aa_tube,sc_bb_tube
18668 do i=itube_start,itube_end
18670 enetube(i+nres)=0.0d0
18672 !C first we calculate the distance from tube center
18674 do i=itube_start,itube_end
18675 !C lets ommit dummy atoms for now
18676 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18677 !C now calculate distance from center of tube and direction vectors
18680 ! Find minimum distance in periodic box
18682 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18683 vectube(1)=vectube(1)+boxxsize*j
18684 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18685 vectube(2)=vectube(2)+boxysize*j
18686 xminact=abs(vectube(1)-tubecenter(1))
18687 yminact=abs(vectube(2)-tubecenter(2))
18688 if (xmin.gt.xminact) then
18692 if (ymin.gt.yminact) then
18699 vectube(1)=vectube(1)-tubecenter(1)
18700 vectube(2)=vectube(2)-tubecenter(2)
18702 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18703 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18705 !C as the tube is infinity we do not calculate the Z-vector use of Z
18708 !C now calculte the distance
18709 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18710 !C now normalize vector
18711 vectube(1)=vectube(1)/tub_r
18712 vectube(2)=vectube(2)/tub_r
18713 !C calculte rdiffrence between r and r0
18716 rdiff6=rdiff**6.0d0
18717 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18718 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
18719 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18720 !C print *,rdiff,rdiff6,pep_aa_tube
18721 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18722 !C now we calculate gradient
18723 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18724 6.0d0*pep_bb_tube)/rdiff6/rdiff
18725 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18727 !C now direction of gg_tube vector
18729 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18730 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18733 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18734 !C print *,gg_tube(1,0),"TU"
18737 do i=itube_start,itube_end
18738 !C Lets not jump over memory as we use many times iti
18740 !C lets ommit dummy atoms for now
18741 if ((iti.eq.ntyp1) &
18742 !C in UNRES uncomment the line below as GLY has no side-chain...
18748 vectube(1)=mod((c(1,i+nres)),boxxsize)
18749 vectube(1)=vectube(1)+boxxsize*j
18750 vectube(2)=mod((c(2,i+nres)),boxysize)
18751 vectube(2)=vectube(2)+boxysize*j
18753 xminact=abs(vectube(1)-tubecenter(1))
18754 yminact=abs(vectube(2)-tubecenter(2))
18755 if (xmin.gt.xminact) then
18759 if (ymin.gt.yminact) then
18766 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
18768 vectube(1)=vectube(1)-tubecenter(1)
18769 vectube(2)=vectube(2)-tubecenter(2)
18771 !C as the tube is infinity we do not calculate the Z-vector use of Z
18774 !C now calculte the distance
18775 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18776 !C now normalize vector
18777 vectube(1)=vectube(1)/tub_r
18778 vectube(2)=vectube(2)/tub_r
18780 !C calculte rdiffrence between r and r0
18783 rdiff6=rdiff**6.0d0
18784 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18785 sc_aa_tube=sc_aa_tube_par(iti)
18786 sc_bb_tube=sc_bb_tube_par(iti)
18787 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
18788 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
18789 6.0d0*sc_bb_tube/rdiff6/rdiff
18790 !C now direction of gg_tube vector
18792 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
18793 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
18796 do i=itube_start,itube_end
18797 Etube=Etube+enetube(i)+enetube(i+nres)
18799 !C print *,"ETUBE", etube
18801 end subroutine calctube
18802 !C TO DO 1) add to total energy
18803 !C 2) add to gradient summation
18804 !C 3) add reading parameters (AND of course oppening of PARAM file)
18805 !C 4) add reading the center of tube
18807 !C 6) add to zerograd
18808 !C 7) allocate matrices
18811 !C-----------------------------------------------------------------------
18812 !C-----------------------------------------------------------
18813 !C This subroutine is to mimic the histone like structure but as well can be
18814 !C utilizet to nanostructures (infinit) small modification has to be used to
18815 !C make it finite (z gradient at the ends has to be changes as well as the x,y
18816 !C gradient has to be modified at the ends
18817 !C The energy function is Kihara potential
18818 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
18819 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
18820 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
18821 !C simple Kihara potential
18822 subroutine calctube2(Etube)
18823 real(kind=8),dimension(3) :: vectube
18824 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18825 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi,fracinbuf,&
18826 sstube,ssgradtube,sc_aa_tube,sc_bb_tube
18829 do i=itube_start,itube_end
18831 enetube(i+nres)=0.0d0
18833 !C first we calculate the distance from tube center
18834 !C first sugare-phosphate group for NARES this would be peptide group
18836 do i=itube_start,itube_end
18837 !C lets ommit dummy atoms for now
18839 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18840 !C now calculate distance from center of tube and direction vectors
18841 !C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18842 !C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
18843 !C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18844 !C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
18848 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18849 vectube(1)=vectube(1)+boxxsize*j
18850 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18851 vectube(2)=vectube(2)+boxysize*j
18853 xminact=abs(vectube(1)-tubecenter(1))
18854 yminact=abs(vectube(2)-tubecenter(2))
18855 if (xmin.gt.xminact) then
18859 if (ymin.gt.yminact) then
18866 vectube(1)=vectube(1)-tubecenter(1)
18867 vectube(2)=vectube(2)-tubecenter(2)
18869 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18870 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18872 !C as the tube is infinity we do not calculate the Z-vector use of Z
18875 !C now calculte the distance
18876 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18877 !C now normalize vector
18878 vectube(1)=vectube(1)/tub_r
18879 vectube(2)=vectube(2)/tub_r
18880 !C calculte rdiffrence between r and r0
18883 rdiff6=rdiff**6.0d0
18884 !C THIS FRAGMENT MAKES TUBE FINITE
18885 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
18886 if (positi.le.0) positi=positi+boxzsize
18887 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18888 !c for each residue check if it is in lipid or lipid water border area
18889 !C respos=mod(c(3,i+nres),boxzsize)
18890 !C print *,positi,bordtubebot,buftubebot,bordtubetop
18891 if ((positi.gt.bordtubebot) &
18892 .and.(positi.lt.bordtubetop)) then
18893 !C the energy transfer exist
18894 if (positi.lt.buftubebot) then
18896 ((positi-bordtubebot)/tubebufthick)
18897 !C lipbufthick is thickenes of lipid buffore
18898 sstube=sscalelip(fracinbuf)
18899 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
18900 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
18901 enetube(i)=enetube(i)+sstube*tubetranenepep
18902 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18903 !C &+ssgradtube*tubetranene(itype(i,1))
18904 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18905 !C &+ssgradtube*tubetranene(itype(i,1))
18906 !C print *,"doing sccale for lower part"
18907 elseif (positi.gt.buftubetop) then
18909 ((bordtubetop-positi)/tubebufthick)
18910 sstube=sscalelip(fracinbuf)
18911 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
18912 enetube(i)=enetube(i)+sstube*tubetranenepep
18913 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18914 !C &+ssgradtube*tubetranene(itype(i,1))
18915 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18916 !C &+ssgradtube*tubetranene(itype(i,1))
18917 !C print *, "doing sscalefor top part",sslip,fracinbuf
18921 enetube(i)=enetube(i)+sstube*tubetranenepep
18922 !C print *,"I am in true lipid"
18926 !C ssgradtube=0.0d0
18928 endif ! if in lipid or buffor
18930 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18931 enetube(i)=enetube(i)+sstube* &
18932 (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
18933 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18934 !C print *,rdiff,rdiff6,pep_aa_tube
18935 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18936 !C now we calculate gradient
18937 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18938 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
18939 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18942 !C now direction of gg_tube vector
18944 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18945 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18947 gg_tube(3,i)=gg_tube(3,i) &
18948 +ssgradtube*enetube(i)/sstube/2.0d0
18949 gg_tube(3,i-1)= gg_tube(3,i-1) &
18950 +ssgradtube*enetube(i)/sstube/2.0d0
18953 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18954 !C print *,gg_tube(1,0),"TU"
18955 do i=itube_start,itube_end
18956 !C Lets not jump over memory as we use many times iti
18958 !C lets ommit dummy atoms for now
18959 if ((iti.eq.ntyp1) &
18960 !!C in UNRES uncomment the line below as GLY has no side-chain...
18963 vectube(1)=c(1,i+nres)
18964 vectube(1)=mod(vectube(1),boxxsize)
18965 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
18966 vectube(2)=c(2,i+nres)
18967 vectube(2)=mod(vectube(2),boxysize)
18968 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
18970 vectube(1)=vectube(1)-tubecenter(1)
18971 vectube(2)=vectube(2)-tubecenter(2)
18972 !C THIS FRAGMENT MAKES TUBE FINITE
18973 positi=(mod(c(3,i+nres),boxzsize))
18974 if (positi.le.0) positi=positi+boxzsize
18975 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18976 !c for each residue check if it is in lipid or lipid water border area
18977 !C respos=mod(c(3,i+nres),boxzsize)
18978 !C print *,positi,bordtubebot,buftubebot,bordtubetop
18980 if ((positi.gt.bordtubebot) &
18981 .and.(positi.lt.bordtubetop)) then
18982 !C the energy transfer exist
18983 if (positi.lt.buftubebot) then
18985 ((positi-bordtubebot)/tubebufthick)
18986 !C lipbufthick is thickenes of lipid buffore
18987 sstube=sscalelip(fracinbuf)
18988 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
18989 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
18990 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
18991 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18992 !C &+ssgradtube*tubetranene(itype(i,1))
18993 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18994 !C &+ssgradtube*tubetranene(itype(i,1))
18995 !C print *,"doing sccale for lower part"
18996 elseif (positi.gt.buftubetop) then
18998 ((bordtubetop-positi)/tubebufthick)
19000 sstube=sscalelip(fracinbuf)
19001 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
19002 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19003 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19004 !C &+ssgradtube*tubetranene(itype(i,1))
19005 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19006 !C &+ssgradtube*tubetranene(itype(i,1))
19007 !C print *, "doing sscalefor top part",sslip,fracinbuf
19011 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19012 !C print *,"I am in true lipid"
19016 !C ssgradtube=0.0d0
19018 endif ! if in lipid or buffor
19019 !CEND OF FINITE FRAGMENT
19020 !C as the tube is infinity we do not calculate the Z-vector use of Z
19023 !C now calculte the distance
19024 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19025 !C now normalize vector
19026 vectube(1)=vectube(1)/tub_r
19027 vectube(2)=vectube(2)/tub_r
19028 !C calculte rdiffrence between r and r0
19031 rdiff6=rdiff**6.0d0
19032 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19033 sc_aa_tube=sc_aa_tube_par(iti)
19034 sc_bb_tube=sc_bb_tube_par(iti)
19035 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)&
19036 *sstube+enetube(i+nres)
19037 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19038 !C now we calculate gradient
19039 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-&
19040 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
19041 !C now direction of gg_tube vector
19043 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19044 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19046 gg_tube_SC(3,i)=gg_tube_SC(3,i) &
19047 +ssgradtube*enetube(i+nres)/sstube
19048 gg_tube(3,i-1)= gg_tube(3,i-1) &
19049 +ssgradtube*enetube(i+nres)/sstube
19052 do i=itube_start,itube_end
19053 Etube=Etube+enetube(i)+enetube(i+nres)
19055 !C print *,"ETUBE", etube
19057 end subroutine calctube2
19058 !=====================================================================================================================================
19059 subroutine calcnano(Etube)
19060 real(kind=8),dimension(3) :: vectube
19062 real(kind=8) :: Etube,xtemp,xminact,yminact,&
19063 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,denominator,faccav,&
19064 sc_aa_tube,sc_bb_tube,zmin,ztemp,zminact
19065 integer:: i,j,iti,r
19068 ! print *,itube_start,itube_end,"poczatek"
19069 do i=itube_start,itube_end
19071 enetube(i+nres)=0.0d0
19073 !C first we calculate the distance from tube center
19074 !C first sugare-phosphate group for NARES this would be peptide group
19076 do i=itube_start,itube_end
19077 !C lets ommit dummy atoms for now
19078 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
19079 !C now calculate distance from center of tube and direction vectors
19085 vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19086 vectube(1)=vectube(1)+boxxsize*j
19087 vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19088 vectube(2)=vectube(2)+boxysize*j
19089 vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
19090 vectube(3)=vectube(3)+boxzsize*j
19093 xminact=dabs(vectube(1)-tubecenter(1))
19094 yminact=dabs(vectube(2)-tubecenter(2))
19095 zminact=dabs(vectube(3)-tubecenter(3))
19097 if (xmin.gt.xminact) then
19101 if (ymin.gt.yminact) then
19105 if (zmin.gt.zminact) then
19114 vectube(1)=vectube(1)-tubecenter(1)
19115 vectube(2)=vectube(2)-tubecenter(2)
19116 vectube(3)=vectube(3)-tubecenter(3)
19118 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
19119 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
19120 !C as the tube is infinity we do not calculate the Z-vector use of Z
19122 !C vectube(3)=0.0d0
19123 !C now calculte the distance
19124 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19125 !C now normalize vector
19126 vectube(1)=vectube(1)/tub_r
19127 vectube(2)=vectube(2)/tub_r
19128 vectube(3)=vectube(3)/tub_r
19129 !C calculte rdiffrence between r and r0
19132 rdiff6=rdiff**6.0d0
19133 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19134 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
19135 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
19136 !C print *,rdiff,rdiff6,pep_aa_tube
19137 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19138 !C now we calculate gradient
19139 fac=(-12.0d0*pep_aa_tube/rdiff6- &
19140 6.0d0*pep_bb_tube)/rdiff6/rdiff
19141 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
19143 if (acavtubpep.eq.0.0d0) then
19148 denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
19150 (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
19153 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
19154 *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
19155 +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
19156 /denominator**2.0d0
19161 if (energy_dec) write(iout,*),i,rdiff,enetube(i),enecavtube(i)
19163 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
19164 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
19168 do i=itube_start,itube_end
19169 enecavtube(i)=0.0d0
19170 !C Lets not jump over memory as we use many times iti
19172 !C lets ommit dummy atoms for now
19173 if ((iti.eq.ntyp1) &
19174 !C in UNRES uncomment the line below as GLY has no side-chain...
19181 vectube(1)=dmod((c(1,i+nres)),boxxsize)
19182 vectube(1)=vectube(1)+boxxsize*j
19183 vectube(2)=dmod((c(2,i+nres)),boxysize)
19184 vectube(2)=vectube(2)+boxysize*j
19185 vectube(3)=dmod((c(3,i+nres)),boxzsize)
19186 vectube(3)=vectube(3)+boxzsize*j
19189 xminact=dabs(vectube(1)-tubecenter(1))
19190 yminact=dabs(vectube(2)-tubecenter(2))
19191 zminact=dabs(vectube(3)-tubecenter(3))
19193 if (xmin.gt.xminact) then
19197 if (ymin.gt.yminact) then
19201 if (zmin.gt.zminact) then
19210 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
19212 vectube(1)=vectube(1)-tubecenter(1)
19213 vectube(2)=vectube(2)-tubecenter(2)
19214 vectube(3)=vectube(3)-tubecenter(3)
19215 !C now calculte the distance
19216 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19217 !C now normalize vector
19218 vectube(1)=vectube(1)/tub_r
19219 vectube(2)=vectube(2)/tub_r
19220 vectube(3)=vectube(3)/tub_r
19222 !C calculte rdiffrence between r and r0
19225 rdiff6=rdiff**6.0d0
19226 sc_aa_tube=sc_aa_tube_par(iti)
19227 sc_bb_tube=sc_bb_tube_par(iti)
19228 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19229 !C enetube(i+nres)=0.0d0
19230 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19231 !C now we calculate gradient
19232 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
19233 6.0d0*sc_bb_tube/rdiff6/rdiff
19235 !C now direction of gg_tube vector
19236 !C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
19237 if (acavtub(iti).eq.0.0d0) then
19239 enecavtube(i+nres)=0.0d0
19242 denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
19243 enecavtube(i+nres)= &
19244 (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
19246 !C enecavtube(i)=0.0
19247 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
19248 *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
19249 +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
19250 /denominator**2.0d0
19255 !C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
19256 !C & enecavtube(i),faccav
19257 !C print *,"licz=",
19258 !C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
19259 !C print *,"finene=",enetube(i+nres)+enecavtube(i)
19261 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19262 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19264 if (energy_dec) write(iout,*),i,rdiff,enetube(i+nres),enecavtube(i+nres)
19269 do i=itube_start,itube_end
19270 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) &
19271 +enecavtube(i+nres)
19274 ! print *,"begin", i,"a"
19277 ! rdiff6=rdiff**6.0d0
19278 ! sc_aa_tube=sc_aa_tube_par(i)
19279 ! sc_bb_tube=sc_bb_tube_par(i)
19280 ! enetube(i)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19281 ! denominator=(1.0d0+dcavtub(i)*rdiff6*rdiff6)
19283 ! (bcavtub(i)*rdiff+acavtub(i)*dsqrt(rdiff)+ccavtub(i)) &
19286 ! print '(5(f10.3,1x))',rdiff,enetube(i),enecavtube(i),enecavtube(i)+enetube(i)
19288 ! print *,"end",i,"a"
19290 !C print *,"ETUBE", etube
19292 end subroutine calcnano
19294 !===============================================
19295 !--------------------------------------------------------------------------------
19296 !C first for shielding is setting of function of side-chains
19298 subroutine set_shield_fac2
19299 real(kind=8) :: div77_81=0.974996043d0, &
19300 div4_81=0.2222222222d0
19301 real (kind=8) :: dist_pep_side,dist_side_calf,dist_pept_group, &
19302 scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
19303 short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
19304 sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
19305 !C the vector between center of side_chain and peptide group
19306 real(kind=8),dimension(3) :: pep_side_long,side_calf, &
19307 pept_group,costhet_grad,cosphi_grad_long, &
19308 cosphi_grad_loc,pep_side_norm,side_calf_norm, &
19309 sh_frac_dist_grad,pep_side
19311 !C write(2,*) "ivec",ivec_start,ivec_end
19313 fac_shield(i)=0.0d0
19315 grad_shield(j,i)=0.0d0
19318 do i=ivec_start,ivec_end
19320 !C if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
19322 if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
19323 !Cif there two consequtive dummy atoms there is no peptide group between them
19324 !C the line below has to be changed for FGPROC>1
19327 if ((itype(k,1).eq.ntyp1).or.(itype(k,1).eq.10)) cycle
19331 !C first lets set vector conecting the ithe side-chain with kth side-chain
19332 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
19333 !C pep_side(j)=2.0d0
19334 !C and vector conecting the side-chain with its proper calfa
19335 side_calf(j)=c(j,k+nres)-c(j,k)
19336 !C side_calf(j)=2.0d0
19337 pept_group(j)=c(j,i)-c(j,i+1)
19338 !C lets have their lenght
19339 dist_pep_side=pep_side(j)**2+dist_pep_side
19340 dist_side_calf=dist_side_calf+side_calf(j)**2
19341 dist_pept_group=dist_pept_group+pept_group(j)**2
19343 dist_pep_side=sqrt(dist_pep_side)
19344 dist_pept_group=sqrt(dist_pept_group)
19345 dist_side_calf=sqrt(dist_side_calf)
19347 pep_side_norm(j)=pep_side(j)/dist_pep_side
19348 side_calf_norm(j)=dist_side_calf
19350 !C now sscale fraction
19351 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
19352 !C print *,buff_shield,"buff"
19354 if (sh_frac_dist.le.0.0) cycle
19355 !C print *,ishield_list(i),i
19356 !C If we reach here it means that this side chain reaches the shielding sphere
19357 !C Lets add him to the list for gradient
19358 ishield_list(i)=ishield_list(i)+1
19359 !C ishield_list is a list of non 0 side-chain that contribute to factor gradient
19360 !C this list is essential otherwise problem would be O3
19361 shield_list(ishield_list(i),i)=k
19362 !C Lets have the sscale value
19363 if (sh_frac_dist.gt.1.0) then
19364 scale_fac_dist=1.0d0
19366 sh_frac_dist_grad(j)=0.0d0
19369 scale_fac_dist=-sh_frac_dist*sh_frac_dist &
19370 *(2.0d0*sh_frac_dist-3.0d0)
19371 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
19372 /dist_pep_side/buff_shield*0.5d0
19374 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
19375 !C sh_frac_dist_grad(j)=0.0d0
19376 !C scale_fac_dist=1.0d0
19377 !C print *,"jestem",scale_fac_dist,fac_help_scale,
19378 !C & sh_frac_dist_grad(j)
19381 !C this is what is now we have the distance scaling now volume...
19382 short=short_r_sidechain(itype(k,1))
19383 long=long_r_sidechain(itype(k,1))
19384 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
19385 sinthet=short/dist_pep_side*costhet
19386 !C now costhet_grad
19389 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
19390 !C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
19391 !C & -short/dist_pep_side**2/costhet)
19392 !C costhet_fac=0.0d0
19394 costhet_grad(j)=costhet_fac*pep_side(j)
19396 !C remember for the final gradient multiply costhet_grad(j)
19397 !C for side_chain by factor -2 !
19398 !C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
19399 !C pep_side0pept_group is vector multiplication
19400 pep_side0pept_group=0.0d0
19402 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
19404 cosalfa=(pep_side0pept_group/ &
19405 (dist_pep_side*dist_side_calf))
19406 fac_alfa_sin=1.0d0-cosalfa**2
19407 fac_alfa_sin=dsqrt(fac_alfa_sin)
19408 rkprim=fac_alfa_sin*(long-short)+short
19411 !C now costhet_grad
19412 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
19414 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
19415 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ &
19419 cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
19420 +cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
19421 *(long-short)/fac_alfa_sin*cosalfa/ &
19422 ((dist_pep_side*dist_side_calf))* &
19423 ((side_calf(j))-cosalfa* &
19424 ((pep_side(j)/dist_pep_side)*dist_side_calf))
19425 !C cosphi_grad_long(j)=0.0d0
19426 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
19427 *(long-short)/fac_alfa_sin*cosalfa &
19428 /((dist_pep_side*dist_side_calf))* &
19430 cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
19431 !C cosphi_grad_loc(j)=0.0d0
19433 !C print *,sinphi,sinthet
19434 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) &
19437 !C now the gradient...
19439 grad_shield(j,i)=grad_shield(j,i) &
19440 !C gradient po skalowaniu
19441 +(sh_frac_dist_grad(j)*VofOverlap &
19442 !C gradient po costhet
19443 +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
19444 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
19445 sinphi/sinthet*costhet*costhet_grad(j) &
19446 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
19448 !C grad_shield_side is Cbeta sidechain gradient
19449 grad_shield_side(j,ishield_list(i),i)=&
19450 (sh_frac_dist_grad(j)*-2.0d0&
19452 -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
19453 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(&
19454 sinphi/sinthet*costhet*costhet_grad(j)&
19455 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
19458 grad_shield_loc(j,ishield_list(i),i)= &
19459 scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
19460 (1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(&
19461 sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
19465 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
19467 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
19469 !C write(2,*) "TOTAL VOLUME",i,itype(i,1),fac_shield(i)
19472 end subroutine set_shield_fac2
19473 !----------------------------------------------------------------------------
19474 ! SOUBROUTINE FOR AFM
19475 subroutine AFMvel(Eafmforce)
19476 use MD_data, only:totTafm
19477 real(kind=8),dimension(3) :: diffafm
19478 real(kind=8) :: afmdist,Eafmforce
19480 !C Only for check grad COMMENT if not used for checkgrad
19482 !C--------------------------------------------------------
19483 !C print *,"wchodze"
19487 diffafm(i)=c(i,afmend)-c(i,afmbeg)
19488 afmdist=afmdist+diffafm(i)**2
19490 afmdist=dsqrt(afmdist)
19492 Eafmforce=0.5d0*forceAFMconst &
19493 *(distafminit+totTafm*velAFMconst-afmdist)**2
19494 !C Eafmforce=-forceAFMconst*(dist-distafminit)
19496 gradafm(i,afmend-1)=-forceAFMconst* &
19497 (distafminit+totTafm*velAFMconst-afmdist) &
19498 *diffafm(i)/afmdist
19499 gradafm(i,afmbeg-1)=forceAFMconst* &
19500 (distafminit+totTafm*velAFMconst-afmdist) &
19501 *diffafm(i)/afmdist
19503 ! print *,'AFM',Eafmforce,totTafm*velAFMconst,afmdist
19505 end subroutine AFMvel
19506 !---------------------------------------------------------
19507 subroutine AFMforce(Eafmforce)
19509 real(kind=8),dimension(3) :: diffafm
19510 ! real(kind=8) ::afmdist
19511 real(kind=8) :: afmdist,Eafmforce
19516 diffafm(i)=c(i,afmend)-c(i,afmbeg)
19517 afmdist=afmdist+diffafm(i)**2
19519 afmdist=dsqrt(afmdist)
19520 ! print *,afmdist,distafminit
19521 Eafmforce=-forceAFMconst*(afmdist-distafminit)
19523 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/afmdist
19524 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/afmdist
19526 !C print *,'AFM',Eafmforce
19528 end subroutine AFMforce
19530 !-----------------------------------------------------------------------------
19532 subroutine read_ssHist
19535 ! include 'DIMENSIONS'
19536 ! include "DIMENSIONS.FREE"
19537 ! include 'COMMON.FREE'
19540 character(len=80) :: controlcard
19543 call card_concat(controlcard,.true.)
19544 read(controlcard,*) &
19545 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
19549 end subroutine read_ssHist
19551 !-----------------------------------------------------------------------------
19552 integer function indmat(i,j)
19554 ! get the position of the jth ijth fragment of the chain coordinate system
19555 ! in the fromto array.
19558 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
19560 end function indmat
19561 !-----------------------------------------------------------------------------
19562 real(kind=8) function sigm(x)
19568 !-----------------------------------------------------------------------------
19569 !-----------------------------------------------------------------------------
19570 subroutine alloc_ener_arrays
19571 !EL Allocation of arrays used by module energy
19572 use MD_data, only: mset
19573 !el local variables
19576 if(nres.lt.100) then
19578 elseif(nres.lt.200) then
19579 maxconts=0.8*nres ! Max. number of contacts per residue
19581 maxconts=0.6*nres ! (maxconts=maxres/4)
19583 maxcont=12*nres ! Max. number of SC contacts
19584 maxvar=6*nres ! Max. number of variables
19585 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
19586 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
19587 !----------------------
19588 ! arrays in subroutine init_int_table
19590 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
19591 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
19593 allocate(nint_gr(nres))
19594 allocate(nscp_gr(nres))
19595 allocate(ielstart(nres))
19596 allocate(ielend(nres))
19598 allocate(istart(nres,maxint_gr))
19599 allocate(iend(nres,maxint_gr))
19600 !(maxres,maxint_gr)
19601 allocate(iscpstart(nres,maxint_gr))
19602 allocate(iscpend(nres,maxint_gr))
19603 !(maxres,maxint_gr)
19604 allocate(ielstart_vdw(nres))
19605 allocate(ielend_vdw(nres))
19607 allocate(nint_gr_nucl(nres))
19608 allocate(nscp_gr_nucl(nres))
19609 allocate(ielstart_nucl(nres))
19610 allocate(ielend_nucl(nres))
19612 allocate(istart_nucl(nres,maxint_gr))
19613 allocate(iend_nucl(nres,maxint_gr))
19614 !(maxres,maxint_gr)
19615 allocate(iscpstart_nucl(nres,maxint_gr))
19616 allocate(iscpend_nucl(nres,maxint_gr))
19617 !(maxres,maxint_gr)
19618 allocate(ielstart_vdw_nucl(nres))
19619 allocate(ielend_vdw_nucl(nres))
19621 allocate(lentyp(0:nfgtasks-1))
19623 !----------------------
19625 ! common /contacts/
19626 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
19627 allocate(icont(2,maxcont))
19629 ! common /contacts1/
19630 allocate(num_cont(0:nres+4))
19632 allocate(jcont(maxconts,nres))
19634 allocate(facont(maxconts,nres))
19636 allocate(gacont(3,maxconts,nres))
19637 !(3,maxconts,maxres)
19638 ! common /contacts_hb/
19639 allocate(gacontp_hb1(3,maxconts,nres))
19640 allocate(gacontp_hb2(3,maxconts,nres))
19641 allocate(gacontp_hb3(3,maxconts,nres))
19642 allocate(gacontm_hb1(3,maxconts,nres))
19643 allocate(gacontm_hb2(3,maxconts,nres))
19644 allocate(gacontm_hb3(3,maxconts,nres))
19645 allocate(gacont_hbr(3,maxconts,nres))
19646 allocate(grij_hb_cont(3,maxconts,nres))
19647 !(3,maxconts,maxres)
19648 allocate(facont_hb(maxconts,nres))
19650 allocate(ees0p(maxconts,nres))
19651 allocate(ees0m(maxconts,nres))
19652 allocate(d_cont(maxconts,nres))
19653 allocate(ees0plist(maxconts,nres))
19656 allocate(num_cont_hb(nres))
19658 allocate(jcont_hb(maxconts,nres))
19661 allocate(Ug(2,2,nres))
19662 allocate(Ugder(2,2,nres))
19663 allocate(Ug2(2,2,nres))
19664 allocate(Ug2der(2,2,nres))
19666 allocate(obrot(2,nres))
19667 allocate(obrot2(2,nres))
19668 allocate(obrot_der(2,nres))
19669 allocate(obrot2_der(2,nres))
19671 ! common /precomp1/
19672 allocate(mu(2,nres))
19673 allocate(muder(2,nres))
19674 allocate(Ub2(2,nres))
19677 allocate(Ub2der(2,nres))
19678 allocate(Ctobr(2,nres))
19679 allocate(Ctobrder(2,nres))
19680 allocate(Dtobr2(2,nres))
19681 allocate(Dtobr2der(2,nres))
19683 allocate(EUg(2,2,nres))
19684 allocate(EUgder(2,2,nres))
19685 allocate(CUg(2,2,nres))
19686 allocate(CUgder(2,2,nres))
19687 allocate(DUg(2,2,nres))
19688 allocate(Dugder(2,2,nres))
19689 allocate(DtUg2(2,2,nres))
19690 allocate(DtUg2der(2,2,nres))
19692 ! common /precomp2/
19693 allocate(Ug2Db1t(2,nres))
19694 allocate(Ug2Db1tder(2,nres))
19695 allocate(CUgb2(2,nres))
19696 allocate(CUgb2der(2,nres))
19698 allocate(EUgC(2,2,nres))
19699 allocate(EUgCder(2,2,nres))
19700 allocate(EUgD(2,2,nres))
19701 allocate(EUgDder(2,2,nres))
19702 allocate(DtUg2EUg(2,2,nres))
19703 allocate(Ug2DtEUg(2,2,nres))
19705 allocate(Ug2DtEUgder(2,2,2,nres))
19706 allocate(DtUg2EUgder(2,2,2,nres))
19708 ! common /rotat_old/
19709 allocate(costab(nres))
19710 allocate(sintab(nres))
19711 allocate(costab2(nres))
19712 allocate(sintab2(nres))
19715 allocate(a_chuj(2,2,maxconts,nres))
19716 !(2,2,maxconts,maxres)(maxconts=maxres/4)
19717 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
19718 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
19719 ! common /contdistrib/
19720 allocate(ncont_sent(nres))
19721 allocate(ncont_recv(nres))
19723 allocate(iat_sent(nres))
19725 allocate(iint_sent(4,nres,nres))
19726 allocate(iint_sent_local(4,nres,nres))
19728 allocate(iturn3_sent(4,0:nres+4))
19729 allocate(iturn4_sent(4,0:nres+4))
19730 allocate(iturn3_sent_local(4,nres))
19731 allocate(iturn4_sent_local(4,nres))
19733 allocate(itask_cont_from(0:nfgtasks-1))
19734 allocate(itask_cont_to(0:nfgtasks-1))
19735 !(0:max_fg_procs-1)
19739 !----------------------
19742 allocate(dcdv(6,maxdim))
19743 allocate(dxdv(6,maxdim))
19745 allocate(dxds(6,nres))
19747 allocate(gradx(3,-1:nres,0:2))
19748 allocate(gradc(3,-1:nres,0:2))
19750 allocate(gvdwx(3,-1:nres))
19751 allocate(gvdwc(3,-1:nres))
19752 allocate(gelc(3,-1:nres))
19753 allocate(gelc_long(3,-1:nres))
19754 allocate(gvdwpp(3,-1:nres))
19755 allocate(gvdwc_scpp(3,-1:nres))
19756 allocate(gradx_scp(3,-1:nres))
19757 allocate(gvdwc_scp(3,-1:nres))
19758 allocate(ghpbx(3,-1:nres))
19759 allocate(ghpbc(3,-1:nres))
19760 allocate(gradcorr(3,-1:nres))
19761 allocate(gradcorr_long(3,-1:nres))
19762 allocate(gradcorr5_long(3,-1:nres))
19763 allocate(gradcorr6_long(3,-1:nres))
19764 allocate(gcorr6_turn_long(3,-1:nres))
19765 allocate(gradxorr(3,-1:nres))
19766 allocate(gradcorr5(3,-1:nres))
19767 allocate(gradcorr6(3,-1:nres))
19768 allocate(gliptran(3,-1:nres))
19769 allocate(gliptranc(3,-1:nres))
19770 allocate(gliptranx(3,-1:nres))
19771 allocate(gshieldx(3,-1:nres))
19772 allocate(gshieldc(3,-1:nres))
19773 allocate(gshieldc_loc(3,-1:nres))
19774 allocate(gshieldx_ec(3,-1:nres))
19775 allocate(gshieldc_ec(3,-1:nres))
19776 allocate(gshieldc_loc_ec(3,-1:nres))
19777 allocate(gshieldx_t3(3,-1:nres))
19778 allocate(gshieldc_t3(3,-1:nres))
19779 allocate(gshieldc_loc_t3(3,-1:nres))
19780 allocate(gshieldx_t4(3,-1:nres))
19781 allocate(gshieldc_t4(3,-1:nres))
19782 allocate(gshieldc_loc_t4(3,-1:nres))
19783 allocate(gshieldx_ll(3,-1:nres))
19784 allocate(gshieldc_ll(3,-1:nres))
19785 allocate(gshieldc_loc_ll(3,-1:nres))
19786 allocate(grad_shield(3,-1:nres))
19787 allocate(gg_tube_sc(3,-1:nres))
19788 allocate(gg_tube(3,-1:nres))
19789 allocate(gradafm(3,-1:nres))
19790 allocate(gradb_nucl(3,-1:nres))
19791 allocate(gradbx_nucl(3,-1:nres))
19792 allocate(gvdwpsb1(3,-1:nres))
19793 allocate(gelpp(3,-1:nres))
19794 allocate(gvdwpsb(3,-1:nres))
19795 allocate(gelsbc(3,-1:nres))
19796 allocate(gelsbx(3,-1:nres))
19797 allocate(gvdwsbx(3,-1:nres))
19798 allocate(gvdwsbc(3,-1:nres))
19799 allocate(gsbloc(3,-1:nres))
19800 allocate(gsblocx(3,-1:nres))
19801 allocate(gradcorr_nucl(3,-1:nres))
19802 allocate(gradxorr_nucl(3,-1:nres))
19803 allocate(gradcorr3_nucl(3,-1:nres))
19804 allocate(gradxorr3_nucl(3,-1:nres))
19805 allocate(gvdwpp_nucl(3,-1:nres))
19806 allocate(gradpepcat(3,-1:nres))
19807 allocate(gradpepcatx(3,-1:nres))
19808 allocate(gradcatcat(3,-1:nres))
19810 allocate(grad_shield_side(3,50,nres))
19811 allocate(grad_shield_loc(3,50,nres))
19812 ! grad for shielding surroing
19813 allocate(gloc(0:maxvar,0:2))
19814 allocate(gloc_x(0:maxvar,2))
19816 allocate(gel_loc(3,-1:nres))
19817 allocate(gel_loc_long(3,-1:nres))
19818 allocate(gcorr3_turn(3,-1:nres))
19819 allocate(gcorr4_turn(3,-1:nres))
19820 allocate(gcorr6_turn(3,-1:nres))
19821 allocate(gradb(3,-1:nres))
19822 allocate(gradbx(3,-1:nres))
19824 allocate(gel_loc_loc(maxvar))
19825 allocate(gel_loc_turn3(maxvar))
19826 allocate(gel_loc_turn4(maxvar))
19827 allocate(gel_loc_turn6(maxvar))
19828 allocate(gcorr_loc(maxvar))
19829 allocate(g_corr5_loc(maxvar))
19830 allocate(g_corr6_loc(maxvar))
19832 allocate(gsccorc(3,-1:nres))
19833 allocate(gsccorx(3,-1:nres))
19835 allocate(gsccor_loc(-1:nres))
19837 allocate(gvdwx_scbase(3,-1:nres))
19838 allocate(gvdwc_scbase(3,-1:nres))
19839 allocate(gvdwx_pepbase(3,-1:nres))
19840 allocate(gvdwc_pepbase(3,-1:nres))
19841 allocate(gvdwx_scpho(3,-1:nres))
19842 allocate(gvdwc_scpho(3,-1:nres))
19843 allocate(gvdwc_peppho(3,-1:nres))
19845 allocate(dtheta(3,2,-1:nres))
19847 allocate(gscloc(3,-1:nres))
19848 allocate(gsclocx(3,-1:nres))
19850 allocate(dphi(3,3,-1:nres))
19851 allocate(dalpha(3,3,-1:nres))
19852 allocate(domega(3,3,-1:nres))
19854 ! common /deriv_scloc/
19855 allocate(dXX_C1tab(3,nres))
19856 allocate(dYY_C1tab(3,nres))
19857 allocate(dZZ_C1tab(3,nres))
19858 allocate(dXX_Ctab(3,nres))
19859 allocate(dYY_Ctab(3,nres))
19860 allocate(dZZ_Ctab(3,nres))
19861 allocate(dXX_XYZtab(3,nres))
19862 allocate(dYY_XYZtab(3,nres))
19863 allocate(dZZ_XYZtab(3,nres))
19866 allocate(jgrad_start(nres))
19867 allocate(jgrad_end(nres))
19869 !----------------------
19872 allocate(ibond_displ(0:nfgtasks-1))
19873 allocate(ibond_count(0:nfgtasks-1))
19874 allocate(ithet_displ(0:nfgtasks-1))
19875 allocate(ithet_count(0:nfgtasks-1))
19876 allocate(iphi_displ(0:nfgtasks-1))
19877 allocate(iphi_count(0:nfgtasks-1))
19878 allocate(iphi1_displ(0:nfgtasks-1))
19879 allocate(iphi1_count(0:nfgtasks-1))
19880 allocate(ivec_displ(0:nfgtasks-1))
19881 allocate(ivec_count(0:nfgtasks-1))
19882 allocate(iset_displ(0:nfgtasks-1))
19883 allocate(iset_count(0:nfgtasks-1))
19884 allocate(iint_count(0:nfgtasks-1))
19885 allocate(iint_displ(0:nfgtasks-1))
19886 !(0:max_fg_procs-1)
19887 !----------------------
19890 allocate(gcart(3,-1:nres))
19891 allocate(gxcart(3,-1:nres))
19893 allocate(gradcag(3,-1:nres))
19894 allocate(gradxag(3,-1:nres))
19896 ! common /back_constr/
19897 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
19898 allocate(dutheta(nres))
19899 allocate(dugamma(nres))
19901 allocate(duscdiff(3,nres))
19902 allocate(duscdiffx(3,nres))
19904 !el i io:read_fragments
19905 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
19906 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
19908 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
19909 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
19910 allocate(mset(0:nprocs)) !(maxprocs/20)
19912 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
19913 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
19914 allocate(dUdconst(3,0:nres))
19915 allocate(dUdxconst(3,0:nres))
19916 allocate(dqwol(3,0:nres))
19917 allocate(dxqwol(3,0:nres))
19919 !----------------------
19921 ! common /sbridge/ in io_common: read_bridge
19922 !el allocate((:),allocatable :: iss !(maxss)
19923 ! common /links/ in io_common: read_bridge
19924 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
19925 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
19926 ! common /dyn_ssbond/
19927 ! and side-chain vectors in theta or phi.
19928 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
19932 dyn_ssbond_ij(:,:)=1.0d300
19936 ! if (nss.gt.0) then
19937 allocate(idssb(maxdim),jdssb(maxdim))
19938 ! allocate(newihpb(nss),newjhpb(nss))
19941 allocate(ishield_list(nres))
19942 allocate(shield_list(50,nres))
19943 allocate(dyn_ss_mask(nres))
19944 allocate(fac_shield(nres))
19945 allocate(enetube(nres*2))
19946 allocate(enecavtube(nres*2))
19949 dyn_ss_mask(:)=.false.
19950 !----------------------
19952 ! Parameters of the SCCOR term
19954 !el in io_conf: parmread
19955 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
19956 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
19957 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
19958 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
19959 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
19960 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
19961 ! allocate(vlor1sccor(maxterm_sccor,20,20))
19962 ! allocate(vlor2sccor(maxterm_sccor,20,20))
19963 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
19965 allocate(gloc_sc(3,0:2*nres,0:10))
19966 !(3,0:maxres2,10)maxres2=2*maxres
19967 allocate(dcostau(3,3,3,2*nres))
19968 allocate(dsintau(3,3,3,2*nres))
19969 allocate(dtauangle(3,3,3,2*nres))
19970 allocate(dcosomicron(3,3,3,2*nres))
19971 allocate(domicron(3,3,3,2*nres))
19972 !(3,3,3,maxres2)maxres2=2*maxres
19973 !----------------------
19976 allocate(varall(maxvar))
19977 !(maxvar)(maxvar=6*maxres)
19978 allocate(mask_theta(nres))
19979 allocate(mask_phi(nres))
19980 allocate(mask_side(nres))
19982 !----------------------
19985 allocate(uy(3,nres))
19986 allocate(uz(3,nres))
19988 allocate(uygrad(3,3,2,nres))
19989 allocate(uzgrad(3,3,2,nres))
19993 end subroutine alloc_ener_arrays
19994 !-----------------------------------------------------------------
19995 subroutine ebond_nucl(estr_nucl)
19997 !c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
20000 real(kind=8),dimension(3) :: u,ud
20001 real(kind=8) :: usum,uprod,uprod1,uprod2,usumsqder
20002 real(kind=8) :: estr_nucl,diff
20003 integer :: iti,i,j,k,nbi
20005 !C print *,"I enter ebond"
20007 write (iout,*) "ibondp_start,ibondp_end",&
20008 ibondp_nucl_start,ibondp_nucl_end
20009 do i=ibondp_nucl_start,ibondp_nucl_end
20010 if (itype(i-1,2).eq.ntyp1_molec(2) .or. &
20011 itype(i,2).eq.ntyp1_molec(2)) cycle
20012 ! estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
20014 ! gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
20015 ! & *dc(j,i-1)/vbld(i)
20017 ! if (energy_dec) write(iout,*)
20018 ! & "estr1",i,vbld(i),distchainmax,
20019 ! & gnmr1(vbld(i),-1.0d0,distchainmax)
20021 diff = vbld(i)-vbldp0_nucl
20022 if(energy_dec)write(iout,*) "estr_nucl_bb" , i,vbld(i),&
20023 vbldp0_nucl,diff,AKP_nucl*diff*diff
20024 estr_nucl=estr_nucl+diff*diff
20025 ! print *,estr_nucl
20027 gradb_nucl(j,i-1)=AKP_nucl*diff*dc(j,i-1)/vbld(i)
20029 !c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
20031 estr_nucl=0.5d0*AKP_nucl*estr_nucl
20032 ! print *,"partial sum", estr_nucl,AKP_nucl
20035 write (iout,*) "ibondp_start,ibondp_end",&
20036 ibond_nucl_start,ibond_nucl_end
20038 do i=ibond_nucl_start,ibond_nucl_end
20039 !C print *, "I am stuck",i
20041 if (iti.eq.ntyp1_molec(2)) cycle
20042 nbi=nbondterm_nucl(iti)
20045 diff=vbld(i+nres)-vbldsc0_nucl(1,iti)
20048 write (iout,*) "estr_nucl_sc", i,iti,vbld(i+nres),vbldsc0_nucl(1,iti),diff, &
20049 AKSC_nucl(1,iti),AKSC_nucl(1,iti)*diff*diff
20050 estr_nucl=estr_nucl+0.5d0*AKSC_nucl(1,iti)*diff*diff
20051 ! print *,estr_nucl
20053 gradbx_nucl(j,i)=AKSC_nucl(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
20057 diff=vbld(i+nres)-vbldsc0_nucl(j,iti)
20058 ud(j)=aksc_nucl(j,iti)*diff
20059 u(j)=abond0_nucl(j,iti)+0.5d0*ud(j)*diff
20073 uprod2=uprod2*u(k)*u(k)
20077 usumsqder=usumsqder+ud(j)*uprod2
20079 estr_nucl=estr_nucl+uprod/usum
20081 gradbx_nucl(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
20085 !C print *,"I am about to leave ebond"
20087 end subroutine ebond_nucl
20089 !-----------------------------------------------------------------------------
20090 subroutine ebend_nucl(etheta_nucl)
20091 real(kind=8),dimension(nntheterm_nucl+1) :: coskt,sinkt !mmaxtheterm
20092 real(kind=8),dimension(nsingle_nucl+1) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
20093 real(kind=8),dimension(ndouble_nucl+1,ndouble_nucl+1) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
20094 logical :: lprn=.false., lprn1=.false.
20095 !el local variables
20096 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
20097 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
20098 real(kind=8) :: aux,etheta_nucl,ccl,ssl,scl,csl,ethetacnstr
20099 ! local variables for constrains
20100 real(kind=8) :: difi,thetiii
20103 ! print *,"ithet_start",ithet_nucl_start," ithet_end",ithet_nucl_end,nres
20104 do i=ithet_nucl_start,ithet_nucl_end
20105 if ((itype(i-1,2).eq.ntyp1_molec(2)).or.&
20106 (itype(i-2,2).eq.ntyp1_molec(2)).or. &
20107 (itype(i,2).eq.ntyp1_molec(2))) cycle
20111 theti2=0.5d0*theta(i)
20112 ityp2=ithetyp_nucl(itype(i-1,2))
20113 do k=1,nntheterm_nucl
20114 coskt(k)=dcos(k*theti2)
20115 sinkt(k)=dsin(k*theti2)
20117 if (i.gt.3 .and. itype(i-2,2).ne.ntyp1_molec(2)) then
20120 if (phii.ne.phii) phii=150.0
20124 ityp1=ithetyp_nucl(itype(i-2,2))
20125 do k=1,nsingle_nucl
20126 cosph1(k)=dcos(k*phii)
20127 sinph1(k)=dsin(k*phii)
20131 ityp1=nthetyp_nucl+1
20132 do k=1,nsingle_nucl
20138 if (i.lt.nres .and. itype(i,2).ne.ntyp1_molec(2)) then
20141 if (phii1.ne.phii1) phii1=150.0
20142 phii1=pinorm(phii1)
20146 ityp3=ithetyp_nucl(itype(i,2))
20147 do k=1,nsingle_nucl
20148 cosph2(k)=dcos(k*phii1)
20149 sinph2(k)=dsin(k*phii1)
20153 ityp3=nthetyp_nucl+1
20154 do k=1,nsingle_nucl
20159 ethetai=aa0thet_nucl(ityp1,ityp2,ityp3)
20160 do k=1,ndouble_nucl
20162 ccl=cosph1(l)*cosph2(k-l)
20163 ssl=sinph1(l)*sinph2(k-l)
20164 scl=sinph1(l)*cosph2(k-l)
20165 csl=cosph1(l)*sinph2(k-l)
20166 cosph1ph2(l,k)=ccl-ssl
20167 cosph1ph2(k,l)=ccl+ssl
20168 sinph1ph2(l,k)=scl+csl
20169 sinph1ph2(k,l)=scl-csl
20173 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
20174 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
20175 write (iout,*) "coskt and sinkt",nntheterm_nucl
20176 do k=1,nntheterm_nucl
20177 write (iout,*) k,coskt(k),sinkt(k)
20180 do k=1,ntheterm_nucl
20181 ethetai=ethetai+aathet_nucl(k,ityp1,ityp2,ityp3)*sinkt(k)
20182 dethetai=dethetai+0.5d0*k*aathet_nucl(k,ityp1,ityp2,ityp3)&
20185 write (iout,*) "k",k," aathet",aathet_nucl(k,ityp1,ityp2,ityp3),&
20189 write (iout,*) "cosph and sinph"
20190 do k=1,nsingle_nucl
20191 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
20193 write (iout,*) "cosph1ph2 and sinph2ph2"
20194 do k=2,ndouble_nucl
20196 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
20197 sinph1ph2(l,k),sinph1ph2(k,l)
20200 write(iout,*) "ethetai",ethetai
20202 do m=1,ntheterm2_nucl
20203 do k=1,nsingle_nucl
20204 aux=bbthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)&
20205 +ccthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k)&
20206 +ddthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)&
20207 +eethet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k)
20208 ethetai=ethetai+sinkt(m)*aux
20209 dethetai=dethetai+0.5d0*m*aux*coskt(m)
20210 dephii=dephii+k*sinkt(m)*(&
20211 ccthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)-&
20212 bbthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k))
20213 dephii1=dephii1+k*sinkt(m)*(&
20214 eethet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)-&
20215 ddthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k))
20217 write (iout,*) "m",m," k",k," bbthet",&
20218 bbthet_nucl(k,m,ityp1,ityp2,ityp3)," ccthet",&
20219 ccthet_nucl(k,m,ityp1,ityp2,ityp3)," ddthet",&
20220 ddthet_nucl(k,m,ityp1,ityp2,ityp3)," eethet",&
20221 eethet_nucl(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
20225 write(iout,*) "ethetai",ethetai
20226 do m=1,ntheterm3_nucl
20227 do k=2,ndouble_nucl
20229 aux=ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
20230 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+&
20231 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
20232 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
20233 ethetai=ethetai+sinkt(m)*aux
20234 dethetai=dethetai+0.5d0*m*coskt(m)*aux
20235 dephii=dephii+l*sinkt(m)*(&
20236 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-&
20237 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
20238 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
20239 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
20240 dephii1=dephii1+(k-l)*sinkt(m)*( &
20241 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
20242 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
20243 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-&
20244 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
20246 write (iout,*) "m",m," k",k," l",l," ffthet", &
20247 ffthet_nucl(l,k,m,ityp1,ityp2,ityp3), &
20248 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ggthet",&
20249 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3),&
20250 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
20251 write (iout,*) cosph1ph2(l,k)*sinkt(m), &
20252 cosph1ph2(k,l)*sinkt(m),&
20253 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
20259 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
20260 i,theta(i)*rad2deg,phii*rad2deg, &
20261 phii1*rad2deg,ethetai
20262 etheta_nucl=etheta_nucl+ethetai
20263 ! print *,i,"partial sum",etheta_nucl
20264 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang_nucl*dephii
20265 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang_nucl*dephii1
20266 gloc(nphi+i-2,icg)=wang_nucl*dethetai
20269 end subroutine ebend_nucl
20270 !----------------------------------------------------
20271 subroutine etor_nucl(etors_nucl)
20272 ! implicit real*8 (a-h,o-z)
20273 ! include 'DIMENSIONS'
20274 ! include 'COMMON.VAR'
20275 ! include 'COMMON.GEO'
20276 ! include 'COMMON.LOCAL'
20277 ! include 'COMMON.TORSION'
20278 ! include 'COMMON.INTERACT'
20279 ! include 'COMMON.DERIV'
20280 ! include 'COMMON.CHAIN'
20281 ! include 'COMMON.NAMES'
20282 ! include 'COMMON.IOUNITS'
20283 ! include 'COMMON.FFIELD'
20284 ! include 'COMMON.TORCNSTR'
20285 ! include 'COMMON.CONTROL'
20286 real(kind=8) :: etors_nucl,edihcnstr
20288 !el local variables
20289 integer :: i,j,iblock,itori,itori1
20290 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
20291 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
20292 ! Set lprn=.true. for debugging
20296 ! print *,"iphi_nucl_start/end", iphi_nucl_start,iphi_nucl_end
20297 do i=iphi_nucl_start,iphi_nucl_end
20298 if (itype(i-2,2).eq.ntyp1_molec(2) .or. itype(i-1,2).eq.ntyp1_molec(2) &
20299 .or. itype(i-3,2).eq.ntyp1_molec(2) &
20300 .or. itype(i,2).eq.ntyp1_molec(2)) cycle
20302 itori=itortyp_nucl(itype(i-2,2))
20303 itori1=itortyp_nucl(itype(i-1,2))
20305 ! print *,i,itori,itori1
20307 !C Regular cosine and sine terms
20308 do j=1,nterm_nucl(itori,itori1)
20309 v1ij=v1_nucl(j,itori,itori1)
20310 v2ij=v2_nucl(j,itori,itori1)
20311 cosphi=dcos(j*phii)
20312 sinphi=dsin(j*phii)
20313 etors_nucl=etors_nucl+v1ij*cosphi+v2ij*sinphi
20314 if (energy_dec) etors_ii=etors_ii+&
20315 v1ij*cosphi+v2ij*sinphi
20316 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
20320 !C E = SUM ----------------------------------- - v1
20321 !C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
20323 cosphi=dcos(0.5d0*phii)
20324 sinphi=dsin(0.5d0*phii)
20325 do j=1,nlor_nucl(itori,itori1)
20326 vl1ij=vlor1_nucl(j,itori,itori1)
20327 vl2ij=vlor2_nucl(j,itori,itori1)
20328 vl3ij=vlor3_nucl(j,itori,itori1)
20329 pom=vl2ij*cosphi+vl3ij*sinphi
20330 pom1=1.0d0/(pom*pom+1.0d0)
20331 etors_nucl=etors_nucl+vl1ij*pom1
20332 if (energy_dec) etors_ii=etors_ii+ &
20335 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
20337 !C Subtract the constant term
20338 etors_nucl=etors_nucl-v0_nucl(itori,itori1)
20339 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
20340 'etor',i,etors_ii-v0_nucl(itori,itori1)
20342 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
20343 restyp(itype(i-2,2),2),i-2,restyp(itype(i-1,2),2),i-1,itori,itori1, &
20344 (v1_nucl(j,itori,itori1),j=1,6),(v2_nucl(j,itori,itori1),j=1,6)
20345 gloc(i-3,icg)=gloc(i-3,icg)+wtor_nucl*gloci
20346 !c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
20349 end subroutine etor_nucl
20350 !------------------------------------------------------------
20351 subroutine epp_nucl_sub(evdw1,ees)
20353 !C This subroutine calculates the average interaction energy and its gradient
20354 !C in the virtual-bond vectors between non-adjacent peptide groups, based on
20355 !C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
20356 !C The potential depends both on the distance of peptide-group centers and on
20357 !C the orientation of the CA-CA virtual bonds.
20359 integer :: i,j,k,iteli,itelj,num_conti,isubchap,ind
20360 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
20361 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
20362 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
20363 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
20364 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20365 dist_temp, dist_init,sss_grad,fac,evdw1ij
20366 integer xshift,yshift,zshift
20367 real(kind=8),dimension(3):: ggg,gggp,gggm,erij
20368 real(kind=8) :: ees,eesij
20369 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
20370 real(kind=8) scal_el /0.5d0/
20376 !c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
20378 ! print *,"iatel_s_nucl,iatel_e_nucl",iatel_s_nucl,iatel_e_nucl
20379 do i=iatel_s_nucl,iatel_e_nucl
20380 if (itype(i,2).eq.ntyp1_molec(2) .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
20384 dx_normi=dc_norm(1,i)
20385 dy_normi=dc_norm(2,i)
20386 dz_normi=dc_norm(3,i)
20387 xmedi=c(1,i)+0.5d0*dxi
20388 ymedi=c(2,i)+0.5d0*dyi
20389 zmedi=c(3,i)+0.5d0*dzi
20390 xmedi=dmod(xmedi,boxxsize)
20391 if (xmedi.lt.0) xmedi=xmedi+boxxsize
20392 ymedi=dmod(ymedi,boxysize)
20393 if (ymedi.lt.0) ymedi=ymedi+boxysize
20394 zmedi=dmod(zmedi,boxzsize)
20395 if (zmedi.lt.0) zmedi=zmedi+boxzsize
20397 do j=ielstart_nucl(i),ielend_nucl(i)
20398 if (itype(j,2).eq.ntyp1_molec(2) .or. itype(j+1,2).eq.ntyp1_molec(2)) cycle
20403 ! xj=c(1,j)+0.5D0*dxj-xmedi
20404 ! yj=c(2,j)+0.5D0*dyj-ymedi
20405 ! zj=c(3,j)+0.5D0*dzj-zmedi
20406 xj=c(1,j)+0.5D0*dxj
20407 yj=c(2,j)+0.5D0*dyj
20408 zj=c(3,j)+0.5D0*dzj
20409 xj=mod(xj,boxxsize)
20410 if (xj.lt.0) xj=xj+boxxsize
20411 yj=mod(yj,boxysize)
20412 if (yj.lt.0) yj=yj+boxysize
20413 zj=mod(zj,boxzsize)
20414 if (zj.lt.0) zj=zj+boxzsize
20416 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
20423 xj=xj_safe+xshift*boxxsize
20424 yj=yj_safe+yshift*boxysize
20425 zj=zj_safe+zshift*boxzsize
20426 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
20427 if(dist_temp.lt.dist_init) then
20428 dist_init=dist_temp
20437 if (isubchap.eq.1) then
20448 rij=xj*xj+yj*yj+zj*zj
20449 !c write (2,*)"ij",i,j," r0pp",r0pp," rij",rij," epspp",epspp
20450 fac=(r0pp**2/rij)**3
20454 fac=(-ev1-evdw1ij)/rij
20455 ! write (2,*)"fac",fac," ev1",ev1," ev2",ev2," evdw1ij",evdw1ij
20456 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"evdw1ij",evdw1ij
20457 evdw1=evdw1+evdw1ij
20459 !C Calculate contributions to the Cartesian gradient.
20465 gvdwpp_nucl(k,i)=gvdwpp_nucl(k,i)-ggg(k)
20466 gvdwpp_nucl(k,j)=gvdwpp_nucl(k,j)+ggg(k)
20468 !c phoshate-phosphate electrostatic interactions
20471 eesij=dexp(-BEES*rij)*fac
20472 ! write (2,*)"fac",fac," eesijpp",eesij
20473 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"eesijpp",eesij
20476 fac=-(fac+BEES)*eesij*fac
20480 !c write(2,*) "ggg",i,j,ggg(1),ggg(2),ggg(3)
20481 !c write(2,*) "gelpp",i,(gelpp(k,i),k=1,3)
20482 !c write(2,*) "gelpp",j,(gelpp(k,j),k=1,3)
20484 gelpp(k,i)=gelpp(k,i)-ggg(k)
20485 gelpp(k,j)=gelpp(k,j)+ggg(k)
20492 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
20494 gvdwpp_nucl(k,i)=6*gvdwpp_nucl(k,i)
20495 !c gelpp(k,i)=332.0d0*gelpp(k,i)
20496 gelpp(k,i)=AEES*gelpp(k,i)
20498 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
20500 !c write (2,*) "total EES",ees
20502 end subroutine epp_nucl_sub
20503 !---------------------------------------------------------------------
20504 subroutine epsb(evdwpsb,eelpsb)
20507 !C This subroutine calculates the excluded-volume interaction energy between
20508 !C peptide-group centers and side chains and its gradient in virtual-bond and
20509 !C side-chain vectors.
20511 real(kind=8),dimension(3):: ggg
20512 integer :: i,iint,j,k,iteli,itypj,subchap
20513 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
20514 e1,e2,evdwij,rij,evdwpsb,eelpsb
20515 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20516 dist_temp, dist_init
20517 integer xshift,yshift,zshift
20519 !cd print '(a)','Enter ESCP'
20520 !cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
20523 ! print *,"iatscp_s_nucl,iatscp_e_nucl",iatscp_s_nucl,iatscp_e_nucl
20524 do i=iatscp_s_nucl,iatscp_e_nucl
20525 if (itype(i,2).eq.ntyp1_molec(2) &
20526 .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
20527 xi=0.5D0*(c(1,i)+c(1,i+1))
20528 yi=0.5D0*(c(2,i)+c(2,i+1))
20529 zi=0.5D0*(c(3,i)+c(3,i+1))
20530 xi=mod(xi,boxxsize)
20531 if (xi.lt.0) xi=xi+boxxsize
20532 yi=mod(yi,boxysize)
20533 if (yi.lt.0) yi=yi+boxysize
20534 zi=mod(zi,boxzsize)
20535 if (zi.lt.0) zi=zi+boxzsize
20537 do iint=1,nscp_gr_nucl(i)
20539 do j=iscpstart_nucl(i,iint),iscpend_nucl(i,iint)
20541 if (itypj.eq.ntyp1_molec(2)) cycle
20542 !C Uncomment following three lines for SC-p interactions
20543 !c xj=c(1,nres+j)-xi
20544 !c yj=c(2,nres+j)-yi
20545 !c zj=c(3,nres+j)-zi
20546 !C Uncomment following three lines for Ca-p interactions
20553 xj=mod(xj,boxxsize)
20554 if (xj.lt.0) xj=xj+boxxsize
20555 yj=mod(yj,boxysize)
20556 if (yj.lt.0) yj=yj+boxysize
20557 zj=mod(zj,boxzsize)
20558 if (zj.lt.0) zj=zj+boxzsize
20559 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20567 xj=xj_safe+xshift*boxxsize
20568 yj=yj_safe+yshift*boxysize
20569 zj=zj_safe+zshift*boxzsize
20570 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20571 if(dist_temp.lt.dist_init) then
20572 dist_init=dist_temp
20581 if (subchap.eq.1) then
20591 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
20593 e1=fac*fac*aad_nucl(itypj)
20594 e2=fac*bad_nucl(itypj)
20595 if (iabs(j-i) .le. 2) then
20600 evdwpsb=evdwpsb+evdwij
20601 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a4)') &
20602 'evdw2',i,j,evdwij,"tu4"
20604 !C Calculate contributions to the gradient in the virtual-bond and SC vectors.
20606 fac=-(evdwij+e1)*rrij
20611 gvdwpsb1(k,i)=gvdwpsb1(k,i)-ggg(k)
20612 gvdwpsb(k,j)=gvdwpsb(k,j)+ggg(k)
20620 gvdwpsb(j,i)=expon*gvdwpsb(j,i)
20621 gvdwpsb1(j,i)=expon*gvdwpsb1(j,i)
20625 end subroutine epsb
20627 !------------------------------------------------------
20628 subroutine esb_gb(evdwsb,eelsb)
20631 integer :: iint,itypi,itypi1,itypj,subchap,num_conti2
20632 real(kind=8) :: xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
20633 real(kind=8) :: evdw,sig0iji,evdwsb,eelsb,ecorr,eelij
20634 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20635 dist_temp, dist_init,aa,bb,faclip,sig0ij
20644 ! print *,"iastsc_nucl",iatsc_s_nucl,iatsc_e_nucl
20645 do i=iatsc_s_nucl,iatsc_e_nucl
20649 ! PRINT *,"I=",i,itypi
20650 if (itypi.eq.ntyp1_molec(2)) cycle
20651 itypi1=itype(i+1,2)
20655 xi=dmod(xi,boxxsize)
20656 if (xi.lt.0) xi=xi+boxxsize
20657 yi=dmod(yi,boxysize)
20658 if (yi.lt.0) yi=yi+boxysize
20659 zi=dmod(zi,boxzsize)
20660 if (zi.lt.0) zi=zi+boxzsize
20662 dxi=dc_norm(1,nres+i)
20663 dyi=dc_norm(2,nres+i)
20664 dzi=dc_norm(3,nres+i)
20665 dsci_inv=vbld_inv(i+nres)
20667 !C Calculate SC interaction energy.
20669 do iint=1,nint_gr_nucl(i)
20670 ! print *,"tu?",i,istart_nucl(i,iint),iend_nucl(i,iint)
20671 do j=istart_nucl(i,iint),iend_nucl(i,iint)
20675 if (itypj.eq.ntyp1_molec(2)) cycle
20676 dscj_inv=vbld_inv(j+nres)
20677 sig0ij=sigma_nucl(itypi,itypj)
20678 chi1=chi_nucl(itypi,itypj)
20679 chi2=chi_nucl(itypj,itypi)
20681 chip1=chip_nucl(itypi,itypj)
20682 chip2=chip_nucl(itypj,itypi)
20684 ! xj=c(1,nres+j)-xi
20685 ! yj=c(2,nres+j)-yi
20686 ! zj=c(3,nres+j)-zi
20690 xj=dmod(xj,boxxsize)
20691 if (xj.lt.0) xj=xj+boxxsize
20692 yj=dmod(yj,boxysize)
20693 if (yj.lt.0) yj=yj+boxysize
20694 zj=dmod(zj,boxzsize)
20695 if (zj.lt.0) zj=zj+boxzsize
20696 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20704 xj=xj_safe+xshift*boxxsize
20705 yj=yj_safe+yshift*boxysize
20706 zj=zj_safe+zshift*boxzsize
20707 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20708 if(dist_temp.lt.dist_init) then
20709 dist_init=dist_temp
20718 if (subchap.eq.1) then
20728 dxj=dc_norm(1,nres+j)
20729 dyj=dc_norm(2,nres+j)
20730 dzj=dc_norm(3,nres+j)
20731 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
20733 !C Calculate angle-dependent terms of energy and contributions to their
20738 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
20739 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
20740 om12=dxi*dxj+dyi*dyj+dzi*dzj
20741 call sc_angular_nucl
20743 sig=sig0ij*dsqrt(sigsq)
20744 rij_shift=1.0D0/rij-sig+sig0ij
20745 ! print *,rij_shift,"rij_shift"
20746 !c write (2,*) " rij",1.0D0/rij," sig",sig," sig0ij",sig0ij,
20747 !c & " rij_shift",rij_shift
20748 if (rij_shift.le.0.0D0) then
20753 !c---------------------------------------------------------------
20754 rij_shift=1.0D0/rij_shift
20755 fac=rij_shift**expon
20756 e1=fac*fac*aa_nucl(itypi,itypj)
20757 e2=fac*bb_nucl(itypi,itypj)
20758 evdwij=eps1*eps2rt*(e1+e2)
20759 !c write (2,*) "eps1",eps1," eps2rt",eps2rt,
20760 !c & " e1",e1," e2",e2," evdwij",evdwij
20762 evdwij=evdwij*eps2rt
20763 evdwsb=evdwsb+evdwij
20765 sigm=dabs(aa_nucl(itypi,itypj)/bb_nucl(itypi,itypj))**(1.0D0/6.0D0)
20766 epsi=bb_nucl(itypi,itypj)**2/aa_nucl(itypi,itypj)
20767 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
20768 restyp(itypi,2),i,restyp(itypj,2),j, &
20769 epsi,sigm,chi1,chi2,chip1,chip2, &
20770 eps1,eps2rt**2,sig,sig0ij, &
20771 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
20773 write (iout,*) "aa",aa_nucl(itypi,itypj)," bb",bb_nucl(itypi,itypj)
20776 if (energy_dec) write (iout,'(a6,2i5,e15.3,a4)') &
20777 'evdw',i,j,evdwij,"tu3"
20780 !C Calculate gradient components.
20781 e1=e1*eps1*eps2rt**2
20782 fac=-expon*(e1+evdwij)*rij_shift
20786 !C Calculate the radial part of the gradient
20790 !C Calculate angular part of the gradient.
20792 call eelsbij(eelij,num_conti2)
20793 if (energy_dec .and. &
20794 (j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2)) &
20795 write (istat,'(e14.5)') evdwij
20799 num_cont_hb(i)=num_conti2
20801 !c write (iout,*) "Number of loop steps in EGB:",ind
20802 !cccc energy_dec=.false.
20804 end subroutine esb_gb
20805 !-------------------------------------------------------------------------------
20806 subroutine eelsbij(eesij,num_conti2)
20809 real(kind=8),dimension(3) :: ggg,gggp,gggm,dcosb,dcosg
20810 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
20811 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20812 dist_temp, dist_init,rlocshield,fracinbuf
20813 integer xshift,yshift,zshift,ilist,iresshield,num_conti2
20815 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
20816 real(kind=8) scal_el /0.5d0/
20817 integer :: iteli,itelj,kkk,kkll,m,isubchap
20818 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp,facfac
20819 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i,ael63i,ael32i
20820 real(kind=8) :: dx_normj,dy_normj,dz_normj,&
20821 r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,fac5,fac6,&
20822 el1,el2,el3,el4,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
20823 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
20824 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
20825 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
20826 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
20827 ecosgp,ecosam,ecosbm,ecosgm,ghalf,itypi,itypj
20831 ! print *,i,j,itypi,itypj,istype(i),istype(j),"????"
20832 ael6i=ael6_nucl(itypi,itypj)
20833 ael3i=ael3_nucl(itypi,itypj)
20834 ael63i=ael63_nucl(itypi,itypj)
20835 ael32i=ael32_nucl(itypi,itypj)
20836 !c write (iout,*) "eelecij",i,j,itype(i),itype(j),
20837 !c & ael6i,ael3i,ael63i,al32i,rij,rrij
20841 dx_normi=dc_norm(1,i+nres)
20842 dy_normi=dc_norm(2,i+nres)
20843 dz_normi=dc_norm(3,i+nres)
20844 dx_normj=dc_norm(1,j+nres)
20845 dy_normj=dc_norm(2,j+nres)
20846 dz_normj=dc_norm(3,j+nres)
20847 !c xj=c(1,j)+0.5D0*dxj-xmedi
20848 !c yj=c(2,j)+0.5D0*dyj-ymedi
20849 !c zj=c(3,j)+0.5D0*dzj-zmedi
20850 if (ipot_nucl.ne.2) then
20851 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
20852 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
20853 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
20861 fac=cosa-3.0D0*cosb*cosg
20863 fac1=3.0d0*(cosb*cosb+cosg*cosg)
20868 !c write (iout,*) "r3ij",r3ij," r6ij",r6ij," fac",fac," fac1",fac1,
20869 !c & " fac2",fac2," fac3",fac3," fac4",fac4," fac5",fac5," fac6",fac6
20870 el1=fac3*(4.0D0+facfac-fac1)
20872 el3=fac5*(2.0d0-2.0d0*facfac+fac1)
20874 eesij=el1+el2+el3+el4
20875 !C 12/26/95 - for the evaluation of multi-body H-bonding interactions
20876 ees0ij=4.0D0+facfac-fac1
20878 if (energy_dec) then
20879 if(j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2) &
20880 write (istat,'(2a1,i4,1x,2a1,i4,4f10.5,3e12.5,$)') &
20881 sugartyp(istype(i)),restyp(itypi,2),i,sugartyp(istype(j)),&
20882 restyp(itypj,2),j,1.0d0/rij,cosa,cosb,cosg,fac*r3ij, &
20883 (4.0D0+facfac-fac1)*r6ij,(2.0d0-2.0d0*facfac+fac1)*r6ij
20884 write (iout,'(a6,2i5,e15.3)') 'ees',i,j,eesij
20888 !C Calculate contributions to the Cartesian gradient.
20890 facel=-3.0d0*rrij*(eesij+el1+el3+el4)
20896 !* Radial derivatives. First process both termini of the fragment (i,j)
20902 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
20903 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
20904 gelsbx(k,j)=gelsbx(k,j)+ggg(k)
20905 gelsbx(k,i)=gelsbx(k,i)-ggg(k)
20910 ecosa=2.0D0*fac3*fac1+fac4+(-4.0d0*fac5+2.0d0*fac6)*fac1
20915 ecosb=fac3*(fac1*cosg+cosb)+cosg*fac4+(cosb+2*fac1*cosg)*fac5+&
20917 ecosg=fac3*(fac1*cosb+cosg)+cosb*fac4+(cosg+2*fac1*cosb)*fac5+&
20920 dcosb(k)=rij*(dc_norm(k,i+nres)-erij(k)*cosb)
20921 dcosg(k)=rij*(dc_norm(k,j+nres)-erij(k)*cosg)
20924 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
20927 gelsbx(k,i)=gelsbx(k,i)-ggg(k) &
20928 +(ecosa*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres))&
20929 + ecosb*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
20930 gelsbx(k,j)=gelsbx(k,j)+ggg(k) &
20931 +(ecosa*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
20932 + ecosg*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
20933 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
20934 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
20936 ! IF ( (wcorr_nucl.gt.0.0d0.or.wcorr3_nucl.gt.0.0d0) .and.
20937 IF ( j.gt.i+1 .and.&
20938 num_conti.le.maxconts) THEN
20940 !C Calculate the contact function. The ith column of the array JCONT will
20941 !C contain the numbers of atoms that make contacts with the atom I (of numbers
20942 !C greater than I). The arrays FACONT and GACONT will contain the values of
20943 !C the contact function and its derivative.
20944 r0ij=2.20D0*sigma(itypi,itypj)
20945 !c write (2,*) "ij",i,j," rij",1.0d0/rij," r0ij",r0ij
20946 call gcont(rij,r0ij,1.0D0,0.2d0/r0ij,fcont,fprimcont)
20947 !c write (2,*) "fcont",fcont
20948 if (fcont.gt.0.0D0) then
20949 num_conti=num_conti+1
20950 num_conti2=num_conti2+1
20952 if (num_conti.gt.maxconts) then
20953 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
20954 ' will skip next contacts for this conf.'
20956 jcont_hb(num_conti,i)=j
20957 !c write (iout,*) "num_conti",num_conti,
20958 !c & " jcont_hb",jcont_hb(num_conti,i)
20959 !C Calculate contact energies
20961 wij=cosa-3.0D0*cosb*cosg
20964 fac3=dsqrt(-ael6i)*r3ij
20965 !c write (2,*) "ael6i",ael6i," r3ij",r3ij," fac3",fac3
20966 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
20967 if (ees0tmp.gt.0) then
20968 ees0pij=dsqrt(ees0tmp)
20972 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
20973 if (ees0tmp.gt.0) then
20974 ees0mij=dsqrt(ees0tmp)
20978 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
20979 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
20980 !c write (iout,*) "i",i," j",j,
20981 !c & " ees0m",ees0m(num_conti,i)," ees0p",ees0p(num_conti,i)
20982 ees0pij1=fac3/ees0pij
20983 ees0mij1=fac3/ees0mij
20984 fac3p=-3.0D0*fac3*rrij
20985 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
20986 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
20987 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
20988 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
20989 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
20990 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
20991 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
20992 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
20993 ecosap=ecosa1+ecosa2
20994 ecosbp=ecosb1+ecosb2
20995 ecosgp=ecosg1+ecosg2
20996 ecosam=ecosa1-ecosa2
20997 ecosbm=ecosb1-ecosb2
20998 ecosgm=ecosg1-ecosg2
21000 facont_hb(num_conti,i)=fcont
21001 fprimcont=fprimcont/rij
21003 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
21004 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
21006 gggp(1)=gggp(1)+ees0pijp*xj
21007 gggp(2)=gggp(2)+ees0pijp*yj
21008 gggp(3)=gggp(3)+ees0pijp*zj
21009 gggm(1)=gggm(1)+ees0mijp*xj
21010 gggm(2)=gggm(2)+ees0mijp*yj
21011 gggm(3)=gggm(3)+ees0mijp*zj
21012 !C Derivatives due to the contact function
21013 gacont_hbr(1,num_conti,i)=fprimcont*xj
21014 gacont_hbr(2,num_conti,i)=fprimcont*yj
21015 gacont_hbr(3,num_conti,i)=fprimcont*zj
21018 !c Gradient of the correlation terms
21020 gacontp_hb1(k,num_conti,i)= &
21021 (ecosap*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
21022 + ecosbp*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21023 gacontp_hb2(k,num_conti,i)= &
21024 (ecosap*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres)) &
21025 + ecosgp*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21026 gacontp_hb3(k,num_conti,i)=gggp(k)
21027 gacontm_hb1(k,num_conti,i)= &
21028 (ecosam*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
21029 + ecosbm*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21030 gacontm_hb2(k,num_conti,i)= &
21031 (ecosam*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
21032 + ecosgm*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21033 gacontm_hb3(k,num_conti,i)=gggm(k)
21039 end subroutine eelsbij
21040 !------------------------------------------------------------------
21041 subroutine sc_grad_nucl
21044 real(kind=8),dimension(3) :: dcosom1,dcosom2
21045 eom1=eps2der*eps2rt_om1+sigder*sigsq_om1
21046 eom2=eps2der*eps2rt_om2+sigder*sigsq_om2
21047 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12+sigder*sigsq_om12
21049 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
21050 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
21053 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
21056 gvdwsbx(k,i)=gvdwsbx(k,i)-gg(k) &
21057 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
21058 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
21059 gvdwsbx(k,j)=gvdwsbx(k,j)+gg(k) &
21060 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
21061 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
21064 !C Calculate the components of the gradient in DC and X
21067 gvdwsbc(l,i)=gvdwsbc(l,i)-gg(l)
21068 gvdwsbc(l,j)=gvdwsbc(l,j)+gg(l)
21071 end subroutine sc_grad_nucl
21072 !-----------------------------------------------------------------------
21073 subroutine esb(esbloc)
21074 !C Calculate the local energy of a side chain and its derivatives in the
21075 !C corresponding virtual-bond valence angles THETA and the spherical angles
21076 !C ALPHA and OMEGA derived from AM1 all-atom calculations.
21077 !C added by Urszula Kozlowska. 07/11/2007
21079 real(kind=8),dimension(3):: x_prime,y_prime,z_prime
21080 real(kind=8),dimension(9):: x
21081 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1, &
21082 sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,&
21083 de_dxx,de_dyy,de_dzz,de_dt,s1_t,s1_6_t,s2_t,s2_6_t
21084 real(kind=8),dimension(3):: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,&
21085 dYY_Ci,dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
21086 real(kind=8) :: esbloc,delta,cosfac2,cosfac,sinfac2,sinfac,de_dtt,&
21087 cossc,cossc1,cosfac2xx,sinfac2yy,pom1,pom
21088 integer::it,nlobit,i,j,k
21089 ! common /sccalc/ time11,time12,time112,theti,it,nlobit
21092 do i=loc_start_nucl,loc_end_nucl
21093 if (itype(i,2).eq.ntyp1_molec(2)) cycle
21094 costtab(i+1) =dcos(theta(i+1))
21095 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
21096 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
21097 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
21098 cosfac2=0.5d0/(1.0d0+costtab(i+1))
21099 cosfac=dsqrt(cosfac2)
21100 sinfac2=0.5d0/(1.0d0-costtab(i+1))
21101 sinfac=dsqrt(sinfac2)
21103 if (it.eq.10) goto 1
21106 !C Compute the axes of tghe local cartesian coordinates system; store in
21107 !c x_prime, y_prime and z_prime
21114 !C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
21115 !C & dc_norm(3,i+nres)
21117 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
21118 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
21121 z_prime(j) = -uz(j,i-1)
21129 xx = xx + x_prime(j)*dc_norm(j,i+nres)
21130 yy = yy + y_prime(j)*dc_norm(j,i+nres)
21131 zz = zz + z_prime(j)*dc_norm(j,i+nres)
21139 x(j) = sc_parmin_nucl(j,it)
21142 !Cc diagnostics - remove later
21143 xx1 = dcos(alph(2))
21144 yy1 = dsin(alph(2))*dcos(omeg(2))
21145 zz1 = -dsin(alph(2))*dsin(omeg(2))
21146 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
21147 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
21149 !C," --- ", xx_w,yy_w,zz_w
21152 sumene = enesc_nucl(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21153 esbloc = esbloc + sumene
21154 sumene2= enesc_nucl(x,xx,yy,0.0d0,cost2tab(i+1),sint2tab(i+1))
21155 ! print *,"enecomp",sumene,sumene2
21156 ! if (energy_dec) write(iout,*) "i",i," esbloc",sumene,esbloc,xx,yy,zz
21157 ! if (energy_dec) write(iout,*) "x",(x(k),k=1,9)
21159 write (2,*) "x",(x(k),k=1,9)
21161 !C This section to check the numerical derivatives of the energy of ith side
21162 !C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
21163 !C #define DEBUG in the code to turn it on.
21165 write (2,*) "sumene =",sumene
21169 write (2,*) xx,yy,zz
21170 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21171 de_dxx_num=(sumenep-sumene)/aincr
21173 write (2,*) "xx+ sumene from enesc=",sumenep,sumene
21176 write (2,*) xx,yy,zz
21177 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21178 de_dyy_num=(sumenep-sumene)/aincr
21180 write (2,*) "yy+ sumene from enesc=",sumenep,sumene
21183 write (2,*) xx,yy,zz
21184 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21185 de_dzz_num=(sumenep-sumene)/aincr
21187 write (2,*) "zz+ sumene from enesc=",sumenep,sumene
21188 costsave=cost2tab(i+1)
21189 sintsave=sint2tab(i+1)
21190 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
21191 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
21192 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21193 de_dt_num=(sumenep-sumene)/aincr
21194 write (2,*) " t+ sumene from enesc=",sumenep,sumene
21195 cost2tab(i+1)=costsave
21196 sint2tab(i+1)=sintsave
21197 !C End of diagnostics section.
21200 !C Compute the gradient of esc
21202 de_dxx=x(1)+2*x(4)*xx+x(7)*zz+x(8)*yy
21203 de_dyy=x(2)+2*x(5)*yy+x(8)*xx+x(9)*zz
21204 de_dzz=x(3)+2*x(6)*zz+x(7)*xx+x(9)*yy
21207 write (2,*) "x",(x(k),k=1,9)
21208 write (2,*) "xx",xx," yy",yy," zz",zz
21209 write (2,*) "de_xx ",de_xx," de_yy ",de_yy,&
21210 " de_zz ",de_zz," de_tt ",de_tt
21211 write (2,*) "de_xx_num",de_dxx_num," de_yy_num",de_dyy_num,&
21212 " de_zz_num",de_dzz_num," de_dt_num",de_dt_num
21215 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
21216 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
21217 cosfac2xx=cosfac2*xx
21218 sinfac2yy=sinfac2*yy
21220 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*&
21222 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*&
21224 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
21225 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
21226 !c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
21227 !c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
21228 !c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
21229 !c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
21230 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
21231 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
21232 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
21233 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
21237 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
21238 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
21241 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
21242 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
21243 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
21245 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
21246 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
21250 dXX_Ctab(k,i)=dXX_Ci(k)
21251 dXX_C1tab(k,i)=dXX_Ci1(k)
21252 dYY_Ctab(k,i)=dYY_Ci(k)
21253 dYY_C1tab(k,i)=dYY_Ci1(k)
21254 dZZ_Ctab(k,i)=dZZ_Ci(k)
21255 dZZ_C1tab(k,i)=dZZ_Ci1(k)
21256 dXX_XYZtab(k,i)=dXX_XYZ(k)
21257 dYY_XYZtab(k,i)=dYY_XYZ(k)
21258 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
21261 !c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
21262 !c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
21263 !c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
21264 !c & dyy_ci(k)," dzz_ci",dzz_ci(k)
21265 !c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
21267 !c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
21268 !c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
21269 gsbloc(k,i-1)=gsbloc(k,i-1)+(de_dxx*dxx_ci1(k) &
21270 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k))
21271 gsbloc(k,i)=gsbloc(k,i)+(de_dxx*dxx_Ci(k) &
21272 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k))
21273 gsblocx(k,i)= de_dxx*dxx_XYZ(k)&
21274 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
21275 ! print *,i,de_dxx*dxx_ci1(k)+de_dyy*dyy_ci1(k),de_dzz*dzz_ci1(k)*2
21277 !c write(iout,*) "ENERGY GRAD = ", (gsbloc(k,i-1),k=1,3),
21278 !c & (gsbloc(k,i),k=1,3),(gsblocx(k,i),k=1,3)
21280 !C to check gradient call subroutine check_grad
21286 !=-------------------------------------------------------
21287 real(kind=8) function enesc_nucl(x,xx,yy,zz,cost2,sint2)
21289 real(kind=8),dimension(9):: x(9)
21290 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2, &
21291 sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
21293 !c write (2,*) "enesc"
21294 !c write (2,*) "x",(x(i),i=1,9)
21295 !c write(2,*)"xx",xx," yy",yy," zz",zz," cost2",cost2," sint2",sint2
21296 sumene=x(1)*xx+x(2)*yy+x(3)*zz+x(4)*xx**2 &
21297 + x(5)*yy**2+x(6)*zz**2+x(7)*xx*zz+x(8)*xx*yy &
21301 end function enesc_nucl
21302 !-----------------------------------------------------------------------------
21303 subroutine multibody_hb_nucl(ecorr,ecorr3,n_corr,n_corr1)
21306 integer,parameter :: max_cont=2000
21307 integer,parameter:: max_dim=2*(8*3+6)
21308 integer, parameter :: msglen1=max_cont*max_dim
21309 integer,parameter :: msglen2=2*msglen1
21310 integer source,CorrelType,CorrelID,Error
21311 real(kind=8) :: buffer(max_cont,max_dim)
21312 integer status(MPI_STATUS_SIZE)
21313 integer :: ierror,nbytes
21315 real(kind=8),dimension(3):: gx(3),gx1(3)
21316 real(kind=8) :: time00
21318 integer i,j,i1,j1,jj,kk,num_conti,num_conti1,nn
21319 real(kind=8) ecorr,ecorr3
21320 integer :: n_corr,n_corr1,mm,msglen
21321 !C Set lprn=.true. for debugging
21326 if(.not.allocated(zapas2)) allocate(zapas2(3,maxconts,nres,8))
21328 if (nfgtasks.le.1) goto 30
21330 write (iout,'(a)') 'Contact function values:'
21332 write (iout,'(2i3,50(1x,i2,f5.2))') &
21333 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
21334 j=1,num_cont_hb(i))
21337 !C Caution! Following code assumes that electrostatic interactions concerning
21338 !C a given atom are split among at most two processors!
21348 !c write (*,*) 'MyRank',MyRank,' mm',mm
21351 !c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
21352 if (fg_rank.gt.0) then
21353 !C Send correlation contributions to the preceding processor
21355 nn=num_cont_hb(iatel_s_nucl)
21356 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
21357 !c write (*,*) 'The BUFFER array:'
21359 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
21361 if (ielstart_nucl(iatel_s_nucl).gt.iatel_s_nucl+ispp) then
21363 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
21364 !C Clear the contacts of the atom passed to the neighboring processor
21365 nn=num_cont_hb(iatel_s_nucl+1)
21367 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
21369 num_cont_hb(iatel_s_nucl)=0
21371 !cd write (iout,*) 'Processor ',fg_rank,MyRank,
21372 !cd & ' is sending correlation contribution to processor',fg_rank-1,
21373 !cd & ' msglen=',msglen
21374 !c write (*,*) 'Processor ',fg_rank,MyRank,
21375 !c & ' is sending correlation contribution to processor',fg_rank-1,
21376 !c & ' msglen=',msglen,' CorrelType=',CorrelType
21378 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, &
21379 CorrelType,FG_COMM,IERROR)
21380 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
21381 !cd write (iout,*) 'Processor ',fg_rank,
21382 !cd & ' has sent correlation contribution to processor',fg_rank-1,
21383 !cd & ' msglen=',msglen,' CorrelID=',CorrelID
21384 !c write (*,*) 'Processor ',fg_rank,
21385 !c & ' has sent correlation contribution to processor',fg_rank-1,
21386 !c & ' msglen=',msglen,' CorrelID=',CorrelID
21388 endif ! (fg_rank.gt.0)
21392 !c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
21393 if (fg_rank.lt.nfgtasks-1) then
21394 !C Receive correlation contributions from the next processor
21396 if (ielend_nucl(iatel_e_nucl).lt.nct_molec(2)-1) msglen=msglen2
21397 !cd write (iout,*) 'Processor',fg_rank,
21398 !cd & ' is receiving correlation contribution from processor',fg_rank+1,
21399 !cd & ' msglen=',msglen,' CorrelType=',CorrelType
21400 !c write (*,*) 'Processor',fg_rank,
21401 !c &' is receiving correlation contribution from processor',fg_rank+1,
21402 !c & ' msglen=',msglen,' CorrelType=',CorrelType
21405 do while (nbytes.le.0)
21406 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
21407 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
21409 !c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
21410 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, &
21411 fg_rank+1,CorrelType,FG_COMM,status,IERROR)
21412 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
21413 !c write (*,*) 'Processor',fg_rank,
21414 !c &' has received correlation contribution from processor',fg_rank+1,
21415 !c & ' msglen=',msglen,' nbytes=',nbytes
21416 !c write (*,*) 'The received BUFFER array:'
21418 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
21420 if (msglen.eq.msglen1) then
21421 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,0,buffer)
21422 else if (msglen.eq.msglen2) then
21423 call unpack_buffer(max_cont,max_dim,iatel_e_nucl,0,buffer)
21424 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,30,buffer)
21427 'ERROR!!!! message length changed while processing correlations.'
21429 'ERROR!!!! message length changed while processing correlations.'
21430 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
21431 endif ! msglen.eq.msglen1
21432 endif ! fg_rank.lt.nfgtasks-1
21439 write (iout,'(a)') 'Contact function values:'
21440 do i=nnt_molec(2),nct_molec(2)-1
21441 write (iout,'(2i3,50(1x,i2,f5.2))') &
21442 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
21443 j=1,num_cont_hb(i))
21448 !C Remove the loop below after debugging !!!
21449 ! do i=nnt_molec(2),nct_molec(2)
21451 ! gradcorr_nucl(j,i)=0.0D0
21452 ! gradxorr_nucl(j,i)=0.0D0
21453 ! gradcorr3_nucl(j,i)=0.0D0
21454 ! gradxorr3_nucl(j,i)=0.0D0
21457 ! print *,"iatsc_s_nucl,iatsc_e_nucl",iatsc_s_nucl,iatsc_e_nucl
21458 !C Calculate the local-electrostatic correlation terms
21459 do i=iatsc_s_nucl,iatsc_e_nucl
21461 num_conti=num_cont_hb(i)
21462 num_conti1=num_cont_hb(i+1)
21463 ! print *,i,num_conti,num_conti1
21468 !c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
21469 !c & ' jj=',jj,' kk=',kk
21470 if (j1.eq.j+1 .or. j1.eq.j-1) then
21472 !C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
21473 !C The system gains extra energy.
21474 !C Tentative expression & coefficients; assumed d(stacking)=4.5 A,
21475 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
21476 !C Need to implement full formulas 34 and 35 from Liwo et al., 1998.
21478 ecorr=ecorr+ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
21479 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
21480 'ecorrh',i,j,ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
21482 else if (j1.eq.j) then
21484 !C Contacts I-J and I-(J+1) occur simultaneously.
21485 !C The system loses extra energy.
21486 !C Tentative expression & c?oefficients; assumed d(stacking)=4.5 A,
21487 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
21488 !C Need to implement full formulas 32 from Liwo et al., 1998.
21490 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
21491 !c & ' jj=',jj,' kk=',kk
21492 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i+1,j,jj,kk,0.310D0,-0.155D0)
21497 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
21498 !c & ' jj=',jj,' kk=',kk
21499 if (j1.eq.j+1) then
21500 !C Contacts I-J and (I+1)-J occur simultaneously.
21501 !C The system loses extra energy.
21502 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i,j+1,jj,kk,0.310D0,-0.155D0)
21508 end subroutine multibody_hb_nucl
21509 !-----------------------------------------------------------
21510 real(kind=8) function ehbcorr_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
21511 ! implicit real*8 (a-h,o-z)
21512 ! include 'DIMENSIONS'
21513 ! include 'COMMON.IOUNITS'
21514 ! include 'COMMON.DERIV'
21515 ! include 'COMMON.INTERACT'
21516 ! include 'COMMON.CONTACTS'
21517 real(kind=8),dimension(3) :: gx,gx1
21519 !el local variables
21520 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
21521 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
21522 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
21523 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
21527 eij=facont_hb(jj,i)
21528 ekl=facont_hb(kk,k)
21529 ees0pij=ees0p(jj,i)
21530 ees0pkl=ees0p(kk,k)
21531 ees0mij=ees0m(jj,i)
21532 ees0mkl=ees0m(kk,k)
21534 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
21535 ! print *,"ehbcorr_nucl",ekont,ees
21536 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
21537 !C Following 4 lines for diagnostics.
21542 !cd write (iout,*)'Contacts have occurred for nucleic bases',
21543 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
21544 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
21545 !C Calculate the multi-body contribution to energy.
21546 ! ecorr_nucl=ecorr_nucl+ekont*ees
21547 !C Calculate multi-body contributions to the gradient.
21548 coeffpees0pij=coeffp*ees0pij
21549 coeffmees0mij=coeffm*ees0mij
21550 coeffpees0pkl=coeffp*ees0pkl
21551 coeffmees0mkl=coeffm*ees0mkl
21553 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i) &
21554 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
21555 coeffmees0mkl*gacontm_hb1(ll,jj,i))
21556 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j) &
21557 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+&
21558 coeffmees0mkl*gacontm_hb2(ll,jj,i))
21559 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k) &
21560 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
21561 coeffmees0mij*gacontm_hb1(ll,kk,k))
21562 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l) &
21563 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
21564 coeffmees0mij*gacontm_hb2(ll,kk,k))
21565 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
21566 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
21567 coeffmees0mkl*gacontm_hb3(ll,jj,i))
21568 gradcorr_nucl(ll,j)=gradcorr_nucl(ll,j)+gradlongij
21569 gradcorr_nucl(ll,i)=gradcorr_nucl(ll,i)-gradlongij
21570 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
21571 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
21572 coeffmees0mij*gacontm_hb3(ll,kk,k))
21573 gradcorr_nucl(ll,l)=gradcorr_nucl(ll,l)+gradlongkl
21574 gradcorr_nucl(ll,k)=gradcorr_nucl(ll,k)-gradlongkl
21575 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i)-gradlongij
21576 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j)+gradlongij
21577 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k)-gradlongkl
21578 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l)+gradlongkl
21580 ehbcorr_nucl=ekont*ees
21582 end function ehbcorr_nucl
21583 !-------------------------------------------------------------------------
21585 real(kind=8) function ehbcorr3_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
21586 ! implicit real*8 (a-h,o-z)
21587 ! include 'DIMENSIONS'
21588 ! include 'COMMON.IOUNITS'
21589 ! include 'COMMON.DERIV'
21590 ! include 'COMMON.INTERACT'
21591 ! include 'COMMON.CONTACTS'
21592 real(kind=8),dimension(3) :: gx,gx1
21594 !el local variables
21595 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
21596 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
21597 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
21598 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
21602 eij=facont_hb(jj,i)
21603 ekl=facont_hb(kk,k)
21604 ees0pij=ees0p(jj,i)
21605 ees0pkl=ees0p(kk,k)
21606 ees0mij=ees0m(jj,i)
21607 ees0mkl=ees0m(kk,k)
21609 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
21610 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
21611 !C Following 4 lines for diagnostics.
21616 !cd write (iout,*)'Contacts have occurred for nucleic bases',
21617 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
21618 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
21619 !C Calculate the multi-body contribution to energy.
21620 ! ecorr=ecorr+ekont*ees
21621 !C Calculate multi-body contributions to the gradient.
21622 coeffpees0pij=coeffp*ees0pij
21623 coeffmees0mij=coeffm*ees0mij
21624 coeffpees0pkl=coeffp*ees0pkl
21625 coeffmees0mkl=coeffm*ees0mkl
21627 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i) &
21628 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
21629 coeffmees0mkl*gacontm_hb1(ll,jj,i))
21630 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j) &
21631 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
21632 coeffmees0mkl*gacontm_hb2(ll,jj,i))
21633 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k) &
21634 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ &
21635 coeffmees0mij*gacontm_hb1(ll,kk,k))
21636 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l) &
21637 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
21638 coeffmees0mij*gacontm_hb2(ll,kk,k))
21639 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
21640 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
21641 coeffmees0mkl*gacontm_hb3(ll,jj,i))
21642 gradcorr3_nucl(ll,j)=gradcorr3_nucl(ll,j)+gradlongij
21643 gradcorr3_nucl(ll,i)=gradcorr3_nucl(ll,i)-gradlongij
21644 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
21645 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
21646 coeffmees0mij*gacontm_hb3(ll,kk,k))
21647 gradcorr3_nucl(ll,l)=gradcorr3_nucl(ll,l)+gradlongkl
21648 gradcorr3_nucl(ll,k)=gradcorr3_nucl(ll,k)-gradlongkl
21649 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i)-gradlongij
21650 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j)+gradlongij
21651 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k)-gradlongkl
21652 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l)+gradlongkl
21654 ehbcorr3_nucl=ekont*ees
21656 end function ehbcorr3_nucl
21658 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
21659 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
21660 real(kind=8):: buffer(dimen1,dimen2)
21661 num_kont=num_cont_hb(atom)
21665 buffer(i,indx+(k-1)*3+j)=zapas2(j,i,atom,k)
21668 buffer(i,indx+25)=facont_hb(i,atom)
21669 buffer(i,indx+26)=ees0p(i,atom)
21670 buffer(i,indx+27)=ees0m(i,atom)
21671 buffer(i,indx+28)=d_cont(i,atom)
21672 buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
21674 buffer(1,indx+30)=dfloat(num_kont)
21676 end subroutine pack_buffer
21677 !c------------------------------------------------------------------------------
21678 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
21679 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
21680 real(kind=8):: buffer(dimen1,dimen2)
21681 ! double precision zapas
21682 ! common /contacts_hb/ zapas(3,maxconts,maxres,8),
21683 ! & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
21684 ! & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
21685 ! & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
21686 num_kont=buffer(1,indx+30)
21687 num_kont_old=num_cont_hb(atom)
21688 num_cont_hb(atom)=num_kont+num_kont_old
21693 zapas2(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
21696 facont_hb(ii,atom)=buffer(i,indx+25)
21697 ees0p(ii,atom)=buffer(i,indx+26)
21698 ees0m(ii,atom)=buffer(i,indx+27)
21699 d_cont(i,atom)=buffer(i,indx+28)
21700 jcont_hb(ii,atom)=buffer(i,indx+29)
21703 end subroutine unpack_buffer
21704 !c------------------------------------------------------------------------------
21706 subroutine ecatcat(ecationcation)
21707 integer :: i,j,itmp,xshift,yshift,zshift,subchap,k
21708 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
21709 r7,r4,ecationcation,k0,rcal
21710 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
21711 dist_init,dist_temp,Evan1cat,Evan2cat,Eeleccat
21712 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
21715 ecationcation=0.0d0
21716 if (nres_molec(5).eq.0) return
21721 k0 = 332.0*(2.0*2.0)/80.0
21725 itmp=itmp+nres_molec(i)
21727 ! write(iout,*) "itmp",itmp
21728 do i=itmp+1,itmp+nres_molec(5)-1
21734 xi=mod(xi,boxxsize)
21735 if (xi.lt.0) xi=xi+boxxsize
21736 yi=mod(yi,boxysize)
21737 if (yi.lt.0) yi=yi+boxysize
21738 zi=mod(zi,boxzsize)
21739 if (zi.lt.0) zi=zi+boxzsize
21741 do j=i+1,itmp+nres_molec(5)
21742 ! print *,i,j,'catcat'
21746 xj=dmod(xj,boxxsize)
21747 if (xj.lt.0) xj=xj+boxxsize
21748 yj=dmod(yj,boxysize)
21749 if (yj.lt.0) yj=yj+boxysize
21750 zj=dmod(zj,boxzsize)
21751 if (zj.lt.0) zj=zj+boxzsize
21752 ! write(iout,*) c(1,i),xi,xj,"xy",boxxsize
21753 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21761 xj=xj_safe+xshift*boxxsize
21762 yj=yj_safe+yshift*boxysize
21763 zj=zj_safe+zshift*boxzsize
21764 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21765 if(dist_temp.lt.dist_init) then
21766 dist_init=dist_temp
21775 if (subchap.eq.1) then
21784 rcal =xj**2+yj**2+zj**2
21790 ! k0 = 332*(2*2)/80
21791 Evan1cat=epscalc*(r012/rcal**6)
21792 Evan2cat=epscalc*2*(r06/rcal**3)
21800 dEvan1Cmcat(k)=-12*r(k)*epscalc*r012/r7
21801 dEvan2Cmcat(k)=-12*r(k)*epscalc*r06/r4
21802 dEeleccat(k)=-k0*r(k)/ract**3
21805 gg(k) = dEvan1Cmcat(k)+dEvan2Cmcat(k)+dEeleccat(k)
21806 gradcatcat(k,i)=gradcatcat(k,i)-gg(k)
21807 gradcatcat(k,j)=gradcatcat(k,j)+gg(k)
21810 ! write(iout,*) "ecatcat",i,j, ecationcation,xj,yj,zj
21811 ecationcation=ecationcation+Evan1cat+Evan2cat+Eeleccat
21815 end subroutine ecatcat
21816 !---------------------------------------------------------------------------
21817 subroutine ecat_prot(ecation_prot)
21818 integer i,j,k,subchap,itmp,inum
21819 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
21820 r7,r4,ecationcation
21821 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
21822 dist_init,dist_temp,ecation_prot,rcal,rocal, &
21823 Evan1,Evan2,EC,cm1mag,DASGL,delta,r0p,Epepcat, &
21824 catl,cml,calpl, Etotal_p, Etotal_m,rtab,wdip,wmodquad,wquad1, &
21825 wquad2,wvan1,E1,E2,wconst,wvan2,rcpm,dcmag,sin2thet,sinthet, &
21826 costhet,v1m,v2m,wh2o,wc,rsecp,Ir,Irsecp,Irthrp,Irfourp,Irfiftp,&
21827 Irsistp,Irseven,Irtwelv,Irthir,dE1dr,dE2dr,dEdcos,wquad2p,opt, &
21828 rs,rthrp,rfourp,rsixp,reight,Irsixp,Ireight,Irtw,Irfourt, &
21829 opt1,opt2,opt3,opt4,opt5,opt6,opt7,opt8,opt9,opt10,opt11,opt12,&
21830 opt13,opt14,opt15,opt16,opt17,opt18,opt19, &
21831 Equad1,Equad2,dscmag,v1dpv2,dscmag3,constA,constB,Edip
21832 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
21833 gg,r,EtotalCat,dEtotalCm,dEtotalCalp,dEvan1Cm,dEvan2Cm, &
21834 dEtotalpep,dEtotalcat_num,dEddci,dEtotalcm_num,dEtotalcalp_num, &
21835 tab1,tab2,tab3,diff,cm1,sc,p,tcat,talp,cm,drcp,drcp_norm,vcat, &
21836 v1,v2,v3,myd_norm,dx,vcm,valpha,drdpep,dcosdpep,dcosddci,dEdpep,&
21837 dEcCat,dEdipCm,dEdipCalp,dEquad1Cat,dEquad1Cm,dEquad1Calp, &
21838 dEquad2Cat,dEquad2Cm,dEquad2Calpd,Evan1Cat,dEvan1Calp,dEvan2Cat,&
21839 dEvan2Calp,dEtotalCat,dscvec,dEcCm,dEcCalp,dEdipCat,dEquad2Calp,&
21841 real(kind=8),dimension(6) :: vcatprm
21843 ! first lets calculate interaction with peptide groups
21844 if (nres_molec(5).eq.0) return
21846 wdip =1.092777950857032D2
21848 wmodquad=-2.174122713004870D4
21849 wmodquad=wmodquad/wconst
21850 wquad1 = 3.901232068562804D1
21851 wquad1=wquad1/wconst
21853 wquad2=wquad2/wconst
21858 itmp=itmp+nres_molec(i)
21860 ! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
21861 do i=ibond_start,ibond_end
21863 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle ! leave dummy atoms
21864 xi=0.5d0*(c(1,i)+c(1,i+1))
21865 yi=0.5d0*(c(2,i)+c(2,i+1))
21866 zi=0.5d0*(c(3,i)+c(3,i+1))
21867 xi=mod(xi,boxxsize)
21868 if (xi.lt.0) xi=xi+boxxsize
21869 yi=mod(yi,boxysize)
21870 if (yi.lt.0) yi=yi+boxysize
21871 zi=mod(zi,boxzsize)
21872 if (zi.lt.0) zi=zi+boxzsize
21874 do j=itmp+1,itmp+nres_molec(5)
21878 xj=dmod(xj,boxxsize)
21879 if (xj.lt.0) xj=xj+boxxsize
21880 yj=dmod(yj,boxysize)
21881 if (yj.lt.0) yj=yj+boxysize
21882 zj=dmod(zj,boxzsize)
21883 if (zj.lt.0) zj=zj+boxzsize
21884 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21892 xj=xj_safe+xshift*boxxsize
21893 yj=yj_safe+yshift*boxysize
21894 zj=zj_safe+zshift*boxzsize
21895 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21896 if(dist_temp.lt.dist_init) then
21897 dist_init=dist_temp
21906 if (subchap.eq.1) then
21917 rcpm = sqrt(xj**2+yj**2+zj**2)
21918 drcp_norm(1)=xj/rcpm
21919 drcp_norm(2)=yj/rcpm
21920 drcp_norm(3)=zj/rcpm
21923 dcmag=dcmag+dc(k,i)**2
21927 myd_norm(k)=dc(k,i)/dcmag
21929 costhet=drcp_norm(1)*myd_norm(1)+drcp_norm(2)*myd_norm(2)+&
21930 drcp_norm(3)*myd_norm(3)
21933 Irsecp = 1.0d0/rsecp
21934 Irthrp = Irsecp/rcpm
21935 Irfourp = Irthrp/rcpm
21936 Irfiftp = Irfourp/rcpm
21937 Irsistp=Irfiftp/rcpm
21938 Irseven=Irsistp/rcpm
21939 Irtwelv=Irsistp*Irsistp
21940 Irthir=Irtwelv/rcpm
21941 sin2thet = (1-costhet*costhet)
21942 sinthet=sqrt(sin2thet)
21943 E1 = wdip*Irsecp*costhet+(wmodquad*Irfourp+wquad1*Irthrp)&
21945 E2 = -wquad1*Irthrp*wquad2+wvan1*(wvan2**12*Irtwelv-&
21946 2*wvan2**6*Irsistp)
21947 ecation_prot = ecation_prot+E1+E2
21948 dE1dr = -2*costhet*wdip*Irthrp-&
21949 (4*wmodquad*Irfiftp+3*wquad1*Irfourp)*sin2thet
21950 dE2dr = 3*wquad1*wquad2*Irfourp- &
21951 12*wvan1*wvan2**6*(wvan2**6*Irthir-Irseven)
21952 dEdcos = wdip*Irsecp-2*(wmodquad*Irfourp+wquad1*Irthrp)*costhet
21954 drdpep(k) = -drcp_norm(k)
21955 dcosdpep(k) = Ir*(costhet*drcp_norm(k)-myd_norm(k))
21956 dcosddci(k) = drcp_norm(k)/dcmag-costhet*myd_norm(k)/dcmag
21957 dEdpep(k) = (dE1dr+dE2dr)*drdpep(k)+dEdcos*dcosdpep(k)
21958 dEddci(k) = dEdcos*dcosddci(k)
21961 gradpepcat(k,i)=gradpepcat(k,i)+0.5D0*dEdpep(k)-dEddci(k)
21962 gradpepcat(k,i+1)=gradpepcat(k,i+1)+0.5D0*dEdpep(k)+dEddci(k)
21963 gradpepcat(k,j)=gradpepcat(k,j)-dEdpep(k)
21967 !------------------------------------------sidechains
21968 ! do i=1,nres_molec(1)
21969 do i=ibond_start,ibond_end
21970 if ((itype(i,1).eq.ntyp1)) cycle ! leave dummy atoms
21972 ! print *,i,ecation_prot
21976 xi=mod(xi,boxxsize)
21977 if (xi.lt.0) xi=xi+boxxsize
21978 yi=mod(yi,boxysize)
21979 if (yi.lt.0) yi=yi+boxysize
21980 zi=mod(zi,boxzsize)
21981 if (zi.lt.0) zi=zi+boxzsize
21983 cm1(k)=dc(k,i+nres)
21985 cm1mag=sqrt(cm1(1)**2+cm1(2)**2+cm1(3)**2)
21986 do j=itmp+1,itmp+nres_molec(5)
21990 xj=dmod(xj,boxxsize)
21991 if (xj.lt.0) xj=xj+boxxsize
21992 yj=dmod(yj,boxysize)
21993 if (yj.lt.0) yj=yj+boxysize
21994 zj=dmod(zj,boxzsize)
21995 if (zj.lt.0) zj=zj+boxzsize
21996 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22004 xj=xj_safe+xshift*boxxsize
22005 yj=yj_safe+yshift*boxysize
22006 zj=zj_safe+zshift*boxzsize
22007 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22008 if(dist_temp.lt.dist_init) then
22009 dist_init=dist_temp
22018 if (subchap.eq.1) then
22029 if(itype(i,1).eq.15.or.itype(i,1).eq.16) then
22030 if(itype(i,1).eq.16) then
22036 vcatprm(k)=catprm(k,inum)
22038 dASGL=catprm(7,inum)
22040 vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
22045 dx(k) = vcat(k)-vcm(k)
22048 v1(k)=(vcm(k)-valpha(k))
22049 v2(k)=(vcat(k)-valpha(k))
22051 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
22052 v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
22053 v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
22055 ! The weights of the energy function calculated from
22056 !The quantum mechanical GAMESS simulations of calcium with ASP/GLU
22064 wquad2 = vcatprm(4)
22069 opt = dx(1)**2+dx(2)**2
22070 rsecp = opt+dx(3)**2
22074 rsixp = rfourp*rsecp
22079 Irfourp = Irthrp/rs
22085 opt1 = (4*rs*dx(3)*wdip)
22086 opt2 = 6*rsecp*wquad1*opt
22087 opt3 = wquad1*wquad2p*Irsixp
22088 opt4 = (wvan1*wvan2**12)
22089 opt5 = opt4*12*Irfourt
22090 opt6 = 2*wvan1*wvan2**6
22091 opt7 = 6*opt6*Ireight
22094 opt11 = (rsecp*v2m)**2
22095 opt12 = (rsecp*v1m)**2
22096 opt14 = (v1m*v2m*rsecp)**2
22097 opt15 = -wquad1/v2m**2
22098 opt16 = (rthrp*(v1m*v2m)**2)**2
22099 opt17 = (v1m**2*rthrp)**2
22100 opt18 = -wquad1/rthrp
22101 opt19 = (v1m**2*v2m**2)**2
22104 dEcCat(k) = -(dx(k)*wc)*Irthrp
22105 dEcCm(k)=(dx(k)*wc)*Irthrp
22108 Edip=opt8*(v1dpv2)/(rsecp*v2m)
22110 dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m &
22111 *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
22112 dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m &
22113 *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
22114 dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m &
22115 *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp) &
22118 Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
22120 dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp* &
22121 (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2* &
22122 v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
22123 dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp* &
22124 (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2* &
22125 v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
22126 dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
22127 v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)* &
22130 Equad2=wquad1*wquad2p*Irthrp
22132 dEquad2Cat(k)=-3*dx(k)*rs*opt3
22133 dEquad2Cm(k)=3*dx(k)*rs*opt3
22134 dEquad2Calp(k)=0.0d0
22138 dEvan1Cat(k)=-dx(k)*opt5
22139 dEvan1Cm(k)=dx(k)*opt5
22140 dEvan1Calp(k)=0.0d0
22144 dEvan2Cat(k)=dx(k)*opt7
22145 dEvan2Cm(k)=-dx(k)*opt7
22146 dEvan2Calp(k)=0.0d0
22148 ecation_prot=ecation_prot+Ec+Edip+Equad1+Equad2+Evan1+Evan2
22149 ! print *,ecation_prot,Ec+Edip+Equad1+Equad2+Evan1+Evan2
22152 dEtotalCat(k)=dEcCat(k)+dEdipCat(k)+dEquad1Cat(k)+ &
22153 dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
22154 !c write(*,*) 'dEtotalCat inside', (dEtotalCat(l),l=1,3)
22155 dEtotalCm(k)=dEcCm(k)+dEdipCm(k)+dEquad1Cm(k)+ &
22156 dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
22157 dEtotalCalp(k)=dEcCalp(k)+dEdipCalp(k)+dEquad1Calp(k) &
22158 +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
22162 dscvec(k) = dc(k,i+nres)
22163 dscmag = dscmag+dscvec(k)*dscvec(k)
22166 dscmag = sqrt(dscmag)
22167 dscmag3 = dscmag3*dscmag
22168 constA = 1.0d0+dASGL/dscmag
22171 constB = constB+dscvec(k)*dEtotalCm(k)
22173 constB = constB*dASGL/dscmag3
22175 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
22176 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
22177 constA*dEtotalCm(k)-constB*dscvec(k)
22178 ! print *,j,constA,dEtotalCm(k),constB,dscvec(k)
22179 gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
22180 gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
22182 else if (itype(i,1).eq.13.or.itype(i,1).eq.14) then
22183 if(itype(i,1).eq.14) then
22189 vcatprm(k)=catprm(k,inum)
22191 dASGL=catprm(7,inum)
22193 vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
22199 dx(k) = vcat(k)-vcm(k)
22202 v1(k)=(vcm(k)-valpha(k))
22203 v2(k)=(vcat(k)-valpha(k))
22205 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
22206 v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
22207 v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
22208 ! The weights of the energy function calculated from
22209 !The quantum mechanical GAMESS simulations of ASN/GLN with calcium
22215 wquad2 = vcatprm(4)
22220 opt = dx(1)**2+dx(2)**2
22221 rsecp = opt+dx(3)**2
22225 rsixp = rfourp*rsecp
22230 Irfourp = Irthrp/rs
22236 opt1 = (4*rs*dx(3)*wdip)
22237 opt2 = 6*rsecp*wquad1*opt
22238 opt3 = wquad1*wquad2p*Irsixp
22239 opt4 = (wvan1*wvan2**12)
22240 opt5 = opt4*12*Irfourt
22241 opt6 = 2*wvan1*wvan2**6
22242 opt7 = 6*opt6*Ireight
22245 opt11 = (rsecp*v2m)**2
22246 opt12 = (rsecp*v1m)**2
22247 opt14 = (v1m*v2m*rsecp)**2
22248 opt15 = -wquad1/v2m**2
22249 opt16 = (rthrp*(v1m*v2m)**2)**2
22250 opt17 = (v1m**2*rthrp)**2
22251 opt18 = -wquad1/rthrp
22252 opt19 = (v1m**2*v2m**2)**2
22253 Edip=opt8*(v1dpv2)/(rsecp*v2m)
22255 dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m&
22256 *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
22257 dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m&
22258 *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
22259 dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m&
22260 *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp)&
22263 Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
22265 dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp*&
22266 (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2*&
22267 v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
22268 dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp*&
22269 (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2*&
22270 v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
22271 dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
22272 v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)*&
22275 Equad2=wquad1*wquad2p*Irthrp
22277 dEquad2Cat(k)=-3*dx(k)*rs*opt3
22278 dEquad2Cm(k)=3*dx(k)*rs*opt3
22279 dEquad2Calp(k)=0.0d0
22283 dEvan1Cat(k)=-dx(k)*opt5
22284 dEvan1Cm(k)=dx(k)*opt5
22285 dEvan1Calp(k)=0.0d0
22289 dEvan2Cat(k)=dx(k)*opt7
22290 dEvan2Cm(k)=-dx(k)*opt7
22291 dEvan2Calp(k)=0.0d0
22293 ecation_prot = ecation_prot+Edip+Equad1+Equad2+Evan1+Evan2
22295 dEtotalCat(k)=dEdipCat(k)+dEquad1Cat(k)+ &
22296 dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
22297 dEtotalCm(k)=dEdipCm(k)+dEquad1Cm(k)+ &
22298 dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
22299 dEtotalCalp(k)=dEdipCalp(k)+dEquad1Calp(k) &
22300 +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
22304 dscvec(k) = c(k,i+nres)-c(k,i)
22305 dscmag = dscmag+dscvec(k)*dscvec(k)
22308 dscmag = sqrt(dscmag)
22309 dscmag3 = dscmag3*dscmag
22310 constA = 1+dASGL/dscmag
22313 constB = constB+dscvec(k)*dEtotalCm(k)
22315 constB = constB*dASGL/dscmag3
22317 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
22318 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
22319 constA*dEtotalCm(k)-constB*dscvec(k)
22320 gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
22321 gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
22326 r(k) = c(k,j)-c(k,i+nres)
22327 rcal = rcal+r(k)*r(k)
22332 r0p=0.5*(rocal+sig0(itype(i,1)))
22335 Evan1=epscalc*(r012/rcal**6)
22336 Evan2=epscalc*2*(r06/rcal**3)
22340 dEvan1Cm(k) = 12*r(k)*epscalc*r012/r7
22341 dEvan2Cm(k) = 12*r(k)*epscalc*r06/r4
22344 dEtotalCm(k)=dEvan1Cm(k)+dEvan2Cm(k)
22346 ecation_prot = ecation_prot+ Evan1+Evan2
22348 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
22350 gradpepcat(k,i)=gradpepcat(k,i)+dEtotalCm(k)
22351 gradpepcat(k,j)=gradpepcat(k,j)-dEtotalCm(k)
22353 endif ! 13-16 residues
22357 end subroutine ecat_prot
22359 !----------------------------------------------------------------------------
22360 !-----------------------------------------------------------------------------
22361 !-----------------------------------------------------------------------------
22362 subroutine eprot_sc_base(escbase)
22364 ! implicit real*8 (a-h,o-z)
22365 ! include 'DIMENSIONS'
22366 ! include 'COMMON.GEO'
22367 ! include 'COMMON.VAR'
22368 ! include 'COMMON.LOCAL'
22369 ! include 'COMMON.CHAIN'
22370 ! include 'COMMON.DERIV'
22371 ! include 'COMMON.NAMES'
22372 ! include 'COMMON.INTERACT'
22373 ! include 'COMMON.IOUNITS'
22374 ! include 'COMMON.CALC'
22375 ! include 'COMMON.CONTROL'
22376 ! include 'COMMON.SBRIDGE'
22378 !el local variables
22379 integer :: iint,itypi,itypi1,itypj,subchap
22380 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
22381 real(kind=8) :: evdw,sig0ij
22382 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
22383 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
22384 sslipi,sslipj,faclip
22386 real(kind=8) :: fracinbuf
22387 real (kind=8) :: escbase
22388 real (kind=8),dimension(4):: ener
22389 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
22390 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
22391 sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
22392 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
22393 dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
22394 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
22395 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
22396 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
22397 real(kind=8),dimension(3,2)::chead,erhead_tail
22398 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
22402 ! do i=1,nres_molec(1)
22403 do i=ibond_start,ibond_end
22404 if (itype(i,1).eq.ntyp1_molec(1)) cycle
22406 dxi = dc_norm(1,nres+i)
22407 dyi = dc_norm(2,nres+i)
22408 dzi = dc_norm(3,nres+i)
22409 dsci_inv = vbld_inv(i+nres)
22413 xi=mod(xi,boxxsize)
22414 if (xi.lt.0) xi=xi+boxxsize
22415 yi=mod(yi,boxysize)
22416 if (yi.lt.0) yi=yi+boxysize
22417 zi=mod(zi,boxzsize)
22418 if (zi.lt.0) zi=zi+boxzsize
22419 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
22421 if (itype(j,2).eq.ntyp1_molec(2))cycle
22425 xj=dmod(xj,boxxsize)
22426 if (xj.lt.0) xj=xj+boxxsize
22427 yj=dmod(yj,boxysize)
22428 if (yj.lt.0) yj=yj+boxysize
22429 zj=dmod(zj,boxzsize)
22430 if (zj.lt.0) zj=zj+boxzsize
22431 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22440 xj=xj_safe+xshift*boxxsize
22441 yj=yj_safe+yshift*boxysize
22442 zj=zj_safe+zshift*boxzsize
22443 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22444 if(dist_temp.lt.dist_init) then
22445 dist_init=dist_temp
22454 if (subchap.eq.1) then
22463 dxj = dc_norm( 1, nres+j )
22464 dyj = dc_norm( 2, nres+j )
22465 dzj = dc_norm( 3, nres+j )
22466 ! print *,i,j,itypi,itypj
22467 d1i = dhead_scbasei(itypi,itypj) !this is shift of dipole/charge
22468 d1j = dhead_scbasej(itypi,itypj) !this is shift of dipole/charge
22471 ! BetaT = 1.0d0 / (298.0d0 * Rb)
22473 sig0ij = sigma_scbase( itypi,itypj )
22474 chi1 = chi_scbase( itypi, itypj,1 )
22475 chi2 = chi_scbase( itypi, itypj,2 )
22478 chi12 = chi1 * chi2
22479 chip1 = chipp_scbase( itypi, itypj,1 )
22480 chip2 = chipp_scbase( itypi, itypj,2 )
22483 chip12 = chip1 * chip2
22484 ! not used by momo potential, but needed by sc_angular which is shared
22485 ! by all energy_potential subroutines
22489 a12sq = rborn_scbasei(itypi,itypj) * rborn_scbasej(itypi,itypj)
22490 ! a12sq = a12sq * a12sq
22491 ! charge of amino acid itypi is...
22492 chis1 = chis_scbase(itypi,itypj,1)
22493 chis2 = chis_scbase(itypi,itypj,2)
22494 chis12 = chis1 * chis2
22495 sig1 = sigmap1_scbase(itypi,itypj)
22496 sig2 = sigmap2_scbase(itypi,itypj)
22497 ! write (*,*) "sig1 = ", sig1
22498 ! write (*,*) "sig2 = ", sig2
22499 ! alpha factors from Fcav/Gcav
22500 b1 = alphasur_scbase(1,itypi,itypj)
22502 b2 = alphasur_scbase(2,itypi,itypj)
22503 b3 = alphasur_scbase(3,itypi,itypj)
22504 b4 = alphasur_scbase(4,itypi,itypj)
22505 ! used to determine whether we want to do quadrupole calculations
22507 eps_in = epsintab_scbase(itypi,itypj)
22508 if (eps_in.eq.0.0) eps_in=1.0
22509 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
22510 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
22511 !-------------------------------------------------------------------
22512 ! tail location and distance calculations
22514 ! location of polar head is computed by taking hydrophobic centre
22515 ! and moving by a d1 * dc_norm vector
22516 ! see unres publications for very informative images
22517 chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
22518 chead(k,2) = c(k, j+nres) + d1j * dc_norm(k, j+nres)
22520 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
22521 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
22522 Rhead_distance(k) = chead(k,2) - chead(k,1)
22524 ! pitagoras (root of sum of squares)
22526 (Rhead_distance(1)*Rhead_distance(1)) &
22527 + (Rhead_distance(2)*Rhead_distance(2)) &
22528 + (Rhead_distance(3)*Rhead_distance(3)))
22529 !-------------------------------------------------------------------
22530 ! zero everything that should be zero'ed
22548 dscj_inv = vbld_inv(j+nres)
22549 ! print *,i,j,dscj_inv,dsci_inv
22550 ! rij holds 1/(distance of Calpha atoms)
22551 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
22553 !----------------------------
22555 ! this should be in elgrad_init but om's are calculated by sc_angular
22556 ! which in turn is used by older potentials
22557 ! om = omega, sqom = om^2
22560 sqom12 = om12 * om12
22562 ! now we calculate EGB - Gey-Berne
22563 ! It will be summed up in evdwij and saved in evdw
22564 sigsq = 1.0D0 / sigsq
22565 sig = sig0ij * dsqrt(sigsq)
22566 ! rij_shift = 1.0D0 / rij - sig + sig0ij
22567 rij_shift = 1.0/rij - sig + sig0ij
22568 IF (rij_shift.le.0.0D0) THEN
22572 sigder = -sig * sigsq
22573 rij_shift = 1.0D0 / rij_shift
22574 fac = rij_shift**expon
22575 c1 = fac * fac * aa_scbase(itypi,itypj)
22577 c2 = fac * bb_scbase(itypi,itypj)
22579 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
22580 eps2der = eps3rt * evdwij
22581 eps3der = eps2rt * evdwij
22582 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
22583 evdwij = eps2rt * eps3rt * evdwij
22584 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
22585 fac = -expon * (c1 + evdwij) * rij_shift
22586 sigder = fac * sigder
22588 ! Calculate distance derivative
22592 ! if (b2.gt.0.0) then
22593 fac = chis1 * sqom1 + chis2 * sqom2 &
22594 - 2.0d0 * chis12 * om1 * om2 * om12
22595 ! we will use pom later in Gcav, so dont mess with it!
22596 pom = 1.0d0 - chis1 * chis2 * sqom12
22597 Lambf = (1.0d0 - (fac / pom))
22598 Lambf = dsqrt(Lambf)
22599 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
22600 ! write (*,*) "sparrow = ", sparrow
22601 Chif = 1.0d0/rij * sparrow
22602 ChiLambf = Chif * Lambf
22603 eagle = dsqrt(ChiLambf)
22604 bat = ChiLambf ** 11.0d0
22605 top = b1 * ( eagle + b2 * ChiLambf - b3 )
22606 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
22610 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
22611 dbot = 12.0d0 * b4 * bat * Lambf
22612 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
22614 ! write (*,*) "dFcav/dR = ", dFdR
22615 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
22616 dbot = 12.0d0 * b4 * bat * Chif
22617 eagle = Lambf * pom
22618 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
22619 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
22620 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
22621 * (chis2 * om2 * om12 - om1) / (eagle * pom)
22623 dFdL = ((dtop * bot - top * dbot) / botsq)
22625 dCAVdOM1 = dFdL * ( dFdOM1 )
22626 dCAVdOM2 = dFdL * ( dFdOM2 )
22627 dCAVdOM12 = dFdL * ( dFdOM12 )
22632 ! eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
22633 ! eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
22634 ! eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
22635 ! -2.0D0*alf12*eps3der+sigder*sigsq_om12
22636 ! print *,"EOMY",eom1,eom2,eom12
22637 ! erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
22638 ! erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
22640 ! facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
22641 ! facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
22643 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
22644 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
22646 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
22647 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
22648 - (( dFdR + gg(k) ) * pom)
22649 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
22650 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
22651 ! & - ( dFdR * pom )
22653 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
22654 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
22655 + (( dFdR + gg(k) ) * pom)
22656 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
22657 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
22658 !c! & + ( dFdR * pom )
22660 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
22661 - (( dFdR + gg(k) ) * ertail(k))
22662 !c! & - ( dFdR * ertail(k))
22664 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
22665 + (( dFdR + gg(k) ) * ertail(k))
22666 !c! & + ( dFdR * ertail(k))
22669 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
22670 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
22677 if (wdipdip_scbase(2,itypi,itypj).gt.0.0d0) then
22678 w1 = wdipdip_scbase(1,itypi,itypj)
22679 w2 = -wdipdip_scbase(3,itypi,itypj)/2.0
22680 w3 = wdipdip_scbase(2,itypi,itypj)
22681 !c!-------------------------------------------------------------------
22683 fac = (om12 - 3.0d0 * om1 * om2)
22684 c1 = (w1 / (Rhead**3.0d0)) * fac
22685 c2 = (w2 / Rhead ** 6.0d0) &
22686 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
22687 c3= (w3/ Rhead ** 6.0d0) &
22688 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
22690 !c! write (*,*) "w1 = ", w1
22691 !c! write (*,*) "w2 = ", w2
22692 !c! write (*,*) "om1 = ", om1
22693 !c! write (*,*) "om2 = ", om2
22694 !c! write (*,*) "om12 = ", om12
22695 !c! write (*,*) "fac = ", fac
22696 !c! write (*,*) "c1 = ", c1
22697 !c! write (*,*) "c2 = ", c2
22698 !c! write (*,*) "Ecl = ", Ecl
22699 !c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
22700 !c! write (*,*) "c2_2 = ",
22701 !c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
22702 !c!-------------------------------------------------------------------
22703 !c! dervative of ECL is GCL...
22705 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
22706 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
22707 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
22708 c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
22709 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
22710 dGCLdR = c1 - c2 + c3
22712 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
22713 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
22714 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
22715 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
22716 dGCLdOM1 = c1 - c2 + c3
22718 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
22719 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
22720 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
22721 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
22722 dGCLdOM2 = c1 - c2 + c3
22724 c1 = w1 / (Rhead ** 3.0d0)
22725 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
22726 c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
22727 dGCLdOM12 = c1 - c2 + c3
22729 erhead(k) = Rhead_distance(k)/Rhead
22731 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
22732 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
22733 facd1 = d1i * vbld_inv(i+nres)
22734 facd2 = d1j * vbld_inv(j+nres)
22737 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
22738 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
22740 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
22741 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
22744 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
22745 - dGCLdR * erhead(k)
22746 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
22747 + dGCLdR * erhead(k)
22750 !now charge with dipole eg. ARG-dG
22751 if (wqdip_scbase(2,itypi,itypj).gt.0.0d0) then
22752 alphapol1 = alphapol_scbase(itypi,itypj)
22753 w1 = wqdip_scbase(1,itypi,itypj)
22754 w2 = wqdip_scbase(2,itypi,itypj)
22757 ! pis = sig0head_scbase(itypi,itypj)
22758 ! eps_head = epshead_scbase(itypi,itypj)
22759 !c!-------------------------------------------------------------------
22760 !c! R1 - distance between head of ith side chain and tail of jth sidechain
22763 !c! Calculate head-to-tail distances tail is center of side-chain
22764 R1=R1+(c(k,j+nres)-chead(k,1))**2
22769 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
22770 !c! & +dhead(1,1,itypi,itypj))**2))
22771 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
22772 !c! & +dhead(2,1,itypi,itypj))**2))
22774 !c!-------------------------------------------------------------------
22777 hawk = w2 * (1.0d0 - sqom2)
22778 Ecl = sparrow / Rhead**2.0d0 &
22779 - hawk / Rhead**4.0d0
22780 !c!-------------------------------------------------------------------
22781 !c! derivative of ecl is Gcl
22783 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
22784 + 4.0d0 * hawk / Rhead**5.0d0
22786 dGCLdOM1 = (w1) / (Rhead**2.0d0)
22788 dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
22789 !c--------------------------------------------------------------------
22790 !c Polarization energy
22792 MomoFac1 = (1.0d0 - chi1 * sqom2)
22793 RR1 = R1 * R1 / MomoFac1
22794 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
22795 fgb1 = sqrt( RR1 + a12sq * ee1)
22796 ! eps_inout_fac=0.0d0
22797 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
22798 ! derivative of Epol is Gpol...
22799 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
22801 dFGBdR1 = ( (R1 / MomoFac1) &
22802 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
22804 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
22805 * (2.0d0 - 0.5d0 * ee1) ) &
22807 dPOLdR1 = dPOLdFGB1 * dFGBdR1
22810 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
22812 erhead(k) = Rhead_distance(k)/Rhead
22813 erhead_tail(k,1) = ((c(k,j+nres)-chead(k,1))/R1)
22816 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
22817 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
22818 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
22820 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
22821 facd1 = d1i * vbld_inv(i+nres)
22822 facd2 = d1j * vbld_inv(j+nres)
22823 ! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
22826 hawk = (erhead_tail(k,1) + &
22827 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
22830 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
22831 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
22833 - dPOLdR1 * (erhead_tail(k,1))
22836 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
22837 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
22839 + dPOLdR1 * (erhead_tail(k,1))
22843 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
22844 - dGCLdR * erhead(k) &
22845 - dPOLdR1 * erhead_tail(k,1)
22846 ! & - dGLJdR * erhead(k)
22848 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
22849 + dGCLdR * erhead(k) &
22850 + dPOLdR1 * erhead_tail(k,1)
22851 ! & + dGLJdR * erhead(k)
22855 ! print *,i,j,evdwij,epol,Fcav,ECL
22856 escbase=escbase+evdwij+epol+Fcav+ECL
22857 call sc_grad_scbase
22862 end subroutine eprot_sc_base
22863 SUBROUTINE sc_grad_scbase
22866 real (kind=8) :: dcosom1(3),dcosom2(3)
22868 eps2der * eps2rt_om1 &
22869 - 2.0D0 * alf1 * eps3der &
22870 + sigder * sigsq_om1 &
22876 eps2der * eps2rt_om2 &
22877 + 2.0D0 * alf2 * eps3der &
22878 + sigder * sigsq_om2 &
22884 evdwij * eps1_om12 &
22885 + eps2der * eps2rt_om12 &
22886 - 2.0D0 * alf12 * eps3der &
22887 + sigder *sigsq_om12 &
22891 ! print *,eom1,eom2,eom12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
22892 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
22893 ! gg(1),gg(2),"rozne"
22895 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
22896 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
22897 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
22898 gvdwx_scbase(k,i)= gvdwx_scbase(k,i) - gg(k) &
22899 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
22900 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
22901 gvdwx_scbase(k,j)= gvdwx_scbase(k,j) + gg(k) &
22902 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
22903 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
22904 gvdwc_scbase(k,i)=gvdwc_scbase(k,i)-gg(k)
22905 gvdwc_scbase(k,j)=gvdwc_scbase(k,j)+gg(k)
22908 END SUBROUTINE sc_grad_scbase
22911 subroutine epep_sc_base(epepbase)
22914 !el local variables
22915 integer :: iint,itypi,itypi1,itypj,subchap
22916 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
22917 real(kind=8) :: evdw,sig0ij
22918 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
22919 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
22920 sslipi,sslipj,faclip
22922 real(kind=8) :: fracinbuf
22923 real (kind=8) :: epepbase
22924 real (kind=8),dimension(4):: ener
22925 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
22926 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
22927 sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
22928 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
22929 dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
22930 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
22931 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
22932 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
22933 real(kind=8),dimension(3,2)::chead,erhead_tail
22934 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
22938 ! do i=1,nres_molec(1)-1
22939 do i=ibond_start,ibond_end
22940 if (itype(i,1).eq.ntyp1_molec(1).or.itype(i+1,1).eq.ntyp1_molec(1)) cycle
22941 !C itypi = itype(i,1)
22945 ! print *,dxi,(-c(1,i)+c(1,i+1))*vbld_inv(i+1)
22946 dsci_inv = vbld_inv(i+1)/2.0
22947 xi=(c(1,i)+c(1,i+1))/2.0
22948 yi=(c(2,i)+c(2,i+1))/2.0
22949 zi=(c(3,i)+c(3,i+1))/2.0
22950 xi=mod(xi,boxxsize)
22951 if (xi.lt.0) xi=xi+boxxsize
22952 yi=mod(yi,boxysize)
22953 if (yi.lt.0) yi=yi+boxysize
22954 zi=mod(zi,boxzsize)
22955 if (zi.lt.0) zi=zi+boxzsize
22956 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
22958 if (itype(j,2).eq.ntyp1_molec(2))cycle
22962 xj=dmod(xj,boxxsize)
22963 if (xj.lt.0) xj=xj+boxxsize
22964 yj=dmod(yj,boxysize)
22965 if (yj.lt.0) yj=yj+boxysize
22966 zj=dmod(zj,boxzsize)
22967 if (zj.lt.0) zj=zj+boxzsize
22968 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22977 xj=xj_safe+xshift*boxxsize
22978 yj=yj_safe+yshift*boxysize
22979 zj=zj_safe+zshift*boxzsize
22980 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22981 if(dist_temp.lt.dist_init) then
22982 dist_init=dist_temp
22991 if (subchap.eq.1) then
23000 dxj = dc_norm( 1, nres+j )
23001 dyj = dc_norm( 2, nres+j )
23002 dzj = dc_norm( 3, nres+j )
23003 ! d1i = dhead_scbasei(itypi) !this is shift of dipole/charge
23004 ! d1j = dhead_scbasej(itypi) !this is shift of dipole/charge
23007 sig0ij = sigma_pepbase(itypj )
23008 chi1 = chi_pepbase(itypj,1 )
23009 chi2 = chi_pepbase(itypj,2 )
23012 chi12 = chi1 * chi2
23013 chip1 = chipp_pepbase(itypj,1 )
23014 chip2 = chipp_pepbase(itypj,2 )
23017 chip12 = chip1 * chip2
23018 chis1 = chis_pepbase(itypj,1)
23019 chis2 = chis_pepbase(itypj,2)
23020 chis12 = chis1 * chis2
23021 sig1 = sigmap1_pepbase(itypj)
23022 sig2 = sigmap2_pepbase(itypj)
23023 ! write (*,*) "sig1 = ", sig1
23024 ! write (*,*) "sig2 = ", sig2
23026 ! location of polar head is computed by taking hydrophobic centre
23027 ! and moving by a d1 * dc_norm vector
23028 ! see unres publications for very informative images
23029 chead(k,1) = (c(k,i)+c(k,i+1))/2.0
23030 ! + d1i * dc_norm(k, i+nres)
23031 chead(k,2) = c(k, j+nres)
23032 ! + d1j * dc_norm(k, j+nres)
23034 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
23035 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
23036 Rhead_distance(k) = chead(k,2) - chead(k,1)
23037 ! print *,gvdwc_pepbase(k,i)
23041 (Rhead_distance(1)*Rhead_distance(1)) &
23042 + (Rhead_distance(2)*Rhead_distance(2)) &
23043 + (Rhead_distance(3)*Rhead_distance(3)))
23045 ! alpha factors from Fcav/Gcav
23046 b1 = alphasur_pepbase(1,itypj)
23048 b2 = alphasur_pepbase(2,itypj)
23049 b3 = alphasur_pepbase(3,itypj)
23050 b4 = alphasur_pepbase(4,itypj)
23054 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23057 !----------------------------
23075 dscj_inv = vbld_inv(j+nres)
23077 ! this should be in elgrad_init but om's are calculated by sc_angular
23078 ! which in turn is used by older potentials
23079 ! om = omega, sqom = om^2
23082 sqom12 = om12 * om12
23084 ! now we calculate EGB - Gey-Berne
23085 ! It will be summed up in evdwij and saved in evdw
23086 sigsq = 1.0D0 / sigsq
23087 sig = sig0ij * dsqrt(sigsq)
23088 rij_shift = 1.0/rij - sig + sig0ij
23089 IF (rij_shift.le.0.0D0) THEN
23093 sigder = -sig * sigsq
23094 rij_shift = 1.0D0 / rij_shift
23095 fac = rij_shift**expon
23096 c1 = fac * fac * aa_pepbase(itypj)
23098 c2 = fac * bb_pepbase(itypj)
23100 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
23101 eps2der = eps3rt * evdwij
23102 eps3der = eps2rt * evdwij
23103 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
23104 evdwij = eps2rt * eps3rt * evdwij
23105 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
23106 fac = -expon * (c1 + evdwij) * rij_shift
23107 sigder = fac * sigder
23109 ! Calculate distance derivative
23113 fac = chis1 * sqom1 + chis2 * sqom2 &
23114 - 2.0d0 * chis12 * om1 * om2 * om12
23115 ! we will use pom later in Gcav, so dont mess with it!
23116 pom = 1.0d0 - chis1 * chis2 * sqom12
23117 Lambf = (1.0d0 - (fac / pom))
23118 Lambf = dsqrt(Lambf)
23119 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
23120 ! write (*,*) "sparrow = ", sparrow
23121 Chif = 1.0d0/rij * sparrow
23122 ChiLambf = Chif * Lambf
23123 eagle = dsqrt(ChiLambf)
23124 bat = ChiLambf ** 11.0d0
23125 top = b1 * ( eagle + b2 * ChiLambf - b3 )
23126 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
23130 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
23131 dbot = 12.0d0 * b4 * bat * Lambf
23132 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
23134 ! write (*,*) "dFcav/dR = ", dFdR
23135 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
23136 dbot = 12.0d0 * b4 * bat * Chif
23137 eagle = Lambf * pom
23138 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
23139 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
23140 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
23141 * (chis2 * om2 * om12 - om1) / (eagle * pom)
23143 dFdL = ((dtop * bot - top * dbot) / botsq)
23145 dCAVdOM1 = dFdL * ( dFdOM1 )
23146 dCAVdOM2 = dFdL * ( dFdOM2 )
23147 dCAVdOM12 = dFdL * ( dFdOM12 )
23153 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23154 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23156 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
23157 gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
23158 - (( dFdR + gg(k) ) * pom)/2.0
23159 ! print *,gvdwc_pepbase(k,i),i,(( dFdR + gg(k) ) * pom)/2.0
23160 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
23161 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
23162 ! & - ( dFdR * pom )
23164 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
23165 gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
23166 + (( dFdR + gg(k) ) * pom)
23167 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
23168 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23169 !c! & + ( dFdR * pom )
23171 gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
23172 - (( dFdR + gg(k) ) * ertail(k))/2.0
23173 ! print *,gvdwc_pepbase(k,i+1),i+1,(( dFdR + gg(k) ) * pom)/2.0
23175 !c! & - ( dFdR * ertail(k))
23177 gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
23178 + (( dFdR + gg(k) ) * ertail(k))
23179 !c! & + ( dFdR * ertail(k))
23182 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23183 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23187 w1 = wdipdip_pepbase(1,itypj)
23188 w2 = -wdipdip_pepbase(3,itypj)/2.0
23189 w3 = wdipdip_pepbase(2,itypj)
23192 !c!-------------------------------------------------------------------
23195 fac = (om12 - 3.0d0 * om1 * om2)
23196 c1 = (w1 / (Rhead**3.0d0)) * fac
23197 c2 = (w2 / Rhead ** 6.0d0) &
23198 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
23199 c3= (w3/ Rhead ** 6.0d0) &
23200 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
23204 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
23205 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
23206 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
23207 c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
23208 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
23210 dGCLdR = c1 - c2 + c3
23212 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
23213 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
23214 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
23215 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
23216 dGCLdOM1 = c1 - c2 + c3
23218 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
23219 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
23220 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
23221 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
23223 dGCLdOM2 = c1 - c2 + c3
23225 c1 = w1 / (Rhead ** 3.0d0)
23226 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
23227 c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
23228 dGCLdOM12 = c1 - c2 + c3
23230 erhead(k) = Rhead_distance(k)/Rhead
23232 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
23233 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
23234 ! facd1 = d1 * vbld_inv(i+nres)
23235 ! facd2 = d2 * vbld_inv(j+nres)
23239 !+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
23240 ! gvdwx_pepbase(k,i) = gvdwx_scbase(k,i) &
23243 !+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
23244 gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
23247 gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
23248 - dGCLdR * erhead(k)/2.0d0
23249 ! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
23250 gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
23251 - dGCLdR * erhead(k)/2.0d0
23252 ! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
23253 gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
23254 + dGCLdR * erhead(k)
23256 ! print *,i,j,evdwij,Fcav,ECL,"vdw,cav,ecl"
23257 epepbase=epepbase+evdwij+Fcav+ECL
23258 call sc_grad_pepbase
23261 END SUBROUTINE epep_sc_base
23262 SUBROUTINE sc_grad_pepbase
23265 real (kind=8) :: dcosom1(3),dcosom2(3)
23267 eps2der * eps2rt_om1 &
23268 - 2.0D0 * alf1 * eps3der &
23269 + sigder * sigsq_om1 &
23275 eps2der * eps2rt_om2 &
23276 + 2.0D0 * alf2 * eps3der &
23277 + sigder * sigsq_om2 &
23283 evdwij * eps1_om12 &
23284 + eps2der * eps2rt_om12 &
23285 - 2.0D0 * alf12 * eps3der &
23286 + sigder *sigsq_om12 &
23291 ! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
23292 ! if (i.eq.30) print *,gvdwc_pepbase(k,i),- gg(k),&
23293 ! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
23295 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
23296 ! gg(1),gg(2),"rozne"
23298 dcosom1(k) = rij * (dc_norm(k,i) - om1 * erij(k))
23299 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
23300 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
23301 gvdwc_pepbase(k,i)= gvdwc_pepbase(k,i) +0.5*(- gg(k)) &
23302 + (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
23304 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
23305 gvdwc_pepbase(k,i+1)= gvdwc_pepbase(k,i+1) +0.5*(- gg(k)) &
23306 - (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i))) &
23308 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
23309 ! print *,eom12,eom2,om12,om2
23310 !eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
23311 ! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
23312 gvdwx_pepbase(k,j)= gvdwx_pepbase(k,j) + gg(k) &
23313 + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
23314 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23315 gvdwc_pepbase(k,j)=gvdwc_pepbase(k,j)+gg(k)
23318 END SUBROUTINE sc_grad_pepbase
23319 subroutine eprot_sc_phosphate(escpho)
23321 ! implicit real*8 (a-h,o-z)
23322 ! include 'DIMENSIONS'
23323 ! include 'COMMON.GEO'
23324 ! include 'COMMON.VAR'
23325 ! include 'COMMON.LOCAL'
23326 ! include 'COMMON.CHAIN'
23327 ! include 'COMMON.DERIV'
23328 ! include 'COMMON.NAMES'
23329 ! include 'COMMON.INTERACT'
23330 ! include 'COMMON.IOUNITS'
23331 ! include 'COMMON.CALC'
23332 ! include 'COMMON.CONTROL'
23333 ! include 'COMMON.SBRIDGE'
23335 !el local variables
23336 integer :: iint,itypi,itypi1,itypj,subchap
23337 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
23338 real(kind=8) :: evdw,sig0ij
23339 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
23340 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
23341 sslipi,sslipj,faclip,alpha_sco
23343 real(kind=8) :: fracinbuf
23344 real (kind=8) :: escpho
23345 real (kind=8),dimension(4):: ener
23346 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
23347 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
23348 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
23349 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
23350 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
23351 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
23352 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
23353 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
23354 real(kind=8),dimension(3,2)::chead,erhead_tail
23355 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
23359 ! do i=1,nres_molec(1)
23360 do i=ibond_start,ibond_end
23361 if (itype(i,1).eq.ntyp1_molec(1)) cycle
23363 dxi = dc_norm(1,nres+i)
23364 dyi = dc_norm(2,nres+i)
23365 dzi = dc_norm(3,nres+i)
23366 dsci_inv = vbld_inv(i+nres)
23370 xi=mod(xi,boxxsize)
23371 if (xi.lt.0) xi=xi+boxxsize
23372 yi=mod(yi,boxysize)
23373 if (yi.lt.0) yi=yi+boxysize
23374 zi=mod(zi,boxzsize)
23375 if (zi.lt.0) zi=zi+boxzsize
23376 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
23378 if ((itype(j,2).eq.ntyp1_molec(2)).or.&
23379 (itype(j+1,2).eq.ntyp1_molec(2))) cycle
23380 xj=(c(1,j)+c(1,j+1))/2.0
23381 yj=(c(2,j)+c(2,j+1))/2.0
23382 zj=(c(3,j)+c(3,j+1))/2.0
23383 xj=dmod(xj,boxxsize)
23384 if (xj.lt.0) xj=xj+boxxsize
23385 yj=dmod(yj,boxysize)
23386 if (yj.lt.0) yj=yj+boxysize
23387 zj=dmod(zj,boxzsize)
23388 if (zj.lt.0) zj=zj+boxzsize
23389 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23397 xj=xj_safe+xshift*boxxsize
23398 yj=yj_safe+yshift*boxysize
23399 zj=zj_safe+zshift*boxzsize
23400 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23401 if(dist_temp.lt.dist_init) then
23402 dist_init=dist_temp
23411 if (subchap.eq.1) then
23420 dxj = dc_norm( 1,j )
23421 dyj = dc_norm( 2,j )
23422 dzj = dc_norm( 3,j )
23423 dscj_inv = vbld_inv(j+1)
23426 sig0ij = sigma_scpho(itypi )
23427 chi1 = chi_scpho(itypi,1 )
23428 chi2 = chi_scpho(itypi,2 )
23431 chi12 = chi1 * chi2
23432 chip1 = chipp_scpho(itypi,1 )
23433 chip2 = chipp_scpho(itypi,2 )
23436 chip12 = chip1 * chip2
23437 chis1 = chis_scpho(itypi,1)
23438 chis2 = chis_scpho(itypi,2)
23439 chis12 = chis1 * chis2
23440 sig1 = sigmap1_scpho(itypi)
23441 sig2 = sigmap2_scpho(itypi)
23442 ! write (*,*) "sig1 = ", sig1
23443 ! write (*,*) "sig1 = ", sig1
23444 ! write (*,*) "sig2 = ", sig2
23445 ! alpha factors from Fcav/Gcav
23449 a12sq = rborn_scphoi(itypi) * rborn_scphoj(itypi)
23451 b1 = alphasur_scpho(1,itypi)
23453 b2 = alphasur_scpho(2,itypi)
23454 b3 = alphasur_scpho(3,itypi)
23455 b4 = alphasur_scpho(4,itypi)
23456 ! used to determine whether we want to do quadrupole calculations
23458 eps_in = epsintab_scpho(itypi)
23459 if (eps_in.eq.0.0) eps_in=1.0
23460 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
23461 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
23462 !-------------------------------------------------------------------
23463 ! tail location and distance calculations
23464 d1i = dhead_scphoi(itypi) !this is shift of dipole/charge
23467 ! location of polar head is computed by taking hydrophobic centre
23468 ! and moving by a d1 * dc_norm vector
23469 ! see unres publications for very informative images
23470 chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
23471 chead(k,2) = (c(k, j) + c(k, j+1))/2.0
23473 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
23474 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
23475 Rhead_distance(k) = chead(k,2) - chead(k,1)
23477 ! pitagoras (root of sum of squares)
23479 (Rhead_distance(1)*Rhead_distance(1)) &
23480 + (Rhead_distance(2)*Rhead_distance(2)) &
23481 + (Rhead_distance(3)*Rhead_distance(3)))
23482 Rhead_sq=Rhead**2.0
23483 !-------------------------------------------------------------------
23484 ! zero everything that should be zero'ed
23503 dscj_inv = vbld_inv(j+1)/2.0
23504 !dhead_scbasej(itypi,itypj)
23505 ! print *,i,j,dscj_inv,dsci_inv
23506 ! rij holds 1/(distance of Calpha atoms)
23507 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23509 !----------------------------
23511 ! this should be in elgrad_init but om's are calculated by sc_angular
23512 ! which in turn is used by older potentials
23513 ! om = omega, sqom = om^2
23516 sqom12 = om12 * om12
23518 ! now we calculate EGB - Gey-Berne
23519 ! It will be summed up in evdwij and saved in evdw
23520 sigsq = 1.0D0 / sigsq
23521 sig = sig0ij * dsqrt(sigsq)
23522 ! rij_shift = 1.0D0 / rij - sig + sig0ij
23523 rij_shift = 1.0/rij - sig + sig0ij
23524 IF (rij_shift.le.0.0D0) THEN
23528 sigder = -sig * sigsq
23529 rij_shift = 1.0D0 / rij_shift
23530 fac = rij_shift**expon
23531 c1 = fac * fac * aa_scpho(itypi)
23533 c2 = fac * bb_scpho(itypi)
23535 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
23536 eps2der = eps3rt * evdwij
23537 eps3der = eps2rt * evdwij
23538 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
23539 evdwij = eps2rt * eps3rt * evdwij
23540 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
23541 fac = -expon * (c1 + evdwij) * rij_shift
23542 sigder = fac * sigder
23544 ! Calculate distance derivative
23548 fac = chis1 * sqom1 + chis2 * sqom2 &
23549 - 2.0d0 * chis12 * om1 * om2 * om12
23550 ! we will use pom later in Gcav, so dont mess with it!
23551 pom = 1.0d0 - chis1 * chis2 * sqom12
23552 Lambf = (1.0d0 - (fac / pom))
23553 Lambf = dsqrt(Lambf)
23554 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
23555 ! write (*,*) "sparrow = ", sparrow
23556 Chif = 1.0d0/rij * sparrow
23557 ChiLambf = Chif * Lambf
23558 eagle = dsqrt(ChiLambf)
23559 bat = ChiLambf ** 11.0d0
23560 top = b1 * ( eagle + b2 * ChiLambf - b3 )
23561 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
23564 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
23565 dbot = 12.0d0 * b4 * bat * Lambf
23566 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
23568 ! write (*,*) "dFcav/dR = ", dFdR
23569 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
23570 dbot = 12.0d0 * b4 * bat * Chif
23571 eagle = Lambf * pom
23572 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
23573 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
23574 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
23575 * (chis2 * om2 * om12 - om1) / (eagle * pom)
23577 dFdL = ((dtop * bot - top * dbot) / botsq)
23579 dCAVdOM1 = dFdL * ( dFdOM1 )
23580 dCAVdOM2 = dFdL * ( dFdOM2 )
23581 dCAVdOM12 = dFdL * ( dFdOM12 )
23587 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23588 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23589 ! if (i.eq.3) print *,'decl0',gvdwx_scpho(k,i),i
23592 ! print *,pom,gg(k),dFdR
23593 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
23594 gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
23595 - (( dFdR + gg(k) ) * pom)
23596 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
23597 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
23598 ! & - ( dFdR * pom )
23600 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
23601 ! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
23602 ! + (( dFdR + gg(k) ) * pom)
23603 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
23604 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23605 !c! & + ( dFdR * pom )
23607 gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
23608 - (( dFdR + gg(k) ) * ertail(k))
23609 !c! & - ( dFdR * ertail(k))
23611 gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
23612 + (( dFdR + gg(k) ) * ertail(k))/2.0
23614 gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
23615 + (( dFdR + gg(k) ) * ertail(k))/2.0
23617 !c! & + ( dFdR * ertail(k))
23621 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23622 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23623 ! alphapol1 = alphapol_scpho(itypi)
23624 if (wqq_scpho(itypi).ne.0.0) then
23625 Qij=wqq_scpho(itypi)/eps_in
23626 alpha_sco=1.d0/alphi_scpho(itypi)
23628 Ecl = (332.0d0 * Qij*dexp(-Rhead*alpha_sco)) / Rhead
23629 !c! derivative of Ecl is Gcl...
23630 dGCLdR = (-332.0d0 * Qij*dexp(-Rhead*alpha_sco)* &
23631 (Rhead*alpha_sco+1) ) / Rhead_sq
23632 if (energy_dec) write(iout,*) "ECL",ECL,Rhead,1.0/rij
23633 else if (wqdip_scpho(2,itypi).gt.0.0d0) then
23634 w1 = wqdip_scpho(1,itypi)
23635 w2 = wqdip_scpho(2,itypi)
23638 ! pis = sig0head_scbase(itypi,itypj)
23639 ! eps_head = epshead_scbase(itypi,itypj)
23640 !c!-------------------------------------------------------------------
23642 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
23643 !c! & +dhead(1,1,itypi,itypj))**2))
23644 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
23645 !c! & +dhead(2,1,itypi,itypj))**2))
23647 !c!-------------------------------------------------------------------
23650 hawk = w2 * (1.0d0 - sqom2)
23651 Ecl = sparrow / Rhead**2.0d0 &
23652 - hawk / Rhead**4.0d0
23653 !c!-------------------------------------------------------------------
23654 if (energy_dec) write(iout,*) "ECLdipdip",ECL,Rhead,&
23657 !c! derivative of ecl is Gcl
23659 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
23660 + 4.0d0 * hawk / Rhead**5.0d0
23662 dGCLdOM1 = (w1) / (Rhead**2.0d0)
23664 dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
23667 !c--------------------------------------------------------------------
23668 !c Polarization energy
23672 !c! Calculate head-to-tail distances tail is center of side-chain
23673 R1=R1+((c(k,j)+c(k,j+1))/2.0-chead(k,1))**2
23678 alphapol1 = alphapol_scpho(itypi)
23680 MomoFac1 = (1.0d0 - chi2 * sqom1)
23681 RR1 = R1 * R1 / MomoFac1
23682 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
23683 ! print *,"ee1",ee1,a12sq,alphapol1,eps_inout_fac
23684 fgb1 = sqrt( RR1 + a12sq * ee1)
23685 ! eps_inout_fac=0.0d0
23686 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
23687 ! derivative of Epol is Gpol...
23688 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
23690 dFGBdR1 = ( (R1 / MomoFac1) &
23691 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
23693 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
23694 * (2.0d0 - 0.5d0 * ee1) ) &
23696 dPOLdR1 = dPOLdFGB1 * dFGBdR1
23699 dFGBdOM1 = (((R1 * R1 * chi2 * om1) / (MomoFac1 * MomoFac1)) &
23700 * (2.0d0 - 0.5d0 * ee1) ) &
23703 dPOLdOM1 = dPOLdFGB1 * dFGBdOM1
23706 erhead(k) = Rhead_distance(k)/Rhead
23707 erhead_tail(k,1) = (((c(k,j)+c(k,j+1))/2.0-chead(k,1))/R1)
23710 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
23711 erdxj = scalar( erhead(1), dC_norm(1,j) )
23712 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
23714 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j))
23715 facd1 = d1i * vbld_inv(i+nres)
23716 facd2 = d1j * vbld_inv(j)
23717 ! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
23720 hawk = (erhead_tail(k,1) + &
23721 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
23724 ! if (i.eq.3) print *,'decl1',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i,&
23725 ! pom,(erhead_tail(k,1))
23727 ! print *,'decl',dGCLdR,dPOLdR1,gvdwc_scpho(k,i)
23728 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
23729 gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
23731 - dPOLdR1 * (erhead_tail(k,1))
23734 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
23735 ! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
23737 ! + dPOLdR1 * (erhead_tail(k,1))
23741 gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
23742 - dGCLdR * erhead(k) &
23743 - dPOLdR1 * erhead_tail(k,1)
23744 ! & - dGLJdR * erhead(k)
23746 gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
23747 + (dGCLdR * erhead(k) &
23748 + dPOLdR1 * erhead_tail(k,1))/2.0
23749 gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
23750 + (dGCLdR * erhead(k) &
23751 + dPOLdR1 * erhead_tail(k,1))/2.0
23753 ! & + dGLJdR * erhead(k)
23754 ! if (i.eq.3) print *,'decl2',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i
23757 ! if (i.eq.3) print *,i,j,evdwij,epol,Fcav,ECL
23758 if (energy_dec) write (iout,'(a22,2i5,4f8.3,f16.3)'), &
23759 "escpho:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,escpho
23760 escpho=escpho+evdwij+epol+Fcav+ECL
23767 end subroutine eprot_sc_phosphate
23768 SUBROUTINE sc_grad_scpho
23771 real (kind=8) :: dcosom1(3),dcosom2(3)
23773 eps2der * eps2rt_om1 &
23774 - 2.0D0 * alf1 * eps3der &
23775 + sigder * sigsq_om1 &
23781 eps2der * eps2rt_om2 &
23782 + 2.0D0 * alf2 * eps3der &
23783 + sigder * sigsq_om2 &
23789 evdwij * eps1_om12 &
23790 + eps2der * eps2rt_om12 &
23791 - 2.0D0 * alf12 * eps3der &
23792 + sigder *sigsq_om12 &
23797 ! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
23798 ! if (i.eq.30) print *,gvdwc_scpho(k,i),- gg(k),&
23799 ! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
23801 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
23802 ! gg(1),gg(2),"rozne"
23804 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
23805 dcosom2(k) = rij * (dc_norm(k,j) - om2 * erij(k))
23806 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
23807 gvdwc_scpho(k,j)= gvdwc_scpho(k,j) +0.5*( gg(k)) &
23808 + (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)))&
23810 - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
23811 gvdwc_scpho(k,j+1)= gvdwc_scpho(k,j+1) +0.5*( gg(k)) &
23812 - (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j))) &
23814 + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
23815 gvdwx_scpho(k,i)= gvdwx_scpho(k,i) - gg(k) &
23816 + (eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
23817 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
23819 ! print *,eom12,eom2,om12,om2
23820 !eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
23821 ! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
23822 ! gvdwx_scpho(k,j)= gvdwx_scpho(k,j) + gg(k) &
23823 ! + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
23824 ! + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23825 gvdwc_scpho(k,i)=gvdwc_scpho(k,i)-gg(k)
23828 END SUBROUTINE sc_grad_scpho
23829 subroutine eprot_pep_phosphate(epeppho)
23831 ! implicit real*8 (a-h,o-z)
23832 ! include 'DIMENSIONS'
23833 ! include 'COMMON.GEO'
23834 ! include 'COMMON.VAR'
23835 ! include 'COMMON.LOCAL'
23836 ! include 'COMMON.CHAIN'
23837 ! include 'COMMON.DERIV'
23838 ! include 'COMMON.NAMES'
23839 ! include 'COMMON.INTERACT'
23840 ! include 'COMMON.IOUNITS'
23841 ! include 'COMMON.CALC'
23842 ! include 'COMMON.CONTROL'
23843 ! include 'COMMON.SBRIDGE'
23845 !el local variables
23846 integer :: iint,itypi,itypi1,itypj,subchap
23847 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
23848 real(kind=8) :: evdw,sig0ij
23849 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
23850 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
23851 sslipi,sslipj,faclip
23853 real(kind=8) :: fracinbuf
23854 real (kind=8) :: epeppho
23855 real (kind=8),dimension(4):: ener
23856 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
23857 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
23858 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
23859 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
23860 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
23861 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
23862 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
23863 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
23864 real(kind=8),dimension(3,2)::chead,erhead_tail
23865 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
23867 real (kind=8) :: dcosom1(3),dcosom2(3)
23869 ! do i=1,nres_molec(1)
23870 do i=ibond_start,ibond_end
23871 if (itype(i,1).eq.ntyp1_molec(1)) cycle
23873 dsci_inv = vbld_inv(i+1)/2.0
23877 xi=(c(1,i)+c(1,i+1))/2.0
23878 yi=(c(2,i)+c(2,i+1))/2.0
23879 zi=(c(3,i)+c(3,i+1))/2.0
23880 xi=mod(xi,boxxsize)
23881 if (xi.lt.0) xi=xi+boxxsize
23882 yi=mod(yi,boxysize)
23883 if (yi.lt.0) yi=yi+boxysize
23884 zi=mod(zi,boxzsize)
23885 if (zi.lt.0) zi=zi+boxzsize
23886 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
23888 if ((itype(j,2).eq.ntyp1_molec(2)).or.&
23889 (itype(j+1,2).eq.ntyp1_molec(2))) cycle
23890 xj=(c(1,j)+c(1,j+1))/2.0
23891 yj=(c(2,j)+c(2,j+1))/2.0
23892 zj=(c(3,j)+c(3,j+1))/2.0
23893 xj=dmod(xj,boxxsize)
23894 if (xj.lt.0) xj=xj+boxxsize
23895 yj=dmod(yj,boxysize)
23896 if (yj.lt.0) yj=yj+boxysize
23897 zj=dmod(zj,boxzsize)
23898 if (zj.lt.0) zj=zj+boxzsize
23899 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23907 xj=xj_safe+xshift*boxxsize
23908 yj=yj_safe+yshift*boxysize
23909 zj=zj_safe+zshift*boxzsize
23910 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23911 if(dist_temp.lt.dist_init) then
23912 dist_init=dist_temp
23921 if (subchap.eq.1) then
23930 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23932 dxj = dc_norm( 1,j )
23933 dyj = dc_norm( 2,j )
23934 dzj = dc_norm( 3,j )
23935 dscj_inv = vbld_inv(j+1)/2.0
23937 sig0ij = sigma_peppho
23940 chi12 = chi1 * chi2
23943 chip12 = chip1 * chip2
23946 chis12 = chis1 * chis2
23947 sig1 = sigmap1_peppho
23948 sig2 = sigmap2_peppho
23949 ! write (*,*) "sig1 = ", sig1
23950 ! write (*,*) "sig1 = ", sig1
23951 ! write (*,*) "sig2 = ", sig2
23952 ! alpha factors from Fcav/Gcav
23956 b1 = alphasur_peppho(1)
23958 b2 = alphasur_peppho(2)
23959 b3 = alphasur_peppho(3)
23960 b4 = alphasur_peppho(4)
23982 fac = rij_shift**expon
23983 c1 = fac * fac * aa_peppho
23985 c2 = fac * bb_peppho
23988 ! Now cavity....................
23989 eagle = dsqrt(1.0/rij_shift)
23990 top = b1 * ( eagle + b2 * 1.0/rij_shift - b3 )
23991 bot = 1.0d0 + b4 * (1.0/rij_shift ** 12.0d0)
23994 dtop = b1 * ((1.0/ (2.0d0 * eagle)) + (b2))
23995 dbot = 12.0d0 * b4 * (1.0/rij_shift) ** 11.0d0
23996 dFdR = ((dtop * bot - top * dbot) / botsq)
23997 w1 = wqdip_peppho(1)
23998 w2 = wqdip_peppho(2)
24001 ! pis = sig0head_scbase(itypi,itypj)
24002 ! eps_head = epshead_scbase(itypi,itypj)
24003 !c!-------------------------------------------------------------------
24005 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
24006 !c! & +dhead(1,1,itypi,itypj))**2))
24007 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
24008 !c! & +dhead(2,1,itypi,itypj))**2))
24010 !c!-------------------------------------------------------------------
24013 hawk = w2 * (1.0d0 - sqom1)
24014 Ecl = sparrow * rij_shift**2.0d0 &
24015 - hawk * rij_shift**4.0d0
24016 !c!-------------------------------------------------------------------
24017 !c! derivative of ecl is Gcl
24020 dGCLdR = - 2.0d0 * sparrow * rij_shift**3.0d0 &
24021 + 4.0d0 * hawk * rij_shift**5.0d0
24023 dGCLdOM1 = (w1) * (rij_shift**2.0d0)
24025 dGCLdOM2 = (2.0d0 * w2 * om1) * (rij_shift ** 4.0d0)
24026 eom1 = dGCLdOM1+dGCLdOM2
24029 fac = -expon * (c1 + evdwij) * rij_shift+dFdR+dGCLdR
24035 gvdwc_peppho(k,j) = gvdwc_peppho(k,j) +gg(k)/2.0
24036 gvdwc_peppho(k,j+1) = gvdwc_peppho(k,j+1) +gg(k)/2.0
24037 gvdwc_peppho(k,i) = gvdwc_peppho(k,i) -gg(k)/2.0
24038 gvdwc_peppho(k,i+1) = gvdwc_peppho(k,i+1) -gg(k)/2.0
24043 dcosom1(k) = rij* (dc_norm(k,i) - om1 * erij(k))
24044 dcosom2(k) = rij* (dc_norm(k,j) - om2 * erij(k))
24045 gg(k) = gg(k) + eom1 * dcosom1(k)! + eom2 * dcosom2(k)
24046 gvdwc_peppho(k,j)= gvdwc_peppho(k,j) +0.5*( gg(k)) !&
24047 ! - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
24048 gvdwc_peppho(k,j+1)= gvdwc_peppho(k,j+1) +0.5*( gg(k)) !&
24049 ! + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
24050 gvdwc_peppho(k,i)= gvdwc_peppho(k,i) -0.5*( gg(k)) &
24051 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
24052 gvdwc_peppho(k,i+1)= gvdwc_peppho(k,i+1) - 0.5*( gg(k)) &
24053 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
24055 epeppho=epeppho+evdwij+Fcav+ECL
24056 ! print *,i,j,evdwij,Fcav,ECL,rij_shift
24059 end subroutine eprot_pep_phosphate