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 !------------------------------IONS GRADIENT
134 real(kind=8),dimension(:,:),allocatable :: gradcatcat
135 ! real(kind=8),dimension(:,:),allocatable :: gloc,gloc_x !(maxvar,2)
136 real(kind=8),dimension(:,:),allocatable :: gel_loc,gel_loc_long,&
137 gcorr3_turn,gcorr4_turn,gcorr6_turn,gradb,gradbx !(3,maxres)
138 real(kind=8),dimension(:),allocatable :: gel_loc_loc,&
139 gel_loc_turn3,gel_loc_turn4,gel_loc_turn6,gcorr_loc,g_corr5_loc,&
140 g_corr6_loc !(maxvar)
141 real(kind=8),dimension(:,:),allocatable :: gsccorc,gsccorx !(3,maxres)
142 real(kind=8),dimension(:),allocatable :: gsccor_loc !(maxres)
143 ! real(kind=8),dimension(:,:,:),allocatable :: dtheta !(3,2,maxres)
144 real(kind=8),dimension(:,:),allocatable :: gscloc,gsclocx !(3,maxres)
145 ! real(kind=8),dimension(:,:,:),allocatable :: dphi,dalpha,domega !(3,3,maxres)
146 real(kind=8),dimension(:,:,:),allocatable :: grad_shield_side, &
147 grad_shield_loc ! (3,maxcontsshileding,maxnres)
150 real(kind=8), dimension(:),allocatable :: fac_shield
151 real(kind=8),dimension(3,5,2) :: derx,derx_turn
152 ! common /deriv_scloc/
153 real(kind=8),dimension(:,:),allocatable :: dXX_C1tab,dYY_C1tab,&
154 dZZ_C1tab,dXX_Ctab,dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,&
155 dZZ_XYZtab !(3,maxres)
156 !-----------------------------------------------------------------------------
159 real(kind=8) :: gvdwc_max,gvdwc_scp_max,gelc_max,gvdwpp_max,&
160 gradb_max,ghpbc_max,&
161 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
162 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
163 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
164 gsccorx_max,gsclocx_max
165 !-----------------------------------------------------------------------------
167 ! common /back_constr/
168 real(kind=8),dimension(:),allocatable :: dutheta,dugamma !(maxres)
169 real(kind=8),dimension(:,:),allocatable :: duscdiff,duscdiffx !(3,maxres)
171 real(kind=8) :: Ucdfrag,Ucdpair
172 real(kind=8),dimension(:,:),allocatable :: dUdconst,dUdxconst,&
173 dqwol,dxqwol !(3,0:MAXRES)
174 !-----------------------------------------------------------------------------
176 ! common /dyn_ssbond/
177 real(kind=8),dimension(:,:),allocatable :: dyn_ssbond_ij !(maxres,maxres)
178 !-----------------------------------------------------------------------------
180 ! Parameters of the SCCOR term
182 real(kind=8),dimension(:,:,:,:),allocatable :: dcostau,dsintau,&
183 dcosomicron,domicron !(3,3,3,maxres2)
184 !-----------------------------------------------------------------------------
187 real(kind=8),dimension(:,:),allocatable :: uy,uz !(3,maxres)
188 real(kind=8),dimension(:,:,:,:),allocatable :: uygrad,uzgrad !(3,3,2,maxres)
189 !-----------------------------------------------------------------------------
190 ! common /przechowalnia/
191 real(kind=8),dimension(:,:,:),allocatable :: zapas
192 real(kind=8),dimension(:,:,:,:),allocatable ::zapas2 !(max_dim,maxconts,max_fg_procs)
193 real(kind=8),dimension(:,:,:),allocatable :: fromto !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
194 !-----------------------------------------------------------------------------
195 !-----------------------------------------------------------------------------
198 !-----------------------------------------------------------------------------
200 !-----------------------------------------------------------------------------
201 ! energy_p_new_barrier.F
202 !-----------------------------------------------------------------------------
203 subroutine etotal(energia)
204 ! implicit real*8 (a-h,o-z)
205 ! include 'DIMENSIONS'
210 !MS$ATTRIBUTES C :: proc_proc
216 ! include 'COMMON.SETUP'
217 ! include 'COMMON.IOUNITS'
218 real(kind=8),dimension(0:n_ene) :: energia
219 ! include 'COMMON.LOCAL'
220 ! include 'COMMON.FFIELD'
221 ! include 'COMMON.DERIV'
222 ! include 'COMMON.INTERACT'
223 ! include 'COMMON.SBRIDGE'
224 ! include 'COMMON.CHAIN'
225 ! include 'COMMON.VAR'
226 ! include 'COMMON.MD'
227 ! include 'COMMON.CONTROL'
228 ! include 'COMMON.TIME1'
229 real(kind=8) :: time00
231 integer :: n_corr,n_corr1,ierror
232 real(kind=8) :: etors,edihcnstr,etors_d,esccor,ehpb
233 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,escloc,ees,eel_loc
234 real(kind=8) :: eello_turn3,eello_turn4,estr,ebe,eliptran,etube, &
235 Eafmforce,ethetacnstr
236 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
237 ! now energies for nulceic alone parameters
238 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
239 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
242 real(kind=8) :: weights_(n_ene) !,time_Bcast,time_Bcastw
243 ! shielding effect varibles for MPI
244 ! real(kind=8) fac_shieldbuf(maxres),
245 ! & grad_shield_locbuf(3,maxcontsshi,-1:maxres),
246 ! & grad_shield_sidebuf(3,maxcontsshi,-1:maxres),
247 ! & grad_shieldbuf(3,-1:maxres)
248 ! integer ishield_listbuf(maxres),
249 ! &shield_listbuf(maxcontsshi,maxres)
251 ! print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
252 ! & " nfgtasks",nfgtasks
253 if (nfgtasks.gt.1) then
255 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
256 if (fg_rank.eq.0) then
257 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
258 ! print *,"Processor",myrank," BROADCAST iorder"
259 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
260 ! FG slaves as WEIGHTS array.
280 weights_(26)=wvdwpp_nucl
286 weights_(32)=wbond_nucl
287 weights_(33)=wang_nucl
289 weights_(35)=wtor_nucl
290 weights_(36)=wtor_d_nucl
291 weights_(37)=wcorr_nucl
292 weights_(38)=wcorr3_nucl
294 ! FG Master broadcasts the WEIGHTS_ array
295 call MPI_Bcast(weights_(1),n_ene,&
296 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
298 ! FG slaves receive the WEIGHTS array
299 call MPI_Bcast(weights(1),n_ene,&
300 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
320 wvdwpp_nucl =weights(26)
326 wbond_nucl =weights(32)
327 wang_nucl =weights(33)
329 wtor_nucl =weights(35)
330 wtor_d_nucl =weights(36)
331 wcorr_nucl =weights(37)
332 wcorr3_nucl =weights(38)
335 time_Bcast=time_Bcast+MPI_Wtime()-time00
336 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
337 ! call chainbuild_cart
339 ! print *,'Processor',myrank,' calling etotal ipot=',ipot
340 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
342 ! if (modecalc.eq.12.or.modecalc.eq.14) then
343 ! call int_from_cart1(.false.)
350 ! Compute the side-chain and electrostatic interaction energy
351 ! print *, "Before EVDW"
352 ! goto (101,102,103,104,105,106) ipot
354 ! Lennard-Jones potential.
358 !d print '(a)','Exit ELJcall el'
360 ! Lennard-Jones-Kihara potential (shifted).
361 ! 102 call eljk(evdw)
365 ! Berne-Pechukas potential (dilated LJ, angular dependence).
370 ! Gay-Berne potential (shifted LJ, angular dependence).
375 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
376 ! 105 call egbv(evdw)
380 ! Soft-sphere potential
381 ! 106 call e_softsphere(evdw)
383 call e_softsphere(evdw)
385 ! Calculate electrostatic (H-bonding) energy of the main chain.
389 write(iout,*)"Wrong ipot"
394 ! print *,"after EGB"
396 if (shield_mode.eq.2) then
399 ! print *,"AFTER EGB",ipot,evdw
401 !mc Sep-06: egb takes care of dynamic ss bonds too
403 ! if (dyn_ss) call dyn_set_nss
404 ! print *,"Processor",myrank," computed USCSC"
410 time_vec=time_vec+MPI_Wtime()-time01
412 ! print *,"Processor",myrank," left VEC_AND_DERIV"
415 ! print *,"after ipot if", ipot
416 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
417 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
418 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
419 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
421 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
422 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
423 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
424 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
426 ! print *,"just befor eelec call"
427 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
428 ! write (iout,*) "ELEC calc"
437 ! write (iout,*) "Soft-spheer ELEC potential"
438 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
441 ! print *,"Processor",myrank," computed UELEC"
443 ! Calculate excluded-volume interaction energy between peptide groups
446 !elwrite(iout,*) "in etotal calc exc;luded",ipot
450 call escp(evdw2,evdw2_14)
456 ! write (iout,*) "Soft-sphere SCP potential"
457 call escp_soft_sphere(evdw2,evdw2_14)
459 ! write(iout,*) "in etotal before ebond",ipot
462 ! Calculate the bond-stretching energy
465 ! print *,"EBOND",estr
466 ! write(iout,*) "in etotal afer ebond",ipot
469 ! Calculate the disulfide-bridge and other energy and the contributions
470 ! from other distance constraints.
471 ! print *,'Calling EHPB'
473 !elwrite(iout,*) "in etotal afer edis",ipot
474 ! print *,'EHPB exitted succesfully.'
476 ! Calculate the virtual-bond-angle energy.
478 if (wang.gt.0d0) then
479 call ebend(ebe,ethetacnstr)
484 ! print *,"Processor",myrank," computed UB"
486 ! Calculate the SC local energy.
489 !elwrite(iout,*) "in etotal afer esc",ipot
490 ! print *,"Processor",myrank," computed USC"
492 ! Calculate the virtual-bond torsional energy.
494 !d print *,'nterm=',nterm
496 call etor(etors,edihcnstr)
501 ! print *,"Processor",myrank," computed Utor"
503 ! 6/23/01 Calculate double-torsional energy
505 !elwrite(iout,*) "in etotal",ipot
506 if (wtor_d.gt.0) then
511 ! print *,"Processor",myrank," computed Utord"
513 ! 21/5/07 Calculate local sicdechain correlation energy
515 if (wsccor.gt.0.0d0) then
516 call eback_sc_corr(esccor)
520 ! print *,"Processor",myrank," computed Usccorr"
522 ! 12/1/95 Multi-body terms
526 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
527 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
528 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
529 !d write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
530 !d &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
537 !elwrite(iout,*) "in etotal",ipot
538 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
539 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
540 !d write (iout,*) "multibody_hb ecorr",ecorr
542 !elwrite(iout,*) "afeter multibody hb"
544 ! print *,"Processor",myrank," computed Ucorr"
546 ! If performing constraint dynamics, call the constraint energy
547 ! after the equilibration time
548 if(usampl.and.totT.gt.eq_time) then
549 !elwrite(iout,*) "afeter multibody hb"
551 !elwrite(iout,*) "afeter multibody hb"
553 !elwrite(iout,*) "afeter multibody hb"
559 ! write(iout,*) "after Econstr"
561 if (wliptran.gt.0) then
562 ! print *,"PRZED WYWOLANIEM"
563 call Eliptransfer(eliptran)
567 if (fg_rank.eq.0) then
568 if (AFMlog.gt.0) then
569 call AFMforce(Eafmforce)
570 else if (selfguide.gt.0) then
571 call AFMvel(Eafmforce)
574 if (tubemode.eq.1) then
576 else if (tubemode.eq.2) then
577 call calctube2(etube)
578 elseif (tubemode.eq.3) then
583 !--------------------------------------------------------
584 ! print *,"before",ees,evdw1,ecorr
585 call ebond_nucl(estr_nucl)
586 call ebend_nucl(ebe_nucl)
587 call etor_nucl(etors_nucl)
588 call esb_gb(evdwsb,eelsb)
589 call epp_nucl_sub(evdwpp,eespp)
590 call epsb(evdwpsb,eelpsb)
592 call multibody_hb_nucl(ecorr_nucl,ecorr3_nucl,n_corr,n_corr1)
594 ! print *,"after ebend", ebe_nucl
596 time_enecalc=time_enecalc+MPI_Wtime()-time00
598 ! print *,"Processor",myrank," computed Uconstr"
607 energia(2)=evdw2-evdw2_14
624 energia(8)=eello_turn3
625 energia(9)=eello_turn4
632 energia(19)=edihcnstr
634 energia(20)=Uconst+Uconst_back
637 energia(23)=Eafmforce
638 energia(24)=ethetacnstr
640 !---------------------------------------------------------------
647 energia(32)=estr_nucl
650 energia(35)=etors_nucl
651 energia(36)=etors_d_nucl
652 energia(37)=ecorr_nucl
653 energia(38)=ecorr3_nucl
654 !----------------------------------------------------------------------
655 ! Here are the energies showed per procesor if the are more processors
656 ! per molecule then we sum it up in sum_energy subroutine
657 ! print *," Processor",myrank," calls SUM_ENERGY"
658 call sum_energy(energia,.true.)
659 if (dyn_ss) call dyn_set_nss
660 ! print *," Processor",myrank," left SUM_ENERGY"
662 time_sumene=time_sumene+MPI_Wtime()-time00
664 !el call enerprint(energia)
665 !elwrite(iout,*)"finish etotal"
667 end subroutine etotal
668 !-----------------------------------------------------------------------------
669 subroutine sum_energy(energia,reduce)
670 ! implicit real*8 (a-h,o-z)
671 ! include 'DIMENSIONS'
675 !MS$ATTRIBUTES C :: proc_proc
681 ! include 'COMMON.SETUP'
682 ! include 'COMMON.IOUNITS'
683 real(kind=8) :: energia(0:n_ene),enebuff(0:n_ene+1)
684 ! include 'COMMON.FFIELD'
685 ! include 'COMMON.DERIV'
686 ! include 'COMMON.INTERACT'
687 ! include 'COMMON.SBRIDGE'
688 ! include 'COMMON.CHAIN'
689 ! include 'COMMON.VAR'
690 ! include 'COMMON.CONTROL'
691 ! include 'COMMON.TIME1'
693 real(kind=8) :: evdw,evdw2,evdw2_14,ees,evdw1,ecorr,ecorr5,ecorr6
694 real(kind=8) :: eel_loc,eello_turn3,eello_turn4,eturn6,ebe,escloc
695 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,esccor,etot, &
696 eliptran,etube, Eafmforce,ethetacnstr
697 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
698 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
704 real(kind=8) :: time00
705 if (nfgtasks.gt.1 .and. reduce) then
708 write (iout,*) "energies before REDUCE"
709 call enerprint(energia)
713 enebuff(i)=energia(i)
716 call MPI_Barrier(FG_COMM,IERR)
717 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
719 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,&
720 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
722 write (iout,*) "energies after REDUCE"
723 call enerprint(energia)
726 time_Reduce=time_Reduce+MPI_Wtime()-time00
728 if (fg_rank.eq.0) then
732 evdw2=energia(2)+energia(18)
748 eello_turn3=energia(8)
749 eello_turn4=energia(9)
756 edihcnstr=energia(19)
761 Eafmforce=energia(23)
762 ethetacnstr=energia(24)
770 estr_nucl=energia(32)
773 etors_nucl=energia(35)
774 etors_d_nucl=energia(36)
775 ecorr_nucl=energia(37)
776 ecorr3_nucl=energia(38)
780 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 &
781 +wang*ebe+wtor*etors+wscloc*escloc &
782 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
783 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
784 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
785 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
786 +Eafmforce+ethetacnstr &
787 +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
788 +wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
789 +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
790 +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl
792 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) &
793 +wang*ebe+wtor*etors+wscloc*escloc &
794 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
795 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
796 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
797 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
798 +Eafmforce+ethetacnstr &
799 +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
800 +wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
801 +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
802 +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl
808 if (isnan(etot).ne.0) energia(0)=1.0d+99
810 if (isnan(etot)) energia(0)=1.0d+99
815 idumm=proc_proc(etot,i)
817 call proc_proc(etot,i)
819 if(i.eq.1)energia(0)=1.0d+99
824 ! call enerprint(energia)
827 end subroutine sum_energy
828 !-----------------------------------------------------------------------------
829 subroutine rescale_weights(t_bath)
830 ! implicit real*8 (a-h,o-z)
834 ! include 'DIMENSIONS'
835 ! include 'COMMON.IOUNITS'
836 ! include 'COMMON.FFIELD'
837 ! include 'COMMON.SBRIDGE'
838 real(kind=8) :: kfac=2.4d0
839 real(kind=8) :: x,x2,x3,x4,x5,licznik=1.12692801104297249644
841 real(kind=8) :: t_bath,facT(6) !,facT2,facT3,facT4,facT5,facT6
842 real(kind=8) :: T0=3.0d2
845 ! facT=2*temp0/(t_bath+temp0)
846 if (rescale_mode.eq.0) then
853 else if (rescale_mode.eq.1) then
854 facT(1)=kfac/(kfac-1.0d0+t_bath/temp0)
855 facT(2)=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
856 facT(3)=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
857 facT(4)=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
858 facT(5)=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
860 !#if defined(WHAM_RUN) || defined(CLUSTER)
862 ! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
863 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
870 else if (rescale_mode.eq.2) then
876 facT(1)=licznik/dlog(dexp(x)+dexp(-x))
877 facT(2)=licznik/dlog(dexp(x2)+dexp(-x2))
878 facT(3)=licznik/dlog(dexp(x3)+dexp(-x3))
879 facT(4)=licznik/dlog(dexp(x4)+dexp(-x4))
880 facT(5)=licznik/dlog(dexp(x5)+dexp(-x5))
882 !#if defined(WHAM_RUN) || defined(CLUSTER)
884 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
892 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
893 write (*,*) "Wrong RESCALE_MODE",rescale_mode
895 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
899 welec=weights(3)*fact(1)
900 wcorr=weights(4)*fact(3)
901 wcorr5=weights(5)*fact(4)
902 wcorr6=weights(6)*fact(5)
903 wel_loc=weights(7)*fact(2)
904 wturn3=weights(8)*fact(2)
905 wturn4=weights(9)*fact(3)
906 wturn6=weights(10)*fact(5)
907 wtor=weights(13)*fact(1)
908 wtor_d=weights(14)*fact(2)
909 wsccor=weights(21)*fact(1)
912 end subroutine rescale_weights
913 !-----------------------------------------------------------------------------
914 subroutine enerprint(energia)
915 ! implicit real*8 (a-h,o-z)
916 ! include 'DIMENSIONS'
917 ! include 'COMMON.IOUNITS'
918 ! include 'COMMON.FFIELD'
919 ! include 'COMMON.SBRIDGE'
920 ! include 'COMMON.MD'
921 real(kind=8) :: energia(0:n_ene)
923 real(kind=8) :: etot,evdw,evdw2,ees,evdw1,ecorr,ecorr5,ecorr6,eel_loc
924 real(kind=8) :: eello_turn6,eello_turn3,eello_turn4,ebe,escloc
925 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,Uconst,esccor,eliptran,&
926 etube,ethetacnstr,Eafmforce
927 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
928 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
935 evdw2=energia(2)+energia(18)
947 eello_turn3=energia(8)
948 eello_turn4=energia(9)
949 eello_turn6=energia(10)
955 edihcnstr=energia(19)
960 Eafmforce=energia(23)
961 ethetacnstr=energia(24)
969 estr_nucl=energia(32)
972 etors_nucl=energia(35)
973 etors_d_nucl=energia(36)
974 ecorr_nucl=energia(37)
975 ecorr3_nucl=energia(38)
978 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,&
979 estr,wbond,ebe,wang,&
980 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
982 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
983 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,&
984 edihcnstr,ethetacnstr,ebr*nss,&
985 Uconst,eliptran,wliptran,Eafmforce,etube,wtube, & ! till now protein
986 estr_nucl,wbond_nucl,ebe_nucl,wang_nucl, &
987 evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb,&
988 evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl,&
989 etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
990 ecorr3_nucl,wcorr3_nucl, &
992 10 format (/'Virtual-chain energies:'// &
993 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
994 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
995 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
996 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ &
997 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
998 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
999 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
1000 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
1001 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
1002 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
1003 ' (SS bridges & dist. cnstr.)'/ &
1004 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1005 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1006 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1007 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
1008 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
1009 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
1010 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
1011 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
1012 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
1013 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
1014 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
1015 'UCONST= ',1pE16.6,' (Constraint energy)'/ &
1016 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/&
1017 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
1018 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
1019 'ESTR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
1020 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
1021 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
1022 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
1023 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
1024 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
1025 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
1026 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
1027 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
1028 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
1029 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
1030 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
1031 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
1032 'ETOT= ',1pE16.6,' (total)')
1034 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,&
1035 estr,wbond,ebe,wang,&
1036 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
1038 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
1039 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,&
1040 ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc, &
1042 estr_nucl,wbond_nucl, ebe_nucl,wang_nucl,&
1043 evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb&
1044 evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl&
1045 etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
1046 ecorr3_nucl,wcorr3_nucl, &
1048 10 format (/'Virtual-chain energies:'// &
1049 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
1050 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
1051 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
1052 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
1053 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
1054 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
1055 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
1056 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
1057 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
1058 ' (SS bridges & dist. cnstr.)'/ &
1059 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1060 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1061 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1062 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
1063 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
1064 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
1065 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
1066 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
1067 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
1068 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
1069 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
1070 'UCONST=',1pE16.6,' (Constraint energy)'/ &
1071 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ &
1072 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
1073 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
1074 'ESTR_nucl= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
1075 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
1076 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
1077 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
1078 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
1079 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
1080 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
1081 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
1082 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
1083 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
1084 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
1085 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
1086 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
1087 'ETOT= ',1pE16.6,' (total)')
1090 end subroutine enerprint
1091 !-----------------------------------------------------------------------------
1092 subroutine elj(evdw)
1094 ! This subroutine calculates the interaction energy of nonbonded side chains
1095 ! assuming the LJ potential of interaction.
1097 ! implicit real*8 (a-h,o-z)
1098 ! include 'DIMENSIONS'
1099 real(kind=8),parameter :: accur=1.0d-10
1100 ! include 'COMMON.GEO'
1101 ! include 'COMMON.VAR'
1102 ! include 'COMMON.LOCAL'
1103 ! include 'COMMON.CHAIN'
1104 ! include 'COMMON.DERIV'
1105 ! include 'COMMON.INTERACT'
1106 ! include 'COMMON.TORSION'
1107 ! include 'COMMON.SBRIDGE'
1108 ! include 'COMMON.NAMES'
1109 ! include 'COMMON.IOUNITS'
1110 ! include 'COMMON.CONTACTS'
1111 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1112 integer :: num_conti
1114 integer :: i,itypi,iint,j,itypi1,itypj,k
1115 real(kind=8) :: rij,rcut,fcont,fprimcont,rrij
1116 real(kind=8) :: evdw,xi,yi,zi,xj,yj,zj
1117 real(kind=8) :: eps0ij,fac,e1,e2,evdwij,sigij,r0ij
1119 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1121 ! allocate(num_cont(iatsc_s:iatsc_e)) !(maxres) nnt,nct-2
1122 ! allocate(jcont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres) (maxconts=maxres/4)
1123 ! allocate(facont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres)
1124 ! allocate(gacont(3,nres/4,iatsc_s:iatsc_e)) !(3,maxconts,maxres)
1126 do i=iatsc_s,iatsc_e
1127 itypi=iabs(itype(i,1))
1128 if (itypi.eq.ntyp1) cycle
1129 itypi1=iabs(itype(i+1,1))
1136 ! Calculate SC interaction energy.
1138 do iint=1,nint_gr(i)
1139 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1140 !d & 'iend=',iend(i,iint)
1141 do j=istart(i,iint),iend(i,iint)
1142 itypj=iabs(itype(j,1))
1143 if (itypj.eq.ntyp1) cycle
1147 ! Change 12/1/95 to calculate four-body interactions
1148 rij=xj*xj+yj*yj+zj*zj
1150 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1151 eps0ij=eps(itypi,itypj)
1153 e1=fac*fac*aa_aq(itypi,itypj)
1154 e2=fac*bb_aq(itypi,itypj)
1156 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1157 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1158 !d write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1159 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1160 !d & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1161 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1164 ! Calculate the components of the gradient in DC and X
1166 fac=-rrij*(e1+evdwij)
1171 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1172 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1173 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1174 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1178 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1182 ! 12/1/95, revised on 5/20/97
1184 ! Calculate the contact function. The ith column of the array JCONT will
1185 ! contain the numbers of atoms that make contacts with the atom I (of numbers
1186 ! greater than I). The arrays FACONT and GACONT will contain the values of
1187 ! the contact function and its derivative.
1189 ! Uncomment next line, if the correlation interactions include EVDW explicitly.
1190 ! if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1191 ! Uncomment next line, if the correlation interactions are contact function only
1192 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1194 sigij=sigma(itypi,itypj)
1195 r0ij=rs0(itypi,itypj)
1197 ! Check whether the SC's are not too far to make a contact.
1200 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1201 ! Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1203 if (fcont.gt.0.0D0) then
1204 ! If the SC-SC distance if close to sigma, apply spline.
1205 !Adam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1206 !Adam & fcont1,fprimcont1)
1207 !Adam fcont1=1.0d0-fcont1
1208 !Adam if (fcont1.gt.0.0d0) then
1209 !Adam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1210 !Adam fcont=fcont*fcont1
1212 ! Uncomment following 4 lines to have the geometric average of the epsilon0's
1213 !ga eps0ij=1.0d0/dsqrt(eps0ij)
1215 !ga gg(k)=gg(k)*eps0ij
1217 !ga eps0ij=-evdwij*eps0ij
1218 ! Uncomment for AL's type of SC correlation interactions.
1219 !adam eps0ij=-evdwij
1220 num_conti=num_conti+1
1221 jcont(num_conti,i)=j
1222 facont(num_conti,i)=fcont*eps0ij
1223 fprimcont=eps0ij*fprimcont/rij
1225 !Adam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1226 !Adam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1227 !Adam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1228 ! Uncomment following 3 lines for Skolnick's type of SC correlation.
1229 gacont(1,num_conti,i)=-fprimcont*xj
1230 gacont(2,num_conti,i)=-fprimcont*yj
1231 gacont(3,num_conti,i)=-fprimcont*zj
1232 !d write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1233 !d write (iout,'(2i3,3f10.5)')
1234 !d & i,j,(gacont(kk,num_conti,i),kk=1,3)
1240 num_cont(i)=num_conti
1244 gvdwc(j,i)=expon*gvdwc(j,i)
1245 gvdwx(j,i)=expon*gvdwx(j,i)
1248 !******************************************************************************
1252 ! To save time, the factor of EXPON has been extracted from ALL components
1253 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
1256 !******************************************************************************
1259 !-----------------------------------------------------------------------------
1260 subroutine eljk(evdw)
1262 ! This subroutine calculates the interaction energy of nonbonded side chains
1263 ! assuming the LJK potential of interaction.
1265 ! implicit real*8 (a-h,o-z)
1266 ! include 'DIMENSIONS'
1267 ! include 'COMMON.GEO'
1268 ! include 'COMMON.VAR'
1269 ! include 'COMMON.LOCAL'
1270 ! include 'COMMON.CHAIN'
1271 ! include 'COMMON.DERIV'
1272 ! include 'COMMON.INTERACT'
1273 ! include 'COMMON.IOUNITS'
1274 ! include 'COMMON.NAMES'
1275 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1278 integer :: i,iint,j,itypi,itypi1,k,itypj
1279 real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij
1280 real(kind=8) :: evdw,rij,r_shift_inv,fac,e1,e2,evdwij
1282 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1284 do i=iatsc_s,iatsc_e
1285 itypi=iabs(itype(i,1))
1286 if (itypi.eq.ntyp1) cycle
1287 itypi1=iabs(itype(i+1,1))
1292 ! Calculate SC interaction energy.
1294 do iint=1,nint_gr(i)
1295 do j=istart(i,iint),iend(i,iint)
1296 itypj=iabs(itype(j,1))
1297 if (itypj.eq.ntyp1) cycle
1301 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1302 fac_augm=rrij**expon
1303 e_augm=augm(itypi,itypj)*fac_augm
1304 r_inv_ij=dsqrt(rrij)
1306 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1307 fac=r_shift_inv**expon
1308 e1=fac*fac*aa_aq(itypi,itypj)
1309 e2=fac*bb_aq(itypi,itypj)
1311 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1312 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1313 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1314 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1315 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1316 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1317 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1320 ! Calculate the components of the gradient in DC and X
1322 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1327 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1328 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1329 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1330 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1334 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1342 gvdwc(j,i)=expon*gvdwc(j,i)
1343 gvdwx(j,i)=expon*gvdwx(j,i)
1348 !-----------------------------------------------------------------------------
1349 subroutine ebp(evdw)
1351 ! This subroutine calculates the interaction energy of nonbonded side chains
1352 ! assuming the Berne-Pechukas potential of interaction.
1356 ! implicit real*8 (a-h,o-z)
1357 ! include 'DIMENSIONS'
1358 ! include 'COMMON.GEO'
1359 ! include 'COMMON.VAR'
1360 ! include 'COMMON.LOCAL'
1361 ! include 'COMMON.CHAIN'
1362 ! include 'COMMON.DERIV'
1363 ! include 'COMMON.NAMES'
1364 ! include 'COMMON.INTERACT'
1365 ! include 'COMMON.IOUNITS'
1366 ! include 'COMMON.CALC'
1368 !el integer :: icall
1369 !el common /srutu/ icall
1370 ! double precision rrsave(maxdim)
1373 integer :: iint,itypi,itypi1,itypj
1374 real(kind=8) :: rrij,xi,yi,zi
1375 real(kind=8) :: evdw,fac,e1,e2,sigm,epsi
1377 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1379 ! if (icall.eq.0) then
1385 do i=iatsc_s,iatsc_e
1386 itypi=iabs(itype(i,1))
1387 if (itypi.eq.ntyp1) cycle
1388 itypi1=iabs(itype(i+1,1))
1392 dxi=dc_norm(1,nres+i)
1393 dyi=dc_norm(2,nres+i)
1394 dzi=dc_norm(3,nres+i)
1395 ! dsci_inv=dsc_inv(itypi)
1396 dsci_inv=vbld_inv(i+nres)
1398 ! Calculate SC interaction energy.
1400 do iint=1,nint_gr(i)
1401 do j=istart(i,iint),iend(i,iint)
1403 itypj=iabs(itype(j,1))
1404 if (itypj.eq.ntyp1) cycle
1405 ! dscj_inv=dsc_inv(itypj)
1406 dscj_inv=vbld_inv(j+nres)
1407 chi1=chi(itypi,itypj)
1408 chi2=chi(itypj,itypi)
1415 alf12=0.5D0*(alf1+alf2)
1416 ! For diagnostics only!!!
1429 dxj=dc_norm(1,nres+j)
1430 dyj=dc_norm(2,nres+j)
1431 dzj=dc_norm(3,nres+j)
1432 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1433 !d if (icall.eq.0) then
1439 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
1441 ! Calculate whole angle-dependent part of epsilon and contributions
1442 ! to its derivatives
1443 fac=(rrij*sigsq)**expon2
1444 e1=fac*fac*aa_aq(itypi,itypj)
1445 e2=fac*bb_aq(itypi,itypj)
1446 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1447 eps2der=evdwij*eps3rt
1448 eps3der=evdwij*eps2rt
1449 evdwij=evdwij*eps2rt*eps3rt
1452 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1453 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1454 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1455 !d & restyp(itypi,1),i,restyp(itypj,1),j,
1456 !d & epsi,sigm,chi1,chi2,chip1,chip2,
1457 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1458 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
1461 ! Calculate gradient components.
1462 e1=e1*eps1*eps2rt**2*eps3rt**2
1463 fac=-expon*(e1+evdwij)
1466 ! Calculate radial part of the gradient
1470 ! Calculate the angular part of the gradient and sum add the contributions
1471 ! to the appropriate components of the Cartesian gradient.
1479 !-----------------------------------------------------------------------------
1480 subroutine egb(evdw)
1482 ! This subroutine calculates the interaction energy of nonbonded side chains
1483 ! assuming the Gay-Berne potential of interaction.
1486 ! implicit real*8 (a-h,o-z)
1487 ! include 'DIMENSIONS'
1488 ! include 'COMMON.GEO'
1489 ! include 'COMMON.VAR'
1490 ! include 'COMMON.LOCAL'
1491 ! include 'COMMON.CHAIN'
1492 ! include 'COMMON.DERIV'
1493 ! include 'COMMON.NAMES'
1494 ! include 'COMMON.INTERACT'
1495 ! include 'COMMON.IOUNITS'
1496 ! include 'COMMON.CALC'
1497 ! include 'COMMON.CONTROL'
1498 ! include 'COMMON.SBRIDGE'
1501 integer :: iint,itypi,itypi1,itypj,subchap
1502 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
1503 real(kind=8) :: evdw,sig0ij
1504 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
1505 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
1506 sslipi,sslipj,faclip
1508 real(kind=8) :: fracinbuf
1510 !cccc energy_dec=.false.
1511 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1514 ! if (icall.eq.0) lprn=.false.
1516 do i=iatsc_s,iatsc_e
1517 !C print *,"I am in EVDW",i
1518 itypi=iabs(itype(i,1))
1519 ! if (i.ne.47) cycle
1520 if (itypi.eq.ntyp1) cycle
1521 itypi1=iabs(itype(i+1,1))
1525 xi=dmod(xi,boxxsize)
1526 if (xi.lt.0) xi=xi+boxxsize
1527 yi=dmod(yi,boxysize)
1528 if (yi.lt.0) yi=yi+boxysize
1529 zi=dmod(zi,boxzsize)
1530 if (zi.lt.0) zi=zi+boxzsize
1532 if ((zi.gt.bordlipbot) &
1533 .and.(zi.lt.bordliptop)) then
1534 !C the energy transfer exist
1535 if (zi.lt.buflipbot) then
1536 !C what fraction I am in
1538 ((zi-bordlipbot)/lipbufthick)
1539 !C lipbufthick is thickenes of lipid buffore
1540 sslipi=sscalelip(fracinbuf)
1541 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1542 elseif (zi.gt.bufliptop) then
1543 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1544 sslipi=sscalelip(fracinbuf)
1545 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1554 ! print *, sslipi,ssgradlipi
1555 dxi=dc_norm(1,nres+i)
1556 dyi=dc_norm(2,nres+i)
1557 dzi=dc_norm(3,nres+i)
1558 ! dsci_inv=dsc_inv(itypi)
1559 dsci_inv=vbld_inv(i+nres)
1560 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1561 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1563 ! Calculate SC interaction energy.
1565 do iint=1,nint_gr(i)
1566 do j=istart(i,iint),iend(i,iint)
1567 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1568 call dyn_ssbond_ene(i,j,evdwij)
1570 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1571 'evdw',i,j,evdwij,' ss'
1572 ! if (energy_dec) write (iout,*) &
1573 ! 'evdw',i,j,evdwij,' ss'
1574 do k=j+1,iend(i,iint)
1575 !C search over all next residues
1576 if (dyn_ss_mask(k)) then
1577 !C check if they are cysteins
1578 !C write(iout,*) 'k=',k
1580 !c write(iout,*) "PRZED TRI", evdwij
1581 ! evdwij_przed_tri=evdwij
1582 call triple_ssbond_ene(i,j,k,evdwij)
1583 !c if(evdwij_przed_tri.ne.evdwij) then
1584 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1587 !c write(iout,*) "PO TRI", evdwij
1588 !C call the energy function that removes the artifical triple disulfide
1589 !C bond the soubroutine is located in ssMD.F
1591 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1592 'evdw',i,j,evdwij,'tss'
1593 endif!dyn_ss_mask(k)
1597 itypj=iabs(itype(j,1))
1598 if (itypj.eq.ntyp1) cycle
1599 ! if (j.ne.78) cycle
1600 ! dscj_inv=dsc_inv(itypj)
1601 dscj_inv=vbld_inv(j+nres)
1602 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,&
1603 ! 1.0d0/vbld(j+nres) !d
1604 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
1605 sig0ij=sigma(itypi,itypj)
1606 chi1=chi(itypi,itypj)
1607 chi2=chi(itypj,itypi)
1614 alf12=0.5D0*(alf1+alf2)
1615 ! For diagnostics only!!!
1628 xj=dmod(xj,boxxsize)
1629 if (xj.lt.0) xj=xj+boxxsize
1630 yj=dmod(yj,boxysize)
1631 if (yj.lt.0) yj=yj+boxysize
1632 zj=dmod(zj,boxzsize)
1633 if (zj.lt.0) zj=zj+boxzsize
1634 ! print *,"tu",xi,yi,zi,xj,yj,zj
1635 ! print *,"tu2",j,j+nres,c(1,j),c(1,j+nres)
1636 ! this fragment set correct epsilon for lipid phase
1637 if ((zj.gt.bordlipbot) &
1638 .and.(zj.lt.bordliptop)) then
1639 !C the energy transfer exist
1640 if (zj.lt.buflipbot) then
1641 !C what fraction I am in
1643 ((zj-bordlipbot)/lipbufthick)
1644 !C lipbufthick is thickenes of lipid buffore
1645 sslipj=sscalelip(fracinbuf)
1646 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1647 elseif (zj.gt.bufliptop) then
1648 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1649 sslipj=sscalelip(fracinbuf)
1650 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1659 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1660 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1661 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1662 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1663 !------------------------------------------------
1664 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1672 xj=xj_safe+xshift*boxxsize
1673 yj=yj_safe+yshift*boxysize
1674 zj=zj_safe+zshift*boxzsize
1675 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1676 if(dist_temp.lt.dist_init) then
1686 if (subchap.eq.1) then
1695 dxj=dc_norm(1,nres+j)
1696 dyj=dc_norm(2,nres+j)
1697 dzj=dc_norm(3,nres+j)
1698 ! write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1699 ! write (iout,*) "j",j," dc_norm",& !d
1700 ! dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1701 ! write(iout,*)"rrij ",rrij
1702 ! write(iout,*)"xj yj zj ", xj, yj, zj
1703 ! write(iout,*)"xi yi zi ", xi, yi, zi
1704 ! write(iout,*)"c ", c(1,:), c(2,:), c(3,:)
1705 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1707 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
1708 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
1709 ! print *,sss_ele_cut,sss_ele_grad,&
1710 ! 1.0d0/(rij),r_cut_ele,rlamb_ele
1711 if (sss_ele_cut.le.0.0) cycle
1712 ! Calculate angle-dependent terms of energy and contributions to their
1716 sig=sig0ij*dsqrt(sigsq)
1717 rij_shift=1.0D0/rij-sig+sig0ij
1718 ! write(iout,*)" rij_shift",rij_shift," rij",rij," sig",sig,&
1720 ! for diagnostics; uncomment
1721 ! rij_shift=1.2*sig0ij
1722 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1723 if (rij_shift.le.0.0D0) then
1725 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1726 !d & restyp(itypi,1),i,restyp(itypj,1),j,
1727 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1731 !---------------------------------------------------------------
1732 rij_shift=1.0D0/rij_shift
1733 fac=rij_shift**expon
1735 e1=fac*fac*aa!(itypi,itypj)
1736 e2=fac*bb!(itypi,itypj)
1737 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1738 eps2der=evdwij*eps3rt
1739 eps3der=evdwij*eps2rt
1740 ! write(iout,*)"aa, bb ",aa(:,:),bb(:,:)
1741 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,& !d
1742 ! " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2," fac",fac !d
1743 evdwij=evdwij*eps2rt*eps3rt
1744 evdw=evdw+evdwij*sss_ele_cut
1746 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1747 epsi=bb**2/aa!(itypi,itypj)
1748 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1749 restyp(itypi,1),i,restyp(itypj,1),j, &
1750 epsi,sigm,chi1,chi2,chip1,chip2, &
1751 eps1,eps2rt**2,eps3rt**2,sig,sig0ij, &
1752 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, &
1756 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2e10.2,e11.3)')&
1757 'evdw',i,j,evdwij,xi,xj,rij !,"egb"
1758 !C print *,i,j,c(1,i),c(1,j),c(2,i),c(2,j),c(3,i),c(3,j)
1759 ! if (energy_dec) write (iout,*) &
1761 ! print *,"ZALAMKA", evdw
1763 ! Calculate gradient components.
1764 e1=e1*eps1*eps2rt**2*eps3rt**2
1765 fac=-expon*(e1+evdwij)*rij_shift
1768 ! print *,'before fac',fac,rij,evdwij
1769 fac=fac+evdwij*sss_ele_grad/sss_ele_cut&
1770 /sigma(itypi,itypj)*rij
1771 ! print *,'grad part scale',fac, &
1772 ! evdwij*sss_ele_grad/sss_ele_cut &
1773 ! /sigma(itypi,itypj)*rij
1775 ! Calculate the radial part of the gradient
1779 !C Calculate the radial part of the gradient
1780 gg_lipi(3)=eps1*(eps2rt*eps2rt)&
1781 *(eps3rt*eps3rt)*sss_ele_cut/2.0d0*(faclip*faclip*&
1782 (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))&
1783 +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1784 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1785 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1787 ! print *,'before sc_grad', gg(1),gg(2),gg(3)
1788 ! Calculate angular part of the gradient.
1794 ! print *,"ZALAMKA", evdw
1795 ! write (iout,*) "Number of loop steps in EGB:",ind
1796 !ccc energy_dec=.false.
1799 !-----------------------------------------------------------------------------
1800 subroutine egbv(evdw)
1802 ! This subroutine calculates the interaction energy of nonbonded side chains
1803 ! assuming the Gay-Berne-Vorobjev potential of interaction.
1807 ! implicit real*8 (a-h,o-z)
1808 ! include 'DIMENSIONS'
1809 ! include 'COMMON.GEO'
1810 ! include 'COMMON.VAR'
1811 ! include 'COMMON.LOCAL'
1812 ! include 'COMMON.CHAIN'
1813 ! include 'COMMON.DERIV'
1814 ! include 'COMMON.NAMES'
1815 ! include 'COMMON.INTERACT'
1816 ! include 'COMMON.IOUNITS'
1817 ! include 'COMMON.CALC'
1819 !el integer :: icall
1820 !el common /srutu/ icall
1823 integer :: iint,itypi,itypi1,itypj
1824 real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2,sigm
1825 real(kind=8) :: evdw,sig0ij,sig,rij_shift,epsi
1827 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1830 ! if (icall.eq.0) lprn=.true.
1832 do i=iatsc_s,iatsc_e
1833 itypi=iabs(itype(i,1))
1834 if (itypi.eq.ntyp1) cycle
1835 itypi1=iabs(itype(i+1,1))
1839 dxi=dc_norm(1,nres+i)
1840 dyi=dc_norm(2,nres+i)
1841 dzi=dc_norm(3,nres+i)
1842 ! dsci_inv=dsc_inv(itypi)
1843 dsci_inv=vbld_inv(i+nres)
1845 ! Calculate SC interaction energy.
1847 do iint=1,nint_gr(i)
1848 do j=istart(i,iint),iend(i,iint)
1850 itypj=iabs(itype(j,1))
1851 if (itypj.eq.ntyp1) cycle
1852 ! dscj_inv=dsc_inv(itypj)
1853 dscj_inv=vbld_inv(j+nres)
1854 sig0ij=sigma(itypi,itypj)
1855 r0ij=r0(itypi,itypj)
1856 chi1=chi(itypi,itypj)
1857 chi2=chi(itypj,itypi)
1864 alf12=0.5D0*(alf1+alf2)
1865 ! For diagnostics only!!!
1878 dxj=dc_norm(1,nres+j)
1879 dyj=dc_norm(2,nres+j)
1880 dzj=dc_norm(3,nres+j)
1881 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1883 ! Calculate angle-dependent terms of energy and contributions to their
1887 sig=sig0ij*dsqrt(sigsq)
1888 rij_shift=1.0D0/rij-sig+r0ij
1889 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1890 if (rij_shift.le.0.0D0) then
1895 !---------------------------------------------------------------
1896 rij_shift=1.0D0/rij_shift
1897 fac=rij_shift**expon
1898 e1=fac*fac*aa_aq(itypi,itypj)
1899 e2=fac*bb_aq(itypi,itypj)
1900 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1901 eps2der=evdwij*eps3rt
1902 eps3der=evdwij*eps2rt
1903 fac_augm=rrij**expon
1904 e_augm=augm(itypi,itypj)*fac_augm
1905 evdwij=evdwij*eps2rt*eps3rt
1906 evdw=evdw+evdwij+e_augm
1908 sigm=dabs(aa_aq(itypi,itypj)/&
1909 bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1910 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1911 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1912 restyp(itypi,1),i,restyp(itypj,1),j,&
1913 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
1914 chi1,chi2,chip1,chip2,&
1915 eps1,eps2rt**2,eps3rt**2,&
1916 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
1919 ! Calculate gradient components.
1920 e1=e1*eps1*eps2rt**2*eps3rt**2
1921 fac=-expon*(e1+evdwij)*rij_shift
1923 fac=rij*fac-2*expon*rrij*e_augm
1924 ! Calculate the radial part of the gradient
1928 ! Calculate angular part of the gradient.
1934 !-----------------------------------------------------------------------------
1935 !el subroutine sc_angular in module geometry
1936 !-----------------------------------------------------------------------------
1937 subroutine e_softsphere(evdw)
1939 ! This subroutine calculates the interaction energy of nonbonded side chains
1940 ! assuming the LJ potential of interaction.
1942 ! implicit real*8 (a-h,o-z)
1943 ! include 'DIMENSIONS'
1944 real(kind=8),parameter :: accur=1.0d-10
1945 ! include 'COMMON.GEO'
1946 ! include 'COMMON.VAR'
1947 ! include 'COMMON.LOCAL'
1948 ! include 'COMMON.CHAIN'
1949 ! include 'COMMON.DERIV'
1950 ! include 'COMMON.INTERACT'
1951 ! include 'COMMON.TORSION'
1952 ! include 'COMMON.SBRIDGE'
1953 ! include 'COMMON.NAMES'
1954 ! include 'COMMON.IOUNITS'
1955 ! include 'COMMON.CONTACTS'
1956 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1957 !d print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1959 integer :: i,iint,j,itypi,itypi1,itypj,k
1960 real(kind=8) :: evdw,xj,yj,zj,xi,yi,zi,rij,r0ij,r0ijsq,evdwij
1964 do i=iatsc_s,iatsc_e
1965 itypi=iabs(itype(i,1))
1966 if (itypi.eq.ntyp1) cycle
1967 itypi1=iabs(itype(i+1,1))
1972 ! Calculate SC interaction energy.
1974 do iint=1,nint_gr(i)
1975 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1976 !d & 'iend=',iend(i,iint)
1977 do j=istart(i,iint),iend(i,iint)
1978 itypj=iabs(itype(j,1))
1979 if (itypj.eq.ntyp1) cycle
1983 rij=xj*xj+yj*yj+zj*zj
1984 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1985 r0ij=r0(itypi,itypj)
1987 ! print *,i,j,r0ij,dsqrt(rij)
1988 if (rij.lt.r0ijsq) then
1989 evdwij=0.25d0*(rij-r0ijsq)**2
1997 ! Calculate the components of the gradient in DC and X
2003 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2004 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2005 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2006 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2010 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2017 end subroutine e_softsphere
2018 !-----------------------------------------------------------------------------
2019 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2021 ! Soft-sphere potential of p-p interaction
2023 ! implicit real*8 (a-h,o-z)
2024 ! include 'DIMENSIONS'
2025 ! include 'COMMON.CONTROL'
2026 ! include 'COMMON.IOUNITS'
2027 ! include 'COMMON.GEO'
2028 ! include 'COMMON.VAR'
2029 ! include 'COMMON.LOCAL'
2030 ! include 'COMMON.CHAIN'
2031 ! include 'COMMON.DERIV'
2032 ! include 'COMMON.INTERACT'
2033 ! include 'COMMON.CONTACTS'
2034 ! include 'COMMON.TORSION'
2035 ! include 'COMMON.VECTORS'
2036 ! include 'COMMON.FFIELD'
2037 real(kind=8),dimension(3) :: ggg
2038 !d write(iout,*) 'In EELEC_soft_sphere'
2040 integer :: i,j,k,num_conti,iteli,itelj
2041 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
2042 real(kind=8) :: dxi,dyi,dzi,xmedi,ymedi,zmedi,r0ij,r0ijsq
2043 real(kind=8) :: dxj,dyj,dzj,xj,yj,zj,rij,evdw1ij,fac
2051 do i=iatel_s,iatel_e
2052 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
2056 xmedi=c(1,i)+0.5d0*dxi
2057 ymedi=c(2,i)+0.5d0*dyi
2058 zmedi=c(3,i)+0.5d0*dzi
2060 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2061 do j=ielstart(i),ielend(i)
2062 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
2066 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2067 r0ij=rpp(iteli,itelj)
2072 xj=c(1,j)+0.5D0*dxj-xmedi
2073 yj=c(2,j)+0.5D0*dyj-ymedi
2074 zj=c(3,j)+0.5D0*dzj-zmedi
2075 rij=xj*xj+yj*yj+zj*zj
2076 if (rij.lt.r0ijsq) then
2077 evdw1ij=0.25d0*(rij-r0ijsq)**2
2085 ! Calculate contributions to the Cartesian gradient.
2091 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2092 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2095 ! Loop over residues i+1 thru j-1.
2099 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2104 !grad do i=nnt,nct-1
2106 !grad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2108 !grad do j=i+1,nct-1
2110 !grad gelc(k,i)=gelc(k,i)+gelc(k,j)
2115 end subroutine eelec_soft_sphere
2116 !-----------------------------------------------------------------------------
2117 subroutine vec_and_deriv
2118 ! implicit real*8 (a-h,o-z)
2119 ! include 'DIMENSIONS'
2123 ! include 'COMMON.IOUNITS'
2124 ! include 'COMMON.GEO'
2125 ! include 'COMMON.VAR'
2126 ! include 'COMMON.LOCAL'
2127 ! include 'COMMON.CHAIN'
2128 ! include 'COMMON.VECTORS'
2129 ! include 'COMMON.SETUP'
2130 ! include 'COMMON.TIME1'
2131 real(kind=8),dimension(3,3,2) :: uyder,uzder
2132 real(kind=8),dimension(2) :: vbld_inv_temp
2133 ! Compute the local reference systems. For reference system (i), the
2134 ! X-axis points from CA(i) to CA(i+1), the Y axis is in the
2135 ! CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2138 real(kind=8) :: facy,fac,costh
2141 do i=ivec_start,ivec_end
2145 if (i.eq.nres-1) then
2146 ! Case of the last full residue
2147 ! Compute the Z-axis
2148 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2149 costh=dcos(pi-theta(nres))
2150 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2154 ! Compute the derivatives of uz
2156 uzder(2,1,1)=-dc_norm(3,i-1)
2157 uzder(3,1,1)= dc_norm(2,i-1)
2158 uzder(1,2,1)= dc_norm(3,i-1)
2160 uzder(3,2,1)=-dc_norm(1,i-1)
2161 uzder(1,3,1)=-dc_norm(2,i-1)
2162 uzder(2,3,1)= dc_norm(1,i-1)
2165 uzder(2,1,2)= dc_norm(3,i)
2166 uzder(3,1,2)=-dc_norm(2,i)
2167 uzder(1,2,2)=-dc_norm(3,i)
2169 uzder(3,2,2)= dc_norm(1,i)
2170 uzder(1,3,2)= dc_norm(2,i)
2171 uzder(2,3,2)=-dc_norm(1,i)
2173 ! Compute the Y-axis
2176 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2178 ! Compute the derivatives of uy
2181 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) &
2182 -dc_norm(k,i)*dc_norm(j,i-1)
2183 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2185 uyder(j,j,1)=uyder(j,j,1)-costh
2186 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2191 uygrad(l,k,j,i)=uyder(l,k,j)
2192 uzgrad(l,k,j,i)=uzder(l,k,j)
2196 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2197 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2198 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2199 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2202 ! Compute the Z-axis
2203 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2204 costh=dcos(pi-theta(i+2))
2205 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2209 ! Compute the derivatives of uz
2211 uzder(2,1,1)=-dc_norm(3,i+1)
2212 uzder(3,1,1)= dc_norm(2,i+1)
2213 uzder(1,2,1)= dc_norm(3,i+1)
2215 uzder(3,2,1)=-dc_norm(1,i+1)
2216 uzder(1,3,1)=-dc_norm(2,i+1)
2217 uzder(2,3,1)= dc_norm(1,i+1)
2220 uzder(2,1,2)= dc_norm(3,i)
2221 uzder(3,1,2)=-dc_norm(2,i)
2222 uzder(1,2,2)=-dc_norm(3,i)
2224 uzder(3,2,2)= dc_norm(1,i)
2225 uzder(1,3,2)= dc_norm(2,i)
2226 uzder(2,3,2)=-dc_norm(1,i)
2228 ! Compute the Y-axis
2231 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2233 ! Compute the derivatives of uy
2236 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) &
2237 -dc_norm(k,i)*dc_norm(j,i+1)
2238 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2240 uyder(j,j,1)=uyder(j,j,1)-costh
2241 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2246 uygrad(l,k,j,i)=uyder(l,k,j)
2247 uzgrad(l,k,j,i)=uzder(l,k,j)
2251 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2252 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2253 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2254 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2258 vbld_inv_temp(1)=vbld_inv(i+1)
2259 if (i.lt.nres-1) then
2260 vbld_inv_temp(2)=vbld_inv(i+2)
2262 vbld_inv_temp(2)=vbld_inv(i)
2267 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2268 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2273 #if defined(PARVEC) && defined(MPI)
2274 if (nfgtasks1.gt.1) then
2276 ! print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2277 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2278 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2279 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),&
2280 MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2282 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),&
2283 MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2285 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),&
2286 ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),&
2287 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2288 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),&
2289 ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),&
2290 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2291 time_gather=time_gather+MPI_Wtime()-time00
2293 ! if (fg_rank.eq.0) then
2294 ! write (iout,*) "Arrays UY and UZ"
2296 ! write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2302 end subroutine vec_and_deriv
2303 !-----------------------------------------------------------------------------
2304 subroutine check_vecgrad
2305 ! implicit real*8 (a-h,o-z)
2306 ! include 'DIMENSIONS'
2307 ! include 'COMMON.IOUNITS'
2308 ! include 'COMMON.GEO'
2309 ! include 'COMMON.VAR'
2310 ! include 'COMMON.LOCAL'
2311 ! include 'COMMON.CHAIN'
2312 ! include 'COMMON.VECTORS'
2313 real(kind=8),dimension(3,3,2,nres) :: uygradt,uzgradt !(3,3,2,maxres)
2314 real(kind=8),dimension(3,nres) :: uyt,uzt !(3,maxres)
2315 real(kind=8),dimension(3,3,2) :: uygradn,uzgradn
2316 real(kind=8),dimension(3) :: erij
2317 real(kind=8) :: delta=1.0d-7
2323 !rc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2324 !rc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2325 !rc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2326 !d write(iout,'(2i5,2(3f10.5,5x))') i,1,
2327 !d & (dc_norm(if90,i),if90=1,3)
2328 !d write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2329 !d write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2330 !d write(iout,'(a)')
2336 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2337 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2350 !d write (iout,*) 'i=',i
2352 erij(k)=dc_norm(k,i)
2356 dc_norm(k,i)=erij(k)
2358 dc_norm(j,i)=dc_norm(j,i)+delta
2359 ! fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2361 ! dc_norm(k,i)=dc_norm(k,i)/fac
2363 ! write (iout,*) (dc_norm(k,i),k=1,3)
2364 ! write (iout,*) (erij(k),k=1,3)
2367 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2368 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2369 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2370 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2372 ! write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2373 ! & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2374 ! & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2377 dc_norm(k,i)=erij(k)
2380 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2381 !d & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2382 !d & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2383 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2384 !d & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2385 !d & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2386 !d write (iout,'(a)')
2390 end subroutine check_vecgrad
2391 !-----------------------------------------------------------------------------
2392 subroutine set_matrices
2393 ! implicit real*8 (a-h,o-z)
2394 ! include 'DIMENSIONS'
2397 ! include "COMMON.SETUP"
2399 integer :: status(MPI_STATUS_SIZE)
2401 ! include 'COMMON.IOUNITS'
2402 ! include 'COMMON.GEO'
2403 ! include 'COMMON.VAR'
2404 ! include 'COMMON.LOCAL'
2405 ! include 'COMMON.CHAIN'
2406 ! include 'COMMON.DERIV'
2407 ! include 'COMMON.INTERACT'
2408 ! include 'COMMON.CONTACTS'
2409 ! include 'COMMON.TORSION'
2410 ! include 'COMMON.VECTORS'
2411 ! include 'COMMON.FFIELD'
2412 real(kind=8) :: auxvec(2),auxmat(2,2)
2413 integer :: i,iti1,iti,k,l
2414 real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2
2415 ! print *,"in set matrices"
2417 ! Compute the virtual-bond-torsional-angle dependent quantities needed
2418 ! to calculate the el-loc multibody terms of various order.
2422 do i=ivec_start+2,ivec_end+2
2427 if (i .lt. nres+1) then
2464 if (i .gt. 3 .and. i .lt. nres+1) then
2465 obrot_der(1,i-2)=-sin1
2466 obrot_der(2,i-2)= cos1
2467 Ugder(1,1,i-2)= sin1
2468 Ugder(1,2,i-2)=-cos1
2469 Ugder(2,1,i-2)=-cos1
2470 Ugder(2,2,i-2)=-sin1
2473 obrot2_der(1,i-2)=-dwasin2
2474 obrot2_der(2,i-2)= dwacos2
2475 Ug2der(1,1,i-2)= dwasin2
2476 Ug2der(1,2,i-2)=-dwacos2
2477 Ug2der(2,1,i-2)=-dwacos2
2478 Ug2der(2,2,i-2)=-dwasin2
2480 obrot_der(1,i-2)=0.0d0
2481 obrot_der(2,i-2)=0.0d0
2482 Ugder(1,1,i-2)=0.0d0
2483 Ugder(1,2,i-2)=0.0d0
2484 Ugder(2,1,i-2)=0.0d0
2485 Ugder(2,2,i-2)=0.0d0
2486 obrot2_der(1,i-2)=0.0d0
2487 obrot2_der(2,i-2)=0.0d0
2488 Ug2der(1,1,i-2)=0.0d0
2489 Ug2der(1,2,i-2)=0.0d0
2490 Ug2der(2,1,i-2)=0.0d0
2491 Ug2der(2,2,i-2)=0.0d0
2493 ! if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2494 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2495 iti = itortyp(itype(i-2,1))
2499 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2500 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2501 iti1 = itortyp(itype(i-1,1))
2505 ! print *,iti,i,"iti",iti1,itype(i-1,1),itype(i-2,1)
2506 !d write (iout,*) '*******i',i,' iti1',iti
2507 !d write (iout,*) 'b1',b1(:,iti)
2508 !d write (iout,*) 'b2',b2(:,iti)
2509 !d write (iout,*) 'Ug',Ug(:,:,i-2)
2510 ! if (i .gt. iatel_s+2) then
2511 if (i .gt. nnt+2) then
2512 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2513 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2514 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2516 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2517 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2518 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2519 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2520 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2531 DtUg2(l,k,i-2)=0.0d0
2535 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2536 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2538 muder(k,i-2)=Ub2der(k,i-2)
2540 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2541 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2542 if (itype(i-1,1).le.ntyp) then
2543 iti1 = itortyp(itype(i-1,1))
2551 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2553 ! if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2)
2554 ! if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,iti1)
2555 ! if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2)
2556 !d write (iout,*) 'mu1',mu1(:,i-2)
2557 !d write (iout,*) 'mu2',mu2(:,i-2)
2558 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2560 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2561 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2562 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2563 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2564 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2565 ! Vectors and matrices dependent on a single virtual-bond dihedral.
2566 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2567 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2568 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2569 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2570 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2571 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2572 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2573 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2574 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2577 ! Matrices dependent on two consecutive virtual-bond dihedrals.
2578 ! The order of matrices is from left to right.
2579 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2581 ! do i=max0(ivec_start,2),ivec_end
2583 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2584 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2585 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2586 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2587 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2588 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2589 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2590 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2593 #if defined(MPI) && defined(PARMAT)
2595 ! if (fg_rank.eq.0) then
2596 write (iout,*) "Arrays UG and UGDER before GATHER"
2598 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2599 ((ug(l,k,i),l=1,2),k=1,2),&
2600 ((ugder(l,k,i),l=1,2),k=1,2)
2602 write (iout,*) "Arrays UG2 and UG2DER"
2604 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2605 ((ug2(l,k,i),l=1,2),k=1,2),&
2606 ((ug2der(l,k,i),l=1,2),k=1,2)
2608 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2610 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2611 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2612 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2614 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2616 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2617 costab(i),sintab(i),costab2(i),sintab2(i)
2619 write (iout,*) "Array MUDER"
2621 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2625 if (nfgtasks.gt.1) then
2627 ! write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2628 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2629 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2631 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),&
2632 MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2634 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),&
2635 MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2637 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),&
2638 MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2640 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),&
2641 MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2643 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),&
2644 MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2646 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),&
2647 MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2649 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),&
2650 MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),&
2651 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2652 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),&
2653 MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),&
2654 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2655 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),&
2656 MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),&
2657 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2658 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),&
2659 MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),&
2660 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2661 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2663 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),&
2664 MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2666 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),&
2667 MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2669 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),&
2670 MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2672 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),&
2673 MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2675 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),&
2676 MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2678 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),&
2679 ivec_count(fg_rank1),&
2680 MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2682 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),&
2683 MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2685 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),&
2686 MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2688 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),&
2689 MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2691 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),&
2692 MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2694 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),&
2695 MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2697 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),&
2698 MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2700 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),&
2701 MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2703 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),&
2704 ivec_count(fg_rank1),&
2705 MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2707 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),&
2708 MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2710 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),&
2711 MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2713 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),&
2714 MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2716 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),&
2717 MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2719 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),&
2720 ivec_count(fg_rank1),&
2721 MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2723 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),&
2724 ivec_count(fg_rank1),&
2725 MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2727 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),&
2728 ivec_count(fg_rank1),&
2729 MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2730 MPI_MAT2,FG_COMM1,IERR)
2731 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),&
2732 ivec_count(fg_rank1),&
2733 MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2734 MPI_MAT2,FG_COMM1,IERR)
2737 ! Passes matrix info through the ring
2740 if (irecv.lt.0) irecv=nfgtasks1-1
2743 if (inext.ge.nfgtasks1) inext=0
2745 ! write (iout,*) "isend",isend," irecv",irecv
2747 lensend=lentyp(isend)
2748 lenrecv=lentyp(irecv)
2749 ! write (iout,*) "lensend",lensend," lenrecv",lenrecv
2750 ! call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2751 ! & MPI_ROTAT1(lensend),inext,2200+isend,
2752 ! & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2753 ! & iprev,2200+irecv,FG_COMM,status,IERR)
2754 ! write (iout,*) "Gather ROTAT1"
2756 ! call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2757 ! & MPI_ROTAT2(lensend),inext,3300+isend,
2758 ! & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2759 ! & iprev,3300+irecv,FG_COMM,status,IERR)
2760 ! write (iout,*) "Gather ROTAT2"
2762 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,&
2763 MPI_ROTAT_OLD(lensend),inext,4400+isend,&
2764 costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),&
2765 iprev,4400+irecv,FG_COMM,status,IERR)
2766 ! write (iout,*) "Gather ROTAT_OLD"
2768 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,&
2769 MPI_PRECOMP11(lensend),inext,5500+isend,&
2770 mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),&
2771 iprev,5500+irecv,FG_COMM,status,IERR)
2772 ! write (iout,*) "Gather PRECOMP11"
2774 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,&
2775 MPI_PRECOMP12(lensend),inext,6600+isend,&
2776 Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),&
2777 iprev,6600+irecv,FG_COMM,status,IERR)
2778 ! write (iout,*) "Gather PRECOMP12"
2780 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2782 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,&
2783 MPI_ROTAT2(lensend),inext,7700+isend,&
2784 ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),&
2785 iprev,7700+irecv,FG_COMM,status,IERR)
2786 ! write (iout,*) "Gather PRECOMP21"
2788 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,&
2789 MPI_PRECOMP22(lensend),inext,8800+isend,&
2790 EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),&
2791 iprev,8800+irecv,FG_COMM,status,IERR)
2792 ! write (iout,*) "Gather PRECOMP22"
2794 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,&
2795 MPI_PRECOMP23(lensend),inext,9900+isend,&
2796 Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,&
2797 MPI_PRECOMP23(lenrecv),&
2798 iprev,9900+irecv,FG_COMM,status,IERR)
2799 ! write (iout,*) "Gather PRECOMP23"
2804 if (irecv.lt.0) irecv=nfgtasks1-1
2807 time_gather=time_gather+MPI_Wtime()-time00
2810 ! if (fg_rank.eq.0) then
2811 write (iout,*) "Arrays UG and UGDER"
2813 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2814 ((ug(l,k,i),l=1,2),k=1,2),&
2815 ((ugder(l,k,i),l=1,2),k=1,2)
2817 write (iout,*) "Arrays UG2 and UG2DER"
2819 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2820 ((ug2(l,k,i),l=1,2),k=1,2),&
2821 ((ug2der(l,k,i),l=1,2),k=1,2)
2823 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2825 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2826 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2827 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2829 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2831 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2832 costab(i),sintab(i),costab2(i),sintab2(i)
2834 write (iout,*) "Array MUDER"
2836 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2842 !d iti = itortyp(itype(i,1))
2845 !d write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2846 !d & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2850 end subroutine set_matrices
2851 !-----------------------------------------------------------------------------
2852 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2854 ! This subroutine calculates the average interaction energy and its gradient
2855 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
2856 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2857 ! The potential depends both on the distance of peptide-group centers and on
2858 ! the orientation of the CA-CA virtual bonds.
2861 ! implicit real*8 (a-h,o-z)
2865 ! include 'DIMENSIONS'
2866 ! include 'COMMON.CONTROL'
2867 ! include 'COMMON.SETUP'
2868 ! include 'COMMON.IOUNITS'
2869 ! include 'COMMON.GEO'
2870 ! include 'COMMON.VAR'
2871 ! include 'COMMON.LOCAL'
2872 ! include 'COMMON.CHAIN'
2873 ! include 'COMMON.DERIV'
2874 ! include 'COMMON.INTERACT'
2875 ! include 'COMMON.CONTACTS'
2876 ! include 'COMMON.TORSION'
2877 ! include 'COMMON.VECTORS'
2878 ! include 'COMMON.FFIELD'
2879 ! include 'COMMON.TIME1'
2880 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
2881 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
2882 real(kind=8),dimension(2,2) :: acipa !el,a_temp
2883 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
2884 real(kind=8),dimension(4) :: muij
2885 !el integer :: num_conti,j1,j2
2886 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
2887 !el dz_normi,xmedi,ymedi,zmedi
2889 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
2890 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
2893 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2895 real(kind=8) :: scal_el=1.0d0
2897 real(kind=8) :: scal_el=0.5d0
2900 ! 13-go grudnia roku pamietnego...
2901 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
2903 0.0d0,0.0d0,1.0d0/),shape(unmat))
2906 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
2907 real(kind=8) :: fac,t_eelecij,fracinbuf
2910 !d write(iout,*) 'In EELEC'
2911 ! print *,"IN EELEC"
2913 !d write(iout,*) 'Type',i
2914 !d write(iout,*) 'B1',B1(:,i)
2915 !d write(iout,*) 'B2',B2(:,i)
2916 !d write(iout,*) 'CC',CC(:,:,i)
2917 !d write(iout,*) 'DD',DD(:,:,i)
2918 !d write(iout,*) 'EE',EE(:,:,i)
2920 !d call check_vecgrad
2935 if (icheckgrad.eq.1) then
2938 ! dc_norm(1,i)=0.0d0
2939 ! dc_norm(2,i)=0.0d0
2940 ! dc_norm(3,i)=0.0d0
2943 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2945 dc_norm(k,i)=dc(k,i)*fac
2947 ! write (iout,*) 'i',i,' fac',fac
2950 ! print *,wel_loc,"wel_loc",wcorr4,wcorr5,wcorr6,wturn3,wturn4, &
2952 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
2953 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
2954 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2955 ! call vec_and_deriv
2959 ! print *, "before set matrices"
2961 ! print *, "after set matrices"
2964 time_mat=time_mat+MPI_Wtime()-time01
2967 ! print *, "after set matrices"
2969 !d write (iout,*) 'i=',i
2971 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2974 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2975 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2988 !d print '(a)','Enter EELEC'
2989 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2990 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
2991 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
2993 gel_loc_loc(i)=0.0d0
2998 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3000 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
3004 ! print *,"before iturn3 loop"
3005 do i=iturn3_start,iturn3_end
3006 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
3007 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
3011 dx_normi=dc_norm(1,i)
3012 dy_normi=dc_norm(2,i)
3013 dz_normi=dc_norm(3,i)
3014 xmedi=c(1,i)+0.5d0*dxi
3015 ymedi=c(2,i)+0.5d0*dyi
3016 zmedi=c(3,i)+0.5d0*dzi
3017 xmedi=dmod(xmedi,boxxsize)
3018 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3019 ymedi=dmod(ymedi,boxysize)
3020 if (ymedi.lt.0) ymedi=ymedi+boxysize
3021 zmedi=dmod(zmedi,boxzsize)
3022 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3024 if ((zmedi.gt.bordlipbot) &
3025 .and.(zmedi.lt.bordliptop)) then
3026 !C the energy transfer exist
3027 if (zmedi.lt.buflipbot) then
3028 !C what fraction I am in
3030 ((zmedi-bordlipbot)/lipbufthick)
3031 !C lipbufthick is thickenes of lipid buffore
3032 sslipi=sscalelip(fracinbuf)
3033 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3034 elseif (zmedi.gt.bufliptop) then
3035 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3036 sslipi=sscalelip(fracinbuf)
3037 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3046 ! print *,i,sslipi,ssgradlipi
3047 call eelecij(i,i+2,ees,evdw1,eel_loc)
3048 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3049 num_cont_hb(i)=num_conti
3051 do i=iturn4_start,iturn4_end
3052 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
3053 .or. itype(i+3,1).eq.ntyp1 &
3054 .or. itype(i+4,1).eq.ntyp1) cycle
3058 dx_normi=dc_norm(1,i)
3059 dy_normi=dc_norm(2,i)
3060 dz_normi=dc_norm(3,i)
3061 xmedi=c(1,i)+0.5d0*dxi
3062 ymedi=c(2,i)+0.5d0*dyi
3063 zmedi=c(3,i)+0.5d0*dzi
3064 xmedi=dmod(xmedi,boxxsize)
3065 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3066 ymedi=dmod(ymedi,boxysize)
3067 if (ymedi.lt.0) ymedi=ymedi+boxysize
3068 zmedi=dmod(zmedi,boxzsize)
3069 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3070 if ((zmedi.gt.bordlipbot) &
3071 .and.(zmedi.lt.bordliptop)) then
3072 !C the energy transfer exist
3073 if (zmedi.lt.buflipbot) then
3074 !C what fraction I am in
3076 ((zmedi-bordlipbot)/lipbufthick)
3077 !C lipbufthick is thickenes of lipid buffore
3078 sslipi=sscalelip(fracinbuf)
3079 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3080 elseif (zmedi.gt.bufliptop) then
3081 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3082 sslipi=sscalelip(fracinbuf)
3083 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3093 num_conti=num_cont_hb(i)
3094 call eelecij(i,i+3,ees,evdw1,eel_loc)
3095 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
3096 call eturn4(i,eello_turn4)
3097 num_cont_hb(i)=num_conti
3100 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3102 ! print *,"iatel_s,iatel_e,",iatel_s,iatel_e
3103 do i=iatel_s,iatel_e
3104 if (itype(i,1).eq.ntyp1 .or. itype(i+1,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
3120 if ((zmedi.gt.bordlipbot) &
3121 .and.(zmedi.lt.bordliptop)) then
3122 !C the energy transfer exist
3123 if (zmedi.lt.buflipbot) then
3124 !C what fraction I am in
3126 ((zmedi-bordlipbot)/lipbufthick)
3127 !C lipbufthick is thickenes of lipid buffore
3128 sslipi=sscalelip(fracinbuf)
3129 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3130 elseif (zmedi.gt.bufliptop) then
3131 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3132 sslipi=sscalelip(fracinbuf)
3133 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3143 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3144 num_conti=num_cont_hb(i)
3145 do j=ielstart(i),ielend(i)
3146 ! write (iout,*) i,j,itype(i,1),itype(j,1)
3147 if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
3148 call eelecij(i,j,ees,evdw1,eel_loc)
3150 num_cont_hb(i)=num_conti
3152 ! write (iout,*) "Number of loop steps in EELEC:",ind
3154 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
3155 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3157 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3158 !cc eel_loc=eel_loc+eello_turn3
3159 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
3161 end subroutine eelec
3162 !-----------------------------------------------------------------------------
3163 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3166 ! implicit real*8 (a-h,o-z)
3167 ! include 'DIMENSIONS'
3171 ! include 'COMMON.CONTROL'
3172 ! include 'COMMON.IOUNITS'
3173 ! include 'COMMON.GEO'
3174 ! include 'COMMON.VAR'
3175 ! include 'COMMON.LOCAL'
3176 ! include 'COMMON.CHAIN'
3177 ! include 'COMMON.DERIV'
3178 ! include 'COMMON.INTERACT'
3179 ! include 'COMMON.CONTACTS'
3180 ! include 'COMMON.TORSION'
3181 ! include 'COMMON.VECTORS'
3182 ! include 'COMMON.FFIELD'
3183 ! include 'COMMON.TIME1'
3184 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
3185 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
3186 real(kind=8),dimension(2,2) :: acipa !el,a_temp
3187 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3188 real(kind=8),dimension(4) :: muij
3189 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
3190 dist_temp, dist_init,rlocshield,fracinbuf
3191 integer xshift,yshift,zshift,ilist,iresshield
3192 !el integer :: num_conti,j1,j2
3193 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3194 !el dz_normi,xmedi,ymedi,zmedi
3196 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3197 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3200 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3202 real(kind=8) :: scal_el=1.0d0
3204 real(kind=8) :: scal_el=0.5d0
3207 ! 13-go grudnia roku pamietnego...
3208 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
3210 0.0d0,0.0d0,1.0d0/),shape(unmat))
3211 ! integer :: maxconts=nres/4
3213 integer :: k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap
3214 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
3215 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
3216 real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
3217 rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
3218 evdwij,el1,el2,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
3219 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
3220 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
3221 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
3222 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
3223 ecosgp,ecosam,ecosbm,ecosgm,ghalf
3225 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
3226 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
3228 ! time00=MPI_Wtime()
3229 !d write (iout,*) "eelecij",i,j
3233 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3234 aaa=app(iteli,itelj)
3235 bbb=bpp(iteli,itelj)
3236 ael6i=ael6(iteli,itelj)
3237 ael3i=ael3(iteli,itelj)
3241 dx_normj=dc_norm(1,j)
3242 dy_normj=dc_norm(2,j)
3243 dz_normj=dc_norm(3,j)
3244 ! xj=c(1,j)+0.5D0*dxj-xmedi
3245 ! yj=c(2,j)+0.5D0*dyj-ymedi
3246 ! zj=c(3,j)+0.5D0*dzj-zmedi
3251 if (xj.lt.0) xj=xj+boxxsize
3253 if (yj.lt.0) yj=yj+boxysize
3255 if (zj.lt.0) zj=zj+boxzsize
3256 if ((zj.gt.bordlipbot) &
3257 .and.(zj.lt.bordliptop)) then
3258 !C the energy transfer exist
3259 if (zj.lt.buflipbot) then
3260 !C what fraction I am in
3262 ((zj-bordlipbot)/lipbufthick)
3263 !C lipbufthick is thickenes of lipid buffore
3264 sslipj=sscalelip(fracinbuf)
3265 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
3266 elseif (zj.gt.bufliptop) then
3267 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
3268 sslipj=sscalelip(fracinbuf)
3269 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
3280 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3287 xj=xj_safe+xshift*boxxsize
3288 yj=yj_safe+yshift*boxysize
3289 zj=zj_safe+zshift*boxzsize
3290 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3291 if(dist_temp.lt.dist_init) then
3301 if (isubchap.eq.1) then
3312 rij=xj*xj+yj*yj+zj*zj
3315 !C print *,xmedi,ymedi,zmedi,xj,yj,zj,boxxsize,rij
3316 sss_ele_cut=sscale_ele(rij)
3317 sss_ele_grad=sscagrad_ele(rij)
3319 ! sss_ele_grad=0.0d0
3320 ! print *,sss_ele_cut,sss_ele_grad,&
3321 ! (rij),r_cut_ele,rlamb_ele
3322 ! if (sss_ele_cut.le.0.0) go to 128
3327 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3328 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3329 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3330 fac=cosa-3.0D0*cosb*cosg
3332 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3333 if (j.eq.i+2) ev1=scal_el*ev1
3338 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3341 if (shield_mode.gt.0) then
3342 !C fac_shield(i)=0.4
3343 !C fac_shield(j)=0.6
3344 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3345 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3347 ees=ees+eesij*sss_ele_cut
3348 !C FOR NOW SHIELD IS NOT USED WITH LIPSCALE
3349 !C & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3355 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)*sss_ele_cut
3356 !C print *,"TUCC",(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
3359 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
3360 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3361 ! ees=ees+eesij*sss_ele_cut
3362 evdw1=evdw1+evdwij*sss_ele_cut &
3363 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3364 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3365 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3366 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3367 !d & xmedi,ymedi,zmedi,xj,yj,zj
3369 if (energy_dec) then
3370 ! write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') &
3371 ! 'evdw1',i,j,evdwij,&
3372 ! iteli,itelj,aaa,evdw1
3373 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3374 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3377 ! Calculate contributions to the Cartesian gradient.
3380 facvdw=-6*rrmij*(ev1+evdwij)*sss_ele_cut &
3381 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3382 facel=-3*rrmij*(el1+eesij)*sss_ele_cut &
3383 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3389 ! Radial derivatives. First process both termini of the fragment (i,j)
3391 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj* &
3392 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3393 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj* &
3394 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3395 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj* &
3396 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3398 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3399 (shield_mode.gt.0)) then
3401 do ilist=1,ishield_list(i)
3402 iresshield=shield_list(ilist,i)
3404 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)&
3406 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3408 +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0 &
3410 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3413 do ilist=1,ishield_list(j)
3414 iresshield=shield_list(ilist,j)
3416 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j) &
3418 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3420 +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0 &
3422 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3426 gshieldc(k,i)=gshieldc(k,i)+ &
3427 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3430 gshieldc(k,j)=gshieldc(k,j)+ &
3431 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3434 gshieldc(k,i-1)=gshieldc(k,i-1)+ &
3435 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3438 gshieldc(k,j-1)=gshieldc(k,j-1)+ &
3439 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3447 ! ghalf=0.5D0*ggg(k)
3448 ! gelc(k,i)=gelc(k,i)+ghalf
3449 ! gelc(k,j)=gelc(k,j)+ghalf
3451 ! 9/28/08 AL Gradient compotents will be summed only at the end
3453 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3454 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3456 gelc_long(3,j)=gelc_long(3,j)+ &
3457 ssgradlipj*eesij/2.0d0*lipscale**2&
3460 gelc_long(3,i)=gelc_long(3,i)+ &
3461 ssgradlipi*eesij/2.0d0*lipscale**2&
3466 ! Loop over residues i+1 thru j-1.
3470 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3473 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj &
3474 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3475 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj &
3476 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3477 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj &
3478 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3481 ! ghalf=0.5D0*ggg(k)
3482 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3483 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3485 ! 9/28/08 AL Gradient compotents will be summed only at the end
3487 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3488 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3491 !C Lipidic part for scaling weight
3492 gvdwpp(3,j)=gvdwpp(3,j)+ &
3493 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3494 gvdwpp(3,i)=gvdwpp(3,i)+ &
3495 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3496 !! Loop over residues i+1 thru j-1.
3500 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3504 facvdw=(ev1+evdwij)*sss_ele_cut &
3505 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3507 facel=(el1+eesij)*sss_ele_cut
3509 fac=-3*rrmij*(facvdw+facvdw+facel)
3514 ! Radial derivatives. First process both termini of the fragment (i,j)
3516 ggg(1)=fac*xj+sss_ele_grad*rmij*(eesij+evdwij)*xj
3517 ggg(2)=fac*yj+sss_ele_grad*rmij*(eesij+evdwij)*yj
3518 ggg(3)=fac*zj+sss_ele_grad*rmij*(eesij+evdwij)*zj
3520 ! ghalf=0.5D0*ggg(k)
3521 ! gelc(k,i)=gelc(k,i)+ghalf
3522 ! gelc(k,j)=gelc(k,j)+ghalf
3524 ! 9/28/08 AL Gradient compotents will be summed only at the end
3526 gelc_long(k,j)=gelc(k,j)+ggg(k)
3527 gelc_long(k,i)=gelc(k,i)-ggg(k)
3530 ! Loop over residues i+1 thru j-1.
3534 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3537 ! 9/28/08 AL Gradient compotents will be summed only at the end
3539 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3541 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3543 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3546 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3547 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3549 gvdwpp(3,j)=gvdwpp(3,j)+ &
3550 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3551 gvdwpp(3,i)=gvdwpp(3,i)+ &
3552 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3558 ecosa=2.0D0*fac3*fac1+fac4
3561 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3562 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3564 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3565 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3567 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3568 !d & (dcosg(k),k=1,3)
3570 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*sss_ele_cut &
3571 *fac_shield(i)**2*fac_shield(j)**2 &
3572 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3576 ! ghalf=0.5D0*ggg(k)
3577 ! gelc(k,i)=gelc(k,i)+ghalf
3578 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3579 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3580 ! gelc(k,j)=gelc(k,j)+ghalf
3581 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3582 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3586 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3590 gelc(k,i)=gelc(k,i) &
3591 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3592 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
3594 *fac_shield(i)**2*fac_shield(j)**2 &
3595 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3597 gelc(k,j)=gelc(k,j) &
3598 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3599 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
3601 *fac_shield(i)**2*fac_shield(j)**2 &
3602 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3604 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3605 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3608 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3609 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
3610 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3612 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3613 ! energy of a peptide unit is assumed in the form of a second-order
3614 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3615 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3616 ! are computed for EVERY pair of non-contiguous peptide groups.
3618 if (j.lt.nres-1) then
3629 muij(kkk)=mu(k,i)*mu(l,j)
3632 !d write (iout,*) 'EELEC: i',i,' j',j
3633 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
3634 !d write(iout,*) 'muij',muij
3635 ury=scalar(uy(1,i),erij)
3636 urz=scalar(uz(1,i),erij)
3637 vry=scalar(uy(1,j),erij)
3638 vrz=scalar(uz(1,j),erij)
3639 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3640 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3641 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3642 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3643 fac=dsqrt(-ael6i)*r3ij
3648 !d write (iout,'(4i5,4f10.5)')
3649 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
3650 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3651 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3652 !d & uy(:,j),uz(:,j)
3653 !d write (iout,'(4f10.5)')
3654 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3655 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3656 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
3657 !d write (iout,'(9f10.5/)')
3658 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3659 ! Derivatives of the elements of A in virtual-bond vectors
3660 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3662 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3663 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3664 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3665 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3666 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3667 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3668 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3669 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3670 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3671 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3672 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3673 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3675 ! Compute radial contributions to the gradient
3693 ! Add the contributions coming from er
3696 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3697 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3698 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3699 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3702 ! Derivatives in DC(i)
3703 !grad ghalf1=0.5d0*agg(k,1)
3704 !grad ghalf2=0.5d0*agg(k,2)
3705 !grad ghalf3=0.5d0*agg(k,3)
3706 !grad ghalf4=0.5d0*agg(k,4)
3707 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
3708 -3.0d0*uryg(k,2)*vry)!+ghalf1
3709 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
3710 -3.0d0*uryg(k,2)*vrz)!+ghalf2
3711 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
3712 -3.0d0*urzg(k,2)*vry)!+ghalf3
3713 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
3714 -3.0d0*urzg(k,2)*vrz)!+ghalf4
3715 ! Derivatives in DC(i+1)
3716 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
3717 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3718 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
3719 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3720 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
3721 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3722 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
3723 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3724 ! Derivatives in DC(j)
3725 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
3726 -3.0d0*vryg(k,2)*ury)!+ghalf1
3727 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
3728 -3.0d0*vrzg(k,2)*ury)!+ghalf2
3729 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
3730 -3.0d0*vryg(k,2)*urz)!+ghalf3
3731 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
3732 -3.0d0*vrzg(k,2)*urz)!+ghalf4
3733 ! Derivatives in DC(j+1) or DC(nres-1)
3734 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
3735 -3.0d0*vryg(k,3)*ury)
3736 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
3737 -3.0d0*vrzg(k,3)*ury)
3738 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
3739 -3.0d0*vryg(k,3)*urz)
3740 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
3741 -3.0d0*vrzg(k,3)*urz)
3742 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
3744 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3757 aggi(k,l)=-aggi(k,l)
3758 aggi1(k,l)=-aggi1(k,l)
3759 aggj(k,l)=-aggj(k,l)
3760 aggj1(k,l)=-aggj1(k,l)
3763 if (j.lt.nres-1) then
3769 aggi(k,l)=-aggi(k,l)
3770 aggi1(k,l)=-aggi1(k,l)
3771 aggj(k,l)=-aggj(k,l)
3772 aggj1(k,l)=-aggj1(k,l)
3783 aggi(k,l)=-aggi(k,l)
3784 aggi1(k,l)=-aggi1(k,l)
3785 aggj(k,l)=-aggj(k,l)
3786 aggj1(k,l)=-aggj1(k,l)
3791 IF (wel_loc.gt.0.0d0) THEN
3792 ! Contribution to the local-electrostatic energy coming from the i-j pair
3793 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
3795 if (shield_mode.eq.0) then
3799 eel_loc_ij=eel_loc_ij &
3800 *fac_shield(i)*fac_shield(j) &
3801 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3802 !C Now derivative over eel_loc
3803 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3804 (shield_mode.gt.0)) then
3807 do ilist=1,ishield_list(i)
3808 iresshield=shield_list(ilist,i)
3810 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij &
3813 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
3815 +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i) &
3818 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
3822 do ilist=1,ishield_list(j)
3823 iresshield=shield_list(ilist,j)
3825 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij &
3828 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
3830 +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j) &
3833 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
3840 gshieldc_ll(k,i)=gshieldc_ll(k,i)+ &
3841 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
3843 gshieldc_ll(k,j)=gshieldc_ll(k,j)+ &
3844 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
3846 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+ &
3847 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
3849 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+ &
3850 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
3857 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3859 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3860 'eelloc',i,j,eel_loc_ij
3861 ! if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33
3862 ! if (energy_dec) write (iout,*) "muij",muij
3863 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3865 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
3866 ! Partial derivatives in virtual-bond dihedral angles gamma
3868 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
3869 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
3870 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
3872 *fac_shield(i)*fac_shield(j) &
3873 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3875 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
3876 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
3877 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
3879 *fac_shield(i)*fac_shield(j) &
3880 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3881 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3883 ! ggg(1)=(agg(1,1)*muij(1)+ &
3884 ! agg(1,2)*muij(2)+agg(1,3)*muij(3)+agg(1,4)*muij(4)) &
3886 ! +eel_loc_ij*sss_ele_grad*rmij*xj
3887 ! ggg(2)=(agg(2,1)*muij(1)+ &
3888 ! agg(2,2)*muij(2)+agg(2,3)*muij(3)+agg(2,4)*muij(4)) &
3890 ! +eel_loc_ij*sss_ele_grad*rmij*yj
3891 ! ggg(3)=(agg(3,1)*muij(1)+ &
3892 ! agg(3,2)*muij(2)+agg(3,3)*muij(3)+agg(3,4)*muij(4)) &
3894 ! +eel_loc_ij*sss_ele_grad*rmij*zj
3900 ggg(l)=(agg(l,1)*muij(1)+ &
3901 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
3903 *fac_shield(i)*fac_shield(j) &
3904 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) &
3905 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3908 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3909 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3910 !grad ghalf=0.5d0*ggg(l)
3911 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
3912 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
3914 gel_loc_long(3,j)=gel_loc_long(3,j)+ &
3915 ssgradlipj*eel_loc_ij/2.0d0*lipscale/ &
3916 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
3918 gel_loc_long(3,i)=gel_loc_long(3,i)+ &
3919 ssgradlipi*eel_loc_ij/2.0d0*lipscale/ &
3920 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
3924 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3927 ! Remaining derivatives of eello
3929 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
3930 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
3932 *fac_shield(i)*fac_shield(j) &
3933 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3935 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3936 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
3937 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3) &
3938 +aggi1(l,4)*muij(4))&
3940 *fac_shield(i)*fac_shield(j) &
3941 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3943 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3944 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
3945 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
3947 *fac_shield(i)*fac_shield(j) &
3948 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3950 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3951 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
3952 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3) &
3953 +aggj1(l,4)*muij(4))&
3955 *fac_shield(i)*fac_shield(j) &
3956 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3958 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3961 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
3962 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
3963 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
3964 .and. num_conti.le.maxconts) then
3965 ! write (iout,*) i,j," entered corr"
3967 ! Calculate the contact function. The ith column of the array JCONT will
3968 ! contain the numbers of atoms that make contacts with the atom I (of numbers
3969 ! greater than I). The arrays FACONT and GACONT will contain the values of
3970 ! the contact function and its derivative.
3971 ! r0ij=1.02D0*rpp(iteli,itelj)
3972 ! r0ij=1.11D0*rpp(iteli,itelj)
3973 r0ij=2.20D0*rpp(iteli,itelj)
3974 ! r0ij=1.55D0*rpp(iteli,itelj)
3975 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3976 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
3977 if (fcont.gt.0.0D0) then
3978 num_conti=num_conti+1
3979 if (num_conti.gt.maxconts) then
3980 !el write (iout,*) "esrgresgdsrgdfsrgdswrgaresfgaerwgae"
3981 !el write (iout,*) "num_conti",num_conti, "maxconts",maxconts
3982 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
3983 ' will skip next contacts for this conf.', num_conti
3985 jcont_hb(num_conti,i)=j
3986 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
3987 !d & " jcont_hb",jcont_hb(num_conti,i)
3988 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
3989 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3990 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3992 d_cont(num_conti,i)=rij
3993 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3994 ! --- Electrostatic-interaction matrix ---
3995 a_chuj(1,1,num_conti,i)=a22
3996 a_chuj(1,2,num_conti,i)=a23
3997 a_chuj(2,1,num_conti,i)=a32
3998 a_chuj(2,2,num_conti,i)=a33
3999 ! --- Gradient of rij
4001 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4008 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4009 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4010 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4011 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4012 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4017 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4018 ! Calculate contact energies
4020 wij=cosa-3.0D0*cosb*cosg
4023 ! fac3=dsqrt(-ael6i)/r0ij**3
4024 fac3=dsqrt(-ael6i)*r3ij
4025 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4026 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4027 if (ees0tmp.gt.0) then
4028 ees0pij=dsqrt(ees0tmp)
4032 if (shield_mode.eq.0) then
4036 ees0plist(num_conti,i)=j
4038 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4039 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4040 if (ees0tmp.gt.0) then
4041 ees0mij=dsqrt(ees0tmp)
4046 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
4048 *fac_shield(i)*fac_shield(j)
4050 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
4052 *fac_shield(i)*fac_shield(j)
4054 ! Diagnostics. Comment out or remove after debugging!
4055 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4056 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4057 ! ees0m(num_conti,i)=0.0D0
4059 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4060 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4061 ! Angular derivatives of the contact function
4062 ees0pij1=fac3/ees0pij
4063 ees0mij1=fac3/ees0mij
4064 fac3p=-3.0D0*fac3*rrmij
4065 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4066 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4068 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4069 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4070 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4071 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4072 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4073 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4074 ecosap=ecosa1+ecosa2
4075 ecosbp=ecosb1+ecosb2
4076 ecosgp=ecosg1+ecosg2
4077 ecosam=ecosa1-ecosa2
4078 ecosbm=ecosb1-ecosb2
4079 ecosgm=ecosg1-ecosg2
4088 facont_hb(num_conti,i)=fcont
4089 fprimcont=fprimcont/rij
4090 !d facont_hb(num_conti,i)=1.0D0
4091 ! Following line is for diagnostics.
4094 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4095 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4098 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4099 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4101 gggp(1)=gggp(1)+ees0pijp*xj &
4102 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
4103 gggp(2)=gggp(2)+ees0pijp*yj &
4104 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
4105 gggp(3)=gggp(3)+ees0pijp*zj &
4106 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
4108 gggm(1)=gggm(1)+ees0mijp*xj &
4109 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
4111 gggm(2)=gggm(2)+ees0mijp*yj &
4112 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
4114 gggm(3)=gggm(3)+ees0mijp*zj &
4115 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
4117 ! Derivatives due to the contact function
4118 gacont_hbr(1,num_conti,i)=fprimcont*xj
4119 gacont_hbr(2,num_conti,i)=fprimcont*yj
4120 gacont_hbr(3,num_conti,i)=fprimcont*zj
4123 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
4124 ! following the change of gradient-summation algorithm.
4126 !grad ghalfp=0.5D0*gggp(k)
4127 !grad ghalfm=0.5D0*gggm(k)
4128 gacontp_hb1(k,num_conti,i)= & !ghalfp+
4129 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4130 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
4131 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4133 gacontp_hb2(k,num_conti,i)= & !ghalfp+
4134 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4135 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
4136 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4138 gacontp_hb3(k,num_conti,i)=gggp(k) &
4139 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4141 gacontm_hb1(k,num_conti,i)= & !ghalfm+
4142 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4143 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
4144 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4146 gacontm_hb2(k,num_conti,i)= & !ghalfm+
4147 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4148 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
4149 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4151 gacontm_hb3(k,num_conti,i)=gggm(k) &
4152 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4155 ! Diagnostics. Comment out or remove after debugging!
4157 !diag gacontp_hb1(k,num_conti,i)=0.0D0
4158 !diag gacontp_hb2(k,num_conti,i)=0.0D0
4159 !diag gacontp_hb3(k,num_conti,i)=0.0D0
4160 !diag gacontm_hb1(k,num_conti,i)=0.0D0
4161 !diag gacontm_hb2(k,num_conti,i)=0.0D0
4162 !diag gacontm_hb3(k,num_conti,i)=0.0D0
4165 endif ! num_conti.le.maxconts
4168 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4171 ghalf=0.5d0*agg(l,k)
4172 aggi(l,k)=aggi(l,k)+ghalf
4173 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4174 aggj(l,k)=aggj(l,k)+ghalf
4177 if (j.eq.nres-1 .and. i.lt.j-2) then
4180 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4186 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
4188 end subroutine eelecij
4189 !-----------------------------------------------------------------------------
4190 subroutine eturn3(i,eello_turn3)
4191 ! Third- and fourth-order contributions from turns
4194 ! implicit real*8 (a-h,o-z)
4195 ! include 'DIMENSIONS'
4196 ! include 'COMMON.IOUNITS'
4197 ! include 'COMMON.GEO'
4198 ! include 'COMMON.VAR'
4199 ! include 'COMMON.LOCAL'
4200 ! include 'COMMON.CHAIN'
4201 ! include 'COMMON.DERIV'
4202 ! include 'COMMON.INTERACT'
4203 ! include 'COMMON.CONTACTS'
4204 ! include 'COMMON.TORSION'
4205 ! include 'COMMON.VECTORS'
4206 ! include 'COMMON.FFIELD'
4207 ! include 'COMMON.CONTROL'
4208 real(kind=8),dimension(3) :: ggg
4209 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4210 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
4211 real(kind=8),dimension(2) :: auxvec,auxvec1
4212 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4213 real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
4214 !el integer :: num_conti,j1,j2
4215 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4216 !el dz_normi,xmedi,ymedi,zmedi
4218 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4219 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4222 integer :: i,j,l,k,ilist,iresshield
4223 real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield
4226 ! write (iout,*) "eturn3",i,j,j1,j2
4227 zj=(c(3,j)+c(3,j+1))/2.0d0
4229 if (zj.lt.0) zj=zj+boxzsize
4230 if ((zj.lt.0)) write (*,*) "CHUJ"
4231 if ((zj.gt.bordlipbot) &
4232 .and.(zj.lt.bordliptop)) then
4233 !C the energy transfer exist
4234 if (zj.lt.buflipbot) then
4235 !C what fraction I am in
4237 ((zj-bordlipbot)/lipbufthick)
4238 !C lipbufthick is thickenes of lipid buffore
4239 sslipj=sscalelip(fracinbuf)
4240 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4241 elseif (zj.gt.bufliptop) then
4242 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4243 sslipj=sscalelip(fracinbuf)
4244 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4258 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4260 ! Third-order contributions
4267 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4268 !d call checkint_turn3(i,a_temp,eello_turn3_num)
4269 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4270 call transpose2(auxmat(1,1),auxmat1(1,1))
4271 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4272 if (shield_mode.eq.0) then
4277 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) &
4278 *fac_shield(i)*fac_shield(j) &
4279 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4281 0.5d0*(pizda(1,1)+pizda(2,2)) &
4282 *fac_shield(i)*fac_shield(j)
4284 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4285 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4286 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4287 (shield_mode.gt.0)) then
4290 do ilist=1,ishield_list(i)
4291 iresshield=shield_list(ilist,i)
4293 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4294 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4296 +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4297 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4301 do ilist=1,ishield_list(j)
4302 iresshield=shield_list(ilist,j)
4304 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4305 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4307 +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4308 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4315 gshieldc_t3(k,i)=gshieldc_t3(k,i)+ &
4316 grad_shield(k,i)*eello_t3/fac_shield(i)
4317 gshieldc_t3(k,j)=gshieldc_t3(k,j)+ &
4318 grad_shield(k,j)*eello_t3/fac_shield(j)
4319 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+ &
4320 grad_shield(k,i)*eello_t3/fac_shield(i)
4321 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+ &
4322 grad_shield(k,j)*eello_t3/fac_shield(j)
4326 !d write (2,*) 'i,',i,' j',j,'eello_turn3',
4327 !d & 0.5d0*(pizda(1,1)+pizda(2,2)),
4328 !d & ' eello_turn3_num',4*eello_turn3_num
4329 ! Derivatives in gamma(i)
4330 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4331 call transpose2(auxmat2(1,1),auxmat3(1,1))
4332 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4333 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))&
4334 *fac_shield(i)*fac_shield(j) &
4335 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4336 ! Derivatives in gamma(i+1)
4337 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4338 call transpose2(auxmat2(1,1),auxmat3(1,1))
4339 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4340 gel_loc_turn3(i+1)=gel_loc_turn3(i+1) &
4341 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4342 *fac_shield(i)*fac_shield(j) &
4343 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4345 ! Cartesian derivatives
4347 ! ghalf1=0.5d0*agg(l,1)
4348 ! ghalf2=0.5d0*agg(l,2)
4349 ! ghalf3=0.5d0*agg(l,3)
4350 ! ghalf4=0.5d0*agg(l,4)
4351 a_temp(1,1)=aggi(l,1)!+ghalf1
4352 a_temp(1,2)=aggi(l,2)!+ghalf2
4353 a_temp(2,1)=aggi(l,3)!+ghalf3
4354 a_temp(2,2)=aggi(l,4)!+ghalf4
4355 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4356 gcorr3_turn(l,i)=gcorr3_turn(l,i) &
4357 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4358 *fac_shield(i)*fac_shield(j) &
4359 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4361 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4362 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4363 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4364 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4365 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4366 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) &
4367 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4368 *fac_shield(i)*fac_shield(j) &
4369 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4371 a_temp(1,1)=aggj(l,1)!+ghalf1
4372 a_temp(1,2)=aggj(l,2)!+ghalf2
4373 a_temp(2,1)=aggj(l,3)!+ghalf3
4374 a_temp(2,2)=aggj(l,4)!+ghalf4
4375 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4376 gcorr3_turn(l,j)=gcorr3_turn(l,j) &
4377 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4378 *fac_shield(i)*fac_shield(j) &
4379 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4381 a_temp(1,1)=aggj1(l,1)
4382 a_temp(1,2)=aggj1(l,2)
4383 a_temp(2,1)=aggj1(l,3)
4384 a_temp(2,2)=aggj1(l,4)
4385 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4386 gcorr3_turn(l,j1)=gcorr3_turn(l,j1) &
4387 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4388 *fac_shield(i)*fac_shield(j) &
4389 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4391 gshieldc_t3(3,i)=gshieldc_t3(3,i)+ &
4392 ssgradlipi*eello_t3/4.0d0*lipscale
4393 gshieldc_t3(3,j)=gshieldc_t3(3,j)+ &
4394 ssgradlipj*eello_t3/4.0d0*lipscale
4395 gshieldc_t3(3,i-1)=gshieldc_t3(3,i-1)+ &
4396 ssgradlipi*eello_t3/4.0d0*lipscale
4397 gshieldc_t3(3,j-1)=gshieldc_t3(3,j-1)+ &
4398 ssgradlipj*eello_t3/4.0d0*lipscale
4401 end subroutine eturn3
4402 !-----------------------------------------------------------------------------
4403 subroutine eturn4(i,eello_turn4)
4404 ! Third- and fourth-order contributions from turns
4407 ! implicit real*8 (a-h,o-z)
4408 ! include 'DIMENSIONS'
4409 ! include 'COMMON.IOUNITS'
4410 ! include 'COMMON.GEO'
4411 ! include 'COMMON.VAR'
4412 ! include 'COMMON.LOCAL'
4413 ! include 'COMMON.CHAIN'
4414 ! include 'COMMON.DERIV'
4415 ! include 'COMMON.INTERACT'
4416 ! include 'COMMON.CONTACTS'
4417 ! include 'COMMON.TORSION'
4418 ! include 'COMMON.VECTORS'
4419 ! include 'COMMON.FFIELD'
4420 ! include 'COMMON.CONTROL'
4421 real(kind=8),dimension(3) :: ggg
4422 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4423 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
4424 real(kind=8),dimension(2) :: auxvec,auxvec1
4425 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4426 real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
4427 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4428 !el dz_normi,xmedi,ymedi,zmedi
4429 !el integer :: num_conti,j1,j2
4430 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4431 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4434 integer :: i,j,iti1,iti2,iti3,l,k,ilist,iresshield
4435 real(kind=8) :: eello_turn4,s1,s2,s3,zj,fracinbuf,eello_t4,&
4439 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4441 ! Fourth-order contributions
4449 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4450 !d call checkint_turn4(i,a_temp,eello_turn4_num)
4451 ! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4452 zj=(c(3,j)+c(3,j+1))/2.0d0
4454 if (zj.lt.0) zj=zj+boxzsize
4455 if ((zj.gt.bordlipbot) &
4456 .and.(zj.lt.bordliptop)) then
4457 !C the energy transfer exist
4458 if (zj.lt.buflipbot) then
4459 !C what fraction I am in
4461 ((zj-bordlipbot)/lipbufthick)
4462 !C lipbufthick is thickenes of lipid buffore
4463 sslipj=sscalelip(fracinbuf)
4464 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4465 elseif (zj.gt.bufliptop) then
4466 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4467 sslipj=sscalelip(fracinbuf)
4468 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4482 iti1=itortyp(itype(i+1,1))
4483 iti2=itortyp(itype(i+2,1))
4484 iti3=itortyp(itype(i+3,1))
4485 ! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4486 call transpose2(EUg(1,1,i+1),e1t(1,1))
4487 call transpose2(Eug(1,1,i+2),e2t(1,1))
4488 call transpose2(Eug(1,1,i+3),e3t(1,1))
4489 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4490 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4491 s1=scalar2(b1(1,iti2),auxvec(1))
4492 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4493 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4494 s2=scalar2(b1(1,iti1),auxvec(1))
4495 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4496 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4497 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4498 if (shield_mode.eq.0) then
4503 eello_turn4=eello_turn4-(s1+s2+s3) &
4504 *fac_shield(i)*fac_shield(j) &
4505 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4506 eello_t4=-(s1+s2+s3) &
4507 *fac_shield(i)*fac_shield(j)
4508 !C Now derivative over shield:
4509 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4510 (shield_mode.gt.0)) then
4513 do ilist=1,ishield_list(i)
4514 iresshield=shield_list(ilist,i)
4516 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
4517 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
4519 +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
4520 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
4524 do ilist=1,ishield_list(j)
4525 iresshield=shield_list(ilist,j)
4527 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
4528 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
4530 +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
4531 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
4538 gshieldc_t4(k,i)=gshieldc_t4(k,i)+ &
4539 grad_shield(k,i)*eello_t4/fac_shield(i)
4540 gshieldc_t4(k,j)=gshieldc_t4(k,j)+ &
4541 grad_shield(k,j)*eello_t4/fac_shield(j)
4542 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+ &
4543 grad_shield(k,i)*eello_t4/fac_shield(i)
4544 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+ &
4545 grad_shield(k,j)*eello_t4/fac_shield(j)
4549 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4550 'eturn4',i,j,-(s1+s2+s3)
4551 !d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4552 !d & ' eello_turn4_num',8*eello_turn4_num
4553 ! Derivatives in gamma(i)
4554 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4555 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4556 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4557 s1=scalar2(b1(1,iti2),auxvec(1))
4558 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4559 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4560 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) &
4561 *fac_shield(i)*fac_shield(j) &
4562 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4564 ! Derivatives in gamma(i+1)
4565 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4566 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4567 s2=scalar2(b1(1,iti1),auxvec(1))
4568 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4569 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4570 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4571 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) &
4572 *fac_shield(i)*fac_shield(j) &
4573 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4575 ! Derivatives in gamma(i+2)
4576 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4577 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4578 s1=scalar2(b1(1,iti2),auxvec(1))
4579 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4580 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4581 s2=scalar2(b1(1,iti1),auxvec(1))
4582 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4583 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4584 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4585 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) &
4586 *fac_shield(i)*fac_shield(j) &
4587 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4589 ! Cartesian derivatives
4590 ! Derivatives of this turn contributions in DC(i+2)
4591 if (j.lt.nres-1) then
4593 a_temp(1,1)=agg(l,1)
4594 a_temp(1,2)=agg(l,2)
4595 a_temp(2,1)=agg(l,3)
4596 a_temp(2,2)=agg(l,4)
4597 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4598 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4599 s1=scalar2(b1(1,iti2),auxvec(1))
4600 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4601 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4602 s2=scalar2(b1(1,iti1),auxvec(1))
4603 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4604 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4605 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4607 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)&
4608 *fac_shield(i)*fac_shield(j) &
4609 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4613 ! Remaining derivatives of this turn contribution
4615 a_temp(1,1)=aggi(l,1)
4616 a_temp(1,2)=aggi(l,2)
4617 a_temp(2,1)=aggi(l,3)
4618 a_temp(2,2)=aggi(l,4)
4619 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4620 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4621 s1=scalar2(b1(1,iti2),auxvec(1))
4622 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4623 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4624 s2=scalar2(b1(1,iti1),auxvec(1))
4625 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4626 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4627 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4628 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) &
4629 *fac_shield(i)*fac_shield(j) &
4630 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4633 a_temp(1,1)=aggi1(l,1)
4634 a_temp(1,2)=aggi1(l,2)
4635 a_temp(2,1)=aggi1(l,3)
4636 a_temp(2,2)=aggi1(l,4)
4637 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4638 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4639 s1=scalar2(b1(1,iti2),auxvec(1))
4640 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4641 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4642 s2=scalar2(b1(1,iti1),auxvec(1))
4643 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4644 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4645 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4646 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) &
4647 *fac_shield(i)*fac_shield(j) &
4648 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4651 a_temp(1,1)=aggj(l,1)
4652 a_temp(1,2)=aggj(l,2)
4653 a_temp(2,1)=aggj(l,3)
4654 a_temp(2,2)=aggj(l,4)
4655 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4656 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4657 s1=scalar2(b1(1,iti2),auxvec(1))
4658 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4659 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4660 s2=scalar2(b1(1,iti1),auxvec(1))
4661 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4662 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4663 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4664 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) &
4665 *fac_shield(i)*fac_shield(j) &
4666 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4669 a_temp(1,1)=aggj1(l,1)
4670 a_temp(1,2)=aggj1(l,2)
4671 a_temp(2,1)=aggj1(l,3)
4672 a_temp(2,2)=aggj1(l,4)
4673 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4674 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4675 s1=scalar2(b1(1,iti2),auxvec(1))
4676 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4677 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4678 s2=scalar2(b1(1,iti1),auxvec(1))
4679 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4680 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4681 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4682 ! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4683 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) &
4684 *fac_shield(i)*fac_shield(j) &
4685 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4688 gshieldc_t4(3,i)=gshieldc_t4(3,i)+ &
4689 ssgradlipi*eello_t4/4.0d0*lipscale
4690 gshieldc_t4(3,j)=gshieldc_t4(3,j)+ &
4691 ssgradlipj*eello_t4/4.0d0*lipscale
4692 gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+ &
4693 ssgradlipi*eello_t4/4.0d0*lipscale
4694 gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+ &
4695 ssgradlipj*eello_t4/4.0d0*lipscale
4698 end subroutine eturn4
4699 !-----------------------------------------------------------------------------
4700 subroutine unormderiv(u,ugrad,unorm,ungrad)
4701 ! This subroutine computes the derivatives of a normalized vector u, given
4702 ! the derivatives computed without normalization conditions, ugrad. Returns
4705 real(kind=8),dimension(3) :: u,vec
4706 real(kind=8),dimension(3,3) ::ugrad,ungrad
4707 real(kind=8) :: unorm !,scalar
4709 ! write (2,*) 'ugrad',ugrad
4712 vec(i)=scalar(ugrad(1,i),u(1))
4714 ! write (2,*) 'vec',vec
4717 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4720 ! write (2,*) 'ungrad',ungrad
4722 end subroutine unormderiv
4723 !-----------------------------------------------------------------------------
4724 subroutine escp_soft_sphere(evdw2,evdw2_14)
4726 ! This subroutine calculates the excluded-volume interaction energy between
4727 ! peptide-group centers and side chains and its gradient in virtual-bond and
4728 ! side-chain vectors.
4730 ! implicit real*8 (a-h,o-z)
4731 ! include 'DIMENSIONS'
4732 ! include 'COMMON.GEO'
4733 ! include 'COMMON.VAR'
4734 ! include 'COMMON.LOCAL'
4735 ! include 'COMMON.CHAIN'
4736 ! include 'COMMON.DERIV'
4737 ! include 'COMMON.INTERACT'
4738 ! include 'COMMON.FFIELD'
4739 ! include 'COMMON.IOUNITS'
4740 ! include 'COMMON.CONTROL'
4741 real(kind=8),dimension(3) :: ggg
4743 integer :: i,iint,j,k,iteli,itypj
4744 real(kind=8) :: evdw2,evdw2_14,r0_scp,xi,yi,zi,xj,yj,zj,&
4745 fac,rij,r0ij,r0ijsq,evdwij,e1,e2
4750 !d print '(a)','Enter ESCP'
4751 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4752 do i=iatscp_s,iatscp_e
4753 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
4755 xi=0.5D0*(c(1,i)+c(1,i+1))
4756 yi=0.5D0*(c(2,i)+c(2,i+1))
4757 zi=0.5D0*(c(3,i)+c(3,i+1))
4759 do iint=1,nscp_gr(i)
4761 do j=iscpstart(i,iint),iscpend(i,iint)
4762 if (itype(j,1).eq.ntyp1) cycle
4763 itypj=iabs(itype(j,1))
4764 ! Uncomment following three lines for SC-p interactions
4768 ! Uncomment following three lines for Ca-p interactions
4772 rij=xj*xj+yj*yj+zj*zj
4775 if (rij.lt.r0ijsq) then
4776 evdwij=0.25d0*(rij-r0ijsq)**2
4784 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
4789 !grad if (j.lt.i) then
4790 !d write (iout,*) 'j<i'
4791 ! Uncomment following three lines for SC-p interactions
4793 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4796 !d write (iout,*) 'j>i'
4798 !grad ggg(k)=-ggg(k)
4799 ! Uncomment following line for SC-p interactions
4800 ! gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4804 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4806 !grad kstart=min0(i+1,j)
4807 !grad kend=max0(i-1,j-1)
4808 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4809 !d write (iout,*) ggg(1),ggg(2),ggg(3)
4810 !grad do k=kstart,kend
4812 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4816 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4817 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4824 end subroutine escp_soft_sphere
4825 !-----------------------------------------------------------------------------
4826 subroutine escp(evdw2,evdw2_14)
4828 ! This subroutine calculates the excluded-volume interaction energy between
4829 ! peptide-group centers and side chains and its gradient in virtual-bond and
4830 ! side-chain vectors.
4832 ! implicit real*8 (a-h,o-z)
4833 ! include 'DIMENSIONS'
4834 ! include 'COMMON.GEO'
4835 ! include 'COMMON.VAR'
4836 ! include 'COMMON.LOCAL'
4837 ! include 'COMMON.CHAIN'
4838 ! include 'COMMON.DERIV'
4839 ! include 'COMMON.INTERACT'
4840 ! include 'COMMON.FFIELD'
4841 ! include 'COMMON.IOUNITS'
4842 ! include 'COMMON.CONTROL'
4843 real(kind=8),dimension(3) :: ggg
4845 integer :: i,iint,j,k,iteli,itypj,subchap
4846 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
4848 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
4849 dist_temp, dist_init
4850 integer xshift,yshift,zshift
4854 !d print '(a)','Enter ESCP'
4855 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4856 do i=iatscp_s,iatscp_e
4857 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
4859 xi=0.5D0*(c(1,i)+c(1,i+1))
4860 yi=0.5D0*(c(2,i)+c(2,i+1))
4861 zi=0.5D0*(c(3,i)+c(3,i+1))
4863 if (xi.lt.0) xi=xi+boxxsize
4865 if (yi.lt.0) yi=yi+boxysize
4867 if (zi.lt.0) zi=zi+boxzsize
4869 do iint=1,nscp_gr(i)
4871 do j=iscpstart(i,iint),iscpend(i,iint)
4872 itypj=iabs(itype(j,1))
4873 if (itypj.eq.ntyp1) cycle
4874 ! Uncomment following three lines for SC-p interactions
4878 ! Uncomment following three lines for Ca-p interactions
4886 if (xj.lt.0) xj=xj+boxxsize
4888 if (yj.lt.0) yj=yj+boxysize
4890 if (zj.lt.0) zj=zj+boxzsize
4891 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4899 xj=xj_safe+xshift*boxxsize
4900 yj=yj_safe+yshift*boxysize
4901 zj=zj_safe+zshift*boxzsize
4902 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4903 if(dist_temp.lt.dist_init) then
4913 if (subchap.eq.1) then
4923 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4924 rij=dsqrt(1.0d0/rrij)
4925 sss_ele_cut=sscale_ele(rij)
4926 sss_ele_grad=sscagrad_ele(rij)
4927 ! print *,sss_ele_cut,sss_ele_grad,&
4928 ! (rij),r_cut_ele,rlamb_ele
4929 if (sss_ele_cut.le.0.0) cycle
4931 e1=fac*fac*aad(itypj,iteli)
4932 e2=fac*bad(itypj,iteli)
4933 if (iabs(j-i) .le. 2) then
4936 evdw2_14=evdw2_14+(e1+e2)*sss_ele_cut
4939 evdw2=evdw2+evdwij*sss_ele_cut
4940 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') &
4941 ! 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),&
4942 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4945 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
4947 fac=-(evdwij+e1)*rrij*sss_ele_cut
4948 fac=fac+evdwij*sss_ele_grad/rij/expon
4952 !grad if (j.lt.i) then
4953 !d write (iout,*) 'j<i'
4954 ! Uncomment following three lines for SC-p interactions
4956 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4959 !d write (iout,*) 'j>i'
4961 !grad ggg(k)=-ggg(k)
4962 ! Uncomment following line for SC-p interactions
4963 !cgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4964 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4968 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4970 !grad kstart=min0(i+1,j)
4971 !grad kend=max0(i-1,j-1)
4972 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4973 !d write (iout,*) ggg(1),ggg(2),ggg(3)
4974 !grad do k=kstart,kend
4976 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4980 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4981 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4989 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4990 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4991 gradx_scp(j,i)=expon*gradx_scp(j,i)
4994 !******************************************************************************
4998 ! To save time the factor EXPON has been extracted from ALL components
4999 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
5002 !******************************************************************************
5005 !-----------------------------------------------------------------------------
5006 subroutine edis(ehpb)
5008 ! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5010 ! implicit real*8 (a-h,o-z)
5011 ! include 'DIMENSIONS'
5012 ! include 'COMMON.SBRIDGE'
5013 ! include 'COMMON.CHAIN'
5014 ! include 'COMMON.DERIV'
5015 ! include 'COMMON.VAR'
5016 ! include 'COMMON.INTERACT'
5017 ! include 'COMMON.IOUNITS'
5018 real(kind=8),dimension(3) :: ggg
5020 integer :: i,j,ii,jj,iii,jjj,k
5021 real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
5024 !d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5025 !d write(iout,*)'link_start=',link_start,' link_end=',link_end
5026 if (link_end.eq.0) return
5027 do i=link_start,link_end
5028 ! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5029 ! CA-CA distance used in regularization of structure.
5032 ! iii and jjj point to the residues for which the distance is assigned.
5033 if (ii.gt.nres) then
5040 ! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5041 ! & dhpb(i),dhpb1(i),forcon(i)
5042 ! 24/11/03 AL: SS bridges handled separately because of introducing a specific
5043 ! distance and angle dependent SS bond potential.
5044 !mc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5045 ! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5046 if (.not.dyn_ss .and. i.le.nss) then
5047 ! 15/02/13 CC dynamic SSbond - additional check
5048 if (ii.gt.nres .and. iabs(itype(iii,1)).eq.1 .and. &
5049 iabs(itype(jjj,1)).eq.1) then
5050 call ssbond_ene(iii,jjj,eij)
5052 !d write (iout,*) "eij",eij
5054 else if (ii.gt.nres .and. jj.gt.nres) then
5055 !c Restraints from contact prediction
5057 if (constr_dist.eq.11) then
5058 ehpb=ehpb+fordepth(i)**4.0d0 &
5059 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5060 fac=fordepth(i)**4.0d0 &
5061 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5062 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
5065 if (dhpb1(i).gt.0.0d0) then
5066 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5067 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5068 !c write (iout,*) "beta nmr",
5069 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5073 !C Get the force constant corresponding to this distance.
5075 !C Calculate the contribution to energy.
5076 ehpb=ehpb+waga*rdis*rdis
5077 !c write (iout,*) "beta reg",dd,waga*rdis*rdis
5079 !C Evaluate gradient.
5085 ggg(j)=fac*(c(j,jj)-c(j,ii))
5088 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5089 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5092 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5093 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5097 if (constr_dist.eq.11) then
5098 ehpb=ehpb+fordepth(i)**4.0d0 &
5099 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5100 fac=fordepth(i)**4.0d0 &
5101 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5102 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
5105 if (dhpb1(i).gt.0.0d0) then
5106 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5107 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5108 !c write (iout,*) "alph nmr",
5109 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5112 !C Get the force constant corresponding to this distance.
5114 !C Calculate the contribution to energy.
5115 ehpb=ehpb+waga*rdis*rdis
5116 !c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5118 !C Evaluate gradient.
5125 ggg(j)=fac*(c(j,jj)-c(j,ii))
5127 !cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5128 !C If this is a SC-SC distance, we need to calculate the contributions to the
5129 !C Cartesian gradient in the SC vectors (ghpbx).
5132 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5133 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5136 !cgrad do j=iii,jjj-1
5138 !cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5142 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5143 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5147 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5151 !-----------------------------------------------------------------------------
5152 subroutine ssbond_ene(i,j,eij)
5154 ! Calculate the distance and angle dependent SS-bond potential energy
5155 ! using a free-energy function derived based on RHF/6-31G** ab initio
5156 ! calculations of diethyl disulfide.
5158 ! A. Liwo and U. Kozlowska, 11/24/03
5160 ! implicit real*8 (a-h,o-z)
5161 ! include 'DIMENSIONS'
5162 ! include 'COMMON.SBRIDGE'
5163 ! include 'COMMON.CHAIN'
5164 ! include 'COMMON.DERIV'
5165 ! include 'COMMON.LOCAL'
5166 ! include 'COMMON.INTERACT'
5167 ! include 'COMMON.VAR'
5168 ! include 'COMMON.IOUNITS'
5169 real(kind=8),dimension(3) :: erij,dcosom1,dcosom2,gg
5171 integer :: i,j,itypi,itypj,k
5172 real(kind=8) :: eij,rij,rrij,xi,yi,zi,dxi,dyi,dzi,dsci_inv,&
5173 xj,yj,zj,dxj,dyj,dzj,om1,om2,om12,deltad,dscj_inv,&
5174 deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,&
5177 itypi=iabs(itype(i,1))
5181 dxi=dc_norm(1,nres+i)
5182 dyi=dc_norm(2,nres+i)
5183 dzi=dc_norm(3,nres+i)
5184 ! dsci_inv=dsc_inv(itypi)
5185 dsci_inv=vbld_inv(nres+i)
5186 itypj=iabs(itype(j,1))
5187 ! dscj_inv=dsc_inv(itypj)
5188 dscj_inv=vbld_inv(nres+j)
5192 dxj=dc_norm(1,nres+j)
5193 dyj=dc_norm(2,nres+j)
5194 dzj=dc_norm(3,nres+j)
5195 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5200 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5201 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5202 om12=dxi*dxj+dyi*dyj+dzi*dzj
5204 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5205 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5211 deltat12=om2-om1+2.0d0
5213 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
5214 +akct*deltad*deltat12 &
5215 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5216 ! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5217 ! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5218 ! & " deltat12",deltat12," eij",eij
5219 ed=2*akcm*deltad+akct*deltat12
5221 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5222 eom1=-2*akth*deltat1-pom1-om2*pom2
5223 eom2= 2*akth*deltat2+pom1-om1*pom2
5226 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5227 ghpbx(k,i)=ghpbx(k,i)-ggk &
5228 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
5229 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5230 ghpbx(k,j)=ghpbx(k,j)+ggk &
5231 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
5232 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5233 ghpbc(k,i)=ghpbc(k,i)-ggk
5234 ghpbc(k,j)=ghpbc(k,j)+ggk
5237 ! Calculate the components of the gradient in DC and X
5241 !grad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5245 end subroutine ssbond_ene
5246 !-----------------------------------------------------------------------------
5247 subroutine ebond(estr)
5249 ! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5251 ! implicit real*8 (a-h,o-z)
5252 ! include 'DIMENSIONS'
5253 ! include 'COMMON.LOCAL'
5254 ! include 'COMMON.GEO'
5255 ! include 'COMMON.INTERACT'
5256 ! include 'COMMON.DERIV'
5257 ! include 'COMMON.VAR'
5258 ! include 'COMMON.CHAIN'
5259 ! include 'COMMON.IOUNITS'
5260 ! include 'COMMON.NAMES'
5261 ! include 'COMMON.FFIELD'
5262 ! include 'COMMON.CONTROL'
5263 ! include 'COMMON.SETUP'
5264 real(kind=8),dimension(3) :: u,ud
5266 integer :: i,j,iti,nbi,k
5267 real(kind=8) :: estr,estr1,diff,uprod,usum,usumsqder,&
5272 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
5273 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
5275 do i=ibondp_start,ibondp_end
5276 if (itype(i-1,1).eq.ntyp1 .and. itype(i,1).eq.ntyp1) cycle
5277 if (itype(i-1,1).eq.ntyp1 .or. itype(i,1).eq.ntyp1) then
5278 !C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5280 !C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) &
5281 !C *dc(j,i-1)/vbld(i)
5283 !C if (energy_dec) write(iout,*) &
5284 !C "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5285 diff = vbld(i)-vbldpDUM
5287 diff = vbld(i)-vbldp0
5289 if (energy_dec) write (iout,'(a7,i5,4f7.3)') &
5290 "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5293 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5295 ! write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5298 estr=0.5d0*AKP*estr+estr1
5299 ! print *,"estr_bb",estr,AKP
5301 ! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5303 do i=ibond_start,ibond_end
5304 iti=iabs(itype(i,1))
5305 if (iti.eq.0) print *,"WARNING WRONG SETTTING",i
5306 if (iti.ne.10 .and. iti.ne.ntyp1) then
5309 diff=vbld(i+nres)-vbldsc0(1,iti)
5310 if (energy_dec) write (iout,*) &
5311 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5312 AKSC(1,iti),AKSC(1,iti)*diff*diff
5313 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5314 ! print *,"estr_sc",estr
5316 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5320 diff=vbld(i+nres)-vbldsc0(j,iti)
5321 ud(j)=aksc(j,iti)*diff
5322 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5336 uprod2=uprod2*u(k)*u(k)
5340 usumsqder=usumsqder+ud(j)*uprod2
5342 estr=estr+uprod/usum
5343 ! print *,"estr_sc",estr,i
5345 if (energy_dec) write (iout,*) &
5346 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5347 AKSC(1,iti),uprod/usum
5349 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5355 end subroutine ebond
5357 !-----------------------------------------------------------------------------
5358 subroutine ebend(etheta)
5360 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5361 ! angles gamma and its derivatives in consecutive thetas and gammas.
5364 ! implicit real*8 (a-h,o-z)
5365 ! include 'DIMENSIONS'
5366 ! include 'COMMON.LOCAL'
5367 ! include 'COMMON.GEO'
5368 ! include 'COMMON.INTERACT'
5369 ! include 'COMMON.DERIV'
5370 ! include 'COMMON.VAR'
5371 ! include 'COMMON.CHAIN'
5372 ! include 'COMMON.IOUNITS'
5373 ! include 'COMMON.NAMES'
5374 ! include 'COMMON.FFIELD'
5375 ! include 'COMMON.CONTROL'
5376 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5377 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5378 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5380 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5381 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5382 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5384 integer :: i,k,ichir1,ichir2,itype1,ichir11,ichir12,itype2,&
5386 real(kind=8) :: etheta,delta,ss,ssd,phii,phii1,thet_pred_mean,&
5387 athetk,bthetk,dthett,dthetg1,dthetg2,f0,fprim0,E_tc0,fprim_tc0,&
5388 f1,fprim1,E_tc1,ethetai,E_theta,E_tc
5389 real(kind=8),dimension(2) :: y,z
5392 ! time11=dexp(-2*time)
5395 ! write (*,'(a,i2)') 'EBEND ICG=',icg
5396 do i=ithet_start,ithet_end
5397 if (itype(i-1,1).eq.ntyp1) cycle
5398 ! Zero the energy function and its derivative at 0 or pi.
5399 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5401 ichir1=isign(1,itype(i-2,1))
5402 ichir2=isign(1,itype(i,1))
5403 if (itype(i-2,1).eq.10) ichir1=isign(1,itype(i-1,1))
5404 if (itype(i,1).eq.10) ichir2=isign(1,itype(i-1,1))
5405 if (itype(i-1,1).eq.10) then
5406 itype1=isign(10,itype(i-2,1))
5407 ichir11=isign(1,itype(i-2,1))
5408 ichir12=isign(1,itype(i-2,1))
5409 itype2=isign(10,itype(i,1))
5410 ichir21=isign(1,itype(i,1))
5411 ichir22=isign(1,itype(i,1))
5414 if (i.gt.3 .and. itype(i-2,1).ne.ntyp1) then
5417 if (phii.ne.phii) phii=150.0
5427 if (i.lt.nres .and. itype(i,1).ne.ntyp1) then
5430 if (phii1.ne.phii1) phii1=150.0
5442 ! Calculate the "mean" value of theta from the part of the distribution
5443 ! dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5444 ! In following comments this theta will be referred to as t_c.
5445 thet_pred_mean=0.0d0
5447 athetk=athet(k,it,ichir1,ichir2)
5448 bthetk=bthet(k,it,ichir1,ichir2)
5450 athetk=athet(k,itype1,ichir11,ichir12)
5451 bthetk=bthet(k,itype2,ichir21,ichir22)
5453 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5455 dthett=thet_pred_mean*ssd
5456 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5457 ! Derivatives of the "mean" values in gamma1 and gamma2.
5458 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) &
5459 +athet(2,it,ichir1,ichir2)*y(1))*ss
5460 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) &
5461 +bthet(2,it,ichir1,ichir2)*z(1))*ss
5463 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) &
5464 +athet(2,itype1,ichir11,ichir12)*y(1))*ss
5465 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) &
5466 +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5468 if (theta(i).gt.pi-delta) then
5469 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,&
5471 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5472 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5473 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,&
5475 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,&
5477 else if (theta(i).lt.delta) then
5478 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5479 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5480 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,&
5482 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5483 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,&
5486 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,&
5489 etheta=etheta+ethetai
5490 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5492 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5493 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5494 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
5496 ! print *,ithetaconstr_start,ithetaconstr_end,"TU"
5498 ! Ufff.... We've done all this!!!
5500 end subroutine ebend
5501 !-----------------------------------------------------------------------------
5502 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
5505 ! implicit real*8 (a-h,o-z)
5506 ! include 'DIMENSIONS'
5507 ! include 'COMMON.LOCAL'
5508 ! include 'COMMON.IOUNITS'
5509 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5510 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5511 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5513 real(kind=8) :: thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc
5515 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5516 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5517 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5519 real(kind=8) :: sig,fac,escloci0,escloci1,esclocbi0,dersc12,&
5520 esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5522 ! Calculate the contributions to both Gaussian lobes.
5523 ! 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5524 ! The "polynomial part" of the "standard deviation" of this part of
5528 sig=sig*thet_pred_mean+polthet(j,it)
5530 ! Derivative of the "interior part" of the "standard deviation of the"
5531 ! gamma-dependent Gaussian lobe in t_c.
5532 sigtc=3*polthet(3,it)
5534 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5537 ! Set the parameters of both Gaussian lobes of the distribution.
5538 ! "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5539 fac=sig*sig+sigc0(it)
5542 ! Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5543 sigsqtc=-4.0D0*sigcsq*sigtc
5544 ! print *,i,sig,sigtc,sigsqtc
5545 ! Following variable (sigtc) is d[sigma(t_c)]/dt_c
5546 sigtc=-sigtc/(fac*fac)
5547 ! Following variable is sigma(t_c)**(-2)
5548 sigcsq=sigcsq*sigcsq
5550 sig0inv=1.0D0/sig0i**2
5551 delthec=thetai-thet_pred_mean
5552 delthe0=thetai-theta0i
5553 term1=-0.5D0*sigcsq*delthec*delthec
5554 term2=-0.5D0*sig0inv*delthe0*delthe0
5555 ! Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5556 ! NaNs in taking the logarithm. We extract the largest exponent which is added
5557 ! to the energy (this being the log of the distribution) at the end of energy
5558 ! term evaluation for this virtual-bond angle.
5559 if (term1.gt.term2) then
5561 term2=dexp(term2-termm)
5565 term1=dexp(term1-termm)
5568 ! The ratio between the gamma-independent and gamma-dependent lobes of
5569 ! the distribution is a Gaussian function of thet_pred_mean too.
5570 diffak=gthet(2,it)-thet_pred_mean
5571 ratak=diffak/gthet(3,it)**2
5572 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5573 ! Let's differentiate it in thet_pred_mean NOW.
5575 ! Now put together the distribution terms to make complete distribution.
5576 termexp=term1+ak*term2
5577 termpre=sigc+ak*sig0i
5578 ! Contribution of the bending energy from this theta is just the -log of
5579 ! the sum of the contributions from the two lobes and the pre-exponential
5580 ! factor. Simple enough, isn't it?
5581 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5582 ! NOW the derivatives!!!
5583 ! 6/6/97 Take into account the deformation.
5584 E_theta=(delthec*sigcsq*term1 &
5585 +ak*delthe0*sig0inv*term2)/termexp
5586 E_tc=((sigtc+aktc*sig0i)/termpre &
5587 -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ &
5588 aktc*term2)/termexp)
5590 end subroutine theteng
5592 !-----------------------------------------------------------------------------
5593 subroutine ebend(etheta,ethetacnstr)
5595 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5596 ! angles gamma and its derivatives in consecutive thetas and gammas.
5597 ! ab initio-derived potentials from
5598 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5600 ! implicit real*8 (a-h,o-z)
5601 ! include 'DIMENSIONS'
5602 ! include 'COMMON.LOCAL'
5603 ! include 'COMMON.GEO'
5604 ! include 'COMMON.INTERACT'
5605 ! include 'COMMON.DERIV'
5606 ! include 'COMMON.VAR'
5607 ! include 'COMMON.CHAIN'
5608 ! include 'COMMON.IOUNITS'
5609 ! include 'COMMON.NAMES'
5610 ! include 'COMMON.FFIELD'
5611 ! include 'COMMON.CONTROL'
5612 real(kind=8),dimension(nntheterm) :: coskt,sinkt !mmaxtheterm
5613 real(kind=8),dimension(nsingle) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
5614 real(kind=8),dimension(ndouble,ndouble) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
5615 logical :: lprn=.false., lprn1=.false.
5617 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
5618 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
5619 real(kind=8) :: aux,etheta,ccl,ssl,scl,csl,ethetacnstr
5620 ! local variables for constrains
5621 real(kind=8) :: difi,thetiii
5625 do i=ithet_start,ithet_end
5626 if (itype(i-1,1).eq.ntyp1) cycle
5627 if (itype(i-2,1).eq.ntyp1.or.itype(i,1).eq.ntyp1) cycle
5628 if (iabs(itype(i+1,1)).eq.20) iblock=2
5629 if (iabs(itype(i+1,1)).ne.20) iblock=1
5633 theti2=0.5d0*theta(i)
5634 ityp2=ithetyp((itype(i-1,1)))
5636 coskt(k)=dcos(k*theti2)
5637 sinkt(k)=dsin(k*theti2)
5639 if (i.gt.3 .and. itype(max0(i-3,1),1).ne.ntyp1) then
5642 if (phii.ne.phii) phii=150.0
5646 ityp1=ithetyp((itype(i-2,1)))
5647 ! propagation of chirality for glycine type
5649 cosph1(k)=dcos(k*phii)
5650 sinph1(k)=dsin(k*phii)
5654 ityp1=ithetyp(itype(i-2,1))
5660 if (i.lt.nres .and. itype(i+1,1).ne.ntyp1) then
5663 if (phii1.ne.phii1) phii1=150.0
5668 ityp3=ithetyp((itype(i,1)))
5670 cosph2(k)=dcos(k*phii1)
5671 sinph2(k)=dsin(k*phii1)
5675 ityp3=ithetyp(itype(i,1))
5681 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5684 ccl=cosph1(l)*cosph2(k-l)
5685 ssl=sinph1(l)*sinph2(k-l)
5686 scl=sinph1(l)*cosph2(k-l)
5687 csl=cosph1(l)*sinph2(k-l)
5688 cosph1ph2(l,k)=ccl-ssl
5689 cosph1ph2(k,l)=ccl+ssl
5690 sinph1ph2(l,k)=scl+csl
5691 sinph1ph2(k,l)=scl-csl
5695 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
5696 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5697 write (iout,*) "coskt and sinkt"
5699 write (iout,*) k,coskt(k),sinkt(k)
5703 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5704 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) &
5707 write (iout,*) "k",k,&
5708 "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),&
5712 write (iout,*) "cosph and sinph"
5714 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5716 write (iout,*) "cosph1ph2 and sinph2ph2"
5719 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
5720 sinph1ph2(l,k),sinph1ph2(k,l)
5723 write(iout,*) "ethetai",ethetai
5727 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) &
5728 +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) &
5729 +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) &
5730 +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5731 ethetai=ethetai+sinkt(m)*aux
5732 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5733 dephii=dephii+k*sinkt(m)* &
5734 (ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- &
5735 bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5736 dephii1=dephii1+k*sinkt(m)* &
5737 (eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- &
5738 ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5740 write (iout,*) "m",m," k",k," bbthet", &
5741 bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", &
5742 ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", &
5743 ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", &
5744 eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5748 write(iout,*) "ethetai",ethetai
5752 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
5753 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ &
5754 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
5755 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5756 ethetai=ethetai+sinkt(m)*aux
5757 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5758 dephii=dephii+l*sinkt(m)* &
5759 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- &
5760 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
5761 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
5762 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5763 dephii1=dephii1+(k-l)*sinkt(m)* &
5764 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
5765 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
5766 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- &
5767 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5769 write (iout,*) "m",m," k",k," l",l," ffthet",&
5770 ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
5771 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",&
5772 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
5773 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),&
5775 write (iout,*) cosph1ph2(l,k)*sinkt(m),&
5776 cosph1ph2(k,l)*sinkt(m),&
5777 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5785 write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
5786 i,theta(i)*rad2deg,phii*rad2deg,&
5787 phii1*rad2deg,ethetai
5789 etheta=etheta+ethetai
5790 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5792 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5793 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5794 gloc(nphi+i-2,icg)=wang*dethetai
5796 !-----------thete constrains
5797 ! if (tor_mode.ne.2) then
5799 ! print *,ithetaconstr_start,ithetaconstr_end,"TU"
5800 do i=ithetaconstr_start,ithetaconstr_end
5801 itheta=itheta_constr(i)
5802 thetiii=theta(itheta)
5803 difi=pinorm(thetiii-theta_constr0(i))
5804 if (difi.gt.theta_drange(i)) then
5805 difi=difi-theta_drange(i)
5806 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5807 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
5808 +for_thet_constr(i)*difi**3
5809 else if (difi.lt.-drange(i)) then
5811 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5812 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
5813 +for_thet_constr(i)*difi**3
5817 if (energy_dec) then
5818 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc", &
5819 i,itheta,rad2deg*thetiii, &
5820 rad2deg*theta_constr0(i), rad2deg*theta_drange(i), &
5821 rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4, &
5822 gloc(itheta+nphi-2,icg)
5828 end subroutine ebend
5831 !-----------------------------------------------------------------------------
5832 subroutine esc(escloc)
5833 ! Calculate the local energy of a side chain and its derivatives in the
5834 ! corresponding virtual-bond valence angles THETA and the spherical angles
5838 ! implicit real*8 (a-h,o-z)
5839 ! include 'DIMENSIONS'
5840 ! include 'COMMON.GEO'
5841 ! include 'COMMON.LOCAL'
5842 ! include 'COMMON.VAR'
5843 ! include 'COMMON.INTERACT'
5844 ! include 'COMMON.DERIV'
5845 ! include 'COMMON.CHAIN'
5846 ! include 'COMMON.IOUNITS'
5847 ! include 'COMMON.NAMES'
5848 ! include 'COMMON.FFIELD'
5849 ! include 'COMMON.CONTROL'
5850 real(kind=8),dimension(3) :: x,dersc,xemp,dersc0,dersc1,&
5851 ddersc0,ddummy,xtemp,temp
5852 !el real(kind=8) :: time11,time12,time112,theti
5853 real(kind=8) :: escloc,delta
5854 !el integer :: it,nlobit
5855 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5858 real(kind=8) :: escloci0,escloci1,escloci,esclocbi0,&
5859 dersc12,esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5862 ! write (iout,'(a)') 'ESC'
5863 do i=loc_start,loc_end
5865 if (it.eq.ntyp1) cycle
5866 if (it.eq.10) goto 1
5867 nlobit=nlob(iabs(it))
5868 ! print *,'i=',i,' it=',it,' nlobit=',nlobit
5869 ! write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5870 theti=theta(i+1)-pipol
5875 if (x(2).gt.pi-delta) then
5879 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5881 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5882 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),&
5884 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
5885 ddersc0(1),dersc(1))
5886 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),&
5887 ddersc0(3),dersc(3))
5889 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5891 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5892 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,&
5893 dersc0(2),esclocbi,dersc02)
5894 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
5896 call splinthet(x(2),0.5d0*delta,ss,ssd)
5901 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5903 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5904 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5906 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5908 ! write (iout,*) escloci
5909 else if (x(2).lt.delta) then
5913 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5915 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5916 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),&
5918 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
5919 ddersc0(1),dersc(1))
5920 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),&
5921 ddersc0(3),dersc(3))
5923 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5925 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5926 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,&
5927 dersc0(2),esclocbi,dersc02)
5928 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
5933 call splinthet(x(2),0.5d0*delta,ss,ssd)
5935 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5937 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5938 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5940 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5941 ! write (iout,*) escloci
5943 call enesc(x,escloci,dersc,ddummy,.false.)
5946 escloc=escloc+escloci
5947 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5949 ! write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5951 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ &
5953 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5954 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5959 !-----------------------------------------------------------------------------
5960 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5963 ! implicit real*8 (a-h,o-z)
5964 ! include 'DIMENSIONS'
5965 ! include 'COMMON.GEO'
5966 ! include 'COMMON.LOCAL'
5967 ! include 'COMMON.IOUNITS'
5968 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5969 real(kind=8),dimension(3) :: x,z,dersc,ddersc
5970 real(kind=8),dimension(3,nlobit,-1:1) :: Ax !(3,maxlob,-1:1)
5971 real(kind=8),dimension(nlobit,-1:1) :: contr !(maxlob,-1:1)
5972 real(kind=8) :: escloci
5975 integer :: j,iii,l,k !el,it,nlobit
5976 real(kind=8) :: escloc_i,x3,Axk,expfac,emin !el,theti,&
5977 !el time11,time12,time112
5978 ! write (iout,*) 'it=',it,' nlobit=',nlobit
5982 if (mixed) ddersc(j)=0.0d0
5986 ! Because of periodicity of the dependence of the SC energy in omega we have
5987 ! to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5988 ! To avoid underflows, first compute & store the exponents.
5996 z(k)=x(k)-censc(k,j,it)
6001 Axk=Axk+gaussc(l,k,j,it)*z(l)
6007 expfac=expfac+Ax(k,j,iii)*z(k)
6015 ! As in the case of ebend, we want to avoid underflows in exponentiation and
6016 ! subsequent NaNs and INFs in energy calculation.
6017 ! Find the largest exponent
6021 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6025 !d print *,'it=',it,' emin=',emin
6027 ! Compute the contribution to SC energy and derivatives
6032 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6033 if(adexp.ne.adexp) adexp=1.0
6036 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6038 !d print *,'j=',j,' expfac=',expfac
6039 escloc_i=escloc_i+expfac
6041 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6045 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) &
6046 +gaussc(k,2,j,it))*expfac
6053 dersc(1)=dersc(1)/cos(theti)**2
6054 ddersc(1)=ddersc(1)/cos(theti)**2
6057 escloci=-(dlog(escloc_i)-emin)
6059 dersc(j)=dersc(j)/escloc_i
6063 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6067 end subroutine enesc
6068 !-----------------------------------------------------------------------------
6069 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6072 ! implicit real*8 (a-h,o-z)
6073 ! include 'DIMENSIONS'
6074 ! include 'COMMON.GEO'
6075 ! include 'COMMON.LOCAL'
6076 ! include 'COMMON.IOUNITS'
6077 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6078 real(kind=8),dimension(3) :: x,z,dersc
6079 real(kind=8),dimension(3,nlobit) :: Ax !(3,maxlob)
6080 real(kind=8),dimension(nlobit) :: contr !(maxlob)
6081 real(kind=8) :: escloci,dersc12,emin
6084 integer :: j,k,l !el,it,nlobit
6085 real(kind=8) :: escloc_i,Axk,expfac !el,time11,time12,time112,theti
6095 z(k)=x(k)-censc(k,j,it)
6101 Axk=Axk+gaussc(l,k,j,it)*z(l)
6107 expfac=expfac+Ax(k,j)*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
6117 if (emin.gt.contr(j)) emin=contr(j)
6121 ! Compute the contribution to SC energy and derivatives
6125 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6126 escloc_i=escloc_i+expfac
6128 dersc(k)=dersc(k)+Ax(k,j)*expfac
6130 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) &
6131 +gaussc(1,2,j,it))*expfac
6135 dersc(1)=dersc(1)/cos(theti)**2
6136 dersc12=dersc12/cos(theti)**2
6137 escloci=-(dlog(escloc_i)-emin)
6139 dersc(j)=dersc(j)/escloc_i
6141 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6143 end subroutine enesc_bound
6145 !-----------------------------------------------------------------------------
6146 subroutine esc(escloc)
6147 ! Calculate the local energy of a side chain and its derivatives in the
6148 ! corresponding virtual-bond valence angles THETA and the spherical angles
6149 ! ALPHA and OMEGA derived from AM1 all-atom calculations.
6150 ! added by Urszula Kozlowska. 07/11/2007
6153 ! implicit real*8 (a-h,o-z)
6154 ! include 'DIMENSIONS'
6155 ! include 'COMMON.GEO'
6156 ! include 'COMMON.LOCAL'
6157 ! include 'COMMON.VAR'
6158 ! include 'COMMON.SCROT'
6159 ! include 'COMMON.INTERACT'
6160 ! include 'COMMON.DERIV'
6161 ! include 'COMMON.CHAIN'
6162 ! include 'COMMON.IOUNITS'
6163 ! include 'COMMON.NAMES'
6164 ! include 'COMMON.FFIELD'
6165 ! include 'COMMON.CONTROL'
6166 ! include 'COMMON.VECTORS'
6167 real(kind=8),dimension(3) :: x_prime,y_prime,z_prime
6168 real(kind=8),dimension(65) :: x
6169 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1,sumene2,sumene3,&
6170 sumene4,s1,s1_6,s2,s2_6,de_dxx,de_dyy,de_dzz,de_dt
6171 real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
6172 real(kind=8),dimension(3) :: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,dYY_Ci,&
6173 dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
6175 integer :: i,j,k !el,it,nlobit
6176 real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
6177 !el real(kind=8) :: time11,time12,time112,theti
6178 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6179 real(kind=8) :: dscp1,dscp2,pom_s1,pom_s16,pom_s2,pom_s26,&
6180 pom,pom_dx,pom_dy,pom_dt1,pom_dt2,pom1,pom2,&
6181 sumene1x,sumene2x,sumene3x,sumene4x,&
6182 sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,&
6185 real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,&
6186 de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,&
6189 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
6193 do i=loc_start,loc_end
6194 if (itype(i,1).eq.ntyp1) cycle
6195 costtab(i+1) =dcos(theta(i+1))
6196 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6197 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6198 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6199 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6200 cosfac=dsqrt(cosfac2)
6201 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6202 sinfac=dsqrt(sinfac2)
6204 if (it.eq.10) goto 1
6206 ! Compute the axes of tghe local cartesian coordinates system; store in
6207 ! x_prime, y_prime and z_prime
6214 ! write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6215 ! & dc_norm(3,i+nres)
6217 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6218 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6221 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i,1)))
6224 ! write (2,*) "x_prime",(x_prime(j),j=1,3)
6225 ! write (2,*) "y_prime",(y_prime(j),j=1,3)
6226 ! write (2,*) "z_prime",(z_prime(j),j=1,3)
6227 ! write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6228 ! & " xy",scalar(x_prime(1),y_prime(1)),
6229 ! & " xz",scalar(x_prime(1),z_prime(1)),
6230 ! & " yy",scalar(y_prime(1),y_prime(1)),
6231 ! & " yz",scalar(y_prime(1),z_prime(1)),
6232 ! & " zz",scalar(z_prime(1),z_prime(1))
6234 ! Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6235 ! to local coordinate system. Store in xx, yy, zz.
6241 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6242 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6243 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6250 ! Compute the energy of the ith side cbain
6252 ! write (2,*) "xx",xx," yy",yy," zz",zz
6255 x(j) = sc_parmin(j,it)
6258 !c diagnostics - remove later
6260 yy1 = dsin(alph(2))*dcos(omeg(2))
6261 zz1 = -dsign(1.0,dfloat(itype(i,1)))*dsin(alph(2))*dsin(omeg(2))
6262 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
6263 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
6265 !," --- ", xx_w,yy_w,zz_w
6268 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6269 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6271 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6272 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6274 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6275 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6276 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6277 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6278 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6280 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6281 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6282 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6283 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6284 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6286 dsc_i = 0.743d0+x(61)
6288 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6289 *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6290 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6291 *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6292 s1=(1+x(63))/(0.1d0 + dscp1)
6293 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6294 s2=(1+x(65))/(0.1d0 + dscp2)
6295 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6296 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) &
6297 + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6298 ! write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6300 ! & dscp1,dscp2,sumene
6301 ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6302 escloc = escloc + sumene
6303 ! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i,1)
6308 ! This section to check the numerical derivatives of the energy of ith side
6309 ! chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6310 ! #define DEBUG in the code to turn it on.
6312 write (2,*) "sumene =",sumene
6316 write (2,*) xx,yy,zz
6317 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6318 de_dxx_num=(sumenep-sumene)/aincr
6320 write (2,*) "xx+ sumene from enesc=",sumenep
6323 write (2,*) xx,yy,zz
6324 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6325 de_dyy_num=(sumenep-sumene)/aincr
6327 write (2,*) "yy+ sumene from enesc=",sumenep
6330 write (2,*) xx,yy,zz
6331 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6332 de_dzz_num=(sumenep-sumene)/aincr
6334 write (2,*) "zz+ sumene from enesc=",sumenep
6335 costsave=cost2tab(i+1)
6336 sintsave=sint2tab(i+1)
6337 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6338 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6339 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6340 de_dt_num=(sumenep-sumene)/aincr
6341 write (2,*) " t+ sumene from enesc=",sumenep
6342 cost2tab(i+1)=costsave
6343 sint2tab(i+1)=sintsave
6344 ! End of diagnostics section.
6347 ! Compute the gradient of esc
6349 ! zz=zz*dsign(1.0,dfloat(itype(i,1)))
6350 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6351 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6352 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6353 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6354 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6355 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6356 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6357 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6358 pom1=(sumene3*sint2tab(i+1)+sumene1) &
6359 *(pom_s1/dscp1+pom_s16*dscp1**4)
6360 pom2=(sumene4*cost2tab(i+1)+sumene2) &
6361 *(pom_s2/dscp2+pom_s26*dscp2**4)
6362 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6363 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 &
6364 +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) &
6366 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6367 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 &
6368 +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) &
6370 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) &
6371 +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
6374 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i,1)
6377 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6378 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 &
6379 +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) &
6381 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6382 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz &
6383 +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz &
6384 +x(59)*zz**2 +x(60)*xx*zz
6385 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) &
6386 +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
6389 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i,1)
6392 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
6393 +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx &
6394 +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) &
6395 +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) &
6396 +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 &
6397 +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy &
6398 +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
6399 + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6401 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i,1)
6404 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
6405 -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
6406 +pom1*pom_dt1+pom2*pom_dt2
6408 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i,1)
6412 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6413 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6414 cosfac2xx=cosfac2*xx
6415 sinfac2yy=sinfac2*yy
6417 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* &
6419 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* &
6421 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6422 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6423 ! write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6424 ! & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6425 ! write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6426 ! & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6427 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6428 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6429 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6430 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6434 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
6435 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
6436 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
6437 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
6440 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6441 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6442 dZZ_XYZ(k)=vbld_inv(i+nres)* &
6443 (z_prime(k)-zz*dC_norm(k,i+nres))
6445 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6446 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6450 dXX_Ctab(k,i)=dXX_Ci(k)
6451 dXX_C1tab(k,i)=dXX_Ci1(k)
6452 dYY_Ctab(k,i)=dYY_Ci(k)
6453 dYY_C1tab(k,i)=dYY_Ci1(k)
6454 dZZ_Ctab(k,i)=dZZ_Ci(k)
6455 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6456 dXX_XYZtab(k,i)=dXX_XYZ(k)
6457 dYY_XYZtab(k,i)=dYY_XYZ(k)
6458 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6462 ! write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6463 ! & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6464 ! write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6465 ! & dyy_ci(k)," dzz_ci",dzz_ci(k)
6466 ! write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6468 ! write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6469 ! & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6470 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) &
6471 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6472 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) &
6473 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6474 gsclocx(k,i)= de_dxx*dxx_XYZ(k) &
6475 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6477 ! write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6478 ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6480 ! to check gradient call subroutine check_grad
6486 !-----------------------------------------------------------------------------
6487 real(kind=8) function enesc(x,xx,yy,zz,cost2,sint2)
6489 real(kind=8),dimension(65) :: x
6490 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2,sumene3,&
6491 sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6493 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6494 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6496 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6497 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6499 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6500 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6501 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6502 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6503 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6505 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6506 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6507 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6508 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6509 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6511 dsc_i = 0.743d0+x(61)
6513 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6514 *(xx*cost2+yy*sint2))
6515 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6516 *(xx*cost2-yy*sint2))
6517 s1=(1+x(63))/(0.1d0 + dscp1)
6518 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6519 s2=(1+x(65))/(0.1d0 + dscp2)
6520 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6521 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) &
6522 + (sumene4*cost2 +sumene2)*(s2+s2_6)
6527 !-----------------------------------------------------------------------------
6528 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6530 ! This procedure calculates two-body contact function g(rij) and its derivative:
6533 ! g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6536 ! where x=(rij-r0ij)/delta
6538 ! rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6541 real(kind=8) :: rij,r0ij,eps0ij,fcont,fprimcont
6542 real(kind=8) :: x,x2,x4,delta
6546 if (x.lt.-1.0D0) then
6549 else if (x.le.1.0D0) then
6552 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6553 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6559 end subroutine gcont
6560 !-----------------------------------------------------------------------------
6561 subroutine splinthet(theti,delta,ss,ssder)
6562 ! implicit real*8 (a-h,o-z)
6563 ! include 'DIMENSIONS'
6564 ! include 'COMMON.VAR'
6565 ! include 'COMMON.GEO'
6566 real(kind=8) :: theti,delta,ss,ssder
6567 real(kind=8) :: thetup,thetlow
6570 if (theti.gt.pipol) then
6571 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6573 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6577 end subroutine splinthet
6578 !-----------------------------------------------------------------------------
6579 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6581 real(kind=8) :: x,x0,delta,f0,f1,fprim0,f,fprim
6582 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6583 a1=fprim0*delta/(f1-f0)
6589 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6590 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6592 end subroutine spline1
6593 !-----------------------------------------------------------------------------
6594 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6596 real(kind=8) :: x,x0,delta,f0x,f1x,fprim0x,fx
6597 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6602 a2=3*(f1x-f0x)-2*fprim0x*delta
6603 a3=fprim0x*delta-2*(f1x-f0x)
6604 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6606 end subroutine spline2
6607 !-----------------------------------------------------------------------------
6609 !-----------------------------------------------------------------------------
6610 subroutine etor(etors,edihcnstr)
6611 ! implicit real*8 (a-h,o-z)
6612 ! include 'DIMENSIONS'
6613 ! include 'COMMON.VAR'
6614 ! include 'COMMON.GEO'
6615 ! include 'COMMON.LOCAL'
6616 ! include 'COMMON.TORSION'
6617 ! include 'COMMON.INTERACT'
6618 ! include 'COMMON.DERIV'
6619 ! include 'COMMON.CHAIN'
6620 ! include 'COMMON.NAMES'
6621 ! include 'COMMON.IOUNITS'
6622 ! include 'COMMON.FFIELD'
6623 ! include 'COMMON.TORCNSTR'
6624 ! include 'COMMON.CONTROL'
6625 real(kind=8) :: etors,edihcnstr
6629 real(kind=8) :: phii,fac,etors_ii
6631 ! Set lprn=.true. for debugging
6635 do i=iphi_start,iphi_end
6637 if (itype(i-2,1).eq.ntyp1.or. itype(i-1,1).eq.ntyp1 &
6638 .or. itype(i,1).eq.ntyp1) cycle
6639 itori=itortyp(itype(i-2,1))
6640 itori1=itortyp(itype(i-1,1))
6643 ! Proline-Proline pair is a special case...
6644 if (itori.eq.3 .and. itori1.eq.3) then
6645 if (phii.gt.-dwapi3) then
6647 fac=1.0D0/(1.0D0-cosphi)
6648 etorsi=v1(1,3,3)*fac
6649 etorsi=etorsi+etorsi
6650 etors=etors+etorsi-v1(1,3,3)
6651 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6652 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6655 v1ij=v1(j+1,itori,itori1)
6656 v2ij=v2(j+1,itori,itori1)
6659 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6660 if (energy_dec) etors_ii=etors_ii+ &
6661 v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6662 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6666 v1ij=v1(j,itori,itori1)
6667 v2ij=v2(j,itori,itori1)
6670 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6671 if (energy_dec) etors_ii=etors_ii+ &
6672 v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6673 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6676 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6679 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6680 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
6681 (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6682 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6683 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6685 ! 6/20/98 - dihedral angle constraints
6688 itori=idih_constr(i)
6691 if (difi.gt.drange(i)) then
6693 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6694 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6695 else if (difi.lt.-drange(i)) then
6697 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6698 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6700 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6701 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6703 ! write (iout,*) 'edihcnstr',edihcnstr
6706 !-----------------------------------------------------------------------------
6707 subroutine etor_d(etors_d)
6708 real(kind=8) :: etors_d
6711 end subroutine etor_d
6713 !-----------------------------------------------------------------------------
6714 subroutine etor(etors,edihcnstr)
6715 ! implicit real*8 (a-h,o-z)
6716 ! include 'DIMENSIONS'
6717 ! include 'COMMON.VAR'
6718 ! include 'COMMON.GEO'
6719 ! include 'COMMON.LOCAL'
6720 ! include 'COMMON.TORSION'
6721 ! include 'COMMON.INTERACT'
6722 ! include 'COMMON.DERIV'
6723 ! include 'COMMON.CHAIN'
6724 ! include 'COMMON.NAMES'
6725 ! include 'COMMON.IOUNITS'
6726 ! include 'COMMON.FFIELD'
6727 ! include 'COMMON.TORCNSTR'
6728 ! include 'COMMON.CONTROL'
6729 real(kind=8) :: etors,edihcnstr
6732 integer :: i,j,iblock,itori,itori1
6733 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
6734 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
6735 ! Set lprn=.true. for debugging
6739 do i=iphi_start,iphi_end
6740 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
6741 .or. itype(i-3,1).eq.ntyp1 &
6742 .or. itype(i,1).eq.ntyp1) cycle
6744 if (iabs(itype(i,1)).eq.20) then
6749 itori=itortyp(itype(i-2,1))
6750 itori1=itortyp(itype(i-1,1))
6753 ! Regular cosine and sine terms
6754 do j=1,nterm(itori,itori1,iblock)
6755 v1ij=v1(j,itori,itori1,iblock)
6756 v2ij=v2(j,itori,itori1,iblock)
6759 etors=etors+v1ij*cosphi+v2ij*sinphi
6760 if (energy_dec) etors_ii=etors_ii+ &
6761 v1ij*cosphi+v2ij*sinphi
6762 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6766 ! E = SUM ----------------------------------- - v1
6767 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6769 cosphi=dcos(0.5d0*phii)
6770 sinphi=dsin(0.5d0*phii)
6771 do j=1,nlor(itori,itori1,iblock)
6772 vl1ij=vlor1(j,itori,itori1)
6773 vl2ij=vlor2(j,itori,itori1)
6774 vl3ij=vlor3(j,itori,itori1)
6775 pom=vl2ij*cosphi+vl3ij*sinphi
6776 pom1=1.0d0/(pom*pom+1.0d0)
6777 etors=etors+vl1ij*pom1
6778 if (energy_dec) etors_ii=etors_ii+ &
6781 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6783 ! Subtract the constant term
6784 etors=etors-v0(itori,itori1,iblock)
6785 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6786 'etor',i,etors_ii-v0(itori,itori1,iblock)
6788 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6789 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
6790 (v1(j,itori,itori1,iblock),j=1,6),&
6791 (v2(j,itori,itori1,iblock),j=1,6)
6792 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6793 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6795 ! 6/20/98 - dihedral angle constraints
6797 ! do i=1,ndih_constr
6798 do i=idihconstr_start,idihconstr_end
6799 itori=idih_constr(i)
6801 difi=pinorm(phii-phi0(i))
6802 if (difi.gt.drange(i)) then
6804 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6805 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6806 else if (difi.lt.-drange(i)) then
6808 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6809 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6813 !d write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6814 !d & rad2deg*phi0(i), rad2deg*drange(i),
6815 !d & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6817 !d write (iout,*) 'edihcnstr',edihcnstr
6820 !-----------------------------------------------------------------------------
6821 subroutine etor_d(etors_d)
6822 ! 6/23/01 Compute double torsional energy
6823 ! implicit real*8 (a-h,o-z)
6824 ! include 'DIMENSIONS'
6825 ! include 'COMMON.VAR'
6826 ! include 'COMMON.GEO'
6827 ! include 'COMMON.LOCAL'
6828 ! include 'COMMON.TORSION'
6829 ! include 'COMMON.INTERACT'
6830 ! include 'COMMON.DERIV'
6831 ! include 'COMMON.CHAIN'
6832 ! include 'COMMON.NAMES'
6833 ! include 'COMMON.IOUNITS'
6834 ! include 'COMMON.FFIELD'
6835 ! include 'COMMON.TORCNSTR'
6836 real(kind=8) :: etors_d,etors_d_ii
6839 integer :: i,j,k,l,itori,itori1,itori2,iblock
6840 real(kind=8) :: phii,phii1,gloci1,gloci2,&
6841 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
6842 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
6843 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
6844 ! Set lprn=.true. for debugging
6848 ! write(iout,*) "a tu??"
6849 do i=iphid_start,iphid_end
6851 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
6852 .or. itype(i-3,1).eq.ntyp1 &
6853 .or. itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
6854 itori=itortyp(itype(i-2,1))
6855 itori1=itortyp(itype(i-1,1))
6856 itori2=itortyp(itype(i,1))
6862 if (iabs(itype(i+1,1)).eq.20) iblock=2
6864 ! Regular cosine and sine terms
6865 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6866 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6867 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6868 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6869 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6870 cosphi1=dcos(j*phii)
6871 sinphi1=dsin(j*phii)
6872 cosphi2=dcos(j*phii1)
6873 sinphi2=dsin(j*phii1)
6874 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
6875 v2cij*cosphi2+v2sij*sinphi2
6876 if (energy_dec) etors_d_ii=etors_d_ii+ &
6877 v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
6878 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6879 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6881 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6883 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6884 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6885 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6886 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6887 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6888 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6889 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6890 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6891 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
6892 v1sdij*sinphi1p2+v2sdij*sinphi1m2
6893 if (energy_dec) etors_d_ii=etors_d_ii+ &
6894 v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
6895 v1sdij*sinphi1p2+v2sdij*sinphi1m2
6896 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
6897 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6898 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
6899 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6902 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6903 'etor_d',i,etors_d_ii
6904 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6905 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6908 end subroutine etor_d
6910 !-----------------------------------------------------------------------------
6911 subroutine eback_sc_corr(esccor)
6912 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
6913 ! conformational states; temporarily implemented as differences
6914 ! between UNRES torsional potentials (dependent on three types of
6915 ! residues) and the torsional potentials dependent on all 20 types
6916 ! of residues computed from AM1 energy surfaces of terminally-blocked
6917 ! amino-acid residues.
6918 ! implicit real*8 (a-h,o-z)
6919 ! include 'DIMENSIONS'
6920 ! include 'COMMON.VAR'
6921 ! include 'COMMON.GEO'
6922 ! include 'COMMON.LOCAL'
6923 ! include 'COMMON.TORSION'
6924 ! include 'COMMON.SCCOR'
6925 ! include 'COMMON.INTERACT'
6926 ! include 'COMMON.DERIV'
6927 ! include 'COMMON.CHAIN'
6928 ! include 'COMMON.NAMES'
6929 ! include 'COMMON.IOUNITS'
6930 ! include 'COMMON.FFIELD'
6931 ! include 'COMMON.CONTROL'
6932 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
6935 integer :: i,interty,j,isccori,isccori1,intertyp
6936 ! Set lprn=.true. for debugging
6939 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6941 do i=itau_start,itau_end
6942 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1)) cycle
6944 isccori=isccortyp(itype(i-2,1))
6945 isccori1=isccortyp(itype(i-1,1))
6947 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6949 do intertyp=1,3 !intertyp
6951 !c Added 09 May 2012 (Adasko)
6952 !c Intertyp means interaction type of backbone mainchain correlation:
6953 ! 1 = SC...Ca...Ca...Ca
6954 ! 2 = Ca...Ca...Ca...SC
6955 ! 3 = SC...Ca...Ca...SCi
6957 if (((intertyp.eq.3).and.((itype(i-2,1).eq.10).or. &
6958 (itype(i-1,1).eq.10).or.(itype(i-2,1).eq.ntyp1).or. &
6959 (itype(i-1,1).eq.ntyp1))) &
6960 .or. ((intertyp.eq.1).and.((itype(i-2,1).eq.10) &
6961 .or.(itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1) &
6962 .or.(itype(i,1).eq.ntyp1))) &
6963 .or.((intertyp.eq.2).and.((itype(i-1,1).eq.10).or. &
6964 (itype(i-1,1).eq.ntyp1).or.(itype(i-2,1).eq.ntyp1).or. &
6965 (itype(i-3,1).eq.ntyp1)))) cycle
6966 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1,1).eq.ntyp1)) cycle
6967 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres,1).eq.ntyp1)) &
6969 do j=1,nterm_sccor(isccori,isccori1)
6970 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6971 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6972 cosphi=dcos(j*tauangle(intertyp,i))
6973 sinphi=dsin(j*tauangle(intertyp,i))
6974 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
6975 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6976 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6978 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
6979 'esccor',i,intertyp,esccor_ii
6980 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6981 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6983 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6984 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,isccori,isccori1,&
6985 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
6986 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6987 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6992 end subroutine eback_sc_corr
6993 !-----------------------------------------------------------------------------
6994 subroutine multibody(ecorr)
6995 ! This subroutine calculates multi-body contributions to energy following
6996 ! the idea of Skolnick et al. If side chains I and J make a contact and
6997 ! at the same time side chains I+1 and J+1 make a contact, an extra
6998 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6999 ! implicit real*8 (a-h,o-z)
7000 ! include 'DIMENSIONS'
7001 ! include 'COMMON.IOUNITS'
7002 ! include 'COMMON.DERIV'
7003 ! include 'COMMON.INTERACT'
7004 ! include 'COMMON.CONTACTS'
7005 real(kind=8),dimension(3) :: gx,gx1
7007 real(kind=8) :: ecorr
7008 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
7009 ! Set lprn=.true. for debugging
7013 write (iout,'(a)') 'Contact function values:'
7015 write (iout,'(i2,20(1x,i2,f10.5))') &
7016 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7021 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7022 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7034 num_conti=num_cont(i)
7035 num_conti1=num_cont(i1)
7040 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7041 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7042 !d & ' ishift=',ishift
7043 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7044 ! The system gains extra energy.
7045 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7046 endif ! j1==j+-ishift
7054 end subroutine multibody
7055 !-----------------------------------------------------------------------------
7056 real(kind=8) function esccorr(i,j,k,l,jj,kk)
7057 ! implicit real*8 (a-h,o-z)
7058 ! include 'DIMENSIONS'
7059 ! include 'COMMON.IOUNITS'
7060 ! include 'COMMON.DERIV'
7061 ! include 'COMMON.INTERACT'
7062 ! include 'COMMON.CONTACTS'
7063 real(kind=8),dimension(3) :: gx,gx1
7065 integer :: i,j,k,l,jj,kk,m,ll
7066 real(kind=8) :: eij,ekl
7070 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7071 ! Calculate the multi-body contribution to energy.
7072 ! Calculate multi-body contributions to the gradient.
7073 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7074 !d & k,l,(gacont(m,kk,k),m=1,3)
7076 gx(m) =ekl*gacont(m,jj,i)
7077 gx1(m)=eij*gacont(m,kk,k)
7078 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7079 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7080 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7081 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7085 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7090 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7095 end function esccorr
7096 !-----------------------------------------------------------------------------
7097 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7098 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7099 ! implicit real*8 (a-h,o-z)
7100 ! include 'DIMENSIONS'
7101 ! include 'COMMON.IOUNITS'
7104 ! integer :: maxconts !max_cont=maxconts =nres/4
7105 integer,parameter :: max_dim=26
7106 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7107 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7108 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7109 !el common /przechowalnia/ zapas
7110 integer :: status(MPI_STATUS_SIZE)
7111 integer,dimension((nres/4)*2) :: req !maxconts*2
7112 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
7114 ! include 'COMMON.SETUP'
7115 ! include 'COMMON.FFIELD'
7116 ! include 'COMMON.DERIV'
7117 ! include 'COMMON.INTERACT'
7118 ! include 'COMMON.CONTACTS'
7119 ! include 'COMMON.CONTROL'
7120 ! include 'COMMON.LOCAL'
7121 real(kind=8),dimension(3) :: gx,gx1
7122 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
7123 logical :: lprn,ldone
7125 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
7126 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
7128 ! Set lprn=.true. for debugging
7132 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7135 if (nfgtasks.le.1) goto 30
7137 write (iout,'(a)') 'Contact function values before RECEIVE:'
7139 write (iout,'(2i3,50(1x,i2,f5.2))') &
7140 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7145 do i=1,ntask_cont_from
7148 do i=1,ntask_cont_to
7151 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7153 ! Make the list of contacts to send to send to other procesors
7154 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7156 do i=iturn3_start,iturn3_end
7157 ! write (iout,*) "make contact list turn3",i," num_cont",
7159 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7161 do i=iturn4_start,iturn4_end
7162 ! write (iout,*) "make contact list turn4",i," num_cont",
7164 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7168 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7170 do j=1,num_cont_hb(i)
7173 iproc=iint_sent_local(k,jjc,ii)
7174 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7175 if (iproc.gt.0) then
7176 ncont_sent(iproc)=ncont_sent(iproc)+1
7177 nn=ncont_sent(iproc)
7179 zapas(2,nn,iproc)=jjc
7180 zapas(3,nn,iproc)=facont_hb(j,i)
7181 zapas(4,nn,iproc)=ees0p(j,i)
7182 zapas(5,nn,iproc)=ees0m(j,i)
7183 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7184 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7185 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7186 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7187 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7188 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7189 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7190 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7191 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7192 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7193 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7194 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7195 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7196 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7197 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7198 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7199 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7200 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7201 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7202 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7203 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7210 "Numbers of contacts to be sent to other processors",&
7211 (ncont_sent(i),i=1,ntask_cont_to)
7212 write (iout,*) "Contacts sent"
7213 do ii=1,ntask_cont_to
7215 iproc=itask_cont_to(ii)
7216 write (iout,*) nn," contacts to processor",iproc,&
7217 " of CONT_TO_COMM group"
7219 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7227 CorrelID1=nfgtasks+fg_rank+1
7229 ! Receive the numbers of needed contacts from other processors
7230 do ii=1,ntask_cont_from
7231 iproc=itask_cont_from(ii)
7233 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7234 FG_COMM,req(ireq),IERR)
7236 ! write (iout,*) "IRECV ended"
7238 ! Send the number of contacts needed by other processors
7239 do ii=1,ntask_cont_to
7240 iproc=itask_cont_to(ii)
7242 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7243 FG_COMM,req(ireq),IERR)
7245 ! write (iout,*) "ISEND ended"
7246 ! write (iout,*) "number of requests (nn)",ireq
7249 call MPI_Waitall(ireq,req,status_array,ierr)
7251 ! & "Numbers of contacts to be received from other processors",
7252 ! & (ncont_recv(i),i=1,ntask_cont_from)
7256 do ii=1,ntask_cont_from
7257 iproc=itask_cont_from(ii)
7259 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7260 ! & " of CONT_TO_COMM group"
7264 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7265 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7266 ! write (iout,*) "ireq,req",ireq,req(ireq)
7269 ! Send the contacts to processors that need them
7270 do ii=1,ntask_cont_to
7271 iproc=itask_cont_to(ii)
7273 ! write (iout,*) nn," contacts to processor",iproc,
7274 ! & " of CONT_TO_COMM group"
7277 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7278 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7279 ! write (iout,*) "ireq,req",ireq,req(ireq)
7281 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7285 ! write (iout,*) "number of requests (contacts)",ireq
7286 ! write (iout,*) "req",(req(i),i=1,4)
7289 call MPI_Waitall(ireq,req,status_array,ierr)
7290 do iii=1,ntask_cont_from
7291 iproc=itask_cont_from(iii)
7294 write (iout,*) "Received",nn," contacts from processor",iproc,&
7295 " of CONT_FROM_COMM group"
7298 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7303 ii=zapas_recv(1,i,iii)
7304 ! Flag the received contacts to prevent double-counting
7305 jj=-zapas_recv(2,i,iii)
7306 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7308 nnn=num_cont_hb(ii)+1
7311 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7312 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7313 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7314 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7315 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7316 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7317 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7318 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7319 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7320 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7321 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7322 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7323 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7324 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7325 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7326 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7327 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7328 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7329 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7330 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7331 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7332 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7333 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7334 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7339 write (iout,'(a)') 'Contact function values after receive:'
7341 write (iout,'(2i3,50(1x,i3,f5.2))') &
7342 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7350 write (iout,'(a)') 'Contact function values:'
7352 write (iout,'(2i3,50(1x,i3,f5.2))') &
7353 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7359 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7360 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7361 ! Remove the loop below after debugging !!!
7368 ! Calculate the local-electrostatic correlation terms
7369 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7371 num_conti=num_cont_hb(i)
7372 num_conti1=num_cont_hb(i+1)
7379 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
7380 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
7381 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7382 .or. j.lt.0 .and. j1.gt.0) .and. &
7383 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7384 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7385 ! The system gains extra energy.
7386 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7387 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
7388 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7390 else if (j1.eq.j) then
7391 ! Contacts I-J and I-(J+1) occur simultaneously.
7392 ! The system loses extra energy.
7393 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7398 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7399 ! & ' jj=',jj,' kk=',kk
7401 ! Contacts I-J and (I+1)-J occur simultaneously.
7402 ! The system loses extra energy.
7403 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7409 end subroutine multibody_hb
7410 !-----------------------------------------------------------------------------
7411 subroutine add_hb_contact(ii,jj,itask)
7412 ! implicit real*8 (a-h,o-z)
7413 ! include "DIMENSIONS"
7414 ! include "COMMON.IOUNITS"
7415 ! include "COMMON.CONTACTS"
7416 ! integer,parameter :: maxconts=nres/4
7417 integer,parameter :: max_dim=26
7418 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7419 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7420 ! common /przechowalnia/ zapas
7421 integer :: i,j,ii,jj,iproc,nn,jjc
7422 integer,dimension(4) :: itask
7423 ! write (iout,*) "itask",itask
7426 if (iproc.gt.0) then
7427 do j=1,num_cont_hb(ii)
7429 ! write (iout,*) "i",ii," j",jj," jjc",jjc
7431 ncont_sent(iproc)=ncont_sent(iproc)+1
7432 nn=ncont_sent(iproc)
7433 zapas(1,nn,iproc)=ii
7434 zapas(2,nn,iproc)=jjc
7435 zapas(3,nn,iproc)=facont_hb(j,ii)
7436 zapas(4,nn,iproc)=ees0p(j,ii)
7437 zapas(5,nn,iproc)=ees0m(j,ii)
7438 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7439 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7440 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7441 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7442 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7443 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7444 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7445 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7446 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7447 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7448 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7449 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7450 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7451 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7452 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7453 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7454 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7455 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7456 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7457 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7458 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7465 end subroutine add_hb_contact
7466 !-----------------------------------------------------------------------------
7467 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
7468 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7469 ! implicit real*8 (a-h,o-z)
7470 ! include 'DIMENSIONS'
7471 ! include 'COMMON.IOUNITS'
7472 integer,parameter :: max_dim=70
7475 ! integer :: maxconts !max_cont=maxconts=nres/4
7476 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7477 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7478 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7479 ! common /przechowalnia/ zapas
7480 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
7481 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
7484 ! include 'COMMON.SETUP'
7485 ! include 'COMMON.FFIELD'
7486 ! include 'COMMON.DERIV'
7487 ! include 'COMMON.LOCAL'
7488 ! include 'COMMON.INTERACT'
7489 ! include 'COMMON.CONTACTS'
7490 ! include 'COMMON.CHAIN'
7491 ! include 'COMMON.CONTROL'
7492 real(kind=8),dimension(3) :: gx,gx1
7493 integer,dimension(nres) :: num_cont_hb_old
7494 logical :: lprn,ldone
7495 !EL double precision eello4,eello5,eelo6,eello_turn6
7496 !EL external eello4,eello5,eello6,eello_turn6
7498 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
7499 j1,jp1,i1,num_conti1
7500 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
7501 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
7503 ! Set lprn=.true. for debugging
7508 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7510 num_cont_hb_old(i)=num_cont_hb(i)
7514 if (nfgtasks.le.1) goto 30
7516 write (iout,'(a)') 'Contact function values before RECEIVE:'
7518 write (iout,'(2i3,50(1x,i2,f5.2))') &
7519 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7524 do i=1,ntask_cont_from
7527 do i=1,ntask_cont_to
7530 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7532 ! Make the list of contacts to send to send to other procesors
7533 do i=iturn3_start,iturn3_end
7534 ! write (iout,*) "make contact list turn3",i," num_cont",
7536 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7538 do i=iturn4_start,iturn4_end
7539 ! write (iout,*) "make contact list turn4",i," num_cont",
7541 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7545 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7547 do j=1,num_cont_hb(i)
7550 iproc=iint_sent_local(k,jjc,ii)
7551 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7552 if (iproc.ne.0) then
7553 ncont_sent(iproc)=ncont_sent(iproc)+1
7554 nn=ncont_sent(iproc)
7556 zapas(2,nn,iproc)=jjc
7557 zapas(3,nn,iproc)=d_cont(j,i)
7561 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7566 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7574 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7585 "Numbers of contacts to be sent to other processors",&
7586 (ncont_sent(i),i=1,ntask_cont_to)
7587 write (iout,*) "Contacts sent"
7588 do ii=1,ntask_cont_to
7590 iproc=itask_cont_to(ii)
7591 write (iout,*) nn," contacts to processor",iproc,&
7592 " of CONT_TO_COMM group"
7594 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7602 CorrelID1=nfgtasks+fg_rank+1
7604 ! Receive the numbers of needed contacts from other processors
7605 do ii=1,ntask_cont_from
7606 iproc=itask_cont_from(ii)
7608 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7609 FG_COMM,req(ireq),IERR)
7611 ! write (iout,*) "IRECV ended"
7613 ! Send the number of contacts needed by other processors
7614 do ii=1,ntask_cont_to
7615 iproc=itask_cont_to(ii)
7617 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7618 FG_COMM,req(ireq),IERR)
7620 ! write (iout,*) "ISEND ended"
7621 ! write (iout,*) "number of requests (nn)",ireq
7624 call MPI_Waitall(ireq,req,status_array,ierr)
7626 ! & "Numbers of contacts to be received from other processors",
7627 ! & (ncont_recv(i),i=1,ntask_cont_from)
7631 do ii=1,ntask_cont_from
7632 iproc=itask_cont_from(ii)
7634 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7635 ! & " of CONT_TO_COMM group"
7639 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7640 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7641 ! write (iout,*) "ireq,req",ireq,req(ireq)
7644 ! Send the contacts to processors that need them
7645 do ii=1,ntask_cont_to
7646 iproc=itask_cont_to(ii)
7648 ! write (iout,*) nn," contacts to processor",iproc,
7649 ! & " of CONT_TO_COMM group"
7652 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7653 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7654 ! write (iout,*) "ireq,req",ireq,req(ireq)
7656 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7660 ! write (iout,*) "number of requests (contacts)",ireq
7661 ! write (iout,*) "req",(req(i),i=1,4)
7664 call MPI_Waitall(ireq,req,status_array,ierr)
7665 do iii=1,ntask_cont_from
7666 iproc=itask_cont_from(iii)
7669 write (iout,*) "Received",nn," contacts from processor",iproc,&
7670 " of CONT_FROM_COMM group"
7673 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7678 ii=zapas_recv(1,i,iii)
7679 ! Flag the received contacts to prevent double-counting
7680 jj=-zapas_recv(2,i,iii)
7681 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7683 nnn=num_cont_hb(ii)+1
7686 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7690 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7695 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7703 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7712 write (iout,'(a)') 'Contact function values after receive:'
7714 write (iout,'(2i3,50(1x,i3,5f6.3))') &
7715 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
7716 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7723 write (iout,'(a)') 'Contact function values:'
7725 write (iout,'(2i3,50(1x,i2,5f6.3))') &
7726 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
7727 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7734 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7735 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7736 ! Remove the loop below after debugging !!!
7743 ! Calculate the dipole-dipole interaction energies
7744 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7745 do i=iatel_s,iatel_e+1
7746 num_conti=num_cont_hb(i)
7755 ! Calculate the local-electrostatic correlation terms
7756 ! write (iout,*) "gradcorr5 in eello5 before loop"
7758 ! write (iout,'(i5,3f10.5)')
7759 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7761 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7762 ! write (iout,*) "corr loop i",i
7764 num_conti=num_cont_hb(i)
7765 num_conti1=num_cont_hb(i+1)
7772 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7773 ! & ' jj=',jj,' kk=',kk
7774 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
7775 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7776 .or. j.lt.0 .and. j1.gt.0) .and. &
7777 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7778 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7779 ! The system gains extra energy.
7781 sqd1=dsqrt(d_cont(jj,i))
7782 sqd2=dsqrt(d_cont(kk,i1))
7783 sred_geom = sqd1*sqd2
7784 IF (sred_geom.lt.cutoff_corr) THEN
7785 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
7787 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7788 !d & ' jj=',jj,' kk=',kk
7789 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7790 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7792 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7793 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7796 !d write (iout,*) 'sred_geom=',sred_geom,
7797 !d & ' ekont=',ekont,' fprim=',fprimcont,
7798 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7799 !d write (iout,*) "g_contij",g_contij
7800 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7801 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7802 call calc_eello(i,jp,i+1,jp1,jj,kk)
7803 if (wcorr4.gt.0.0d0) &
7804 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7805 if (energy_dec.and.wcorr4.gt.0.0d0) &
7806 write (iout,'(a6,4i5,0pf7.3)') &
7807 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7808 ! write (iout,*) "gradcorr5 before eello5"
7810 ! write (iout,'(i5,3f10.5)')
7811 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7813 if (wcorr5.gt.0.0d0) &
7814 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7815 ! write (iout,*) "gradcorr5 after eello5"
7817 ! write (iout,'(i5,3f10.5)')
7818 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7820 if (energy_dec.and.wcorr5.gt.0.0d0) &
7821 write (iout,'(a6,4i5,0pf7.3)') &
7822 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7823 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7824 !d write(2,*)'ijkl',i,jp,i+1,jp1
7825 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
7826 .or. wturn6.eq.0.0d0))then
7827 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7828 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7829 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
7830 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7831 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7832 !d & 'ecorr6=',ecorr6
7833 !d write (iout,'(4e15.5)') sred_geom,
7834 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7835 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7836 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7837 else if (wturn6.gt.0.0d0 &
7838 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7839 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7840 eturn6=eturn6+eello_turn6(i,jj,kk)
7841 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
7842 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7843 !d write (2,*) 'multibody_eello:eturn6',eturn6
7852 num_cont_hb(i)=num_cont_hb_old(i)
7854 ! write (iout,*) "gradcorr5 in eello5"
7856 ! write (iout,'(i5,3f10.5)')
7857 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7860 end subroutine multibody_eello
7861 !-----------------------------------------------------------------------------
7862 subroutine add_hb_contact_eello(ii,jj,itask)
7863 ! implicit real*8 (a-h,o-z)
7864 ! include "DIMENSIONS"
7865 ! include "COMMON.IOUNITS"
7866 ! include "COMMON.CONTACTS"
7867 ! integer,parameter :: maxconts=nres/4
7868 integer,parameter :: max_dim=70
7869 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7870 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7871 ! common /przechowalnia/ zapas
7873 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
7874 integer,dimension(4) ::itask
7875 ! write (iout,*) "itask",itask
7878 if (iproc.gt.0) then
7879 do j=1,num_cont_hb(ii)
7881 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7883 ncont_sent(iproc)=ncont_sent(iproc)+1
7884 nn=ncont_sent(iproc)
7885 zapas(1,nn,iproc)=ii
7886 zapas(2,nn,iproc)=jjc
7887 zapas(3,nn,iproc)=d_cont(j,ii)
7891 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7896 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7904 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7915 end subroutine add_hb_contact_eello
7916 !-----------------------------------------------------------------------------
7917 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7918 ! implicit real*8 (a-h,o-z)
7919 ! include 'DIMENSIONS'
7920 ! include 'COMMON.IOUNITS'
7921 ! include 'COMMON.DERIV'
7922 ! include 'COMMON.INTERACT'
7923 ! include 'COMMON.CONTACTS'
7924 real(kind=8),dimension(3) :: gx,gx1
7927 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
7928 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
7929 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
7930 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
7941 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7942 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7943 ! Following 4 lines for diagnostics.
7948 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7949 ! & 'Contacts ',i,j,
7950 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7951 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7953 ! Calculate the multi-body contribution to energy.
7954 ! ecorr=ecorr+ekont*ees
7955 ! Calculate multi-body contributions to the gradient.
7956 coeffpees0pij=coeffp*ees0pij
7957 coeffmees0mij=coeffm*ees0mij
7958 coeffpees0pkl=coeffp*ees0pkl
7959 coeffmees0mkl=coeffm*ees0mkl
7961 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7962 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
7963 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
7964 coeffmees0mkl*gacontm_hb1(ll,jj,i))
7965 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
7966 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
7967 coeffmees0mkl*gacontm_hb2(ll,jj,i))
7968 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7969 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
7970 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
7971 coeffmees0mij*gacontm_hb1(ll,kk,k))
7972 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
7973 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
7974 coeffmees0mij*gacontm_hb2(ll,kk,k))
7975 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
7976 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
7977 coeffmees0mkl*gacontm_hb3(ll,jj,i))
7978 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7979 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7980 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
7981 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
7982 coeffmees0mij*gacontm_hb3(ll,kk,k))
7983 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7984 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7985 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7990 !grad gradcorr(ll,m)=gradcorr(ll,m)+
7991 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
7992 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7993 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7998 !grad gradcorr(ll,m)=gradcorr(ll,m)+
7999 !grad & ees*eij*gacont_hbr(ll,kk,k)-
8000 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8001 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8004 ! write (iout,*) "ehbcorr",ekont*ees
8006 if (shield_mode.gt.0) then
8009 !C print *,i,j,fac_shield(i),fac_shield(j),
8010 !C &fac_shield(k),fac_shield(l)
8011 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
8012 (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
8013 do ilist=1,ishield_list(i)
8014 iresshield=shield_list(ilist,i)
8016 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
8017 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8019 +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
8020 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8024 do ilist=1,ishield_list(j)
8025 iresshield=shield_list(ilist,j)
8027 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
8028 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8030 +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
8031 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8036 do ilist=1,ishield_list(k)
8037 iresshield=shield_list(ilist,k)
8039 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
8040 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8042 +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
8043 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8047 do ilist=1,ishield_list(l)
8048 iresshield=shield_list(ilist,l)
8050 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
8051 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8053 +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
8054 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8059 gshieldc_ec(m,i)=gshieldc_ec(m,i)+ &
8060 grad_shield(m,i)*ehbcorr/fac_shield(i)
8061 gshieldc_ec(m,j)=gshieldc_ec(m,j)+ &
8062 grad_shield(m,j)*ehbcorr/fac_shield(j)
8063 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ &
8064 grad_shield(m,i)*ehbcorr/fac_shield(i)
8065 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ &
8066 grad_shield(m,j)*ehbcorr/fac_shield(j)
8068 gshieldc_ec(m,k)=gshieldc_ec(m,k)+ &
8069 grad_shield(m,k)*ehbcorr/fac_shield(k)
8070 gshieldc_ec(m,l)=gshieldc_ec(m,l)+ &
8071 grad_shield(m,l)*ehbcorr/fac_shield(l)
8072 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ &
8073 grad_shield(m,k)*ehbcorr/fac_shield(k)
8074 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ &
8075 grad_shield(m,l)*ehbcorr/fac_shield(l)
8081 end function ehbcorr
8083 !-----------------------------------------------------------------------------
8084 subroutine dipole(i,j,jj)
8085 ! implicit real*8 (a-h,o-z)
8086 ! include 'DIMENSIONS'
8087 ! include 'COMMON.IOUNITS'
8088 ! include 'COMMON.CHAIN'
8089 ! include 'COMMON.FFIELD'
8090 ! include 'COMMON.DERIV'
8091 ! include 'COMMON.INTERACT'
8092 ! include 'COMMON.CONTACTS'
8093 ! include 'COMMON.TORSION'
8094 ! include 'COMMON.VAR'
8095 ! include 'COMMON.GEO'
8096 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
8097 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
8098 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
8100 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
8101 allocate(dipderx(3,5,4,maxconts,nres))
8104 iti1 = itortyp(itype(i+1,1))
8105 if (j.lt.nres-1) then
8106 itj1 = itortyp(itype(j+1,1))
8111 dipi(iii,1)=Ub2(iii,i)
8112 dipderi(iii)=Ub2der(iii,i)
8113 dipi(iii,2)=b1(iii,iti1)
8114 dipj(iii,1)=Ub2(iii,j)
8115 dipderj(iii)=Ub2der(iii,j)
8116 dipj(iii,2)=b1(iii,itj1)
8120 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8123 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8130 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
8134 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8139 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8140 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8142 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8144 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8146 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8149 end subroutine dipole
8151 !-----------------------------------------------------------------------------
8152 subroutine calc_eello(i,j,k,l,jj,kk)
8154 ! This subroutine computes matrices and vectors needed to calculate
8155 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
8158 ! implicit real*8 (a-h,o-z)
8159 ! include 'DIMENSIONS'
8160 ! include 'COMMON.IOUNITS'
8161 ! include 'COMMON.CHAIN'
8162 ! include 'COMMON.DERIV'
8163 ! include 'COMMON.INTERACT'
8164 ! include 'COMMON.CONTACTS'
8165 ! include 'COMMON.TORSION'
8166 ! include 'COMMON.VAR'
8167 ! include 'COMMON.GEO'
8168 ! include 'COMMON.FFIELD'
8169 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
8170 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
8171 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
8174 !el common /kutas/ lprn
8175 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8176 !d & ' jj=',jj,' kk=',kk
8177 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8178 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8179 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8182 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8183 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8186 call transpose2(aa1(1,1),aa1t(1,1))
8187 call transpose2(aa2(1,1),aa2t(1,1))
8190 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
8191 aa1tder(1,1,lll,kkk))
8192 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
8193 aa2tder(1,1,lll,kkk))
8197 ! parallel orientation of the two CA-CA-CA frames.
8199 iti=itortyp(itype(i,1))
8203 itk1=itortyp(itype(k+1,1))
8204 itj=itortyp(itype(j,1))
8205 if (l.lt.nres-1) then
8206 itl1=itortyp(itype(l+1,1))
8210 ! A1 kernel(j+1) A2T
8212 !d write (iout,'(3f10.5,5x,3f10.5)')
8213 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8215 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8216 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
8217 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8218 ! Following matrices are needed only for 6-th order cumulants
8219 IF (wcorr6.gt.0.0d0) THEN
8220 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8221 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
8222 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8223 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8224 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
8225 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8226 ADtEAderx(1,1,1,1,1,1))
8228 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8229 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
8230 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8231 ADtEA1derx(1,1,1,1,1,1))
8233 ! End 6-th order cumulants
8236 !d write (2,*) 'In calc_eello6'
8238 !d write (2,*) 'iii=',iii
8240 !d write (2,*) 'kkk=',kkk
8242 !d write (2,'(3(2f10.5),5x)')
8243 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8248 call transpose2(EUgder(1,1,k),auxmat(1,1))
8249 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8250 call transpose2(EUg(1,1,k),auxmat(1,1))
8251 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8252 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8256 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8257 EAEAderx(1,1,lll,kkk,iii,1))
8261 ! A1T kernel(i+1) A2
8262 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8263 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
8264 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8265 ! Following matrices are needed only for 6-th order cumulants
8266 IF (wcorr6.gt.0.0d0) THEN
8267 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8268 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
8269 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8270 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8271 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
8272 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8273 ADtEAderx(1,1,1,1,1,2))
8274 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8275 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
8276 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8277 ADtEA1derx(1,1,1,1,1,2))
8279 ! End 6-th order cumulants
8280 call transpose2(EUgder(1,1,l),auxmat(1,1))
8281 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8282 call transpose2(EUg(1,1,l),auxmat(1,1))
8283 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8284 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8288 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8289 EAEAderx(1,1,lll,kkk,iii,2))
8294 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8295 ! They are needed only when the fifth- or the sixth-order cumulants are
8297 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8298 call transpose2(AEA(1,1,1),auxmat(1,1))
8299 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8300 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8301 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8302 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8303 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8304 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8305 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8306 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8307 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8308 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8309 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8310 call transpose2(AEA(1,1,2),auxmat(1,1))
8311 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
8312 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8313 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8314 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8315 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
8316 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8317 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
8318 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
8319 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8320 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8321 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8322 ! Calculate the Cartesian derivatives of the vectors.
8326 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8327 call matvec2(auxmat(1,1),b1(1,iti),&
8328 AEAb1derx(1,lll,kkk,iii,1,1))
8329 call matvec2(auxmat(1,1),Ub2(1,i),&
8330 AEAb2derx(1,lll,kkk,iii,1,1))
8331 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8332 AEAb1derx(1,lll,kkk,iii,2,1))
8333 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8334 AEAb2derx(1,lll,kkk,iii,2,1))
8335 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8336 call matvec2(auxmat(1,1),b1(1,itj),&
8337 AEAb1derx(1,lll,kkk,iii,1,2))
8338 call matvec2(auxmat(1,1),Ub2(1,j),&
8339 AEAb2derx(1,lll,kkk,iii,1,2))
8340 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
8341 AEAb1derx(1,lll,kkk,iii,2,2))
8342 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
8343 AEAb2derx(1,lll,kkk,iii,2,2))
8350 ! Antiparallel orientation of the two CA-CA-CA frames.
8352 iti=itortyp(itype(i,1))
8356 itk1=itortyp(itype(k+1,1))
8357 itl=itortyp(itype(l,1))
8358 itj=itortyp(itype(j,1))
8359 if (j.lt.nres-1) then
8360 itj1=itortyp(itype(j+1,1))
8364 ! A2 kernel(j-1)T A1T
8365 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8366 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
8367 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8368 ! Following matrices are needed only for 6-th order cumulants
8369 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8370 j.eq.i+4 .and. l.eq.i+3)) THEN
8371 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8372 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
8373 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8374 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8375 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
8376 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8377 ADtEAderx(1,1,1,1,1,1))
8378 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8379 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
8380 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8381 ADtEA1derx(1,1,1,1,1,1))
8383 ! End 6-th order cumulants
8384 call transpose2(EUgder(1,1,k),auxmat(1,1))
8385 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8386 call transpose2(EUg(1,1,k),auxmat(1,1))
8387 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8388 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8392 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8393 EAEAderx(1,1,lll,kkk,iii,1))
8397 ! A2T kernel(i+1)T A1
8398 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8399 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
8400 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8401 ! Following matrices are needed only for 6-th order cumulants
8402 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8403 j.eq.i+4 .and. l.eq.i+3)) THEN
8404 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8405 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
8406 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8407 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8408 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
8409 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8410 ADtEAderx(1,1,1,1,1,2))
8411 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8412 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
8413 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8414 ADtEA1derx(1,1,1,1,1,2))
8416 ! End 6-th order cumulants
8417 call transpose2(EUgder(1,1,j),auxmat(1,1))
8418 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8419 call transpose2(EUg(1,1,j),auxmat(1,1))
8420 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8421 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8425 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8426 EAEAderx(1,1,lll,kkk,iii,2))
8431 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8432 ! They are needed only when the fifth- or the sixth-order cumulants are
8434 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
8435 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8436 call transpose2(AEA(1,1,1),auxmat(1,1))
8437 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8438 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8439 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8440 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8441 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8442 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8443 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8444 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8445 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8446 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8447 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8448 call transpose2(AEA(1,1,2),auxmat(1,1))
8449 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
8450 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8451 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8452 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8453 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
8454 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8455 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
8456 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
8457 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8458 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8459 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8460 ! Calculate the Cartesian derivatives of the vectors.
8464 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8465 call matvec2(auxmat(1,1),b1(1,iti),&
8466 AEAb1derx(1,lll,kkk,iii,1,1))
8467 call matvec2(auxmat(1,1),Ub2(1,i),&
8468 AEAb2derx(1,lll,kkk,iii,1,1))
8469 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8470 AEAb1derx(1,lll,kkk,iii,2,1))
8471 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8472 AEAb2derx(1,lll,kkk,iii,2,1))
8473 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8474 call matvec2(auxmat(1,1),b1(1,itl),&
8475 AEAb1derx(1,lll,kkk,iii,1,2))
8476 call matvec2(auxmat(1,1),Ub2(1,l),&
8477 AEAb2derx(1,lll,kkk,iii,1,2))
8478 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
8479 AEAb1derx(1,lll,kkk,iii,2,2))
8480 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
8481 AEAb2derx(1,lll,kkk,iii,2,2))
8489 end subroutine calc_eello
8490 !-----------------------------------------------------------------------------
8491 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
8496 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
8497 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
8498 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
8499 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
8500 integer :: iii,kkk,lll
8503 !el common /kutas/ lprn
8504 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8506 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
8509 !d if (lprn) write (2,*) 'In kernel'
8511 !d if (lprn) write (2,*) 'kkk=',kkk
8513 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
8514 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8516 !d write (2,*) 'lll=',lll
8517 !d write (2,*) 'iii=1'
8519 !d write (2,'(3(2f10.5),5x)')
8520 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8523 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
8524 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8526 !d write (2,*) 'lll=',lll
8527 !d write (2,*) 'iii=2'
8529 !d write (2,'(3(2f10.5),5x)')
8530 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8536 end subroutine kernel
8537 !-----------------------------------------------------------------------------
8538 real(kind=8) function eello4(i,j,k,l,jj,kk)
8539 ! implicit real*8 (a-h,o-z)
8540 ! include 'DIMENSIONS'
8541 ! include 'COMMON.IOUNITS'
8542 ! include 'COMMON.CHAIN'
8543 ! include 'COMMON.DERIV'
8544 ! include 'COMMON.INTERACT'
8545 ! include 'COMMON.CONTACTS'
8546 ! include 'COMMON.TORSION'
8547 ! include 'COMMON.VAR'
8548 ! include 'COMMON.GEO'
8549 real(kind=8),dimension(2,2) :: pizda
8550 real(kind=8),dimension(3) :: ggg1,ggg2
8551 real(kind=8) :: eel4,glongij,glongkl
8552 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
8553 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8557 !d print *,'eello4:',i,j,k,l,jj,kk
8558 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
8559 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
8560 !old eij=facont_hb(jj,i)
8561 !old ekl=facont_hb(kk,k)
8563 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8564 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8565 gcorr_loc(k-1)=gcorr_loc(k-1) &
8566 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8568 gcorr_loc(l-1)=gcorr_loc(l-1) &
8569 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8571 gcorr_loc(j-1)=gcorr_loc(j-1) &
8572 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8577 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
8578 -EAEAderx(2,2,lll,kkk,iii,1)
8579 !d derx(lll,kkk,iii)=0.0d0
8583 !d gcorr_loc(l-1)=0.0d0
8584 !d gcorr_loc(j-1)=0.0d0
8585 !d gcorr_loc(k-1)=0.0d0
8587 !d write (iout,*)'Contacts have occurred for peptide groups',
8588 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
8589 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8590 if (j.lt.nres-1) then
8597 if (l.lt.nres-1) then
8605 !grad ggg1(ll)=eel4*g_contij(ll,1)
8606 !grad ggg2(ll)=eel4*g_contij(ll,2)
8607 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8608 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8609 !grad ghalf=0.5d0*ggg1(ll)
8610 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8611 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8612 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8613 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8614 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8615 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8616 !grad ghalf=0.5d0*ggg2(ll)
8617 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8618 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8619 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8620 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8621 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8622 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8626 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8631 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8636 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8641 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8645 !d write (2,*) iii,gcorr_loc(iii)
8648 !d write (2,*) 'ekont',ekont
8649 !d write (iout,*) 'eello4',ekont*eel4
8652 !-----------------------------------------------------------------------------
8653 real(kind=8) function eello5(i,j,k,l,jj,kk)
8654 ! implicit real*8 (a-h,o-z)
8655 ! include 'DIMENSIONS'
8656 ! include 'COMMON.IOUNITS'
8657 ! include 'COMMON.CHAIN'
8658 ! include 'COMMON.DERIV'
8659 ! include 'COMMON.INTERACT'
8660 ! include 'COMMON.CONTACTS'
8661 ! include 'COMMON.TORSION'
8662 ! include 'COMMON.VAR'
8663 ! include 'COMMON.GEO'
8664 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8665 real(kind=8),dimension(2) :: vv
8666 real(kind=8),dimension(3) :: ggg1,ggg2
8667 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
8668 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
8669 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
8670 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8675 ! /l\ / \ \ / \ / \ / C
8676 ! / \ / \ \ / \ / \ / C
8677 ! j| o |l1 | o | o| o | | o |o C
8678 ! \ |/k\| |/ \| / |/ \| |/ \| C
8679 ! \i/ \ / \ / / \ / \ C
8681 ! (I) (II) (III) (IV) C
8683 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8685 ! Antiparallel chains C
8688 ! /j\ / \ \ / \ / \ / C
8689 ! / \ / \ \ / \ / \ / C
8690 ! j1| o |l | o | o| o | | o |o C
8691 ! \ |/k\| |/ \| / |/ \| |/ \| C
8692 ! \i/ \ / \ / / \ / \ C
8694 ! (I) (II) (III) (IV) C
8696 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8698 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
8700 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8701 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8706 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8708 itk=itortyp(itype(k,1))
8709 itl=itortyp(itype(l,1))
8710 itj=itortyp(itype(j,1))
8715 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8716 !d & eel5_3_num,eel5_4_num)
8720 derx(lll,kkk,iii)=0.0d0
8724 !d eij=facont_hb(jj,i)
8725 !d ekl=facont_hb(kk,k)
8727 !d write (iout,*)'Contacts have occurred for peptide groups',
8728 !d & i,j,' fcont:',eij,' eij',' and ',k,l
8730 ! Contribution from the graph I.
8731 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8732 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8733 call transpose2(EUg(1,1,k),auxmat(1,1))
8734 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8735 vv(1)=pizda(1,1)-pizda(2,2)
8736 vv(2)=pizda(1,2)+pizda(2,1)
8737 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
8738 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8739 ! Explicit gradient in virtual-dihedral angles.
8740 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
8741 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
8742 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8743 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8744 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8745 vv(1)=pizda(1,1)-pizda(2,2)
8746 vv(2)=pizda(1,2)+pizda(2,1)
8747 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8748 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
8749 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8750 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8751 vv(1)=pizda(1,1)-pizda(2,2)
8752 vv(2)=pizda(1,2)+pizda(2,1)
8754 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8755 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
8756 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8758 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8759 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
8760 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8762 ! Cartesian gradient
8766 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
8768 vv(1)=pizda(1,1)-pizda(2,2)
8769 vv(2)=pizda(1,2)+pizda(2,1)
8770 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8771 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
8772 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8778 ! Contribution from graph II
8779 call transpose2(EE(1,1,itk),auxmat(1,1))
8780 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8781 vv(1)=pizda(1,1)+pizda(2,2)
8782 vv(2)=pizda(2,1)-pizda(1,2)
8783 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
8784 -0.5d0*scalar2(vv(1),Ctobr(1,k))
8785 ! Explicit gradient in virtual-dihedral angles.
8786 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8787 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8788 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8789 vv(1)=pizda(1,1)+pizda(2,2)
8790 vv(2)=pizda(2,1)-pizda(1,2)
8792 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8793 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
8794 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8796 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8797 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
8798 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8800 ! Cartesian gradient
8804 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8806 vv(1)=pizda(1,1)+pizda(2,2)
8807 vv(2)=pizda(2,1)-pizda(1,2)
8808 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8809 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
8810 -0.5d0*scalar2(vv(1),Ctobr(1,k))
8818 ! Parallel orientation
8819 ! Contribution from graph III
8820 call transpose2(EUg(1,1,l),auxmat(1,1))
8821 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8822 vv(1)=pizda(1,1)-pizda(2,2)
8823 vv(2)=pizda(1,2)+pizda(2,1)
8824 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
8825 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8826 ! Explicit gradient in virtual-dihedral angles.
8827 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8828 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
8829 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8830 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8831 vv(1)=pizda(1,1)-pizda(2,2)
8832 vv(2)=pizda(1,2)+pizda(2,1)
8833 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8834 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
8835 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8836 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8837 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8838 vv(1)=pizda(1,1)-pizda(2,2)
8839 vv(2)=pizda(1,2)+pizda(2,1)
8840 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8841 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
8842 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8843 ! Cartesian gradient
8847 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
8849 vv(1)=pizda(1,1)-pizda(2,2)
8850 vv(2)=pizda(1,2)+pizda(2,1)
8851 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8852 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
8853 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8858 ! Contribution from graph IV
8860 call transpose2(EE(1,1,itl),auxmat(1,1))
8861 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8862 vv(1)=pizda(1,1)+pizda(2,2)
8863 vv(2)=pizda(2,1)-pizda(1,2)
8864 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
8865 -0.5d0*scalar2(vv(1),Ctobr(1,l))
8866 ! Explicit gradient in virtual-dihedral angles.
8867 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8868 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8869 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8870 vv(1)=pizda(1,1)+pizda(2,2)
8871 vv(2)=pizda(2,1)-pizda(1,2)
8872 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8873 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
8874 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8875 ! Cartesian gradient
8879 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8881 vv(1)=pizda(1,1)+pizda(2,2)
8882 vv(2)=pizda(2,1)-pizda(1,2)
8883 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8884 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
8885 -0.5d0*scalar2(vv(1),Ctobr(1,l))
8890 ! Antiparallel orientation
8891 ! Contribution from graph III
8893 call transpose2(EUg(1,1,j),auxmat(1,1))
8894 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8895 vv(1)=pizda(1,1)-pizda(2,2)
8896 vv(2)=pizda(1,2)+pizda(2,1)
8897 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
8898 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8899 ! Explicit gradient in virtual-dihedral angles.
8900 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8901 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
8902 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8903 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8904 vv(1)=pizda(1,1)-pizda(2,2)
8905 vv(2)=pizda(1,2)+pizda(2,1)
8906 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8907 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
8908 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8909 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8910 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8911 vv(1)=pizda(1,1)-pizda(2,2)
8912 vv(2)=pizda(1,2)+pizda(2,1)
8913 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8914 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
8915 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8916 ! Cartesian gradient
8920 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
8922 vv(1)=pizda(1,1)-pizda(2,2)
8923 vv(2)=pizda(1,2)+pizda(2,1)
8924 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
8925 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
8926 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8931 ! Contribution from graph IV
8933 call transpose2(EE(1,1,itj),auxmat(1,1))
8934 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8935 vv(1)=pizda(1,1)+pizda(2,2)
8936 vv(2)=pizda(2,1)-pizda(1,2)
8937 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
8938 -0.5d0*scalar2(vv(1),Ctobr(1,j))
8939 ! Explicit gradient in virtual-dihedral angles.
8940 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8941 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8942 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8943 vv(1)=pizda(1,1)+pizda(2,2)
8944 vv(2)=pizda(2,1)-pizda(1,2)
8945 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8946 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
8947 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8948 ! Cartesian gradient
8952 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8954 vv(1)=pizda(1,1)+pizda(2,2)
8955 vv(2)=pizda(2,1)-pizda(1,2)
8956 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
8957 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
8958 -0.5d0*scalar2(vv(1),Ctobr(1,j))
8964 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8965 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8966 !d write (2,*) 'ijkl',i,j,k,l
8967 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8968 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
8970 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8971 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8972 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8973 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8974 if (j.lt.nres-1) then
8981 if (l.lt.nres-1) then
8991 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8992 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
8993 ! summed up outside the subrouine as for the other subroutines
8994 ! handling long-range interactions. The old code is commented out
8995 ! with "cgrad" to keep track of changes.
8997 !grad ggg1(ll)=eel5*g_contij(ll,1)
8998 !grad ggg2(ll)=eel5*g_contij(ll,2)
8999 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9000 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9001 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9002 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9003 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9004 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9005 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9006 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9008 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9009 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9010 !grad ghalf=0.5d0*ggg1(ll)
9012 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9013 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9014 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9015 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9016 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9017 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9018 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9019 !grad ghalf=0.5d0*ggg2(ll)
9021 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
9022 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9023 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
9024 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9025 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9026 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9031 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9032 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9037 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9038 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9044 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9049 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9053 !d write (2,*) iii,g_corr5_loc(iii)
9056 !d write (2,*) 'ekont',ekont
9057 !d write (iout,*) 'eello5',ekont*eel5
9060 !-----------------------------------------------------------------------------
9061 real(kind=8) function eello6(i,j,k,l,jj,kk)
9062 ! implicit real*8 (a-h,o-z)
9063 ! include 'DIMENSIONS'
9064 ! include 'COMMON.IOUNITS'
9065 ! include 'COMMON.CHAIN'
9066 ! include 'COMMON.DERIV'
9067 ! include 'COMMON.INTERACT'
9068 ! include 'COMMON.CONTACTS'
9069 ! include 'COMMON.TORSION'
9070 ! include 'COMMON.VAR'
9071 ! include 'COMMON.GEO'
9072 ! include 'COMMON.FFIELD'
9073 real(kind=8),dimension(3) :: ggg1,ggg2
9074 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
9076 real(kind=8) :: gradcorr6ij,gradcorr6kl
9077 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
9078 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9083 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9091 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9092 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9096 derx(lll,kkk,iii)=0.0d0
9100 !d eij=facont_hb(jj,i)
9101 !d ekl=facont_hb(kk,k)
9107 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9108 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9109 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9110 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9111 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9112 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9114 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9115 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9116 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9117 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9118 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9119 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9123 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9125 ! If turn contributions are considered, they will be handled separately.
9126 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9127 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9128 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9129 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9130 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9131 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9132 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9134 if (j.lt.nres-1) then
9141 if (l.lt.nres-1) then
9149 !grad ggg1(ll)=eel6*g_contij(ll,1)
9150 !grad ggg2(ll)=eel6*g_contij(ll,2)
9151 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9152 !grad ghalf=0.5d0*ggg1(ll)
9154 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9155 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9156 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9157 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9158 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9159 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9160 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9161 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9162 !grad ghalf=0.5d0*ggg2(ll)
9163 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9165 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9166 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9167 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9168 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9169 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9170 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9175 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9176 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9181 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9182 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9188 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9193 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9197 !d write (2,*) iii,g_corr6_loc(iii)
9200 !d write (2,*) 'ekont',ekont
9201 !d write (iout,*) 'eello6',ekont*eel6
9204 !-----------------------------------------------------------------------------
9205 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
9207 ! implicit real*8 (a-h,o-z)
9208 ! include 'DIMENSIONS'
9209 ! include 'COMMON.IOUNITS'
9210 ! include 'COMMON.CHAIN'
9211 ! include 'COMMON.DERIV'
9212 ! include 'COMMON.INTERACT'
9213 ! include 'COMMON.CONTACTS'
9214 ! include 'COMMON.TORSION'
9215 ! include 'COMMON.VAR'
9216 ! include 'COMMON.GEO'
9217 real(kind=8),dimension(2) :: vv,vv1
9218 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
9221 !el common /kutas/ lprn
9222 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
9223 real(kind=8) :: s1,s2,s3,s4,s5
9224 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9226 ! Parallel Antiparallel C
9232 ! \ j|/k\| / \ |/k\|l / C
9237 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9238 itk=itortyp(itype(k,1))
9239 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9240 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9241 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9242 call transpose2(EUgC(1,1,k),auxmat(1,1))
9243 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9244 vv1(1)=pizda1(1,1)-pizda1(2,2)
9245 vv1(2)=pizda1(1,2)+pizda1(2,1)
9246 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9247 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
9248 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
9249 s5=scalar2(vv(1),Dtobr2(1,i))
9250 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9251 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9252 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
9253 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
9254 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
9255 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
9256 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
9257 +scalar2(vv(1),Dtobr2der(1,i)))
9258 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9259 vv1(1)=pizda1(1,1)-pizda1(2,2)
9260 vv1(2)=pizda1(1,2)+pizda1(2,1)
9261 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
9262 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
9264 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
9265 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
9266 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
9267 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
9268 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9270 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
9271 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
9272 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
9273 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
9274 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9276 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9277 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9278 vv1(1)=pizda1(1,1)-pizda1(2,2)
9279 vv1(2)=pizda1(1,2)+pizda1(2,1)
9280 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
9281 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
9282 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
9283 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9292 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9293 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9294 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9295 call transpose2(EUgC(1,1,k),auxmat(1,1))
9296 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
9298 vv1(1)=pizda1(1,1)-pizda1(2,2)
9299 vv1(2)=pizda1(1,2)+pizda1(2,1)
9300 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9301 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
9302 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
9303 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
9304 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
9305 s5=scalar2(vv(1),Dtobr2(1,i))
9306 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9311 end function eello6_graph1
9312 !-----------------------------------------------------------------------------
9313 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
9315 ! implicit real*8 (a-h,o-z)
9316 ! include 'DIMENSIONS'
9317 ! include 'COMMON.IOUNITS'
9318 ! include 'COMMON.CHAIN'
9319 ! include 'COMMON.DERIV'
9320 ! include 'COMMON.INTERACT'
9321 ! include 'COMMON.CONTACTS'
9322 ! include 'COMMON.TORSION'
9323 ! include 'COMMON.VAR'
9324 ! include 'COMMON.GEO'
9326 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
9327 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9329 !el common /kutas/ lprn
9330 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
9331 real(kind=8) :: s2,s3,s4
9332 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9334 ! Parallel Antiparallel C
9340 ! \ j|/k\| \ |/k\|l C
9345 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9346 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9347 ! AL 7/4/01 s1 would occur in the sixth-order moment,
9348 ! but not in a cluster cumulant
9350 s1=dip(1,jj,i)*dip(1,kk,k)
9352 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9353 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9354 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9355 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9356 call transpose2(EUg(1,1,k),auxmat(1,1))
9357 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9358 vv(1)=pizda(1,1)-pizda(2,2)
9359 vv(2)=pizda(1,2)+pizda(2,1)
9360 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9361 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9363 eello6_graph2=-(s1+s2+s3+s4)
9365 eello6_graph2=-(s2+s3+s4)
9368 ! Derivatives in gamma(i-1)
9371 s1=dipderg(1,jj,i)*dip(1,kk,k)
9373 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9374 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9375 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9376 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9378 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9380 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9382 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9384 ! Derivatives in gamma(k-1)
9386 s1=dip(1,jj,i)*dipderg(1,kk,k)
9388 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9389 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9390 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9391 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9392 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9393 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9394 vv(1)=pizda(1,1)-pizda(2,2)
9395 vv(2)=pizda(1,2)+pizda(2,1)
9396 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9398 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9400 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9402 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9403 ! Derivatives in gamma(j-1) or gamma(l-1)
9406 s1=dipderg(3,jj,i)*dip(1,kk,k)
9408 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9409 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9410 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9411 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9412 vv(1)=pizda(1,1)-pizda(2,2)
9413 vv(2)=pizda(1,2)+pizda(2,1)
9414 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9417 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9419 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9422 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9423 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9425 ! Derivatives in gamma(l-1) or gamma(j-1)
9428 s1=dip(1,jj,i)*dipderg(3,kk,k)
9430 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9431 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9432 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9433 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9434 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9435 vv(1)=pizda(1,1)-pizda(2,2)
9436 vv(2)=pizda(1,2)+pizda(2,1)
9437 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9440 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9442 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9445 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9446 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9448 ! Cartesian derivatives.
9450 write (2,*) 'In eello6_graph2'
9452 write (2,*) 'iii=',iii
9454 write (2,*) 'kkk=',kkk
9456 write (2,'(3(2f10.5),5x)') &
9457 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9467 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9469 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9472 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
9474 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9475 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
9477 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9478 call transpose2(EUg(1,1,k),auxmat(1,1))
9479 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
9481 vv(1)=pizda(1,1)-pizda(2,2)
9482 vv(2)=pizda(1,2)+pizda(2,1)
9483 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9484 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9486 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9488 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9491 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9493 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9499 end function eello6_graph2
9500 !-----------------------------------------------------------------------------
9501 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
9502 ! implicit real*8 (a-h,o-z)
9503 ! include 'DIMENSIONS'
9504 ! include 'COMMON.IOUNITS'
9505 ! include 'COMMON.CHAIN'
9506 ! include 'COMMON.DERIV'
9507 ! include 'COMMON.INTERACT'
9508 ! include 'COMMON.CONTACTS'
9509 ! include 'COMMON.TORSION'
9510 ! include 'COMMON.VAR'
9511 ! include 'COMMON.GEO'
9512 real(kind=8),dimension(2) :: vv,auxvec
9513 real(kind=8),dimension(2,2) :: pizda,auxmat
9515 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
9516 real(kind=8) :: s1,s2,s3,s4
9517 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9519 ! Parallel Antiparallel C
9525 ! j|/k\| / |/k\|l / C
9530 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9532 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9533 ! energy moment and not to the cluster cumulant.
9534 iti=itortyp(itype(i,1))
9535 if (j.lt.nres-1) then
9536 itj1=itortyp(itype(j+1,1))
9540 itk=itortyp(itype(k,1))
9541 itk1=itortyp(itype(k+1,1))
9542 if (l.lt.nres-1) then
9543 itl1=itortyp(itype(l+1,1))
9548 s1=dip(4,jj,i)*dip(4,kk,k)
9550 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
9551 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9552 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
9553 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9554 call transpose2(EE(1,1,itk),auxmat(1,1))
9555 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9556 vv(1)=pizda(1,1)+pizda(2,2)
9557 vv(2)=pizda(2,1)-pizda(1,2)
9558 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9559 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9560 !d & "sum",-(s2+s3+s4)
9562 eello6_graph3=-(s1+s2+s3+s4)
9564 eello6_graph3=-(s2+s3+s4)
9567 ! Derivatives in gamma(k-1)
9568 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
9569 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9570 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9571 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9572 ! Derivatives in gamma(l-1)
9573 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
9574 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9575 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9576 vv(1)=pizda(1,1)+pizda(2,2)
9577 vv(2)=pizda(2,1)-pizda(1,2)
9578 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9579 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9580 ! Cartesian derivatives.
9586 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9588 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9591 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
9593 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9594 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
9596 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9597 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
9599 vv(1)=pizda(1,1)+pizda(2,2)
9600 vv(2)=pizda(2,1)-pizda(1,2)
9601 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9603 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9605 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9608 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9610 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9612 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9617 end function eello6_graph3
9618 !-----------------------------------------------------------------------------
9619 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9620 ! implicit real*8 (a-h,o-z)
9621 ! include 'DIMENSIONS'
9622 ! include 'COMMON.IOUNITS'
9623 ! include 'COMMON.CHAIN'
9624 ! include 'COMMON.DERIV'
9625 ! include 'COMMON.INTERACT'
9626 ! include 'COMMON.CONTACTS'
9627 ! include 'COMMON.TORSION'
9628 ! include 'COMMON.VAR'
9629 ! include 'COMMON.GEO'
9630 ! include 'COMMON.FFIELD'
9631 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
9632 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9634 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
9636 real(kind=8) :: s1,s2,s3,s4
9637 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9639 ! Parallel Antiparallel C
9645 ! \ j|/k\| \ |/k\|l C
9650 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9652 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9653 ! energy moment and not to the cluster cumulant.
9654 !d write (2,*) 'eello_graph4: wturn6',wturn6
9655 iti=itortyp(itype(i,1))
9656 itj=itortyp(itype(j,1))
9657 if (j.lt.nres-1) then
9658 itj1=itortyp(itype(j+1,1))
9662 itk=itortyp(itype(k,1))
9663 if (k.lt.nres-1) then
9664 itk1=itortyp(itype(k+1,1))
9668 itl=itortyp(itype(l,1))
9669 if (l.lt.nres-1) then
9670 itl1=itortyp(itype(l+1,1))
9674 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9675 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9676 !d & ' itl',itl,' itl1',itl1
9679 s1=dip(3,jj,i)*dip(3,kk,k)
9681 s1=dip(2,jj,j)*dip(2,kk,l)
9684 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9685 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9687 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9688 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9690 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9691 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9693 call transpose2(EUg(1,1,k),auxmat(1,1))
9694 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9695 vv(1)=pizda(1,1)-pizda(2,2)
9696 vv(2)=pizda(2,1)+pizda(1,2)
9697 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9698 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9700 eello6_graph4=-(s1+s2+s3+s4)
9702 eello6_graph4=-(s2+s3+s4)
9704 ! Derivatives in gamma(i-1)
9708 s1=dipderg(2,jj,i)*dip(3,kk,k)
9710 s1=dipderg(4,jj,j)*dip(2,kk,l)
9713 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9715 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9716 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9718 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9719 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9721 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9722 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9723 !d write (2,*) 'turn6 derivatives'
9725 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9727 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9731 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9733 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9737 ! Derivatives in gamma(k-1)
9740 s1=dip(3,jj,i)*dipderg(2,kk,k)
9742 s1=dip(2,jj,j)*dipderg(4,kk,l)
9745 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9746 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9748 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9749 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9751 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9752 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9754 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9755 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9756 vv(1)=pizda(1,1)-pizda(2,2)
9757 vv(2)=pizda(2,1)+pizda(1,2)
9758 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9759 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9761 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9763 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9767 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9769 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9772 ! Derivatives in gamma(j-1) or gamma(l-1)
9773 if (l.eq.j+1 .and. l.gt.1) then
9774 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9775 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9776 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9777 vv(1)=pizda(1,1)-pizda(2,2)
9778 vv(2)=pizda(2,1)+pizda(1,2)
9779 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9780 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9781 else if (j.gt.1) then
9782 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9783 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9784 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9785 vv(1)=pizda(1,1)-pizda(2,2)
9786 vv(2)=pizda(2,1)+pizda(1,2)
9787 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9788 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9789 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9791 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9794 ! Cartesian derivatives.
9801 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9803 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9807 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9809 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9813 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
9815 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9817 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
9818 b1(1,itj1),auxvec(1))
9819 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9821 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
9822 b1(1,itl1),auxvec(1))
9823 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9825 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
9827 vv(1)=pizda(1,1)-pizda(2,2)
9828 vv(2)=pizda(2,1)+pizda(1,2)
9829 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9831 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9833 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
9836 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
9839 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9842 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9844 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9846 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9850 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9852 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9855 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9857 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9864 end function eello6_graph4
9865 !-----------------------------------------------------------------------------
9866 real(kind=8) function eello_turn6(i,jj,kk)
9867 ! implicit real*8 (a-h,o-z)
9868 ! include 'DIMENSIONS'
9869 ! include 'COMMON.IOUNITS'
9870 ! include 'COMMON.CHAIN'
9871 ! include 'COMMON.DERIV'
9872 ! include 'COMMON.INTERACT'
9873 ! include 'COMMON.CONTACTS'
9874 ! include 'COMMON.TORSION'
9875 ! include 'COMMON.VAR'
9876 ! include 'COMMON.GEO'
9877 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
9878 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
9879 real(kind=8),dimension(3) :: ggg1,ggg2
9880 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
9881 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
9882 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9883 ! the respective energy moment and not to the cluster cumulant.
9885 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
9886 integer :: j1,j2,l1,l2,ll
9887 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
9888 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
9897 iti=itortyp(itype(i,1))
9898 itk=itortyp(itype(k,1))
9899 itk1=itortyp(itype(k+1,1))
9900 itl=itortyp(itype(l,1))
9901 itj=itortyp(itype(j,1))
9902 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9903 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
9904 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9909 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9911 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
9915 derx_turn(lll,kkk,iii)=0.0d0
9922 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9924 !d write (2,*) 'eello6_5',eello6_5
9926 call transpose2(AEA(1,1,1),auxmat(1,1))
9927 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9928 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9929 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9931 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9932 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9933 s2 = scalar2(b1(1,itk),vtemp1(1))
9935 call transpose2(AEA(1,1,2),atemp(1,1))
9936 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9937 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9938 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9940 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9941 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9942 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9944 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9945 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9946 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9947 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9948 ss13 = scalar2(b1(1,itk),vtemp4(1))
9949 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9951 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9957 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9958 ! Derivatives in gamma(i+2)
9962 call transpose2(AEA(1,1,1),auxmatd(1,1))
9963 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9964 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9965 call transpose2(AEAderg(1,1,2),atempd(1,1))
9966 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9967 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9969 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9970 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9971 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9977 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9978 ! Derivatives in gamma(i+3)
9980 call transpose2(AEA(1,1,1),auxmatd(1,1))
9981 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9982 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9983 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9985 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9986 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9987 s2d = scalar2(b1(1,itk),vtemp1d(1))
9989 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9990 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9992 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9994 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9995 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9996 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10004 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
10005 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10007 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
10008 -0.5d0*ekont*(s2d+s12d)
10010 ! Derivatives in gamma(i+4)
10011 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10012 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10013 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10015 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10016 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10017 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10025 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10027 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10029 ! Derivatives in gamma(i+5)
10031 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10032 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10033 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10035 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
10036 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10037 s2d = scalar2(b1(1,itk),vtemp1d(1))
10039 call transpose2(AEA(1,1,2),atempd(1,1))
10040 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10041 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10043 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10044 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10046 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10047 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10048 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10056 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
10057 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10059 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
10060 -0.5d0*ekont*(s2d+s12d)
10062 ! Cartesian derivatives
10067 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10068 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10069 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10071 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
10072 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
10074 s2d = scalar2(b1(1,itk),vtemp1d(1))
10076 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10077 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10078 s8d = -(atempd(1,1)+atempd(2,2))* &
10079 scalar2(cc(1,1,itl),vtemp2(1))
10081 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
10083 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10084 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10091 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
10094 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
10098 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
10101 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
10110 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
10112 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10113 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10114 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10115 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10116 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
10118 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10119 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10120 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10124 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10125 !d & 16*eel_turn6_num
10127 if (j.lt.nres-1) then
10134 if (l.lt.nres-1) then
10142 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
10143 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
10144 !grad ghalf=0.5d0*ggg1(ll)
10146 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10147 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10148 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
10149 +ekont*derx_turn(ll,2,1)
10150 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10151 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
10152 +ekont*derx_turn(ll,4,1)
10153 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10154 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10155 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10156 !grad ghalf=0.5d0*ggg2(ll)
10158 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
10159 +ekont*derx_turn(ll,2,2)
10160 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10161 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
10162 +ekont*derx_turn(ll,4,2)
10163 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10164 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10165 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10170 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10175 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10181 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10186 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10190 !d write (2,*) iii,g_corr6_loc(iii)
10192 eello_turn6=ekont*eel_turn6
10193 !d write (2,*) 'ekont',ekont
10194 !d write (2,*) 'eel_turn6',ekont*eel_turn6
10196 end function eello_turn6
10197 !-----------------------------------------------------------------------------
10198 subroutine MATVEC2(A1,V1,V2)
10199 !DIR$ INLINEALWAYS MATVEC2
10201 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10203 ! implicit real*8 (a-h,o-z)
10204 ! include 'DIMENSIONS'
10205 real(kind=8),dimension(2) :: V1,V2
10206 real(kind=8),dimension(2,2) :: A1
10207 real(kind=8) :: vaux1,vaux2
10211 ! 3 VI=VI+A1(I,K)*V1(K)
10215 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10216 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10220 end subroutine MATVEC2
10221 !-----------------------------------------------------------------------------
10222 subroutine MATMAT2(A1,A2,A3)
10224 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10226 ! implicit real*8 (a-h,o-z)
10227 ! include 'DIMENSIONS'
10228 real(kind=8),dimension(2,2) :: A1,A2,A3
10229 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
10230 ! DIMENSION AI3(2,2)
10234 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
10240 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10241 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10242 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10243 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10249 end subroutine MATMAT2
10250 !-----------------------------------------------------------------------------
10251 real(kind=8) function scalar2(u,v)
10252 !DIR$ INLINEALWAYS scalar2
10254 real(kind=8),dimension(2) :: u,v
10257 scalar2=u(1)*v(1)+u(2)*v(2)
10259 end function scalar2
10260 !-----------------------------------------------------------------------------
10261 subroutine transpose2(a,at)
10262 !DIR$ INLINEALWAYS transpose2
10264 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
10267 real(kind=8),dimension(2,2) :: a,at
10273 end subroutine transpose2
10274 !-----------------------------------------------------------------------------
10275 subroutine transpose(n,a,at)
10278 real(kind=8),dimension(n,n) :: a,at
10285 end subroutine transpose
10286 !-----------------------------------------------------------------------------
10287 subroutine prodmat3(a1,a2,kk,transp,prod)
10288 !DIR$ INLINEALWAYS prodmat3
10290 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
10294 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
10296 !rc double precision auxmat(2,2),prod_(2,2)
10299 !rc call transpose2(kk(1,1),auxmat(1,1))
10300 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10301 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10303 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
10304 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10305 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
10306 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10307 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
10308 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10309 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
10310 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10313 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10314 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10316 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
10317 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10318 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
10319 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10320 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
10321 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10322 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
10323 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10326 ! call transpose2(a2(1,1),a2t(1,1))
10329 !rc print *,((prod_(i,j),i=1,2),j=1,2)
10330 !rc print *,((prod(i,j),i=1,2),j=1,2)
10333 end subroutine prodmat3
10334 !-----------------------------------------------------------------------------
10335 ! energy_p_new_barrier.F
10336 !-----------------------------------------------------------------------------
10337 subroutine sum_gradient
10338 ! implicit real*8 (a-h,o-z)
10339 use io_base, only: pdbout
10340 ! include 'DIMENSIONS'
10344 !MS$ATTRIBUTES C :: proc_proc
10350 real(kind=8),dimension(3,-1:nres) :: gradbufc,gradbufx,gradbufc_sum,&
10351 gloc_scbuf !(3,maxres)
10353 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
10355 !el local variables
10356 integer :: i,j,k,ierror,ierr
10357 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
10358 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
10359 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
10360 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
10361 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
10362 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
10363 gsccorr_max,gsccorrx_max,time00
10365 ! include 'COMMON.SETUP'
10366 ! include 'COMMON.IOUNITS'
10367 ! include 'COMMON.FFIELD'
10368 ! include 'COMMON.DERIV'
10369 ! include 'COMMON.INTERACT'
10370 ! include 'COMMON.SBRIDGE'
10371 ! include 'COMMON.CHAIN'
10372 ! include 'COMMON.VAR'
10373 ! include 'COMMON.CONTROL'
10374 ! include 'COMMON.TIME1'
10375 ! include 'COMMON.MAXGRAD'
10376 ! include 'COMMON.SCCOR'
10381 write (iout,*) "sum_gradient gvdwc, gvdwx"
10383 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10384 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
10394 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
10395 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
10396 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
10399 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
10400 ! in virtual-bond-vector coordinates
10403 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
10405 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
10406 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
10408 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
10410 ! write (iout,'(i5,3f10.5,2x,f10.5)')
10411 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
10413 write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
10415 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10416 i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
10417 (gvdwc_scpp(j,i),j=1,3)
10419 write (iout,*) "gelc_long gvdwpp gel_loc_long"
10421 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10422 i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
10423 (gelc_loc_long(j,i),j=1,3)
10430 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10431 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10432 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10433 wel_loc*gel_loc_long(j,i)+ &
10434 wcorr*gradcorr_long(j,i)+ &
10435 wcorr5*gradcorr5_long(j,i)+ &
10436 wcorr6*gradcorr6_long(j,i)+ &
10437 wturn6*gcorr6_turn_long(j,i)+ &
10438 wstrain*ghpbc(j,i) &
10439 +wliptran*gliptranc(j,i) &
10441 +welec*gshieldc(j,i) &
10442 +wcorr*gshieldc_ec(j,i) &
10443 +wturn3*gshieldc_t3(j,i)&
10444 +wturn4*gshieldc_t4(j,i)&
10445 +wel_loc*gshieldc_ll(j,i)&
10446 +wtube*gg_tube(j,i) &
10447 +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
10448 wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
10449 wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
10450 wcorr_nucl*gradcorr_nucl(j,i)&
10451 +wcorr3_nucl*gradcorr3_nucl(j,i)
10458 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10459 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10460 welec*gelc_long(j,i)+ &
10461 wbond*gradb(j,i)+ &
10462 wel_loc*gel_loc_long(j,i)+ &
10463 wcorr*gradcorr_long(j,i)+ &
10464 wcorr5*gradcorr5_long(j,i)+ &
10465 wcorr6*gradcorr6_long(j,i)+ &
10466 wturn6*gcorr6_turn_long(j,i)+ &
10467 wstrain*ghpbc(j,i) &
10468 +wliptran*gliptranc(j,i) &
10470 +welec*gshieldc(j,i)&
10471 +wcorr*gshieldc_ec(j,i) &
10472 +wturn4*gshieldc_t4(j,i) &
10473 +wel_loc*gshieldc_ll(j,i)&
10474 +wtube*gg_tube(j,i) &
10475 +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
10476 wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
10477 wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
10478 wcorr_nucl*gradcorr_nucl(j,i)
10479 +wcorr3_nucl*gradcorr3_nucl(j,i)
10484 if (nfgtasks.gt.1) then
10487 write (iout,*) "gradbufc before allreduce"
10489 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10495 gradbufc_sum(j,i)=gradbufc(j,i)
10498 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
10499 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
10500 ! time_reduce=time_reduce+MPI_Wtime()-time00
10502 ! write (iout,*) "gradbufc_sum after allreduce"
10504 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
10509 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
10513 gradbufc(k,i)=0.0d0
10517 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
10518 write (iout,*) (i," jgrad_start",jgrad_start(i),&
10519 " jgrad_end ",jgrad_end(i),&
10520 i=igrad_start,igrad_end)
10523 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
10524 ! do not parallelize this part.
10526 ! do i=igrad_start,igrad_end
10527 ! do j=jgrad_start(i),jgrad_end(i)
10529 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
10534 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10538 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10542 write (iout,*) "gradbufc after summing"
10544 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10552 write (iout,*) "gradbufc"
10554 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10561 gradbufc_sum(j,i)=gradbufc(j,i)
10562 gradbufc(j,i)=0.0d0
10566 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10570 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10575 ! gradbufc(k,i)=0.0d0
10579 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
10585 write (iout,*) "gradbufc after summing"
10587 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10596 gradbufc(k,nres)=0.0d0
10598 !el----------------
10599 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
10600 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
10601 !el-----------------
10605 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10606 wel_loc*gel_loc(j,i)+ &
10607 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10608 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10609 wel_loc*gel_loc_long(j,i)+ &
10610 wcorr*gradcorr_long(j,i)+ &
10611 wcorr5*gradcorr5_long(j,i)+ &
10612 wcorr6*gradcorr6_long(j,i)+ &
10613 wturn6*gcorr6_turn_long(j,i))+ &
10614 wbond*gradb(j,i)+ &
10615 wcorr*gradcorr(j,i)+ &
10616 wturn3*gcorr3_turn(j,i)+ &
10617 wturn4*gcorr4_turn(j,i)+ &
10618 wcorr5*gradcorr5(j,i)+ &
10619 wcorr6*gradcorr6(j,i)+ &
10620 wturn6*gcorr6_turn(j,i)+ &
10621 wsccor*gsccorc(j,i) &
10622 +wscloc*gscloc(j,i) &
10623 +wliptran*gliptranc(j,i) &
10625 +welec*gshieldc(j,i) &
10626 +welec*gshieldc_loc(j,i) &
10627 +wcorr*gshieldc_ec(j,i) &
10628 +wcorr*gshieldc_loc_ec(j,i) &
10629 +wturn3*gshieldc_t3(j,i) &
10630 +wturn3*gshieldc_loc_t3(j,i) &
10631 +wturn4*gshieldc_t4(j,i) &
10632 +wturn4*gshieldc_loc_t4(j,i) &
10633 +wel_loc*gshieldc_ll(j,i) &
10634 +wel_loc*gshieldc_loc_ll(j,i) &
10635 +wtube*gg_tube(j,i) &
10636 +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
10637 +wvdwpsb*gvdwpsb1(j,i))&
10638 +wbond_nucl*gradb_nucl(j,i)+wsbloc*gsbloc(j,i)
10640 ! if ((i.le.2).and.(i.ge.1))
10641 ! print *,gradc(j,i,icg),&
10642 ! gradbufc(j,i),welec*gelc(j,i), &
10643 ! wel_loc*gel_loc(j,i), &
10644 ! wscp*gvdwc_scpp(j,i), &
10645 ! welec*gelc_long(j,i),wvdwpp*gvdwpp(j,i), &
10646 ! wel_loc*gel_loc_long(j,i), &
10647 ! wcorr*gradcorr_long(j,i), &
10648 ! wcorr5*gradcorr5_long(j,i), &
10649 ! wcorr6*gradcorr6_long(j,i), &
10650 ! wturn6*gcorr6_turn_long(j,i), &
10651 ! wbond*gradb(j,i), &
10652 ! wcorr*gradcorr(j,i), &
10653 ! wturn3*gcorr3_turn(j,i), &
10654 ! wturn4*gcorr4_turn(j,i), &
10655 ! wcorr5*gradcorr5(j,i), &
10656 ! wcorr6*gradcorr6(j,i), &
10657 ! wturn6*gcorr6_turn(j,i), &
10658 ! wsccor*gsccorc(j,i) &
10659 ! ,wscloc*gscloc(j,i) &
10660 ! ,wliptran*gliptranc(j,i) &
10662 ! ,welec*gshieldc(j,i) &
10663 ! ,welec*gshieldc_loc(j,i) &
10664 ! ,wcorr*gshieldc_ec(j,i) &
10665 ! ,wcorr*gshieldc_loc_ec(j,i) &
10666 ! ,wturn3*gshieldc_t3(j,i) &
10667 ! ,wturn3*gshieldc_loc_t3(j,i) &
10668 ! ,wturn4*gshieldc_t4(j,i) &
10669 ! ,wturn4*gshieldc_loc_t4(j,i) &
10670 ! ,wel_loc*gshieldc_ll(j,i) &
10671 ! ,wel_loc*gshieldc_loc_ll(j,i) &
10672 ! ,wtube*gg_tube(j,i) &
10673 ! ,wbond_nucl*gradb_nucl(j,i) &
10674 ! ,wvdwpp_nucl*gvdwpp_nucl(j,i),welpp*gelpp(j,i),&
10675 ! wvdwpsb*gvdwpsb1(j,i)&
10676 ! ,wbond_nucl*gradb_nucl(j,i),wsbloc*gsbloc(j,i)
10680 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10681 wel_loc*gel_loc(j,i)+ &
10682 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10683 welec*gelc_long(j,i)+ &
10684 wel_loc*gel_loc_long(j,i)+ &
10685 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
10686 wcorr5*gradcorr5_long(j,i)+ &
10687 wcorr6*gradcorr6_long(j,i)+ &
10688 wturn6*gcorr6_turn_long(j,i))+ &
10689 wbond*gradb(j,i)+ &
10690 wcorr*gradcorr(j,i)+ &
10691 wturn3*gcorr3_turn(j,i)+ &
10692 wturn4*gcorr4_turn(j,i)+ &
10693 wcorr5*gradcorr5(j,i)+ &
10694 wcorr6*gradcorr6(j,i)+ &
10695 wturn6*gcorr6_turn(j,i)+ &
10696 wsccor*gsccorc(j,i) &
10697 +wscloc*gscloc(j,i) &
10699 +wliptran*gliptranc(j,i) &
10700 +welec*gshieldc(j,i) &
10701 +welec*gshieldc_loc(j,) &
10702 +wcorr*gshieldc_ec(j,i) &
10703 +wcorr*gshieldc_loc_ec(j,i) &
10704 +wturn3*gshieldc_t3(j,i) &
10705 +wturn3*gshieldc_loc_t3(j,i) &
10706 +wturn4*gshieldc_t4(j,i) &
10707 +wturn4*gshieldc_loc_t4(j,i) &
10708 +wel_loc*gshieldc_ll(j,i) &
10709 +wel_loc*gshieldc_loc_ll(j,i) &
10710 +wtube*gg_tube(j,i) &
10711 +wbond_nucl*gradb_nucl(j,i) &
10712 +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
10713 +wvdwpsb*gvdwpsb1(j,i))&
10714 +wsbloc*gsbloc(j,i)
10720 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
10721 wbond*gradbx(j,i)+ &
10722 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
10723 wsccor*gsccorx(j,i) &
10724 +wscloc*gsclocx(j,i) &
10725 +wliptran*gliptranx(j,i) &
10726 +welec*gshieldx(j,i) &
10727 +wcorr*gshieldx_ec(j,i) &
10728 +wturn3*gshieldx_t3(j,i) &
10729 +wturn4*gshieldx_t4(j,i) &
10730 +wel_loc*gshieldx_ll(j,i)&
10731 +wtube*gg_tube_sc(j,i) &
10732 +wbond_nucl*gradbx_nucl(j,i) &
10733 +wvdwsb*gvdwsbx(j,i) &
10734 +welsb*gelsbx(j,i) &
10735 +wcorr_nucl*gradxorr_nucl(j,i)&
10736 +wcorr3_nucl*gradxorr3_nucl(j,i) &
10737 +wsbloc*gsblocx(j,i)
10741 write (iout,*) "gloc before adding corr"
10743 write (iout,*) i,gloc(i,icg)
10747 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
10748 +wcorr5*g_corr5_loc(i) &
10749 +wcorr6*g_corr6_loc(i) &
10750 +wturn4*gel_loc_turn4(i) &
10751 +wturn3*gel_loc_turn3(i) &
10752 +wturn6*gel_loc_turn6(i) &
10753 +wel_loc*gel_loc_loc(i)
10756 write (iout,*) "gloc after adding corr"
10758 write (iout,*) i,gloc(i,icg)
10762 if (nfgtasks.gt.1) then
10765 gradbufc(j,i)=gradc(j,i,icg)
10766 gradbufx(j,i)=gradx(j,i,icg)
10770 glocbuf(i)=gloc(i,icg)
10774 write (iout,*) "gloc_sc before reduce"
10777 write (iout,*) i,j,gloc_sc(j,i,icg)
10784 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
10788 call MPI_Barrier(FG_COMM,IERR)
10789 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
10791 call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,&
10792 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10793 call MPI_Reduce(gradbufx(1,0),gradx(1,0,icg),3*nres+3,&
10794 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10795 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
10796 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10797 time_reduce=time_reduce+MPI_Wtime()-time00
10798 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
10799 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10800 time_reduce=time_reduce+MPI_Wtime()-time00
10802 ! print *,"gradbuf",gradbufc(1,1),gradc(1,1,icg)
10804 write (iout,*) "gloc_sc after reduce"
10807 write (iout,*) i,j,gloc_sc(j,i,icg)
10813 write (iout,*) "gloc after reduce"
10815 write (iout,*) i,gloc(i,icg)
10820 if (gnorm_check) then
10822 ! Compute the maximum elements of the gradient
10825 gvdwc_scp_max=0.0d0
10832 gcorr3_turn_max=0.0d0
10833 gcorr4_turn_max=0.0d0
10834 gradcorr5_max=0.0d0
10835 gradcorr6_max=0.0d0
10836 gcorr6_turn_max=0.0d0
10840 gradx_scp_max=0.0d0
10846 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
10847 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
10848 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
10849 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
10850 gvdwc_scp_max=gvdwc_scp_norm
10851 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
10852 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
10853 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
10854 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
10855 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
10856 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
10857 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
10858 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
10859 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
10860 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
10861 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
10862 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
10863 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
10865 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
10866 gcorr3_turn_max=gcorr3_turn_norm
10867 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
10869 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
10870 gcorr4_turn_max=gcorr4_turn_norm
10871 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
10872 if (gradcorr5_norm.gt.gradcorr5_max) &
10873 gradcorr5_max=gradcorr5_norm
10874 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
10875 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
10876 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
10878 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
10879 gcorr6_turn_max=gcorr6_turn_norm
10880 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
10881 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
10882 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
10883 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
10884 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
10885 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
10886 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
10887 if (gradx_scp_norm.gt.gradx_scp_max) &
10888 gradx_scp_max=gradx_scp_norm
10889 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
10890 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
10891 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
10892 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
10893 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
10894 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
10895 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
10896 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
10900 open(istat,file=statname,position="append")
10902 open(istat,file=statname,access="append")
10904 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
10905 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
10906 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
10907 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
10908 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
10909 gsccorx_max,gsclocx_max
10911 if (gvdwc_max.gt.1.0d4) then
10912 write (iout,*) "gvdwc gvdwx gradb gradbx"
10914 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
10915 gradb(j,i),gradbx(j,i),j=1,3)
10917 call pdbout(0.0d0,'cipiszcze',iout)
10924 write (iout,*) "gradc gradx gloc"
10926 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
10927 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
10932 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
10935 end subroutine sum_gradient
10936 !-----------------------------------------------------------------------------
10938 ! implicit real*8 (a-h,o-z)
10940 ! include 'DIMENSIONS'
10941 ! include 'COMMON.CHAIN'
10942 ! include 'COMMON.DERIV'
10943 ! include 'COMMON.CALC'
10944 ! include 'COMMON.IOUNITS'
10945 real(kind=8), dimension(3) :: dcosom1,dcosom2
10946 ! print *,"wchodze"
10947 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
10948 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
10949 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
10950 -2.0D0*alf12*eps3der+sigder*sigsq_om12
10954 ! eom12=evdwij*eps1_om12
10956 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
10958 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
10959 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
10960 !C print *,sss_ele_cut,'in sc_grad'
10962 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
10963 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
10966 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
10967 !C print *,'gg',k,gg(k)
10969 ! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
10970 ! write (iout,*) "gg",(gg(k),k=1,3)
10972 gvdwx(k,i)=gvdwx(k,i)-gg(k) +gg_lipi(k)&
10973 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
10974 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
10977 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)&
10978 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
10979 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv &
10982 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
10983 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
10984 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
10985 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
10988 ! Calculate the components of the gradient in DC and X
10992 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
10996 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
10997 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
11000 end subroutine sc_grad
11002 !-----------------------------------------------------------------------------
11003 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
11006 ! implicit real*8 (a-h,o-z)
11007 ! include 'DIMENSIONS'
11008 ! include 'COMMON.LOCAL'
11009 ! include 'COMMON.IOUNITS'
11010 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
11011 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
11012 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
11013 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
11014 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
11016 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
11017 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
11018 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
11019 !el local variables
11021 delthec=thetai-thet_pred_mean
11022 delthe0=thetai-theta0i
11023 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
11024 t3 = thetai-thet_pred_mean
11028 t14 = t12+t6*sigsqtc
11030 t21 = thetai-theta0i
11036 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
11037 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
11038 *(-t12*t9-ak*sig0inv*t27)
11040 end subroutine mixder
11042 !-----------------------------------------------------------------------------
11044 !-----------------------------------------------------------------------------
11046 !-----------------------------------------------------------------------------
11047 ! This subroutine calculates the derivatives of the consecutive virtual
11048 ! bond vectors and the SC vectors in the virtual-bond angles theta and
11049 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
11050 ! in the angles alpha and omega, describing the location of a side chain
11051 ! in its local coordinate system.
11053 ! The derivatives are stored in the following arrays:
11055 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
11056 ! The structure is as follows:
11058 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
11059 ! 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)
11060 ! . . . . . . . . . . . . . . . . . .
11061 ! 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)
11065 ! 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)
11067 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
11068 ! The structure is same as above.
11070 ! DCDS - the derivatives of the side chain vectors in the local spherical
11071 ! andgles alph and omega:
11073 ! 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)
11074 ! 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)
11078 ! 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)
11080 ! Version of March '95, based on an early version of November '91.
11082 !**********************************************************************
11083 ! implicit real*8 (a-h,o-z)
11084 ! include 'DIMENSIONS'
11085 ! include 'COMMON.VAR'
11086 ! include 'COMMON.CHAIN'
11087 ! include 'COMMON.DERIV'
11088 ! include 'COMMON.GEO'
11089 ! include 'COMMON.LOCAL'
11090 ! include 'COMMON.INTERACT'
11091 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
11092 real(kind=8),dimension(3,3) :: dp,temp
11093 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
11094 real(kind=8),dimension(3) :: xx,xx1
11095 !el local variables
11096 integer :: i,k,l,j,m,ind,ind1,jjj
11097 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
11098 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
11099 sint2,xp,yp,xxp,yyp,zzp,dj
11101 ! common /przechowalnia/ fromto
11102 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
11103 ! get the position of the jth ijth fragment of the chain coordinate system
11104 ! in the fromto array.
11105 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
11107 ! maxdim=(nres-1)*(nres-2)/2
11108 ! allocate(dcdv(6,maxdim),dxds(6,nres))
11109 ! calculate the derivatives of transformation matrix elements in theta
11112 !el call flush(iout) !el
11114 rdt(1,1,i)=-rt(1,2,i)
11115 rdt(1,2,i)= rt(1,1,i)
11117 rdt(2,1,i)=-rt(2,2,i)
11118 rdt(2,2,i)= rt(2,1,i)
11120 rdt(3,1,i)=-rt(3,2,i)
11121 rdt(3,2,i)= rt(3,1,i)
11125 ! derivatives in phi
11131 drt(2,1,i)= rt(3,1,i)
11132 drt(2,2,i)= rt(3,2,i)
11133 drt(2,3,i)= rt(3,3,i)
11134 drt(3,1,i)=-rt(2,1,i)
11135 drt(3,2,i)=-rt(2,2,i)
11136 drt(3,3,i)=-rt(2,3,i)
11139 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
11145 temp(k,l)=rt(k,l,i)
11150 fromto(k,l,ind)=temp(k,l)
11159 dpkl=dpkl+temp(k,m)*rt(m,l,j)
11162 fromto(k,l,ind)=dpkl
11173 ! Calculate derivatives.
11179 ! Derivatives of DC(i+1) in theta(i+2)
11185 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
11188 prordt(j,k,i)=dp(j,k)
11191 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
11194 ! Derivatives of SC(i+1) in theta(i+2)
11196 xx1(1)=-0.5D0*xloc(2,i+1)
11197 xx1(2)= 0.5D0*xloc(1,i+1)
11201 xj=xj+r(j,k,i)*xx1(k)
11208 rj=rj+prod(j,k,i)*xx(k)
11213 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
11214 ! than the other off-diagonal derivatives.
11219 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
11221 dxdv(j,ind1+1)=dxoiij
11223 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
11225 ! Derivatives of DC(i+1) in phi(i+2)
11231 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
11234 prodrt(j,k,i)=dp(j,k)
11236 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
11239 ! Derivatives of SC(i+1) in phi(i+2)
11242 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
11243 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
11247 rj=rj+prod(j,k,i)*xx(k)
11252 ! Derivatives of SC(i+1) in phi(i+3).
11257 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
11259 dxdv(j+3,ind1+1)=dxoiij
11262 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
11263 ! theta(nres) and phi(i+3) thru phi(nres).
11267 ind=indmat(i+1,j+1)
11268 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
11273 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
11278 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
11279 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
11280 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
11281 ! Derivatives of virtual-bond vectors in theta
11283 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
11285 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
11286 ! Derivatives of SC vectors in theta
11290 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
11292 dxdv(k,ind1+1)=dxoijk
11295 !--- Calculate the derivatives in phi
11301 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
11307 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
11312 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
11314 dxdv(k+3,ind1+1)=dxoijk
11319 ! Derivatives in alpha and omega:
11322 ! dsci=dsc(itype(i,1))
11327 if(alphi.ne.alphi) alphi=100.0
11328 if(omegi.ne.omegi) omegi=-100.0
11333 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
11334 cosalphi=dcos(alphi)
11335 sinalphi=dsin(alphi)
11336 cosomegi=dcos(omegi)
11337 sinomegi=dsin(omegi)
11338 temp(1,1)=-dsci*sinalphi
11339 temp(2,1)= dsci*cosalphi*cosomegi
11340 temp(3,1)=-dsci*cosalphi*sinomegi
11342 temp(2,2)=-dsci*sinalphi*sinomegi
11343 temp(3,2)=-dsci*sinalphi*cosomegi
11344 theta2=pi-0.5D0*theta(i+1)
11348 !d print *,((temp(l,k),l=1,3),k=1,2)
11352 xxp= xp*cost2+yp*sint2
11353 yyp=-xp*sint2+yp*cost2
11356 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
11357 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
11361 dj=dj+prod(k,l,i-1)*xx(l)
11369 end subroutine cartder
11370 !-----------------------------------------------------------------------------
11372 !-----------------------------------------------------------------------------
11373 subroutine check_cartgrad
11374 ! Check the gradient of Cartesian coordinates in internal coordinates.
11375 ! implicit real*8 (a-h,o-z)
11376 ! include 'DIMENSIONS'
11377 ! include 'COMMON.IOUNITS'
11378 ! include 'COMMON.VAR'
11379 ! include 'COMMON.CHAIN'
11380 ! include 'COMMON.GEO'
11381 ! include 'COMMON.LOCAL'
11382 ! include 'COMMON.DERIV'
11383 real(kind=8),dimension(6,nres) :: temp
11384 real(kind=8),dimension(3) :: xx,gg
11385 integer :: i,k,j,ii
11386 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
11387 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
11389 ! Check the gradient of the virtual-bond and SC vectors in the internal
11395 write (iout,'(a)') '**************** dx/dalpha'
11399 alph(i)=alph(i)+aincr
11401 temp(k,i)=dc(k,nres+i)
11405 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11406 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
11408 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11409 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
11415 write (iout,'(a)') '**************** dx/domega'
11419 omeg(i)=omeg(i)+aincr
11421 temp(k,i)=dc(k,nres+i)
11425 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11426 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
11427 (aincr*dabs(dxds(k+3,i))+aincr))
11429 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11430 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
11436 write (iout,'(a)') '**************** dx/dtheta'
11440 theta(i)=theta(i)+aincr
11443 temp(k,j)=dc(k,nres+j)
11449 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
11451 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11452 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
11453 (aincr*dabs(dxdv(k,ii))+aincr))
11455 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11456 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
11463 write (iout,'(a)') '***************** dx/dphi'
11466 phi(i)=phi(i)+aincr
11469 temp(k,j)=dc(k,nres+j)
11477 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11478 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
11479 (aincr*dabs(dxdv(k+3,ii))+aincr))
11481 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11482 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11485 phi(i)=phi(i)-aincr
11488 write (iout,'(a)') '****************** ddc/dtheta'
11491 theta(i+2)=thet+aincr
11502 gg(k)=(dc(k,j)-temp(k,j))/aincr
11503 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
11504 (aincr*dabs(dcdv(k,ii))+aincr))
11506 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11507 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
11517 write (iout,'(a)') '******************* ddc/dphi'
11520 phi(i+3)=phii+aincr
11531 gg(k)=(dc(k,j)-temp(k,j))/aincr
11532 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
11533 (aincr*dabs(dcdv(k+3,ii))+aincr))
11535 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11536 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11547 end subroutine check_cartgrad
11548 !-----------------------------------------------------------------------------
11549 subroutine check_ecart
11550 ! Check the gradient of the energy in Cartesian coordinates.
11551 ! implicit real*8 (a-h,o-z)
11552 ! include 'DIMENSIONS'
11553 ! include 'COMMON.CHAIN'
11554 ! include 'COMMON.DERIV'
11555 ! include 'COMMON.IOUNITS'
11556 ! include 'COMMON.VAR'
11557 ! include 'COMMON.CONTACTS'
11559 !el integer :: icall
11560 !el common /srutu/ icall
11561 real(kind=8),dimension(6) :: ggg
11562 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
11563 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11564 real(kind=8),dimension(6,nres) :: grad_s
11565 real(kind=8),dimension(0:n_ene) :: energia,energia1
11566 integer :: uiparm(1)
11567 real(kind=8) :: urparm(1)
11569 integer :: nf,i,j,k
11570 real(kind=8) :: aincr,etot,etot1
11576 print '(a)','CG processor',me,' calling CHECK_CART.',aincr
11579 call geom_to_var(nvar,x)
11580 call etotal(energia)
11582 !el call enerprint(energia)
11583 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
11586 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11590 grad_s(j,i)=gradc(j,i,icg)
11591 grad_s(j+3,i)=gradx(j,i,icg)
11595 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11600 ddx(j)=dc(j,i+nres)
11603 dc(j,i)=dc(j,i)+aincr
11605 c(j,k)=c(j,k)+aincr
11606 c(j,k+nres)=c(j,k+nres)+aincr
11608 call etotal(energia1)
11610 ggg(j)=(etot1-etot)/aincr
11613 c(j,k)=c(j,k)-aincr
11614 c(j,k+nres)=c(j,k+nres)-aincr
11618 c(j,i+nres)=c(j,i+nres)+aincr
11619 dc(j,i+nres)=dc(j,i+nres)+aincr
11620 call etotal(energia1)
11622 ggg(j+3)=(etot1-etot)/aincr
11624 dc(j,i+nres)=ddx(j)
11626 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
11627 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
11630 end subroutine check_ecart
11632 !-----------------------------------------------------------------------------
11633 subroutine check_ecartint
11634 ! Check the gradient of the energy in Cartesian coordinates.
11635 use io_base, only: intout
11636 ! implicit real*8 (a-h,o-z)
11637 ! include 'DIMENSIONS'
11638 ! include 'COMMON.CONTROL'
11639 ! include 'COMMON.CHAIN'
11640 ! include 'COMMON.DERIV'
11641 ! include 'COMMON.IOUNITS'
11642 ! include 'COMMON.VAR'
11643 ! include 'COMMON.CONTACTS'
11644 ! include 'COMMON.MD'
11645 ! include 'COMMON.LOCAL'
11646 ! include 'COMMON.SPLITELE'
11648 !el integer :: icall
11649 !el common /srutu/ icall
11650 real(kind=8),dimension(6) :: ggg,ggg1
11651 real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
11652 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11653 real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
11654 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
11655 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
11656 real(kind=8),dimension(0:n_ene) :: energia,energia1
11657 integer :: uiparm(1)
11658 real(kind=8) :: urparm(1)
11660 integer :: i,j,k,nf
11661 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
11669 ! call intcartderiv
11670 ! call checkintcartgrad
11673 write(iout,*) 'Calling CHECK_ECARTINT.'
11676 write (iout,*) "Before geom_to_var"
11677 call geom_to_var(nvar,x)
11678 write (iout,*) "after geom_to_var"
11679 write (iout,*) "split_ene ",split_ene
11681 if (.not.split_ene) then
11682 write(iout,*) 'Calling CHECK_ECARTINT if'
11683 call etotal(energia)
11684 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11686 write (iout,*) "etot",etot
11688 !el call enerprint(energia)
11689 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11691 write (iout,*) "enter cartgrad"
11694 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11695 write (iout,*) "exit cartgrad"
11699 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11702 grad_s(j,0)=gcart(j,0)
11704 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11707 grad_s(j,i)=gcart(j,i)
11708 grad_s(j+3,i)=gxcart(j,i)
11712 write(iout,*) 'Calling CHECK_ECARTIN else.'
11713 !- split gradient check
11715 call etotal_long(energia)
11716 !el call enerprint(energia)
11718 write (iout,*) "enter cartgrad"
11721 write (iout,*) "exit cartgrad"
11724 write (iout,*) "longrange grad"
11726 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11727 (gxcart(j,i),j=1,3)
11730 grad_s(j,0)=gcart(j,0)
11734 grad_s(j,i)=gcart(j,i)
11735 grad_s(j+3,i)=gxcart(j,i)
11739 call etotal_short(energia)
11740 call enerprint(energia)
11742 write (iout,*) "enter cartgrad"
11745 write (iout,*) "exit cartgrad"
11748 write (iout,*) "shortrange grad"
11750 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11751 (gxcart(j,i),j=1,3)
11754 grad_s1(j,0)=gcart(j,0)
11758 grad_s1(j,i)=gcart(j,i)
11759 grad_s1(j+3,i)=gxcart(j,i)
11763 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11767 if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
11768 if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
11771 dcnorm_safe1(j)=dc_norm(j,i-1)
11772 dcnorm_safe2(j)=dc_norm(j,i)
11773 dxnorm_safe(j)=dc_norm(j,i+nres)
11776 c(j,i)=ddc(j)+aincr
11777 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
11778 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
11779 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11780 dc(j,i)=c(j,i+1)-c(j,i)
11781 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11782 call int_from_cart1(.false.)
11783 if (.not.split_ene) then
11784 call etotal(energia1)
11786 write (iout,*) "ij",i,j," etot1",etot1
11789 call etotal_long(energia1)
11791 call etotal_short(energia1)
11794 !- end split gradient
11795 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11796 c(j,i)=ddc(j)-aincr
11797 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
11798 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
11799 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11800 dc(j,i)=c(j,i+1)-c(j,i)
11801 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11802 call int_from_cart1(.false.)
11803 if (.not.split_ene) then
11804 call etotal(energia1)
11806 write (iout,*) "ij",i,j," etot2",etot2
11807 ggg(j)=(etot1-etot2)/(2*aincr)
11810 call etotal_long(energia1)
11812 ggg(j)=(etot11-etot21)/(2*aincr)
11813 call etotal_short(energia1)
11815 ggg1(j)=(etot12-etot22)/(2*aincr)
11816 !- end split gradient
11817 ! write (iout,*) "etot21",etot21," etot22",etot22
11819 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11821 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
11822 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
11823 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11824 dc(j,i)=c(j,i+1)-c(j,i)
11825 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11826 dc_norm(j,i-1)=dcnorm_safe1(j)
11827 dc_norm(j,i)=dcnorm_safe2(j)
11828 dc_norm(j,i+nres)=dxnorm_safe(j)
11831 c(j,i+nres)=ddx(j)+aincr
11832 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11833 call int_from_cart1(.false.)
11834 if (.not.split_ene) then
11835 call etotal(energia1)
11839 call etotal_long(energia1)
11841 call etotal_short(energia1)
11844 !- end split gradient
11845 c(j,i+nres)=ddx(j)-aincr
11846 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11847 call int_from_cart1(.false.)
11848 if (.not.split_ene) then
11849 call etotal(energia1)
11851 ggg(j+3)=(etot1-etot2)/(2*aincr)
11854 call etotal_long(energia1)
11856 ggg(j+3)=(etot11-etot21)/(2*aincr)
11857 call etotal_short(energia1)
11859 ggg1(j+3)=(etot12-etot22)/(2*aincr)
11860 !- end split gradient
11862 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11864 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11865 dc_norm(j,i+nres)=dxnorm_safe(j)
11866 call int_from_cart1(.false.)
11868 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11869 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
11870 if (split_ene) then
11871 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11872 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
11874 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11875 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
11876 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
11880 end subroutine check_ecartint
11882 !-----------------------------------------------------------------------------
11883 subroutine check_ecartint
11884 ! Check the gradient of the energy in Cartesian coordinates.
11885 use io_base, only: intout
11886 ! implicit real*8 (a-h,o-z)
11887 ! include 'DIMENSIONS'
11888 ! include 'COMMON.CONTROL'
11889 ! include 'COMMON.CHAIN'
11890 ! include 'COMMON.DERIV'
11891 ! include 'COMMON.IOUNITS'
11892 ! include 'COMMON.VAR'
11893 ! include 'COMMON.CONTACTS'
11894 ! include 'COMMON.MD'
11895 ! include 'COMMON.LOCAL'
11896 ! include 'COMMON.SPLITELE'
11898 !el integer :: icall
11899 !el common /srutu/ icall
11900 real(kind=8),dimension(6) :: ggg,ggg1
11901 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
11902 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11903 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
11904 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
11905 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
11906 real(kind=8),dimension(0:n_ene) :: energia,energia1
11907 integer :: uiparm(1)
11908 real(kind=8) :: urparm(1)
11910 integer :: i,j,k,nf
11911 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
11919 ! call intcartderiv
11920 ! call checkintcartgrad
11923 write(iout,*) 'Calling CHECK_ECARTINT.',aincr
11926 call geom_to_var(nvar,x)
11927 if (.not.split_ene) then
11928 call etotal(energia)
11930 !el call enerprint(energia)
11932 write (iout,*) "enter cartgrad"
11935 write (iout,*) "exit cartgrad"
11939 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11942 grad_s(j,0)=gcart(j,0)
11946 grad_s(j,i)=gcart(j,i)
11947 ! if (i.le.2) print *,"tu?!",gcart(j,i),grad_s(j,i),gxcart(j,i)
11948 grad_s(j+3,i)=gxcart(j,i)
11952 !- split gradient check
11954 call etotal_long(energia)
11955 !el call enerprint(energia)
11957 write (iout,*) "enter cartgrad"
11960 write (iout,*) "exit cartgrad"
11963 write (iout,*) "longrange grad"
11965 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11966 (gxcart(j,i),j=1,3)
11969 grad_s(j,0)=gcart(j,0)
11973 grad_s(j,i)=gcart(j,i)
11974 grad_s(j+3,i)=gxcart(j,i)
11978 call etotal_short(energia)
11979 !el call enerprint(energia)
11981 write (iout,*) "enter cartgrad"
11984 write (iout,*) "exit cartgrad"
11987 write (iout,*) "shortrange grad"
11989 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11990 (gxcart(j,i),j=1,3)
11993 grad_s1(j,0)=gcart(j,0)
11997 grad_s1(j,i)=gcart(j,i)
11998 grad_s1(j+3,i)=gxcart(j,i)
12002 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
12007 ddx(j)=dc(j,i+nres)
12009 dcnorm_safe(k)=dc_norm(k,i)
12010 dxnorm_safe(k)=dc_norm(k,i+nres)
12014 dc(j,i)=ddc(j)+aincr
12015 call chainbuild_cart
12017 ! Broadcast the order to compute internal coordinates to the slaves.
12018 ! if (nfgtasks.gt.1)
12019 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
12021 ! call int_from_cart1(.false.)
12022 if (.not.split_ene) then
12023 call etotal(energia1)
12025 ! call enerprint(energia1)
12028 call etotal_long(energia1)
12030 call etotal_short(energia1)
12032 ! write (iout,*) "etot11",etot11," etot12",etot12
12034 !- end split gradient
12035 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12036 dc(j,i)=ddc(j)-aincr
12037 call chainbuild_cart
12038 ! call int_from_cart1(.false.)
12039 if (.not.split_ene) then
12040 call etotal(energia1)
12042 ggg(j)=(etot1-etot2)/(2*aincr)
12045 call etotal_long(energia1)
12047 ggg(j)=(etot11-etot21)/(2*aincr)
12048 call etotal_short(energia1)
12050 ggg1(j)=(etot12-etot22)/(2*aincr)
12051 !- end split gradient
12052 ! write (iout,*) "etot21",etot21," etot22",etot22
12054 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12056 call chainbuild_cart
12059 dc(j,i+nres)=ddx(j)+aincr
12060 call chainbuild_cart
12061 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
12062 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
12063 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
12064 ! write (iout,*) "dxnormnorm",dsqrt(
12065 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
12066 ! write (iout,*) "dxnormnormsafe",dsqrt(
12067 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
12069 if (.not.split_ene) then
12070 call etotal(energia1)
12074 call etotal_long(energia1)
12076 call etotal_short(energia1)
12079 !- end split gradient
12080 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12081 dc(j,i+nres)=ddx(j)-aincr
12082 call chainbuild_cart
12083 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
12084 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
12085 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
12087 ! write (iout,*) "dxnormnorm",dsqrt(
12088 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
12089 ! write (iout,*) "dxnormnormsafe",dsqrt(
12090 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
12091 if (.not.split_ene) then
12092 call etotal(energia1)
12094 ggg(j+3)=(etot1-etot2)/(2*aincr)
12097 call etotal_long(energia1)
12099 ggg(j+3)=(etot11-etot21)/(2*aincr)
12100 call etotal_short(energia1)
12102 ggg1(j+3)=(etot12-etot22)/(2*aincr)
12103 !- end split gradient
12105 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12106 dc(j,i+nres)=ddx(j)
12107 call chainbuild_cart
12109 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12110 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
12111 if (split_ene) then
12112 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12113 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
12115 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12116 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
12117 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
12121 end subroutine check_ecartint
12123 !-----------------------------------------------------------------------------
12124 subroutine check_eint
12125 ! Check the gradient of energy in internal coordinates.
12126 ! implicit real*8 (a-h,o-z)
12127 ! include 'DIMENSIONS'
12128 ! include 'COMMON.CHAIN'
12129 ! include 'COMMON.DERIV'
12130 ! include 'COMMON.IOUNITS'
12131 ! include 'COMMON.VAR'
12132 ! include 'COMMON.GEO'
12134 !el integer :: icall
12135 !el common /srutu/ icall
12136 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
12137 integer :: uiparm(1)
12138 real(kind=8) :: urparm(1)
12139 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
12140 character(len=6) :: key
12143 real(kind=8) :: xi,aincr,etot,etot1,etot2
12146 print '(a)','Calling CHECK_INT.'
12150 call geom_to_var(nvar,x)
12151 call var_to_geom(nvar,x)
12154 ! print *,'ICG=',ICG
12155 call etotal(energia)
12157 !el call enerprint(energia)
12158 ! print *,'ICG=',ICG
12160 if (MyID.ne.BossID) then
12161 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
12169 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
12170 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
12171 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
12175 x(i)=xi-0.5D0*aincr
12176 call var_to_geom(nvar,x)
12178 call etotal(energia1)
12180 x(i)=xi+0.5D0*aincr
12181 call var_to_geom(nvar,x)
12183 call etotal(energia2)
12185 gg(i)=(etot2-etot1)/aincr
12186 write (iout,*) i,etot1,etot2
12189 write (iout,'(/2a)')' Variable Numerical Analytical',&
12192 if (i.le.nphi) then
12195 else if (i.le.nphi+ntheta) then
12198 else if (i.le.nphi+ntheta+nside) then
12202 ii=i-(nphi+ntheta+nside)
12205 write (iout,'(i3,a,i3,3(1pd16.6))') &
12206 i,key,ii,gg(i),gana(i),&
12207 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
12210 end subroutine check_eint
12211 !-----------------------------------------------------------------------------
12213 !-----------------------------------------------------------------------------
12214 subroutine Econstr_back
12215 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
12216 ! implicit real*8 (a-h,o-z)
12217 ! include 'DIMENSIONS'
12218 ! include 'COMMON.CONTROL'
12219 ! include 'COMMON.VAR'
12220 ! include 'COMMON.MD'
12223 ! include 'COMMON.LANGEVIN'
12225 ! include 'COMMON.LANGEVIN.lang0'
12227 ! include 'COMMON.CHAIN'
12228 ! include 'COMMON.DERIV'
12229 ! include 'COMMON.GEO'
12230 ! include 'COMMON.LOCAL'
12231 ! include 'COMMON.INTERACT'
12232 ! include 'COMMON.IOUNITS'
12233 ! include 'COMMON.NAMES'
12234 ! include 'COMMON.TIME1'
12235 integer :: i,j,ii,k
12236 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
12238 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
12239 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
12240 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
12247 duscdiff(j,i)=0.0d0
12248 duscdiffx(j,i)=0.0d0
12252 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
12254 ! Deviations from theta angles
12257 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
12258 dtheta_i=theta(j)-thetaref(j)
12259 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
12260 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
12262 utheta(i)=utheta_i/(ii-1)
12264 ! Deviations from gamma angles
12267 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
12268 dgamma_i=pinorm(phi(j)-phiref(j))
12269 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
12270 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
12271 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
12272 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
12274 ugamma(i)=ugamma_i/(ii-2)
12276 ! Deviations from local SC geometry
12279 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
12280 dxx=xxtab(j)-xxref(j)
12281 dyy=yytab(j)-yyref(j)
12282 dzz=zztab(j)-zzref(j)
12283 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
12285 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
12286 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
12288 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
12289 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
12291 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
12292 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
12295 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
12296 ! & xxref(j),yyref(j),zzref(j)
12298 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
12299 ! write (iout,*) i," uscdiff",uscdiff(i)
12301 ! Put together deviations from local geometry
12303 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
12304 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
12305 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
12306 ! & " uconst_back",uconst_back
12307 utheta(i)=dsqrt(utheta(i))
12308 ugamma(i)=dsqrt(ugamma(i))
12309 uscdiff(i)=dsqrt(uscdiff(i))
12312 end subroutine Econstr_back
12313 !-----------------------------------------------------------------------------
12314 ! energy_p_new-sep_barrier.F
12315 !-----------------------------------------------------------------------------
12316 real(kind=8) function sscale(r)
12317 ! include "COMMON.SPLITELE"
12318 real(kind=8) :: r,gamm
12319 if(r.lt.r_cut-rlamb) then
12321 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
12322 gamm=(r-(r_cut-rlamb))/rlamb
12323 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12328 end function sscale
12329 real(kind=8) function sscale_grad(r)
12330 ! include "COMMON.SPLITELE"
12331 real(kind=8) :: r,gamm
12332 if(r.lt.r_cut-rlamb) then
12334 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
12335 gamm=(r-(r_cut-rlamb))/rlamb
12336 sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
12341 end function sscale_grad
12343 !!!!!!!!!! PBCSCALE
12344 real(kind=8) function sscale_ele(r)
12345 ! include "COMMON.SPLITELE"
12346 real(kind=8) :: r,gamm
12347 if(r.lt.r_cut_ele-rlamb_ele) then
12349 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12350 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12351 sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12356 end function sscale_ele
12358 real(kind=8) function sscagrad_ele(r)
12359 real(kind=8) :: r,gamm
12360 ! include "COMMON.SPLITELE"
12361 if(r.lt.r_cut_ele-rlamb_ele) then
12363 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12364 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12365 sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
12370 end function sscagrad_ele
12371 real(kind=8) function sscalelip(r)
12372 real(kind=8) r,gamm
12373 sscalelip=1.0d0+r*r*(2.0d0*r-3.0d0)
12375 end function sscalelip
12376 !C-----------------------------------------------------------------------
12377 real(kind=8) function sscagradlip(r)
12378 real(kind=8) r,gamm
12379 sscagradlip=r*(6.0d0*r-6.0d0)
12381 end function sscagradlip
12384 !-----------------------------------------------------------------------------
12385 subroutine elj_long(evdw)
12387 ! This subroutine calculates the interaction energy of nonbonded side chains
12388 ! assuming the LJ potential of interaction.
12390 ! implicit real*8 (a-h,o-z)
12391 ! include 'DIMENSIONS'
12392 ! include 'COMMON.GEO'
12393 ! include 'COMMON.VAR'
12394 ! include 'COMMON.LOCAL'
12395 ! include 'COMMON.CHAIN'
12396 ! include 'COMMON.DERIV'
12397 ! include 'COMMON.INTERACT'
12398 ! include 'COMMON.TORSION'
12399 ! include 'COMMON.SBRIDGE'
12400 ! include 'COMMON.NAMES'
12401 ! include 'COMMON.IOUNITS'
12402 ! include 'COMMON.CONTACTS'
12403 real(kind=8),parameter :: accur=1.0d-10
12404 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12405 !el local variables
12406 integer :: i,iint,j,k,itypi,itypi1,itypj
12407 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12408 real(kind=8) :: e1,e2,evdwij,evdw
12409 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12411 do i=iatsc_s,iatsc_e
12413 if (itypi.eq.ntyp1) cycle
12414 itypi1=itype(i+1,1)
12419 ! Calculate SC interaction energy.
12421 do iint=1,nint_gr(i)
12422 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12423 !d & 'iend=',iend(i,iint)
12424 do j=istart(i,iint),iend(i,iint)
12426 if (itypj.eq.ntyp1) cycle
12430 rij=xj*xj+yj*yj+zj*zj
12431 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12432 if (sss.lt.1.0d0) then
12434 eps0ij=eps(itypi,itypj)
12436 e1=fac*fac*aa_aq(itypi,itypj)
12437 e2=fac*bb_aq(itypi,itypj)
12439 evdw=evdw+(1.0d0-sss)*evdwij
12441 ! Calculate the components of the gradient in DC and X
12443 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
12448 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12449 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12450 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12451 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12459 gvdwc(j,i)=expon*gvdwc(j,i)
12460 gvdwx(j,i)=expon*gvdwx(j,i)
12463 !******************************************************************************
12467 ! To save time, the factor of EXPON has been extracted from ALL components
12468 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12471 !******************************************************************************
12473 end subroutine elj_long
12474 !-----------------------------------------------------------------------------
12475 subroutine elj_short(evdw)
12477 ! This subroutine calculates the interaction energy of nonbonded side chains
12478 ! assuming the LJ potential of interaction.
12480 ! implicit real*8 (a-h,o-z)
12481 ! include 'DIMENSIONS'
12482 ! include 'COMMON.GEO'
12483 ! include 'COMMON.VAR'
12484 ! include 'COMMON.LOCAL'
12485 ! include 'COMMON.CHAIN'
12486 ! include 'COMMON.DERIV'
12487 ! include 'COMMON.INTERACT'
12488 ! include 'COMMON.TORSION'
12489 ! include 'COMMON.SBRIDGE'
12490 ! include 'COMMON.NAMES'
12491 ! include 'COMMON.IOUNITS'
12492 ! include 'COMMON.CONTACTS'
12493 real(kind=8),parameter :: accur=1.0d-10
12494 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12495 !el local variables
12496 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
12497 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12498 real(kind=8) :: e1,e2,evdwij,evdw
12499 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12501 do i=iatsc_s,iatsc_e
12503 if (itypi.eq.ntyp1) cycle
12504 itypi1=itype(i+1,1)
12511 ! Calculate SC interaction energy.
12513 do iint=1,nint_gr(i)
12514 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12515 !d & 'iend=',iend(i,iint)
12516 do j=istart(i,iint),iend(i,iint)
12518 if (itypj.eq.ntyp1) cycle
12522 ! Change 12/1/95 to calculate four-body interactions
12523 rij=xj*xj+yj*yj+zj*zj
12524 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12525 if (sss.gt.0.0d0) then
12527 eps0ij=eps(itypi,itypj)
12529 e1=fac*fac*aa_aq(itypi,itypj)
12530 e2=fac*bb_aq(itypi,itypj)
12532 evdw=evdw+sss*evdwij
12534 ! Calculate the components of the gradient in DC and X
12536 fac=-rrij*(e1+evdwij)*sss
12541 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12542 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12543 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12544 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12552 gvdwc(j,i)=expon*gvdwc(j,i)
12553 gvdwx(j,i)=expon*gvdwx(j,i)
12556 !******************************************************************************
12560 ! To save time, the factor of EXPON has been extracted from ALL components
12561 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12564 !******************************************************************************
12566 end subroutine elj_short
12567 !-----------------------------------------------------------------------------
12568 subroutine eljk_long(evdw)
12570 ! This subroutine calculates the interaction energy of nonbonded side chains
12571 ! assuming the LJK potential of interaction.
12573 ! implicit real*8 (a-h,o-z)
12574 ! include 'DIMENSIONS'
12575 ! include 'COMMON.GEO'
12576 ! include 'COMMON.VAR'
12577 ! include 'COMMON.LOCAL'
12578 ! include 'COMMON.CHAIN'
12579 ! include 'COMMON.DERIV'
12580 ! include 'COMMON.INTERACT'
12581 ! include 'COMMON.IOUNITS'
12582 ! include 'COMMON.NAMES'
12583 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12585 !el local variables
12586 integer :: i,iint,j,k,itypi,itypi1,itypj
12587 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12588 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12589 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12591 do i=iatsc_s,iatsc_e
12593 if (itypi.eq.ntyp1) cycle
12594 itypi1=itype(i+1,1)
12599 ! Calculate SC interaction energy.
12601 do iint=1,nint_gr(i)
12602 do j=istart(i,iint),iend(i,iint)
12604 if (itypj.eq.ntyp1) cycle
12608 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12609 fac_augm=rrij**expon
12610 e_augm=augm(itypi,itypj)*fac_augm
12611 r_inv_ij=dsqrt(rrij)
12613 sss=sscale(rij/sigma(itypi,itypj))
12614 if (sss.lt.1.0d0) then
12615 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12616 fac=r_shift_inv**expon
12617 e1=fac*fac*aa_aq(itypi,itypj)
12618 e2=fac*bb_aq(itypi,itypj)
12619 evdwij=e_augm+e1+e2
12620 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12621 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12622 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12623 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
12624 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12625 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12626 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12627 evdw=evdw+(1.0d0-sss)*evdwij
12629 ! Calculate the components of the gradient in DC and X
12631 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12632 fac=fac*(1.0d0-sss)
12637 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12638 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12639 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12640 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12648 gvdwc(j,i)=expon*gvdwc(j,i)
12649 gvdwx(j,i)=expon*gvdwx(j,i)
12653 end subroutine eljk_long
12654 !-----------------------------------------------------------------------------
12655 subroutine eljk_short(evdw)
12657 ! This subroutine calculates the interaction energy of nonbonded side chains
12658 ! assuming the LJK potential of interaction.
12660 ! implicit real*8 (a-h,o-z)
12661 ! include 'DIMENSIONS'
12662 ! include 'COMMON.GEO'
12663 ! include 'COMMON.VAR'
12664 ! include 'COMMON.LOCAL'
12665 ! include 'COMMON.CHAIN'
12666 ! include 'COMMON.DERIV'
12667 ! include 'COMMON.INTERACT'
12668 ! include 'COMMON.IOUNITS'
12669 ! include 'COMMON.NAMES'
12670 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12672 !el local variables
12673 integer :: i,iint,j,k,itypi,itypi1,itypj
12674 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12675 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12676 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12678 do i=iatsc_s,iatsc_e
12680 if (itypi.eq.ntyp1) cycle
12681 itypi1=itype(i+1,1)
12686 ! Calculate SC interaction energy.
12688 do iint=1,nint_gr(i)
12689 do j=istart(i,iint),iend(i,iint)
12691 if (itypj.eq.ntyp1) cycle
12695 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12696 fac_augm=rrij**expon
12697 e_augm=augm(itypi,itypj)*fac_augm
12698 r_inv_ij=dsqrt(rrij)
12700 sss=sscale(rij/sigma(itypi,itypj))
12701 if (sss.gt.0.0d0) then
12702 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12703 fac=r_shift_inv**expon
12704 e1=fac*fac*aa_aq(itypi,itypj)
12705 e2=fac*bb_aq(itypi,itypj)
12706 evdwij=e_augm+e1+e2
12707 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12708 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12709 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12710 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
12711 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12712 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12713 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12714 evdw=evdw+sss*evdwij
12716 ! Calculate the components of the gradient in DC and X
12718 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12724 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12725 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12726 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12727 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12735 gvdwc(j,i)=expon*gvdwc(j,i)
12736 gvdwx(j,i)=expon*gvdwx(j,i)
12740 end subroutine eljk_short
12741 !-----------------------------------------------------------------------------
12742 subroutine ebp_long(evdw)
12744 ! This subroutine calculates the interaction energy of nonbonded side chains
12745 ! assuming the Berne-Pechukas potential of interaction.
12748 ! implicit real*8 (a-h,o-z)
12749 ! include 'DIMENSIONS'
12750 ! include 'COMMON.GEO'
12751 ! include 'COMMON.VAR'
12752 ! include 'COMMON.LOCAL'
12753 ! include 'COMMON.CHAIN'
12754 ! include 'COMMON.DERIV'
12755 ! include 'COMMON.NAMES'
12756 ! include 'COMMON.INTERACT'
12757 ! include 'COMMON.IOUNITS'
12758 ! include 'COMMON.CALC'
12760 !el integer :: icall
12761 !el common /srutu/ icall
12762 ! double precision rrsave(maxdim)
12764 !el local variables
12765 integer :: iint,itypi,itypi1,itypj
12766 real(kind=8) :: rrij,xi,yi,zi,fac
12767 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
12769 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
12771 ! if (icall.eq.0) then
12777 do i=iatsc_s,iatsc_e
12779 if (itypi.eq.ntyp1) cycle
12780 itypi1=itype(i+1,1)
12784 dxi=dc_norm(1,nres+i)
12785 dyi=dc_norm(2,nres+i)
12786 dzi=dc_norm(3,nres+i)
12787 ! dsci_inv=dsc_inv(itypi)
12788 dsci_inv=vbld_inv(i+nres)
12790 ! Calculate SC interaction energy.
12792 do iint=1,nint_gr(i)
12793 do j=istart(i,iint),iend(i,iint)
12796 if (itypj.eq.ntyp1) cycle
12797 ! dscj_inv=dsc_inv(itypj)
12798 dscj_inv=vbld_inv(j+nres)
12799 chi1=chi(itypi,itypj)
12800 chi2=chi(itypj,itypi)
12807 alf12=0.5D0*(alf1+alf2)
12811 dxj=dc_norm(1,nres+j)
12812 dyj=dc_norm(2,nres+j)
12813 dzj=dc_norm(3,nres+j)
12814 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12816 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12818 if (sss.lt.1.0d0) then
12820 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
12822 ! Calculate whole angle-dependent part of epsilon and contributions
12823 ! to its derivatives
12824 fac=(rrij*sigsq)**expon2
12825 e1=fac*fac*aa_aq(itypi,itypj)
12826 e2=fac*bb_aq(itypi,itypj)
12827 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12828 eps2der=evdwij*eps3rt
12829 eps3der=evdwij*eps2rt
12830 evdwij=evdwij*eps2rt*eps3rt
12831 evdw=evdw+evdwij*(1.0d0-sss)
12833 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
12834 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
12835 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
12836 !d & restyp(itypi,1),i,restyp(itypj,1),j,
12837 !d & epsi,sigm,chi1,chi2,chip1,chip2,
12838 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
12839 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
12842 ! Calculate gradient components.
12843 e1=e1*eps1*eps2rt**2*eps3rt**2
12844 fac=-expon*(e1+evdwij)
12847 ! Calculate radial part of the gradient
12851 ! Calculate the angular part of the gradient and sum add the contributions
12852 ! to the appropriate components of the Cartesian gradient.
12853 call sc_grad_scale(1.0d0-sss)
12860 end subroutine ebp_long
12861 !-----------------------------------------------------------------------------
12862 subroutine ebp_short(evdw)
12864 ! This subroutine calculates the interaction energy of nonbonded side chains
12865 ! assuming the Berne-Pechukas potential of interaction.
12868 ! implicit real*8 (a-h,o-z)
12869 ! include 'DIMENSIONS'
12870 ! include 'COMMON.GEO'
12871 ! include 'COMMON.VAR'
12872 ! include 'COMMON.LOCAL'
12873 ! include 'COMMON.CHAIN'
12874 ! include 'COMMON.DERIV'
12875 ! include 'COMMON.NAMES'
12876 ! include 'COMMON.INTERACT'
12877 ! include 'COMMON.IOUNITS'
12878 ! include 'COMMON.CALC'
12880 !el integer :: icall
12881 !el common /srutu/ icall
12882 ! double precision rrsave(maxdim)
12884 !el local variables
12885 integer :: iint,itypi,itypi1,itypj
12886 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
12887 real(kind=8) :: sss,e1,e2,evdw
12889 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
12891 ! if (icall.eq.0) then
12897 do i=iatsc_s,iatsc_e
12899 if (itypi.eq.ntyp1) cycle
12900 itypi1=itype(i+1,1)
12904 dxi=dc_norm(1,nres+i)
12905 dyi=dc_norm(2,nres+i)
12906 dzi=dc_norm(3,nres+i)
12907 ! dsci_inv=dsc_inv(itypi)
12908 dsci_inv=vbld_inv(i+nres)
12910 ! Calculate SC interaction energy.
12912 do iint=1,nint_gr(i)
12913 do j=istart(i,iint),iend(i,iint)
12916 if (itypj.eq.ntyp1) cycle
12917 ! dscj_inv=dsc_inv(itypj)
12918 dscj_inv=vbld_inv(j+nres)
12919 chi1=chi(itypi,itypj)
12920 chi2=chi(itypj,itypi)
12927 alf12=0.5D0*(alf1+alf2)
12931 dxj=dc_norm(1,nres+j)
12932 dyj=dc_norm(2,nres+j)
12933 dzj=dc_norm(3,nres+j)
12934 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12936 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12938 if (sss.gt.0.0d0) then
12940 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
12942 ! Calculate whole angle-dependent part of epsilon and contributions
12943 ! to its derivatives
12944 fac=(rrij*sigsq)**expon2
12945 e1=fac*fac*aa_aq(itypi,itypj)
12946 e2=fac*bb_aq(itypi,itypj)
12947 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12948 eps2der=evdwij*eps3rt
12949 eps3der=evdwij*eps2rt
12950 evdwij=evdwij*eps2rt*eps3rt
12951 evdw=evdw+evdwij*sss
12953 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
12954 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
12955 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
12956 !d & restyp(itypi,1),i,restyp(itypj,1),j,
12957 !d & epsi,sigm,chi1,chi2,chip1,chip2,
12958 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
12959 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
12962 ! Calculate gradient components.
12963 e1=e1*eps1*eps2rt**2*eps3rt**2
12964 fac=-expon*(e1+evdwij)
12967 ! Calculate radial part of the gradient
12971 ! Calculate the angular part of the gradient and sum add the contributions
12972 ! to the appropriate components of the Cartesian gradient.
12973 call sc_grad_scale(sss)
12980 end subroutine ebp_short
12981 !-----------------------------------------------------------------------------
12982 subroutine egb_long(evdw)
12984 ! This subroutine calculates the interaction energy of nonbonded side chains
12985 ! assuming the Gay-Berne potential of interaction.
12988 ! implicit real*8 (a-h,o-z)
12989 ! include 'DIMENSIONS'
12990 ! include 'COMMON.GEO'
12991 ! include 'COMMON.VAR'
12992 ! include 'COMMON.LOCAL'
12993 ! include 'COMMON.CHAIN'
12994 ! include 'COMMON.DERIV'
12995 ! include 'COMMON.NAMES'
12996 ! include 'COMMON.INTERACT'
12997 ! include 'COMMON.IOUNITS'
12998 ! include 'COMMON.CALC'
12999 ! include 'COMMON.CONTROL'
13001 !el local variables
13002 integer :: iint,itypi,itypi1,itypj,subchap
13003 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
13004 real(kind=8) :: sss,e1,e2,evdw,sss_grad
13005 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13006 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13007 ssgradlipi,ssgradlipj
13011 !cccc energy_dec=.false.
13012 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13015 ! if (icall.eq.0) lprn=.false.
13017 do i=iatsc_s,iatsc_e
13019 if (itypi.eq.ntyp1) cycle
13020 itypi1=itype(i+1,1)
13024 xi=mod(xi,boxxsize)
13025 if (xi.lt.0) xi=xi+boxxsize
13026 yi=mod(yi,boxysize)
13027 if (yi.lt.0) yi=yi+boxysize
13028 zi=mod(zi,boxzsize)
13029 if (zi.lt.0) zi=zi+boxzsize
13030 if ((zi.gt.bordlipbot) &
13031 .and.(zi.lt.bordliptop)) then
13032 !C the energy transfer exist
13033 if (zi.lt.buflipbot) then
13034 !C what fraction I am in
13036 ((zi-bordlipbot)/lipbufthick)
13037 !C lipbufthick is thickenes of lipid buffore
13038 sslipi=sscalelip(fracinbuf)
13039 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
13040 elseif (zi.gt.bufliptop) then
13041 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
13042 sslipi=sscalelip(fracinbuf)
13043 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
13053 dxi=dc_norm(1,nres+i)
13054 dyi=dc_norm(2,nres+i)
13055 dzi=dc_norm(3,nres+i)
13056 ! dsci_inv=dsc_inv(itypi)
13057 dsci_inv=vbld_inv(i+nres)
13058 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
13059 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
13061 ! Calculate SC interaction energy.
13063 do iint=1,nint_gr(i)
13064 do j=istart(i,iint),iend(i,iint)
13065 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
13066 ! call dyn_ssbond_ene(i,j,evdwij)
13068 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13069 ! 'evdw',i,j,evdwij,' ss'
13070 ! if (energy_dec) write (iout,*) &
13071 ! 'evdw',i,j,evdwij,' ss'
13072 ! do k=j+1,iend(i,iint)
13073 !C search over all next residues
13074 ! if (dyn_ss_mask(k)) then
13075 !C check if they are cysteins
13076 !C write(iout,*) 'k=',k
13078 !c write(iout,*) "PRZED TRI", evdwij
13079 ! evdwij_przed_tri=evdwij
13080 ! call triple_ssbond_ene(i,j,k,evdwij)
13081 !c if(evdwij_przed_tri.ne.evdwij) then
13082 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
13085 !c write(iout,*) "PO TRI", evdwij
13086 !C call the energy function that removes the artifical triple disulfide
13087 !C bond the soubroutine is located in ssMD.F
13089 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13090 'evdw',i,j,evdwij,'tss'
13091 ! endif!dyn_ss_mask(k)
13097 if (itypj.eq.ntyp1) cycle
13098 ! dscj_inv=dsc_inv(itypj)
13099 dscj_inv=vbld_inv(j+nres)
13100 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
13101 ! & 1.0d0/vbld(j+nres)
13102 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
13103 sig0ij=sigma(itypi,itypj)
13104 chi1=chi(itypi,itypj)
13105 chi2=chi(itypj,itypi)
13112 alf12=0.5D0*(alf1+alf2)
13116 ! Searching for nearest neighbour
13117 xj=mod(xj,boxxsize)
13118 if (xj.lt.0) xj=xj+boxxsize
13119 yj=mod(yj,boxysize)
13120 if (yj.lt.0) yj=yj+boxysize
13121 zj=mod(zj,boxzsize)
13122 if (zj.lt.0) zj=zj+boxzsize
13123 if ((zj.gt.bordlipbot) &
13124 .and.(zj.lt.bordliptop)) then
13125 !C the energy transfer exist
13126 if (zj.lt.buflipbot) then
13127 !C what fraction I am in
13129 ((zj-bordlipbot)/lipbufthick)
13130 !C lipbufthick is thickenes of lipid buffore
13131 sslipj=sscalelip(fracinbuf)
13132 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
13133 elseif (zj.gt.bufliptop) then
13134 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
13135 sslipj=sscalelip(fracinbuf)
13136 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13145 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13146 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13147 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13148 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13150 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13158 xj=xj_safe+xshift*boxxsize
13159 yj=yj_safe+yshift*boxysize
13160 zj=zj_safe+zshift*boxzsize
13161 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13162 if(dist_temp.lt.dist_init) then
13163 dist_init=dist_temp
13172 if (subchap.eq.1) then
13182 dxj=dc_norm(1,nres+j)
13183 dyj=dc_norm(2,nres+j)
13184 dzj=dc_norm(3,nres+j)
13185 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13187 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13188 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
13189 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
13190 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13191 if (sss_ele_cut.le.0.0) cycle
13192 if (sss.lt.1.0d0) then
13194 ! Calculate angle-dependent terms of energy and contributions to their
13198 sig=sig0ij*dsqrt(sigsq)
13199 rij_shift=1.0D0/rij-sig+sig0ij
13200 ! for diagnostics; uncomment
13201 ! rij_shift=1.2*sig0ij
13202 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13203 if (rij_shift.le.0.0D0) then
13205 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13206 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13207 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13211 !---------------------------------------------------------------
13212 rij_shift=1.0D0/rij_shift
13213 fac=rij_shift**expon
13216 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13217 eps2der=evdwij*eps3rt
13218 eps3der=evdwij*eps2rt
13219 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13220 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13221 evdwij=evdwij*eps2rt*eps3rt
13222 evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
13224 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13225 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13226 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13227 restyp(itypi,1),i,restyp(itypj,1),j,&
13228 epsi,sigm,chi1,chi2,chip1,chip2,&
13229 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13230 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13234 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13236 ! if (energy_dec) write (iout,*) &
13237 ! 'evdw',i,j,evdwij,"egb_long"
13239 ! Calculate gradient components.
13240 e1=e1*eps1*eps2rt**2*eps3rt**2
13241 fac=-expon*(e1+evdwij)*rij_shift
13244 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13245 /sigma(itypi,itypj)*rij-sss_grad/(1.0-sss)*rij &
13246 /sigmaii(itypi,itypj))
13248 ! Calculate the radial part of the gradient
13252 ! Calculate angular part of the gradient.
13253 call sc_grad_scale(1.0d0-sss)
13259 ! write (iout,*) "Number of loop steps in EGB:",ind
13260 !ccc energy_dec=.false.
13262 end subroutine egb_long
13263 !-----------------------------------------------------------------------------
13264 subroutine egb_short(evdw)
13266 ! This subroutine calculates the interaction energy of nonbonded side chains
13267 ! assuming the Gay-Berne potential of interaction.
13270 ! implicit real*8 (a-h,o-z)
13271 ! include 'DIMENSIONS'
13272 ! include 'COMMON.GEO'
13273 ! include 'COMMON.VAR'
13274 ! include 'COMMON.LOCAL'
13275 ! include 'COMMON.CHAIN'
13276 ! include 'COMMON.DERIV'
13277 ! include 'COMMON.NAMES'
13278 ! include 'COMMON.INTERACT'
13279 ! include 'COMMON.IOUNITS'
13280 ! include 'COMMON.CALC'
13281 ! include 'COMMON.CONTROL'
13283 !el local variables
13284 integer :: iint,itypi,itypi1,itypj,subchap
13285 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
13286 real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad
13287 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13288 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13289 ssgradlipi,ssgradlipj
13291 !cccc energy_dec=.false.
13292 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13295 ! if (icall.eq.0) lprn=.false.
13297 do i=iatsc_s,iatsc_e
13299 if (itypi.eq.ntyp1) cycle
13300 itypi1=itype(i+1,1)
13304 xi=mod(xi,boxxsize)
13305 if (xi.lt.0) xi=xi+boxxsize
13306 yi=mod(yi,boxysize)
13307 if (yi.lt.0) yi=yi+boxysize
13308 zi=mod(zi,boxzsize)
13309 if (zi.lt.0) zi=zi+boxzsize
13310 if ((zi.gt.bordlipbot) &
13311 .and.(zi.lt.bordliptop)) then
13312 !C the energy transfer exist
13313 if (zi.lt.buflipbot) then
13314 !C what fraction I am in
13316 ((zi-bordlipbot)/lipbufthick)
13317 !C lipbufthick is thickenes of lipid buffore
13318 sslipi=sscalelip(fracinbuf)
13319 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
13320 elseif (zi.gt.bufliptop) then
13321 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
13322 sslipi=sscalelip(fracinbuf)
13323 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
13333 dxi=dc_norm(1,nres+i)
13334 dyi=dc_norm(2,nres+i)
13335 dzi=dc_norm(3,nres+i)
13336 ! dsci_inv=dsc_inv(itypi)
13337 dsci_inv=vbld_inv(i+nres)
13339 dxi=dc_norm(1,nres+i)
13340 dyi=dc_norm(2,nres+i)
13341 dzi=dc_norm(3,nres+i)
13342 ! dsci_inv=dsc_inv(itypi)
13343 dsci_inv=vbld_inv(i+nres)
13344 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
13345 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
13347 ! Calculate SC interaction energy.
13349 do iint=1,nint_gr(i)
13350 do j=istart(i,iint),iend(i,iint)
13351 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
13352 call dyn_ssbond_ene(i,j,evdwij)
13354 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13355 'evdw',i,j,evdwij,' ss'
13356 do k=j+1,iend(i,iint)
13357 !C search over all next residues
13358 if (dyn_ss_mask(k)) then
13359 !C check if they are cysteins
13360 !C write(iout,*) 'k=',k
13362 !c write(iout,*) "PRZED TRI", evdwij
13363 ! evdwij_przed_tri=evdwij
13364 call triple_ssbond_ene(i,j,k,evdwij)
13365 !c if(evdwij_przed_tri.ne.evdwij) then
13366 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
13369 !c write(iout,*) "PO TRI", evdwij
13370 !C call the energy function that removes the artifical triple disulfide
13371 !C bond the soubroutine is located in ssMD.F
13373 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13374 'evdw',i,j,evdwij,'tss'
13375 endif!dyn_ss_mask(k)
13378 ! if (energy_dec) write (iout,*) &
13379 ! 'evdw',i,j,evdwij,' ss'
13383 if (itypj.eq.ntyp1) cycle
13384 ! dscj_inv=dsc_inv(itypj)
13385 dscj_inv=vbld_inv(j+nres)
13386 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
13387 ! & 1.0d0/vbld(j+nres)
13388 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
13389 sig0ij=sigma(itypi,itypj)
13390 chi1=chi(itypi,itypj)
13391 chi2=chi(itypj,itypi)
13398 alf12=0.5D0*(alf1+alf2)
13399 ! xj=c(1,nres+j)-xi
13400 ! yj=c(2,nres+j)-yi
13401 ! zj=c(3,nres+j)-zi
13405 ! Searching for nearest neighbour
13406 xj=mod(xj,boxxsize)
13407 if (xj.lt.0) xj=xj+boxxsize
13408 yj=mod(yj,boxysize)
13409 if (yj.lt.0) yj=yj+boxysize
13410 zj=mod(zj,boxzsize)
13411 if (zj.lt.0) zj=zj+boxzsize
13412 if ((zj.gt.bordlipbot) &
13413 .and.(zj.lt.bordliptop)) then
13414 !C the energy transfer exist
13415 if (zj.lt.buflipbot) then
13416 !C what fraction I am in
13418 ((zj-bordlipbot)/lipbufthick)
13419 !C lipbufthick is thickenes of lipid buffore
13420 sslipj=sscalelip(fracinbuf)
13421 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
13422 elseif (zj.gt.bufliptop) then
13423 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
13424 sslipj=sscalelip(fracinbuf)
13425 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13434 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13435 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13436 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13437 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13439 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13448 xj=xj_safe+xshift*boxxsize
13449 yj=yj_safe+yshift*boxysize
13450 zj=zj_safe+zshift*boxzsize
13451 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13452 if(dist_temp.lt.dist_init) then
13453 dist_init=dist_temp
13462 if (subchap.eq.1) then
13472 dxj=dc_norm(1,nres+j)
13473 dyj=dc_norm(2,nres+j)
13474 dzj=dc_norm(3,nres+j)
13475 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13477 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13478 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13479 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
13480 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
13481 if (sss_ele_cut.le.0.0) cycle
13483 if (sss.gt.0.0d0) then
13485 ! Calculate angle-dependent terms of energy and contributions to their
13489 sig=sig0ij*dsqrt(sigsq)
13490 rij_shift=1.0D0/rij-sig+sig0ij
13491 ! for diagnostics; uncomment
13492 ! rij_shift=1.2*sig0ij
13493 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13494 if (rij_shift.le.0.0D0) then
13496 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13497 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13498 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13502 !---------------------------------------------------------------
13503 rij_shift=1.0D0/rij_shift
13504 fac=rij_shift**expon
13507 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13508 eps2der=evdwij*eps3rt
13509 eps3der=evdwij*eps2rt
13510 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13511 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13512 evdwij=evdwij*eps2rt*eps3rt
13513 evdw=evdw+evdwij*sss*sss_ele_cut
13515 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13516 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13517 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13518 restyp(itypi,1),i,restyp(itypj,1),j,&
13519 epsi,sigm,chi1,chi2,chip1,chip2,&
13520 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13521 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13525 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13527 ! if (energy_dec) write (iout,*) &
13528 ! 'evdw',i,j,evdwij,"egb_short"
13530 ! Calculate gradient components.
13531 e1=e1*eps1*eps2rt**2*eps3rt**2
13532 fac=-expon*(e1+evdwij)*rij_shift
13535 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13536 /sigma(itypi,itypj)*rij+sss_grad/sss*rij &
13537 /sigmaii(itypi,itypj))
13540 ! Calculate the radial part of the gradient
13544 ! Calculate angular part of the gradient.
13545 call sc_grad_scale(sss)
13551 ! write (iout,*) "Number of loop steps in EGB:",ind
13552 !ccc energy_dec=.false.
13554 end subroutine egb_short
13555 !-----------------------------------------------------------------------------
13556 subroutine egbv_long(evdw)
13558 ! This subroutine calculates the interaction energy of nonbonded side chains
13559 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13562 ! implicit real*8 (a-h,o-z)
13563 ! include 'DIMENSIONS'
13564 ! include 'COMMON.GEO'
13565 ! include 'COMMON.VAR'
13566 ! include 'COMMON.LOCAL'
13567 ! include 'COMMON.CHAIN'
13568 ! include 'COMMON.DERIV'
13569 ! include 'COMMON.NAMES'
13570 ! include 'COMMON.INTERACT'
13571 ! include 'COMMON.IOUNITS'
13572 ! include 'COMMON.CALC'
13574 !el integer :: icall
13575 !el common /srutu/ icall
13577 !el local variables
13578 integer :: iint,itypi,itypi1,itypj
13579 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
13580 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
13582 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13585 ! if (icall.eq.0) lprn=.true.
13587 do i=iatsc_s,iatsc_e
13589 if (itypi.eq.ntyp1) cycle
13590 itypi1=itype(i+1,1)
13594 dxi=dc_norm(1,nres+i)
13595 dyi=dc_norm(2,nres+i)
13596 dzi=dc_norm(3,nres+i)
13597 ! dsci_inv=dsc_inv(itypi)
13598 dsci_inv=vbld_inv(i+nres)
13600 ! Calculate SC interaction energy.
13602 do iint=1,nint_gr(i)
13603 do j=istart(i,iint),iend(i,iint)
13606 if (itypj.eq.ntyp1) cycle
13607 ! dscj_inv=dsc_inv(itypj)
13608 dscj_inv=vbld_inv(j+nres)
13609 sig0ij=sigma(itypi,itypj)
13610 r0ij=r0(itypi,itypj)
13611 chi1=chi(itypi,itypj)
13612 chi2=chi(itypj,itypi)
13619 alf12=0.5D0*(alf1+alf2)
13623 dxj=dc_norm(1,nres+j)
13624 dyj=dc_norm(2,nres+j)
13625 dzj=dc_norm(3,nres+j)
13626 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13629 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13631 if (sss.lt.1.0d0) then
13633 ! Calculate angle-dependent terms of energy and contributions to their
13637 sig=sig0ij*dsqrt(sigsq)
13638 rij_shift=1.0D0/rij-sig+r0ij
13639 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13640 if (rij_shift.le.0.0D0) then
13645 !---------------------------------------------------------------
13646 rij_shift=1.0D0/rij_shift
13647 fac=rij_shift**expon
13648 e1=fac*fac*aa_aq(itypi,itypj)
13649 e2=fac*bb_aq(itypi,itypj)
13650 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13651 eps2der=evdwij*eps3rt
13652 eps3der=evdwij*eps2rt
13653 fac_augm=rrij**expon
13654 e_augm=augm(itypi,itypj)*fac_augm
13655 evdwij=evdwij*eps2rt*eps3rt
13656 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
13658 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13659 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13660 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13661 restyp(itypi,1),i,restyp(itypj,1),j,&
13662 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13663 chi1,chi2,chip1,chip2,&
13664 eps1,eps2rt**2,eps3rt**2,&
13665 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13668 ! Calculate gradient components.
13669 e1=e1*eps1*eps2rt**2*eps3rt**2
13670 fac=-expon*(e1+evdwij)*rij_shift
13672 fac=rij*fac-2*expon*rrij*e_augm
13673 ! Calculate the radial part of the gradient
13677 ! Calculate angular part of the gradient.
13678 call sc_grad_scale(1.0d0-sss)
13683 end subroutine egbv_long
13684 !-----------------------------------------------------------------------------
13685 subroutine egbv_short(evdw)
13687 ! This subroutine calculates the interaction energy of nonbonded side chains
13688 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13691 ! implicit real*8 (a-h,o-z)
13692 ! include 'DIMENSIONS'
13693 ! include 'COMMON.GEO'
13694 ! include 'COMMON.VAR'
13695 ! include 'COMMON.LOCAL'
13696 ! include 'COMMON.CHAIN'
13697 ! include 'COMMON.DERIV'
13698 ! include 'COMMON.NAMES'
13699 ! include 'COMMON.INTERACT'
13700 ! include 'COMMON.IOUNITS'
13701 ! include 'COMMON.CALC'
13703 !el integer :: icall
13704 !el common /srutu/ icall
13706 !el local variables
13707 integer :: iint,itypi,itypi1,itypj
13708 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
13709 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
13711 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13714 ! if (icall.eq.0) lprn=.true.
13716 do i=iatsc_s,iatsc_e
13718 if (itypi.eq.ntyp1) cycle
13719 itypi1=itype(i+1,1)
13723 dxi=dc_norm(1,nres+i)
13724 dyi=dc_norm(2,nres+i)
13725 dzi=dc_norm(3,nres+i)
13726 ! dsci_inv=dsc_inv(itypi)
13727 dsci_inv=vbld_inv(i+nres)
13729 ! Calculate SC interaction energy.
13731 do iint=1,nint_gr(i)
13732 do j=istart(i,iint),iend(i,iint)
13735 if (itypj.eq.ntyp1) cycle
13736 ! dscj_inv=dsc_inv(itypj)
13737 dscj_inv=vbld_inv(j+nres)
13738 sig0ij=sigma(itypi,itypj)
13739 r0ij=r0(itypi,itypj)
13740 chi1=chi(itypi,itypj)
13741 chi2=chi(itypj,itypi)
13748 alf12=0.5D0*(alf1+alf2)
13752 dxj=dc_norm(1,nres+j)
13753 dyj=dc_norm(2,nres+j)
13754 dzj=dc_norm(3,nres+j)
13755 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13758 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13760 if (sss.gt.0.0d0) then
13762 ! Calculate angle-dependent terms of energy and contributions to their
13766 sig=sig0ij*dsqrt(sigsq)
13767 rij_shift=1.0D0/rij-sig+r0ij
13768 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13769 if (rij_shift.le.0.0D0) then
13774 !---------------------------------------------------------------
13775 rij_shift=1.0D0/rij_shift
13776 fac=rij_shift**expon
13777 e1=fac*fac*aa_aq(itypi,itypj)
13778 e2=fac*bb_aq(itypi,itypj)
13779 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13780 eps2der=evdwij*eps3rt
13781 eps3der=evdwij*eps2rt
13782 fac_augm=rrij**expon
13783 e_augm=augm(itypi,itypj)*fac_augm
13784 evdwij=evdwij*eps2rt*eps3rt
13785 evdw=evdw+(evdwij+e_augm)*sss
13787 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13788 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13789 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13790 restyp(itypi,1),i,restyp(itypj,1),j,&
13791 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13792 chi1,chi2,chip1,chip2,&
13793 eps1,eps2rt**2,eps3rt**2,&
13794 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13797 ! Calculate gradient components.
13798 e1=e1*eps1*eps2rt**2*eps3rt**2
13799 fac=-expon*(e1+evdwij)*rij_shift
13801 fac=rij*fac-2*expon*rrij*e_augm
13802 ! Calculate the radial part of the gradient
13806 ! Calculate angular part of the gradient.
13807 call sc_grad_scale(sss)
13812 end subroutine egbv_short
13813 !-----------------------------------------------------------------------------
13814 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
13816 ! This subroutine calculates the average interaction energy and its gradient
13817 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
13818 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
13819 ! The potential depends both on the distance of peptide-group centers and on
13820 ! the orientation of the CA-CA virtual bonds.
13822 ! implicit real*8 (a-h,o-z)
13828 ! include 'DIMENSIONS'
13829 ! include 'COMMON.CONTROL'
13830 ! include 'COMMON.SETUP'
13831 ! include 'COMMON.IOUNITS'
13832 ! include 'COMMON.GEO'
13833 ! include 'COMMON.VAR'
13834 ! include 'COMMON.LOCAL'
13835 ! include 'COMMON.CHAIN'
13836 ! include 'COMMON.DERIV'
13837 ! include 'COMMON.INTERACT'
13838 ! include 'COMMON.CONTACTS'
13839 ! include 'COMMON.TORSION'
13840 ! include 'COMMON.VECTORS'
13841 ! include 'COMMON.FFIELD'
13842 ! include 'COMMON.TIME1'
13843 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
13844 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
13845 real(kind=8),dimension(2,2) :: acipa !el,a_temp
13846 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
13847 real(kind=8),dimension(4) :: muij
13848 !el integer :: num_conti,j1,j2
13849 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
13850 !el dz_normi,xmedi,ymedi,zmedi
13851 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
13852 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
13853 !el num_conti,j1,j2
13854 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
13856 real(kind=8) :: scal_el=1.0d0
13858 real(kind=8) :: scal_el=0.5d0
13861 ! 13-go grudnia roku pamietnego...
13862 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
13863 0.0d0,1.0d0,0.0d0,&
13864 0.0d0,0.0d0,1.0d0/),shape(unmat))
13865 !el local variables
13867 real(kind=8) :: fac
13868 real(kind=8) :: dxj,dyj,dzj
13869 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
13871 ! allocate(num_cont_hb(nres)) !(maxres)
13872 !d write(iout,*) 'In EELEC'
13874 !d write(iout,*) 'Type',i
13875 !d write(iout,*) 'B1',B1(:,i)
13876 !d write(iout,*) 'B2',B2(:,i)
13877 !d write(iout,*) 'CC',CC(:,:,i)
13878 !d write(iout,*) 'DD',DD(:,:,i)
13879 !d write(iout,*) 'EE',EE(:,:,i)
13881 !d call check_vecgrad
13883 if (icheckgrad.eq.1) then
13885 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
13887 dc_norm(k,i)=dc(k,i)*fac
13889 ! write (iout,*) 'i',i,' fac',fac
13892 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
13893 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
13894 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
13895 ! call vec_and_deriv
13899 ! print *, "before set matrices"
13901 ! print *,"after set martices"
13903 time_mat=time_mat+MPI_Wtime()-time01
13907 !d write (iout,*) 'i=',i
13909 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
13912 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
13913 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
13926 !d print '(a)','Enter EELEC'
13927 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
13928 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
13929 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
13931 gel_loc_loc(i)=0.0d0
13936 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
13938 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
13940 do i=iturn3_start,iturn3_end
13941 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1 &
13942 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
13946 dx_normi=dc_norm(1,i)
13947 dy_normi=dc_norm(2,i)
13948 dz_normi=dc_norm(3,i)
13949 xmedi=c(1,i)+0.5d0*dxi
13950 ymedi=c(2,i)+0.5d0*dyi
13951 zmedi=c(3,i)+0.5d0*dzi
13952 xmedi=dmod(xmedi,boxxsize)
13953 if (xmedi.lt.0) xmedi=xmedi+boxxsize
13954 ymedi=dmod(ymedi,boxysize)
13955 if (ymedi.lt.0) ymedi=ymedi+boxysize
13956 zmedi=dmod(zmedi,boxzsize)
13957 if (zmedi.lt.0) zmedi=zmedi+boxzsize
13959 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
13960 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
13961 num_cont_hb(i)=num_conti
13963 do i=iturn4_start,iturn4_end
13964 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
13965 .or. itype(i+3,1).eq.ntyp1 &
13966 .or. itype(i+4,1).eq.ntyp1) cycle
13970 dx_normi=dc_norm(1,i)
13971 dy_normi=dc_norm(2,i)
13972 dz_normi=dc_norm(3,i)
13973 xmedi=c(1,i)+0.5d0*dxi
13974 ymedi=c(2,i)+0.5d0*dyi
13975 zmedi=c(3,i)+0.5d0*dzi
13976 xmedi=dmod(xmedi,boxxsize)
13977 if (xmedi.lt.0) xmedi=xmedi+boxxsize
13978 ymedi=dmod(ymedi,boxysize)
13979 if (ymedi.lt.0) ymedi=ymedi+boxysize
13980 zmedi=dmod(zmedi,boxzsize)
13981 if (zmedi.lt.0) zmedi=zmedi+boxzsize
13982 num_conti=num_cont_hb(i)
13983 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
13984 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
13985 call eturn4(i,eello_turn4)
13986 num_cont_hb(i)=num_conti
13989 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
13991 do i=iatel_s,iatel_e
13992 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
13996 dx_normi=dc_norm(1,i)
13997 dy_normi=dc_norm(2,i)
13998 dz_normi=dc_norm(3,i)
13999 xmedi=c(1,i)+0.5d0*dxi
14000 ymedi=c(2,i)+0.5d0*dyi
14001 zmedi=c(3,i)+0.5d0*dzi
14002 xmedi=dmod(xmedi,boxxsize)
14003 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14004 ymedi=dmod(ymedi,boxysize)
14005 if (ymedi.lt.0) ymedi=ymedi+boxysize
14006 zmedi=dmod(zmedi,boxzsize)
14007 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14008 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
14009 num_conti=num_cont_hb(i)
14010 do j=ielstart(i),ielend(i)
14011 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
14012 call eelecij_scale(i,j,ees,evdw1,eel_loc)
14014 num_cont_hb(i)=num_conti
14016 ! write (iout,*) "Number of loop steps in EELEC:",ind
14018 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
14019 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
14021 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
14022 !cc eel_loc=eel_loc+eello_turn3
14023 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
14025 end subroutine eelec_scale
14026 !-----------------------------------------------------------------------------
14027 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
14028 ! implicit real*8 (a-h,o-z)
14031 ! include 'DIMENSIONS'
14035 ! include 'COMMON.CONTROL'
14036 ! include 'COMMON.IOUNITS'
14037 ! include 'COMMON.GEO'
14038 ! include 'COMMON.VAR'
14039 ! include 'COMMON.LOCAL'
14040 ! include 'COMMON.CHAIN'
14041 ! include 'COMMON.DERIV'
14042 ! include 'COMMON.INTERACT'
14043 ! include 'COMMON.CONTACTS'
14044 ! include 'COMMON.TORSION'
14045 ! include 'COMMON.VECTORS'
14046 ! include 'COMMON.FFIELD'
14047 ! include 'COMMON.TIME1'
14048 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
14049 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
14050 real(kind=8),dimension(2,2) :: acipa !el,a_temp
14051 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
14052 real(kind=8),dimension(4) :: muij
14053 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14054 dist_temp, dist_init,sss_grad
14055 integer xshift,yshift,zshift
14057 !el integer :: num_conti,j1,j2
14058 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
14059 !el dz_normi,xmedi,ymedi,zmedi
14060 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
14061 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14062 !el num_conti,j1,j2
14063 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14065 real(kind=8) :: scal_el=1.0d0
14067 real(kind=8) :: scal_el=0.5d0
14070 ! 13-go grudnia roku pamietnego...
14071 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
14072 0.0d0,1.0d0,0.0d0,&
14073 0.0d0,0.0d0,1.0d0/),shape(unmat))
14074 !el local variables
14075 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m,isubchap
14076 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
14077 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
14078 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
14079 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
14080 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
14081 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
14082 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
14083 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
14084 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
14085 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
14086 ecosam,ecosbm,ecosgm,ghalf,time00
14087 ! integer :: maxconts
14088 ! maxconts = nres/4
14089 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14090 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14091 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14092 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14093 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14094 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14095 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14096 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14097 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
14098 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
14099 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
14100 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
14101 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
14103 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
14104 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
14109 !d write (iout,*) "eelecij",i,j
14113 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
14114 aaa=app(iteli,itelj)
14115 bbb=bpp(iteli,itelj)
14116 ael6i=ael6(iteli,itelj)
14117 ael3i=ael3(iteli,itelj)
14121 dx_normj=dc_norm(1,j)
14122 dy_normj=dc_norm(2,j)
14123 dz_normj=dc_norm(3,j)
14124 ! xj=c(1,j)+0.5D0*dxj-xmedi
14125 ! yj=c(2,j)+0.5D0*dyj-ymedi
14126 ! zj=c(3,j)+0.5D0*dzj-zmedi
14127 xj=c(1,j)+0.5D0*dxj
14128 yj=c(2,j)+0.5D0*dyj
14129 zj=c(3,j)+0.5D0*dzj
14130 xj=mod(xj,boxxsize)
14131 if (xj.lt.0) xj=xj+boxxsize
14132 yj=mod(yj,boxysize)
14133 if (yj.lt.0) yj=yj+boxysize
14134 zj=mod(zj,boxzsize)
14135 if (zj.lt.0) zj=zj+boxzsize
14137 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14144 xj=xj_safe+xshift*boxxsize
14145 yj=yj_safe+yshift*boxysize
14146 zj=zj_safe+zshift*boxzsize
14147 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14148 if(dist_temp.lt.dist_init) then
14149 dist_init=dist_temp
14158 if (isubchap.eq.1) then
14169 rij=xj*xj+yj*yj+zj*zj
14173 ! For extracting the short-range part of Evdwpp
14174 sss=sscale(rij/rpp(iteli,itelj))
14175 sss_ele_cut=sscale_ele(rij)
14176 sss_ele_grad=sscagrad_ele(rij)
14177 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
14178 ! sss_ele_cut=1.0d0
14179 ! sss_ele_grad=0.0d0
14180 if (sss_ele_cut.le.0.0) go to 128
14184 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
14185 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
14186 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
14187 fac=cosa-3.0D0*cosb*cosg
14189 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
14190 if (j.eq.i+2) ev1=scal_el*ev1
14195 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
14198 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
14199 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
14200 ees=ees+eesij*sss_ele_cut
14201 evdw1=evdw1+evdwij*(1.0d0-sss)*sss_ele_cut
14202 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
14203 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
14204 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
14205 !d & xmedi,ymedi,zmedi,xj,yj,zj
14207 if (energy_dec) then
14208 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
14209 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
14213 ! Calculate contributions to the Cartesian gradient.
14216 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
14217 facel=-3*rrmij*(el1+eesij)*sss_ele_cut
14223 ! Radial derivatives. First process both termini of the fragment (i,j)
14225 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj
14226 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj
14227 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj
14229 ! ghalf=0.5D0*ggg(k)
14230 ! gelc(k,i)=gelc(k,i)+ghalf
14231 ! gelc(k,j)=gelc(k,j)+ghalf
14233 ! 9/28/08 AL Gradient compotents will be summed only at the end
14235 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14236 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14239 ! Loop over residues i+1 thru j-1.
14243 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14246 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*(1.0d0-sss) &
14247 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
14248 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*(1.0d0-sss) &
14249 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
14250 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*(1.0d0-sss) &
14251 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
14253 ! ghalf=0.5D0*ggg(k)
14254 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
14255 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
14257 ! 9/28/08 AL Gradient compotents will be summed only at the end
14259 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14260 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14263 ! Loop over residues i+1 thru j-1.
14267 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
14271 facvdw=(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
14272 facel=(el1+eesij)*sss_ele_cut
14274 fac=-3*rrmij*(facvdw+facvdw+facel)
14279 ! Radial derivatives. First process both termini of the fragment (i,j)
14285 ! ghalf=0.5D0*ggg(k)
14286 ! gelc(k,i)=gelc(k,i)+ghalf
14287 ! gelc(k,j)=gelc(k,j)+ghalf
14289 ! 9/28/08 AL Gradient compotents will be summed only at the end
14291 gelc_long(k,j)=gelc(k,j)+ggg(k)
14292 gelc_long(k,i)=gelc(k,i)-ggg(k)
14295 ! Loop over residues i+1 thru j-1.
14299 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14302 ! 9/28/08 AL Gradient compotents will be summed only at the end
14307 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14308 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14314 ecosa=2.0D0*fac3*fac1+fac4
14317 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
14318 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
14320 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14321 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14323 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
14324 !d & (dcosg(k),k=1,3)
14326 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k) )*sss_ele_cut
14329 ! ghalf=0.5D0*ggg(k)
14330 ! gelc(k,i)=gelc(k,i)+ghalf
14331 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
14332 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14333 ! gelc(k,j)=gelc(k,j)+ghalf
14334 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
14335 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14339 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14343 gelc(k,i)=gelc(k,i) &
14344 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14345 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
14347 gelc(k,j)=gelc(k,j) &
14348 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14349 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14351 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14352 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14354 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
14355 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
14356 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14358 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
14359 ! energy of a peptide unit is assumed in the form of a second-order
14360 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
14361 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
14362 ! are computed for EVERY pair of non-contiguous peptide groups.
14364 if (j.lt.nres-1) then
14375 muij(kkk)=mu(k,i)*mu(l,j)
14378 !d write (iout,*) 'EELEC: i',i,' j',j
14379 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
14380 !d write(iout,*) 'muij',muij
14381 ury=scalar(uy(1,i),erij)
14382 urz=scalar(uz(1,i),erij)
14383 vry=scalar(uy(1,j),erij)
14384 vrz=scalar(uz(1,j),erij)
14385 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
14386 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
14387 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
14388 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
14389 fac=dsqrt(-ael6i)*r3ij
14394 !d write (iout,'(4i5,4f10.5)')
14395 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
14396 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
14397 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
14398 !d & uy(:,j),uz(:,j)
14399 !d write (iout,'(4f10.5)')
14400 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
14401 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
14402 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
14403 !d write (iout,'(9f10.5/)')
14404 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
14405 ! Derivatives of the elements of A in virtual-bond vectors
14406 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
14408 uryg(k,1)=scalar(erder(1,k),uy(1,i))
14409 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
14410 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
14411 urzg(k,1)=scalar(erder(1,k),uz(1,i))
14412 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
14413 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
14414 vryg(k,1)=scalar(erder(1,k),uy(1,j))
14415 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
14416 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
14417 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
14418 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
14419 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
14421 ! Compute radial contributions to the gradient
14439 ! Add the contributions coming from er
14442 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
14443 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
14444 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
14445 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
14448 ! Derivatives in DC(i)
14449 !grad ghalf1=0.5d0*agg(k,1)
14450 !grad ghalf2=0.5d0*agg(k,2)
14451 !grad ghalf3=0.5d0*agg(k,3)
14452 !grad ghalf4=0.5d0*agg(k,4)
14453 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
14454 -3.0d0*uryg(k,2)*vry)!+ghalf1
14455 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
14456 -3.0d0*uryg(k,2)*vrz)!+ghalf2
14457 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
14458 -3.0d0*urzg(k,2)*vry)!+ghalf3
14459 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
14460 -3.0d0*urzg(k,2)*vrz)!+ghalf4
14461 ! Derivatives in DC(i+1)
14462 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
14463 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
14464 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
14465 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
14466 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
14467 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
14468 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
14469 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
14470 ! Derivatives in DC(j)
14471 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
14472 -3.0d0*vryg(k,2)*ury)!+ghalf1
14473 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
14474 -3.0d0*vrzg(k,2)*ury)!+ghalf2
14475 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
14476 -3.0d0*vryg(k,2)*urz)!+ghalf3
14477 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
14478 -3.0d0*vrzg(k,2)*urz)!+ghalf4
14479 ! Derivatives in DC(j+1) or DC(nres-1)
14480 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
14481 -3.0d0*vryg(k,3)*ury)
14482 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
14483 -3.0d0*vrzg(k,3)*ury)
14484 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
14485 -3.0d0*vryg(k,3)*urz)
14486 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
14487 -3.0d0*vrzg(k,3)*urz)
14488 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
14490 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
14503 aggi(k,l)=-aggi(k,l)
14504 aggi1(k,l)=-aggi1(k,l)
14505 aggj(k,l)=-aggj(k,l)
14506 aggj1(k,l)=-aggj1(k,l)
14509 if (j.lt.nres-1) then
14515 aggi(k,l)=-aggi(k,l)
14516 aggi1(k,l)=-aggi1(k,l)
14517 aggj(k,l)=-aggj(k,l)
14518 aggj1(k,l)=-aggj1(k,l)
14529 aggi(k,l)=-aggi(k,l)
14530 aggi1(k,l)=-aggi1(k,l)
14531 aggj(k,l)=-aggj(k,l)
14532 aggj1(k,l)=-aggj1(k,l)
14537 IF (wel_loc.gt.0.0d0) THEN
14538 ! Contribution to the local-electrostatic energy coming from the i-j pair
14539 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
14541 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
14543 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
14544 'eelloc',i,j,eel_loc_ij
14545 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
14547 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
14548 ! Partial derivatives in virtual-bond dihedral angles gamma
14550 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
14551 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
14552 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
14554 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
14555 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
14556 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
14562 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
14564 ggg(l)=(agg(l,1)*muij(1)+ &
14565 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
14567 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
14569 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
14570 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
14571 !grad ghalf=0.5d0*ggg(l)
14572 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
14573 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
14577 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
14580 ! Remaining derivatives of eello
14582 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
14583 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
14586 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
14587 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))&
14590 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
14591 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
14594 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
14595 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))&
14600 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
14601 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
14602 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
14603 .and. num_conti.le.maxconts) then
14604 ! write (iout,*) i,j," entered corr"
14606 ! Calculate the contact function. The ith column of the array JCONT will
14607 ! contain the numbers of atoms that make contacts with the atom I (of numbers
14608 ! greater than I). The arrays FACONT and GACONT will contain the values of
14609 ! the contact function and its derivative.
14610 ! r0ij=1.02D0*rpp(iteli,itelj)
14611 ! r0ij=1.11D0*rpp(iteli,itelj)
14612 r0ij=2.20D0*rpp(iteli,itelj)
14613 ! r0ij=1.55D0*rpp(iteli,itelj)
14614 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
14615 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14616 if (fcont.gt.0.0D0) then
14617 num_conti=num_conti+1
14618 if (num_conti.gt.maxconts) then
14619 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14620 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
14621 ' will skip next contacts for this conf.',num_conti
14623 jcont_hb(num_conti,i)=j
14624 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
14625 !d & " jcont_hb",jcont_hb(num_conti,i)
14626 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
14627 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14628 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
14630 d_cont(num_conti,i)=rij
14631 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
14632 ! --- Electrostatic-interaction matrix ---
14633 a_chuj(1,1,num_conti,i)=a22
14634 a_chuj(1,2,num_conti,i)=a23
14635 a_chuj(2,1,num_conti,i)=a32
14636 a_chuj(2,2,num_conti,i)=a33
14637 ! --- Gradient of rij
14639 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
14646 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
14647 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
14648 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
14649 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
14650 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
14655 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
14656 ! Calculate contact energies
14658 wij=cosa-3.0D0*cosb*cosg
14661 ! fac3=dsqrt(-ael6i)/r0ij**3
14662 fac3=dsqrt(-ael6i)*r3ij
14663 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
14664 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
14665 if (ees0tmp.gt.0) then
14666 ees0pij=dsqrt(ees0tmp)
14670 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
14671 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
14672 if (ees0tmp.gt.0) then
14673 ees0mij=dsqrt(ees0tmp)
14678 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
14681 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
14684 ! Diagnostics. Comment out or remove after debugging!
14685 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
14686 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
14687 ! ees0m(num_conti,i)=0.0D0
14689 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
14690 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
14691 ! Angular derivatives of the contact function
14692 ees0pij1=fac3/ees0pij
14693 ees0mij1=fac3/ees0mij
14694 fac3p=-3.0D0*fac3*rrmij
14695 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
14696 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
14698 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
14699 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
14700 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
14701 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
14702 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
14703 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
14704 ecosap=ecosa1+ecosa2
14705 ecosbp=ecosb1+ecosb2
14706 ecosgp=ecosg1+ecosg2
14707 ecosam=ecosa1-ecosa2
14708 ecosbm=ecosb1-ecosb2
14709 ecosgm=ecosg1-ecosg2
14718 facont_hb(num_conti,i)=fcont
14719 fprimcont=fprimcont/rij
14720 !d facont_hb(num_conti,i)=1.0D0
14721 ! Following line is for diagnostics.
14724 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14725 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14728 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
14729 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
14731 ! gggp(1)=gggp(1)+ees0pijp*xj
14732 ! gggp(2)=gggp(2)+ees0pijp*yj
14733 ! gggp(3)=gggp(3)+ees0pijp*zj
14734 ! gggm(1)=gggm(1)+ees0mijp*xj
14735 ! gggm(2)=gggm(2)+ees0mijp*yj
14736 ! gggm(3)=gggm(3)+ees0mijp*zj
14737 gggp(1)=gggp(1)+ees0pijp*xj &
14738 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14739 gggp(2)=gggp(2)+ees0pijp*yj &
14740 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14741 gggp(3)=gggp(3)+ees0pijp*zj &
14742 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14744 gggm(1)=gggm(1)+ees0mijp*xj &
14745 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14747 gggm(2)=gggm(2)+ees0mijp*yj &
14748 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14750 gggm(3)=gggm(3)+ees0mijp*zj &
14751 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14753 ! Derivatives due to the contact function
14754 gacont_hbr(1,num_conti,i)=fprimcont*xj
14755 gacont_hbr(2,num_conti,i)=fprimcont*yj
14756 gacont_hbr(3,num_conti,i)=fprimcont*zj
14759 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
14760 ! following the change of gradient-summation algorithm.
14762 !grad ghalfp=0.5D0*gggp(k)
14763 !grad ghalfm=0.5D0*gggm(k)
14764 ! gacontp_hb1(k,num_conti,i)= & !ghalfp
14765 ! +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14766 ! + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14767 ! gacontp_hb2(k,num_conti,i)= & !ghalfp
14768 ! +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14769 ! + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14770 ! gacontp_hb3(k,num_conti,i)=gggp(k)
14771 ! gacontm_hb1(k,num_conti,i)= &!ghalfm
14772 ! +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14773 ! + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14774 ! gacontm_hb2(k,num_conti,i)= & !ghalfm
14775 ! +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14776 ! + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14777 ! gacontm_hb3(k,num_conti,i)=gggm(k)
14778 gacontp_hb1(k,num_conti,i)= & !ghalfp+
14779 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14780 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14783 gacontp_hb2(k,num_conti,i)= & !ghalfp+
14784 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14785 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14788 gacontp_hb3(k,num_conti,i)=gggp(k) &
14791 gacontm_hb1(k,num_conti,i)= & !ghalfm+
14792 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14793 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14796 gacontm_hb2(k,num_conti,i)= & !ghalfm+
14797 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14798 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
14801 gacontm_hb3(k,num_conti,i)=gggm(k) &
14806 endif ! num_conti.le.maxconts
14809 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
14812 ghalf=0.5d0*agg(l,k)
14813 aggi(l,k)=aggi(l,k)+ghalf
14814 aggi1(l,k)=aggi1(l,k)+agg(l,k)
14815 aggj(l,k)=aggj(l,k)+ghalf
14818 if (j.eq.nres-1 .and. i.lt.j-2) then
14821 aggj1(l,k)=aggj1(l,k)+agg(l,k)
14827 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
14829 end subroutine eelecij_scale
14830 !-----------------------------------------------------------------------------
14831 subroutine evdwpp_short(evdw1)
14835 ! implicit real*8 (a-h,o-z)
14836 ! include 'DIMENSIONS'
14837 ! include 'COMMON.CONTROL'
14838 ! include 'COMMON.IOUNITS'
14839 ! include 'COMMON.GEO'
14840 ! include 'COMMON.VAR'
14841 ! include 'COMMON.LOCAL'
14842 ! include 'COMMON.CHAIN'
14843 ! include 'COMMON.DERIV'
14844 ! include 'COMMON.INTERACT'
14845 ! include 'COMMON.CONTACTS'
14846 ! include 'COMMON.TORSION'
14847 ! include 'COMMON.VECTORS'
14848 ! include 'COMMON.FFIELD'
14849 real(kind=8),dimension(3) :: ggg
14850 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14852 real(kind=8) :: scal_el=1.0d0
14854 real(kind=8) :: scal_el=0.5d0
14856 !el local variables
14857 integer :: i,j,k,iteli,itelj,num_conti,isubchap
14858 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
14859 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
14860 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14861 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
14862 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14863 dist_temp, dist_init,sss_grad
14864 integer xshift,yshift,zshift
14868 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
14869 ! & " iatel_e_vdw",iatel_e_vdw
14871 do i=iatel_s_vdw,iatel_e_vdw
14872 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1) cycle
14876 dx_normi=dc_norm(1,i)
14877 dy_normi=dc_norm(2,i)
14878 dz_normi=dc_norm(3,i)
14879 xmedi=c(1,i)+0.5d0*dxi
14880 ymedi=c(2,i)+0.5d0*dyi
14881 zmedi=c(3,i)+0.5d0*dzi
14882 xmedi=dmod(xmedi,boxxsize)
14883 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14884 ymedi=dmod(ymedi,boxysize)
14885 if (ymedi.lt.0) ymedi=ymedi+boxysize
14886 zmedi=dmod(zmedi,boxzsize)
14887 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14889 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
14890 ! & ' ielend',ielend_vdw(i)
14892 do j=ielstart_vdw(i),ielend_vdw(i)
14893 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
14897 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
14898 aaa=app(iteli,itelj)
14899 bbb=bpp(iteli,itelj)
14903 dx_normj=dc_norm(1,j)
14904 dy_normj=dc_norm(2,j)
14905 dz_normj=dc_norm(3,j)
14906 ! xj=c(1,j)+0.5D0*dxj-xmedi
14907 ! yj=c(2,j)+0.5D0*dyj-ymedi
14908 ! zj=c(3,j)+0.5D0*dzj-zmedi
14909 xj=c(1,j)+0.5D0*dxj
14910 yj=c(2,j)+0.5D0*dyj
14911 zj=c(3,j)+0.5D0*dzj
14912 xj=mod(xj,boxxsize)
14913 if (xj.lt.0) xj=xj+boxxsize
14914 yj=mod(yj,boxysize)
14915 if (yj.lt.0) yj=yj+boxysize
14916 zj=mod(zj,boxzsize)
14917 if (zj.lt.0) zj=zj+boxzsize
14919 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14926 xj=xj_safe+xshift*boxxsize
14927 yj=yj_safe+yshift*boxysize
14928 zj=zj_safe+zshift*boxzsize
14929 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14930 if(dist_temp.lt.dist_init) then
14931 dist_init=dist_temp
14940 if (isubchap.eq.1) then
14951 rij=xj*xj+yj*yj+zj*zj
14954 sss=sscale(rij/rpp(iteli,itelj))
14955 sss_ele_cut=sscale_ele(rij)
14956 sss_ele_grad=sscagrad_ele(rij)
14957 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
14958 if (sss_ele_cut.le.0.0) cycle
14959 if (sss.gt.0.0d0) then
14964 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
14965 if (j.eq.i+2) ev1=scal_el*ev1
14968 if (energy_dec) then
14969 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
14971 evdw1=evdw1+evdwij*sss*sss_ele_cut
14973 ! Calculate contributions to the Cartesian gradient.
14975 facvdw=-6*rrmij*(ev1+evdwij)*sss*sss_ele_cut
14979 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*sss &
14980 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
14981 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*sss &
14982 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
14983 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*sss &
14984 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
14987 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14988 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14994 end subroutine evdwpp_short
14995 !-----------------------------------------------------------------------------
14996 subroutine escp_long(evdw2,evdw2_14)
14998 ! This subroutine calculates the excluded-volume interaction energy between
14999 ! peptide-group centers and side chains and its gradient in virtual-bond and
15000 ! side-chain vectors.
15002 ! implicit real*8 (a-h,o-z)
15003 ! include 'DIMENSIONS'
15004 ! include 'COMMON.GEO'
15005 ! include 'COMMON.VAR'
15006 ! include 'COMMON.LOCAL'
15007 ! include 'COMMON.CHAIN'
15008 ! include 'COMMON.DERIV'
15009 ! include 'COMMON.INTERACT'
15010 ! include 'COMMON.FFIELD'
15011 ! include 'COMMON.IOUNITS'
15012 ! include 'COMMON.CONTROL'
15013 real(kind=8),dimension(3) :: ggg
15014 !el local variables
15015 integer :: i,iint,j,k,iteli,itypj,subchap
15016 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
15017 real(kind=8) :: evdw2,evdw2_14,evdwij
15018 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15019 dist_temp, dist_init
15023 !d print '(a)','Enter ESCP'
15024 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
15025 do i=iatscp_s,iatscp_e
15026 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
15028 xi=0.5D0*(c(1,i)+c(1,i+1))
15029 yi=0.5D0*(c(2,i)+c(2,i+1))
15030 zi=0.5D0*(c(3,i)+c(3,i+1))
15031 xi=mod(xi,boxxsize)
15032 if (xi.lt.0) xi=xi+boxxsize
15033 yi=mod(yi,boxysize)
15034 if (yi.lt.0) yi=yi+boxysize
15035 zi=mod(zi,boxzsize)
15036 if (zi.lt.0) zi=zi+boxzsize
15038 do iint=1,nscp_gr(i)
15040 do j=iscpstart(i,iint),iscpend(i,iint)
15042 if (itypj.eq.ntyp1) cycle
15043 ! Uncomment following three lines for SC-p interactions
15044 ! xj=c(1,nres+j)-xi
15045 ! yj=c(2,nres+j)-yi
15046 ! zj=c(3,nres+j)-zi
15047 ! Uncomment following three lines for Ca-p interactions
15051 xj=mod(xj,boxxsize)
15052 if (xj.lt.0) xj=xj+boxxsize
15053 yj=mod(yj,boxysize)
15054 if (yj.lt.0) yj=yj+boxysize
15055 zj=mod(zj,boxzsize)
15056 if (zj.lt.0) zj=zj+boxzsize
15057 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15065 xj=xj_safe+xshift*boxxsize
15066 yj=yj_safe+yshift*boxysize
15067 zj=zj_safe+zshift*boxzsize
15068 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15069 if(dist_temp.lt.dist_init) then
15070 dist_init=dist_temp
15079 if (subchap.eq.1) then
15088 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15090 rij=dsqrt(1.0d0/rrij)
15091 sss_ele_cut=sscale_ele(rij)
15092 sss_ele_grad=sscagrad_ele(rij)
15093 ! print *,sss_ele_cut,sss_ele_grad,&
15094 ! (rij),r_cut_ele,rlamb_ele
15095 if (sss_ele_cut.le.0.0) cycle
15096 sss=sscale((rij/rscp(itypj,iteli)))
15097 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
15098 if (sss.lt.1.0d0) then
15101 e1=fac*fac*aad(itypj,iteli)
15102 e2=fac*bad(itypj,iteli)
15103 if (iabs(j-i) .le. 2) then
15106 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)*sss_ele_cut
15109 evdw2=evdw2+evdwij*(1.0d0-sss)*sss_ele_cut
15110 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15111 'evdw2',i,j,sss,evdwij
15113 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15115 fac=-(evdwij+e1)*rrij*(1.0d0-sss)*sss_ele_cut
15116 fac=fac+evdwij*sss_ele_grad/rij/expon*(1.0d0-sss)&
15117 -evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15121 ! Uncomment following three lines for SC-p interactions
15123 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15125 ! Uncomment following line for SC-p interactions
15126 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15128 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15129 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15138 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15139 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15140 gradx_scp(j,i)=expon*gradx_scp(j,i)
15143 !******************************************************************************
15147 ! To save time the factor EXPON has been extracted from ALL components
15148 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15151 !******************************************************************************
15153 end subroutine escp_long
15154 !-----------------------------------------------------------------------------
15155 subroutine escp_short(evdw2,evdw2_14)
15157 ! This subroutine calculates the excluded-volume interaction energy between
15158 ! peptide-group centers and side chains and its gradient in virtual-bond and
15159 ! side-chain vectors.
15161 ! implicit real*8 (a-h,o-z)
15162 ! include 'DIMENSIONS'
15163 ! include 'COMMON.GEO'
15164 ! include 'COMMON.VAR'
15165 ! include 'COMMON.LOCAL'
15166 ! include 'COMMON.CHAIN'
15167 ! include 'COMMON.DERIV'
15168 ! include 'COMMON.INTERACT'
15169 ! include 'COMMON.FFIELD'
15170 ! include 'COMMON.IOUNITS'
15171 ! include 'COMMON.CONTROL'
15172 real(kind=8),dimension(3) :: ggg
15173 !el local variables
15174 integer :: i,iint,j,k,iteli,itypj,subchap
15175 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
15176 real(kind=8) :: evdw2,evdw2_14,evdwij
15177 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15178 dist_temp, dist_init
15182 !d print '(a)','Enter ESCP'
15183 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
15184 do i=iatscp_s,iatscp_e
15185 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
15187 xi=0.5D0*(c(1,i)+c(1,i+1))
15188 yi=0.5D0*(c(2,i)+c(2,i+1))
15189 zi=0.5D0*(c(3,i)+c(3,i+1))
15190 xi=mod(xi,boxxsize)
15191 if (xi.lt.0) xi=xi+boxxsize
15192 yi=mod(yi,boxysize)
15193 if (yi.lt.0) yi=yi+boxysize
15194 zi=mod(zi,boxzsize)
15195 if (zi.lt.0) zi=zi+boxzsize
15197 do iint=1,nscp_gr(i)
15199 do j=iscpstart(i,iint),iscpend(i,iint)
15201 if (itypj.eq.ntyp1) cycle
15202 ! Uncomment following three lines for SC-p interactions
15203 ! xj=c(1,nres+j)-xi
15204 ! yj=c(2,nres+j)-yi
15205 ! zj=c(3,nres+j)-zi
15206 ! Uncomment following three lines for Ca-p interactions
15213 xj=mod(xj,boxxsize)
15214 if (xj.lt.0) xj=xj+boxxsize
15215 yj=mod(yj,boxysize)
15216 if (yj.lt.0) yj=yj+boxysize
15217 zj=mod(zj,boxzsize)
15218 if (zj.lt.0) zj=zj+boxzsize
15219 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15227 xj=xj_safe+xshift*boxxsize
15228 yj=yj_safe+yshift*boxysize
15229 zj=zj_safe+zshift*boxzsize
15230 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15231 if(dist_temp.lt.dist_init) then
15232 dist_init=dist_temp
15241 if (subchap.eq.1) then
15251 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15252 rij=dsqrt(1.0d0/rrij)
15253 sss_ele_cut=sscale_ele(rij)
15254 sss_ele_grad=sscagrad_ele(rij)
15255 ! print *,sss_ele_cut,sss_ele_grad,&
15256 ! (rij),r_cut_ele,rlamb_ele
15257 if (sss_ele_cut.le.0.0) cycle
15258 sss=sscale(rij/rscp(itypj,iteli))
15259 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
15260 if (sss.gt.0.0d0) then
15263 e1=fac*fac*aad(itypj,iteli)
15264 e2=fac*bad(itypj,iteli)
15265 if (iabs(j-i) .le. 2) then
15268 evdw2_14=evdw2_14+(e1+e2)*sss*sss_ele_cut
15271 evdw2=evdw2+evdwij*sss*sss_ele_cut
15272 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15273 'evdw2',i,j,sss,evdwij
15275 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15277 fac=-(evdwij+e1)*rrij*sss*sss_ele_cut
15278 fac=fac+evdwij*sss_ele_grad/rij/expon*sss &
15279 +evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15284 ! Uncomment following three lines for SC-p interactions
15286 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15288 ! Uncomment following line for SC-p interactions
15289 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15291 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15292 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15301 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15302 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15303 gradx_scp(j,i)=expon*gradx_scp(j,i)
15306 !******************************************************************************
15310 ! To save time the factor EXPON has been extracted from ALL components
15311 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15314 !******************************************************************************
15316 end subroutine escp_short
15317 !-----------------------------------------------------------------------------
15318 ! energy_p_new-sep_barrier.F
15319 !-----------------------------------------------------------------------------
15320 subroutine sc_grad_scale(scalfac)
15321 ! implicit real*8 (a-h,o-z)
15323 ! include 'DIMENSIONS'
15324 ! include 'COMMON.CHAIN'
15325 ! include 'COMMON.DERIV'
15326 ! include 'COMMON.CALC'
15327 ! include 'COMMON.IOUNITS'
15328 real(kind=8),dimension(3) :: dcosom1,dcosom2
15329 real(kind=8) :: scalfac
15330 !el local variables
15331 ! integer :: i,j,k,l
15333 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
15334 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
15335 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
15336 -2.0D0*alf12*eps3der+sigder*sigsq_om12
15340 ! eom12=evdwij*eps1_om12
15342 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
15343 ! & " sigder",sigder
15344 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
15345 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
15347 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
15348 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
15351 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac&
15354 ! write (iout,*) "gg",(gg(k),k=1,3)
15356 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
15357 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
15358 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
15360 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
15361 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
15362 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac&
15364 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
15365 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
15366 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
15367 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
15370 ! Calculate the components of the gradient in DC and X
15373 gvdwc(l,i)=gvdwc(l,i)-gg(l)
15374 gvdwc(l,j)=gvdwc(l,j)+gg(l)
15377 end subroutine sc_grad_scale
15378 !-----------------------------------------------------------------------------
15379 ! energy_split-sep.F
15380 !-----------------------------------------------------------------------------
15381 subroutine etotal_long(energia)
15383 ! Compute the long-range slow-varying contributions to the energy
15385 ! implicit real*8 (a-h,o-z)
15386 ! include 'DIMENSIONS'
15387 use MD_data, only: totT,usampl,eq_time
15391 !MS$ATTRIBUTES C :: proc_proc
15396 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
15398 ! include 'COMMON.SETUP'
15399 ! include 'COMMON.IOUNITS'
15400 ! include 'COMMON.FFIELD'
15401 ! include 'COMMON.DERIV'
15402 ! include 'COMMON.INTERACT'
15403 ! include 'COMMON.SBRIDGE'
15404 ! include 'COMMON.CHAIN'
15405 ! include 'COMMON.VAR'
15406 ! include 'COMMON.LOCAL'
15407 ! include 'COMMON.MD'
15408 real(kind=8),dimension(0:n_ene) :: energia
15409 !el local variables
15410 integer :: i,n_corr,n_corr1,ierror,ierr
15411 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
15412 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
15413 ecorr,ecorr5,ecorr6,eturn6,time00
15414 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
15415 !elwrite(iout,*)"in etotal long"
15417 if (modecalc.eq.12.or.modecalc.eq.14) then
15419 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
15421 call int_from_cart1(.false.)
15424 !elwrite(iout,*)"in etotal long"
15427 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
15428 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15430 if (nfgtasks.gt.1) then
15432 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15433 if (fg_rank.eq.0) then
15434 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
15435 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15437 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15438 ! FG slaves as WEIGHTS array.
15445 weights_(7)=wel_loc
15448 weights_(10)=wturn6
15450 weights_(12)=wscloc
15452 weights_(14)=wtor_d
15453 weights_(15)=wstrain
15454 weights_(16)=wvdwpp
15456 weights_(18)=scal14
15457 weights_(21)=wsccor
15458 ! FG Master broadcasts the WEIGHTS_ array
15459 call MPI_Bcast(weights_(1),n_ene,&
15460 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15462 ! FG slaves receive the WEIGHTS array
15463 call MPI_Bcast(weights(1),n_ene,&
15464 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15479 wstrain=weights(15)
15485 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
15487 time_Bcast=time_Bcast+MPI_Wtime()-time00
15488 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
15489 ! call chainbuild_cart
15490 ! call int_from_cart1(.false.)
15492 ! write (iout,*) 'Processor',myrank,
15493 ! & ' calling etotal_short ipot=',ipot
15495 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15497 !d print *,'nnt=',nnt,' nct=',nct
15499 !elwrite(iout,*)"in etotal long"
15500 ! Compute the side-chain and electrostatic interaction energy
15502 goto (101,102,103,104,105,106) ipot
15503 ! Lennard-Jones potential.
15504 101 call elj_long(evdw)
15505 !d print '(a)','Exit ELJ'
15507 ! Lennard-Jones-Kihara potential (shifted).
15508 102 call eljk_long(evdw)
15510 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15511 103 call ebp_long(evdw)
15513 ! Gay-Berne potential (shifted LJ, angular dependence).
15514 104 call egb_long(evdw)
15516 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15517 105 call egbv_long(evdw)
15519 ! Soft-sphere potential
15520 106 call e_softsphere(evdw)
15522 ! Calculate electrostatic (H-bonding) energy of the main chain.
15526 if (ipot.lt.6) then
15528 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
15529 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15530 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15531 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15533 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
15534 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15535 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15536 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15538 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
15547 ! write (iout,*) "Soft-spheer ELEC potential"
15548 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
15552 ! Calculate excluded-volume interaction energy between peptide groups
15555 if (ipot.lt.6) then
15556 if(wscp.gt.0d0) then
15557 call escp_long(evdw2,evdw2_14)
15563 call escp_soft_sphere(evdw2,evdw2_14)
15566 ! 12/1/95 Multi-body terms
15570 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
15571 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
15572 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
15573 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
15574 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
15581 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
15582 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
15585 ! If performing constraint dynamics, call the constraint energy
15586 ! after the equilibration time
15587 if(usampl.and.totT.gt.eq_time) then
15602 energia(2)=evdw2-evdw2_14
15603 energia(18)=evdw2_14
15612 energia(3)=ees+evdw1
15619 energia(8)=eello_turn3
15620 energia(9)=eello_turn4
15622 energia(20)=Uconst+Uconst_back
15623 call sum_energy(energia,.true.)
15624 ! write (iout,*) "Exit ETOTAL_LONG"
15627 end subroutine etotal_long
15628 !-----------------------------------------------------------------------------
15629 subroutine etotal_short(energia)
15631 ! Compute the short-range fast-varying contributions to the energy
15633 ! implicit real*8 (a-h,o-z)
15634 ! include 'DIMENSIONS'
15638 !MS$ATTRIBUTES C :: proc_proc
15643 integer :: ierror,ierr
15644 real(kind=8),dimension(n_ene) :: weights_
15645 real(kind=8) :: time00
15647 ! include 'COMMON.SETUP'
15648 ! include 'COMMON.IOUNITS'
15649 ! include 'COMMON.FFIELD'
15650 ! include 'COMMON.DERIV'
15651 ! include 'COMMON.INTERACT'
15652 ! include 'COMMON.SBRIDGE'
15653 ! include 'COMMON.CHAIN'
15654 ! include 'COMMON.VAR'
15655 ! include 'COMMON.LOCAL'
15656 real(kind=8),dimension(0:n_ene) :: energia
15657 !el local variables
15659 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
15660 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr
15663 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
15665 if (modecalc.eq.12.or.modecalc.eq.14) then
15667 if (fg_rank.eq.0) call int_from_cart1(.false.)
15669 call int_from_cart1(.false.)
15673 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
15674 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15676 if (nfgtasks.gt.1) then
15678 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15679 if (fg_rank.eq.0) then
15680 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
15681 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15683 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15684 ! FG slaves as WEIGHTS array.
15691 weights_(7)=wel_loc
15694 weights_(10)=wturn6
15696 weights_(12)=wscloc
15698 weights_(14)=wtor_d
15699 weights_(15)=wstrain
15700 weights_(16)=wvdwpp
15702 weights_(18)=scal14
15703 weights_(21)=wsccor
15704 ! FG Master broadcasts the WEIGHTS_ array
15705 call MPI_Bcast(weights_(1),n_ene,&
15706 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15708 ! FG slaves receive the WEIGHTS array
15709 call MPI_Bcast(weights(1),n_ene,&
15710 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15725 wstrain=weights(15)
15731 ! write (iout,*),"Processor",myrank," BROADCAST weights"
15732 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
15734 ! write (iout,*) "Processor",myrank," BROADCAST c"
15735 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
15737 ! write (iout,*) "Processor",myrank," BROADCAST dc"
15738 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
15740 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
15741 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
15743 ! write (iout,*) "Processor",myrank," BROADCAST theta"
15744 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
15746 ! write (iout,*) "Processor",myrank," BROADCAST phi"
15747 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
15749 ! write (iout,*) "Processor",myrank," BROADCAST alph"
15750 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
15752 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
15753 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
15755 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
15756 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
15758 time_Bcast=time_Bcast+MPI_Wtime()-time00
15759 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
15761 ! write (iout,*) 'Processor',myrank,
15762 ! & ' calling etotal_short ipot=',ipot
15764 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15766 ! call int_from_cart1(.false.)
15768 ! Compute the side-chain and electrostatic interaction energy
15770 goto (101,102,103,104,105,106) ipot
15771 ! Lennard-Jones potential.
15772 101 call elj_short(evdw)
15773 !d print '(a)','Exit ELJ'
15775 ! Lennard-Jones-Kihara potential (shifted).
15776 102 call eljk_short(evdw)
15778 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15779 103 call ebp_short(evdw)
15781 ! Gay-Berne potential (shifted LJ, angular dependence).
15782 104 call egb_short(evdw)
15784 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15785 105 call egbv_short(evdw)
15787 ! Soft-sphere potential - already dealt with in the long-range part
15789 ! 106 call e_softsphere_short(evdw)
15791 ! Calculate electrostatic (H-bonding) energy of the main chain.
15795 ! Calculate the short-range part of Evdwpp
15797 call evdwpp_short(evdw1)
15799 ! Calculate the short-range part of ESCp
15801 if (ipot.lt.6) then
15802 call escp_short(evdw2,evdw2_14)
15805 ! Calculate the bond-stretching energy
15809 ! Calculate the disulfide-bridge and other energy and the contributions
15810 ! from other distance constraints.
15813 ! Calculate the virtual-bond-angle energy.
15815 call ebend(ebe,ethetacnstr)
15817 ! Calculate the SC local energy.
15822 ! Calculate the virtual-bond torsional energy.
15824 call etor(etors,edihcnstr)
15826 ! 6/23/01 Calculate double-torsional energy
15828 call etor_d(etors_d)
15830 ! 21/5/07 Calculate local sicdechain correlation energy
15832 if (wsccor.gt.0.0d0) then
15833 call eback_sc_corr(esccor)
15838 ! Put energy components into an array
15845 energia(2)=evdw2-evdw2_14
15846 energia(18)=evdw2_14
15859 energia(14)=etors_d
15862 energia(19)=edihcnstr
15864 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
15866 call sum_energy(energia,.true.)
15867 ! write (iout,*) "Exit ETOTAL_SHORT"
15870 end subroutine etotal_short
15871 !-----------------------------------------------------------------------------
15873 !-----------------------------------------------------------------------------
15874 real(kind=8) function gnmr1(y,ymin,ymax)
15876 real(kind=8) :: y,ymin,ymax
15877 real(kind=8) :: wykl=4.0d0
15878 if (y.lt.ymin) then
15879 gnmr1=(ymin-y)**wykl/wykl
15880 else if (y.gt.ymax) then
15881 gnmr1=(y-ymax)**wykl/wykl
15887 !-----------------------------------------------------------------------------
15888 real(kind=8) function gnmr1prim(y,ymin,ymax)
15890 real(kind=8) :: y,ymin,ymax
15891 real(kind=8) :: wykl=4.0d0
15892 if (y.lt.ymin) then
15893 gnmr1prim=-(ymin-y)**(wykl-1)
15894 else if (y.gt.ymax) then
15895 gnmr1prim=(y-ymax)**(wykl-1)
15900 end function gnmr1prim
15901 !----------------------------------------------------------------------------
15902 real(kind=8) function rlornmr1(y,ymin,ymax,sigma)
15903 real(kind=8) y,ymin,ymax,sigma
15904 real(kind=8) wykl /4.0d0/
15905 if (y.lt.ymin) then
15906 rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl)
15907 else if (y.gt.ymax) then
15908 rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
15913 end function rlornmr1
15914 !------------------------------------------------------------------------------
15915 real(kind=8) function rlornmr1prim(y,ymin,ymax,sigma)
15916 real(kind=8) y,ymin,ymax,sigma
15917 real(kind=8) wykl /4.0d0/
15918 if (y.lt.ymin) then
15919 rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ &
15920 ((ymin-y)**wykl+sigma**wykl)**2
15921 else if (y.gt.ymax) then
15922 rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ &
15923 ((y-ymax)**wykl+sigma**wykl)**2
15928 end function rlornmr1prim
15930 real(kind=8) function harmonic(y,ymax)
15932 real(kind=8) :: y,ymax
15933 real(kind=8) :: wykl=2.0d0
15934 harmonic=(y-ymax)**wykl
15936 end function harmonic
15937 !-----------------------------------------------------------------------------
15938 real(kind=8) function harmonicprim(y,ymax)
15939 real(kind=8) :: y,ymin,ymax
15940 real(kind=8) :: wykl=2.0d0
15941 harmonicprim=(y-ymax)*wykl
15943 end function harmonicprim
15944 !-----------------------------------------------------------------------------
15946 !-----------------------------------------------------------------------------
15947 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
15949 use io_base, only:intout,briefout
15950 ! implicit real*8 (a-h,o-z)
15951 ! include 'DIMENSIONS'
15952 ! include 'COMMON.CHAIN'
15953 ! include 'COMMON.DERIV'
15954 ! include 'COMMON.VAR'
15955 ! include 'COMMON.INTERACT'
15956 ! include 'COMMON.FFIELD'
15957 ! include 'COMMON.MD'
15958 ! include 'COMMON.IOUNITS'
15959 real(kind=8),external :: ufparm
15960 integer :: uiparm(1)
15961 real(kind=8) :: urparm(1)
15962 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
15963 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
15964 integer :: n,nf,ind,ind1,i,k,j
15966 ! This subroutine calculates total internal coordinate gradient.
15967 ! Depending on the number of function evaluations, either whole energy
15968 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
15969 ! internal coordinates are reevaluated or only the cartesian-in-internal
15970 ! coordinate derivatives are evaluated. The subroutine was designed to work
15976 !d print *,'grad',nf,icg
15977 if (nf-nfl+1) 20,30,40
15978 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
15979 ! write (iout,*) 'grad 20'
15980 if (nf.eq.0) return
15982 30 call var_to_geom(n,x)
15984 ! write (iout,*) 'grad 30'
15986 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
15989 ! write (iout,*) 'grad 40'
15990 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
15992 ! Convert the Cartesian gradient into internal-coordinate gradient.
16002 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
16004 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
16007 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
16013 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
16015 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
16016 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
16019 if (i.gt.1) g(i-1)=gphii
16020 if (n.gt.nphi) g(nphi+i)=gthetai
16022 if (n.le.nphi+ntheta) goto 10
16024 if (itype(i,1).ne.10) then
16028 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
16031 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
16033 g(ialph(i,1))=galphai
16034 g(ialph(i,1)+nside)=gomegai
16038 ! Add the components corresponding to local energy terms.
16042 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
16043 g(i)=g(i)+gloc(i,icg)
16045 ! Uncomment following three lines for diagnostics.
16047 !elwrite(iout,*) "in gradient after calling intout"
16048 !d call briefout(0,0.0d0)
16049 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
16051 end subroutine gradient
16052 !-----------------------------------------------------------------------------
16053 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
16056 ! implicit real*8 (a-h,o-z)
16057 ! include 'DIMENSIONS'
16058 ! include 'COMMON.DERIV'
16059 ! include 'COMMON.IOUNITS'
16060 ! include 'COMMON.GEO'
16063 !el common /chuju/ jjj
16064 real(kind=8) :: energia(0:n_ene)
16065 integer :: uiparm(1)
16066 real(kind=8) :: urparm(1)
16068 real(kind=8),external :: ufparm
16069 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
16070 ! if (jjj.gt.0) then
16071 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
16075 !d print *,'func',nf,nfl,icg
16076 call var_to_geom(n,x)
16079 !d write (iout,*) 'ETOTAL called from FUNC'
16080 call etotal(energia)
16083 ! if (jjj.gt.0) then
16084 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
16085 ! write (iout,*) 'f=',etot
16089 end subroutine func
16090 !-----------------------------------------------------------------------------
16091 subroutine cartgrad
16092 ! implicit real*8 (a-h,o-z)
16093 ! include 'DIMENSIONS'
16095 use MD_data, only: totT,usampl,eq_time
16099 ! include 'COMMON.CHAIN'
16100 ! include 'COMMON.DERIV'
16101 ! include 'COMMON.VAR'
16102 ! include 'COMMON.INTERACT'
16103 ! include 'COMMON.FFIELD'
16104 ! include 'COMMON.MD'
16105 ! include 'COMMON.IOUNITS'
16106 ! include 'COMMON.TIME1'
16110 ! This subrouting calculates total Cartesian coordinate gradient.
16111 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
16121 !el write (iout,*) "After sum_gradient"
16123 !el write (iout,*) "After sum_gradient"
16125 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
16126 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
16129 ! If performing constraint dynamics, add the gradients of the constraint energy
16130 if(usampl.and.totT.gt.eq_time) then
16133 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
16134 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
16138 gloc(i,icg)=gloc(i,icg)+dugamma(i)
16141 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
16144 !elwrite (iout,*) "After sum_gradient"
16149 !elwrite (iout,*) "After sum_gradient"
16151 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
16153 ! call checkintcartgrad
16154 ! write(iout,*) 'calling int_to_cart'
16156 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
16160 gcart(j,i)=gradc(j,i,icg)
16161 gxcart(j,i)=gradx(j,i,icg)
16162 ! if (i.le.2) print *,"gcart_one",gcart(j,i),gradc(j,i,icg)
16165 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
16166 (gxcart(j,i),j=1,3),gloc(i,icg)
16172 print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
16174 print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
16177 time_inttocart=time_inttocart+MPI_Wtime()-time01
16180 write (iout,*) "gcart and gxcart after int_to_cart"
16182 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
16183 (gxcart(j,i),j=1,3)
16188 write (iout,*) "CARGRAD"
16192 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
16193 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
16195 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
16196 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
16198 ! Correction: dummy residues
16201 ! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
16202 gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
16205 if (nct.lt.nres) then
16207 ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
16208 gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
16213 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
16217 end subroutine cartgrad
16218 !-----------------------------------------------------------------------------
16219 subroutine zerograd
16220 ! implicit real*8 (a-h,o-z)
16221 ! include 'DIMENSIONS'
16222 ! include 'COMMON.DERIV'
16223 ! include 'COMMON.CHAIN'
16224 ! include 'COMMON.VAR'
16225 ! include 'COMMON.MD'
16226 ! include 'COMMON.SCCOR'
16228 !el local variables
16229 integer :: i,j,intertyp,k
16230 ! Initialize Cartesian-coordinate gradient
16232 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
16233 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
16235 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
16236 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
16237 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
16238 ! allocate(gradcorr_long(3,nres))
16239 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
16240 ! allocate(gcorr6_turn_long(3,nres))
16241 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
16243 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
16245 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
16246 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
16248 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
16249 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
16251 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
16252 ! allocate(gscloc(3,nres)) !(3,maxres)
16253 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
16257 ! common /deriv_scloc/
16258 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
16259 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
16260 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
16262 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
16266 ! gradc(j,i,icg)=0.0d0
16267 ! gradx(j,i,icg)=0.0d0
16269 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
16270 !elwrite(iout,*) "icg",icg
16274 gradx_scp(j,i)=0.0D0
16276 gvdwc_scp(j,i)=0.0D0
16277 gvdwc_scpp(j,i)=0.0d0
16279 gelc_long(j,i)=0.0D0
16284 gel_loc_long(j,i)=0.0d0
16287 gcorr3_turn(j,i)=0.0d0
16288 gcorr4_turn(j,i)=0.0d0
16289 gradcorr(j,i)=0.0d0
16290 gradcorr_long(j,i)=0.0d0
16291 gradcorr5_long(j,i)=0.0d0
16292 gradcorr6_long(j,i)=0.0d0
16293 gcorr6_turn_long(j,i)=0.0d0
16294 gradcorr5(j,i)=0.0d0
16295 gradcorr6(j,i)=0.0d0
16296 gcorr6_turn(j,i)=0.0d0
16299 gradc(j,i,icg)=0.0d0
16300 gradx(j,i,icg)=0.0d0
16303 gliptran(j,i)=0.0d0
16304 gliptranx(j,i)=0.0d0
16305 gliptranc(j,i)=0.0d0
16306 gshieldx(j,i)=0.0d0
16307 gshieldc(j,i)=0.0d0
16308 gshieldc_loc(j,i)=0.0d0
16309 gshieldx_ec(j,i)=0.0d0
16310 gshieldc_ec(j,i)=0.0d0
16311 gshieldc_loc_ec(j,i)=0.0d0
16312 gshieldx_t3(j,i)=0.0d0
16313 gshieldc_t3(j,i)=0.0d0
16314 gshieldc_loc_t3(j,i)=0.0d0
16315 gshieldx_t4(j,i)=0.0d0
16316 gshieldc_t4(j,i)=0.0d0
16317 gshieldc_loc_t4(j,i)=0.0d0
16318 gshieldx_ll(j,i)=0.0d0
16319 gshieldc_ll(j,i)=0.0d0
16320 gshieldc_loc_ll(j,i)=0.0d0
16322 gg_tube_sc(j,i)=0.0d0
16324 gradb_nucl(j,i)=0.0d0
16325 gradbx_nucl(j,i)=0.0d0
16326 gvdwpp_nucl(j,i)=0.0d0
16330 gvdwpsb1(j,i)=0.0d0
16334 gradcorr_nucl(j,i)=0.0d0
16335 gradcorr3_nucl(j,i)=0.0d0
16336 gradxorr_nucl(j,i)=0.0d0
16337 gradxorr3_nucl(j,i)=0.0d0
16346 gloc_sc(intertyp,i,icg)=0.0d0
16355 grad_shield_side(k,j,i)=0.0d0
16356 grad_shield_loc(k,j,i)=0.0d0
16363 ! Initialize the gradient of local energy terms.
16365 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
16366 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
16367 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
16368 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
16369 ! allocate(gel_loc_turn3(nres))
16370 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
16371 ! allocate(gsccor_loc(nres)) !(maxres)
16377 gel_loc_loc(i)=0.0d0
16379 g_corr5_loc(i)=0.0d0
16380 g_corr6_loc(i)=0.0d0
16381 gel_loc_turn3(i)=0.0d0
16382 gel_loc_turn4(i)=0.0d0
16383 gel_loc_turn6(i)=0.0d0
16384 gsccor_loc(i)=0.0d0
16386 ! initialize gcart and gxcart
16387 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
16395 end subroutine zerograd
16396 !-----------------------------------------------------------------------------
16397 real(kind=8) function fdum()
16401 !-----------------------------------------------------------------------------
16403 !-----------------------------------------------------------------------------
16404 subroutine intcartderiv
16405 ! implicit real*8 (a-h,o-z)
16406 ! include 'DIMENSIONS'
16410 ! include 'COMMON.SETUP'
16411 ! include 'COMMON.CHAIN'
16412 ! include 'COMMON.VAR'
16413 ! include 'COMMON.GEO'
16414 ! include 'COMMON.INTERACT'
16415 ! include 'COMMON.DERIV'
16416 ! include 'COMMON.IOUNITS'
16417 ! include 'COMMON.LOCAL'
16418 ! include 'COMMON.SCCOR'
16419 real(kind=8) :: pi4,pi34
16420 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
16421 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
16422 dcosomega,dsinomega !(3,3,maxres)
16423 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
16426 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
16427 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
16428 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
16429 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
16433 !el from module energy-------------
16434 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
16435 !el allocate(dsintau(3,3,3,itau_start:itau_end))
16436 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
16438 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
16439 !el allocate(dsintau(3,3,3,0:nres2))
16440 !el allocate(dtauangle(3,3,3,0:nres2))
16441 !el allocate(domicron(3,2,2,0:nres2))
16442 !el allocate(dcosomicron(3,2,2,0:nres2))
16446 #if defined(MPI) && defined(PARINTDER)
16447 if (nfgtasks.gt.1 .and. me.eq.king) &
16448 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
16453 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
16454 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
16456 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
16459 dtheta(j,1,i)=0.0d0
16460 dtheta(j,2,i)=0.0d0
16466 ! Derivatives of theta's
16467 #if defined(MPI) && defined(PARINTDER)
16468 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16469 do i=max0(ithet_start-1,3),ithet_end
16473 cost=dcos(theta(i))
16474 sint=sqrt(1-cost*cost)
16476 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
16478 if (itype(i-1,1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
16479 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
16481 if (itype(i-1,1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
16484 #if defined(MPI) && defined(PARINTDER)
16485 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16486 do i=max0(ithet_start-1,3),ithet_end
16490 if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1)) then
16491 cost1=dcos(omicron(1,i))
16492 sint1=sqrt(1-cost1*cost1)
16493 cost2=dcos(omicron(2,i))
16494 sint2=sqrt(1-cost2*cost2)
16496 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
16497 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
16498 cost1*dc_norm(j,i-2))/ &
16500 domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i)
16501 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
16502 +cost1*(dc_norm(j,i-1+nres)))/ &
16504 domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i)
16505 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
16506 !C Looks messy but better than if in loop
16507 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
16508 +cost2*dc_norm(j,i-1))/ &
16510 domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i)
16511 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
16512 +cost2*(-dc_norm(j,i-1+nres)))/ &
16514 ! write(iout,*) "vbld", i,itype(i,1),vbld(i-1+nres)
16515 domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i)
16519 !elwrite(iout,*) "after vbld write"
16520 ! Derivatives of phi:
16521 ! If phi is 0 or 180 degrees, then the formulas
16522 ! have to be derived by power series expansion of the
16523 ! conventional formulas around 0 and 180.
16525 do i=iphi1_start,iphi1_end
16529 ! if (itype(i-1,1).eq.21 .or. itype(i-2,1).eq.21 ) cycle
16530 ! the conventional case
16531 sint=dsin(theta(i))
16532 sint1=dsin(theta(i-1))
16534 cost=dcos(theta(i))
16535 cost1=dcos(theta(i-1))
16537 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
16538 fac0=1.0d0/(sint1*sint)
16541 fac3=cosg*cost1/(sint1*sint1)
16542 fac4=cosg*cost/(sint*sint)
16543 ! Obtaining the gamma derivatives from sine derivative
16544 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
16545 phi(i).gt.pi34.and.phi(i).le.pi.or. &
16546 phi(i).ge.-pi.and.phi(i).le.-pi34) then
16547 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16548 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
16549 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16553 cosg_inv=1.0d0/cosg
16554 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
16555 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16556 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
16557 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
16559 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
16560 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16561 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
16562 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
16563 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16564 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16565 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
16567 ! Bug fixed 3/24/05 (AL)
16569 ! Obtaining the gamma derivatives from cosine derivative
16572 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
16573 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16574 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16575 dc_norm(j,i-3))/vbld(i-2)
16576 dphi(j,1,i)=-1/sing*dcosphi(j,1,i)
16577 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16578 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16580 dphi(j,2,i)=-1/sing*dcosphi(j,2,i)
16581 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16582 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16583 dc_norm(j,i-1))/vbld(i)
16584 dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
16589 !alculate derivative of Tauangle
16591 do i=itau_start,itau_end
16594 !elwrite(iout,*) " vecpr",i,nres
16596 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
16597 ! if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10).or.
16598 ! & (itype(i-1,1).eq.ntyp1).or.(itype(i,1).eq.ntyp1)) cycle
16599 !c dtauangle(j,intertyp,dervityp,residue number)
16600 !c INTERTYP=1 SC...Ca...Ca..Ca
16601 ! the conventional case
16602 sint=dsin(theta(i))
16603 sint1=dsin(omicron(2,i-1))
16604 sing=dsin(tauangle(1,i))
16605 cost=dcos(theta(i))
16606 cost1=dcos(omicron(2,i-1))
16607 cosg=dcos(tauangle(1,i))
16608 !elwrite(iout,*) " vecpr5",i,nres
16610 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
16611 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
16612 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16613 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
16615 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
16616 fac0=1.0d0/(sint1*sint)
16619 fac3=cosg*cost1/(sint1*sint1)
16620 fac4=cosg*cost/(sint*sint)
16621 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
16622 ! Obtaining the gamma derivatives from sine derivative
16623 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
16624 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
16625 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
16626 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16627 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
16628 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16632 cosg_inv=1.0d0/cosg
16633 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16634 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
16635 *vbld_inv(i-2+nres)
16636 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
16637 dsintau(j,1,2,i)= &
16638 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
16639 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16640 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
16641 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
16642 ! Bug fixed 3/24/05 (AL)
16643 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
16644 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16645 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16646 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
16648 ! Obtaining the gamma derivatives from cosine derivative
16651 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16652 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16653 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
16654 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
16655 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16656 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16658 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
16659 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16660 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
16661 dc_norm(j,i-1))/vbld(i)
16662 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
16663 ! write (iout,*) "else",i
16667 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
16670 !C Second case Ca...Ca...Ca...SC
16672 do i=itau_start,itau_end
16676 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
16677 (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle
16678 ! the conventional case
16679 sint=dsin(omicron(1,i))
16680 sint1=dsin(theta(i-1))
16681 sing=dsin(tauangle(2,i))
16682 cost=dcos(omicron(1,i))
16683 cost1=dcos(theta(i-1))
16684 cosg=dcos(tauangle(2,i))
16686 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16688 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
16689 fac0=1.0d0/(sint1*sint)
16692 fac3=cosg*cost1/(sint1*sint1)
16693 fac4=cosg*cost/(sint*sint)
16694 ! Obtaining the gamma derivatives from sine derivative
16695 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
16696 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
16697 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
16698 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
16699 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
16700 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16704 cosg_inv=1.0d0/cosg
16705 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16706 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
16707 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
16708 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
16709 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
16710 dsintau(j,2,2,i)= &
16711 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
16712 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16713 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
16714 ! & sing*ctgt*domicron(j,1,2,i),
16715 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16716 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
16717 ! Bug fixed 3/24/05 (AL)
16718 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16719 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
16720 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16721 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
16723 ! Obtaining the gamma derivatives from cosine derivative
16726 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16727 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16728 dc_norm(j,i-3))/vbld(i-2)
16729 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
16730 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16731 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16732 dcosomicron(j,1,1,i)
16733 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
16734 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16735 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16736 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16737 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
16738 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
16743 !CC third case SC...Ca...Ca...SC
16746 do i=itau_start,itau_end
16750 ! the conventional case
16751 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
16752 (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
16753 sint=dsin(omicron(1,i))
16754 sint1=dsin(omicron(2,i-1))
16755 sing=dsin(tauangle(3,i))
16756 cost=dcos(omicron(1,i))
16757 cost1=dcos(omicron(2,i-1))
16758 cosg=dcos(tauangle(3,i))
16760 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16761 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16763 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
16764 fac0=1.0d0/(sint1*sint)
16767 fac3=cosg*cost1/(sint1*sint1)
16768 fac4=cosg*cost/(sint*sint)
16769 ! Obtaining the gamma derivatives from sine derivative
16770 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
16771 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
16772 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
16773 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
16774 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
16775 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16779 cosg_inv=1.0d0/cosg
16780 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16781 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
16782 *vbld_inv(i-2+nres)
16783 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
16784 dsintau(j,3,2,i)= &
16785 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
16786 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16787 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
16788 ! Bug fixed 3/24/05 (AL)
16789 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16790 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
16791 *vbld_inv(i-1+nres)
16792 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16793 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
16795 ! Obtaining the gamma derivatives from cosine derivative
16798 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16799 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16800 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
16801 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
16802 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16803 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16804 dcosomicron(j,1,1,i)
16805 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
16806 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16807 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
16808 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16809 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
16810 ! write(iout,*) "else",i
16816 ! Derivatives of side-chain angles alpha and omega
16817 #if defined(MPI) && defined(PARINTDER)
16818 do i=ibond_start,ibond_end
16822 if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
16823 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
16826 fac8=fac5/vbld(i+1)
16827 fac9=fac5/vbld(i+nres)
16828 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
16829 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
16830 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
16831 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
16832 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
16833 sina=sqrt(1-cosa*cosa)
16835 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
16837 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
16838 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
16839 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
16840 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
16841 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
16842 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
16843 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
16844 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
16846 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
16848 ! obtaining the derivatives of omega from sines
16849 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
16850 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
16851 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
16852 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
16854 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
16855 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
16856 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
16857 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
16858 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
16859 coso_inv=1.0d0/dcos(omeg(i))
16861 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
16862 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
16863 (sino*dc_norm(j,i-1))/vbld(i)
16864 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
16865 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
16866 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
16867 -sino*dc_norm(j,i)/vbld(i+1)
16868 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
16869 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
16870 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
16872 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
16875 ! obtaining the derivatives of omega from cosines
16876 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
16877 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
16882 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
16883 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
16884 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
16885 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
16886 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
16887 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
16888 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
16889 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
16890 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
16891 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
16892 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
16893 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
16894 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
16895 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
16896 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
16902 dalpha(k,j,i)=0.0d0
16903 domega(k,j,i)=0.0d0
16909 #if defined(MPI) && defined(PARINTDER)
16910 if (nfgtasks.gt.1) then
16912 !d write (iout,*) "Gather dtheta"
16913 !d call flush(iout)
16914 write (iout,*) "dtheta before gather"
16916 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
16919 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
16920 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
16921 king,FG_COMM,IERROR)
16923 !d write (iout,*) "Gather dphi"
16924 !d call flush(iout)
16925 write (iout,*) "dphi before gather"
16927 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
16930 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
16931 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
16932 king,FG_COMM,IERROR)
16933 !d write (iout,*) "Gather dalpha"
16934 !d call flush(iout)
16936 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
16937 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
16938 king,FG_COMM,IERROR)
16939 !d write (iout,*) "Gather domega"
16940 !d call flush(iout)
16941 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
16942 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
16943 king,FG_COMM,IERROR)
16948 write (iout,*) "dtheta after gather"
16950 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
16952 write (iout,*) "dphi after gather"
16954 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
16956 write (iout,*) "dalpha after gather"
16958 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
16960 write (iout,*) "domega after gather"
16962 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
16966 end subroutine intcartderiv
16967 !-----------------------------------------------------------------------------
16968 subroutine checkintcartgrad
16969 ! implicit real*8 (a-h,o-z)
16970 ! include 'DIMENSIONS'
16974 ! include 'COMMON.CHAIN'
16975 ! include 'COMMON.VAR'
16976 ! include 'COMMON.GEO'
16977 ! include 'COMMON.INTERACT'
16978 ! include 'COMMON.DERIV'
16979 ! include 'COMMON.IOUNITS'
16980 ! include 'COMMON.SETUP'
16981 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
16982 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
16983 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
16984 real(kind=8),dimension(3) :: dc_norm_s
16985 real(kind=8) :: aincr=1.0d-5
16987 real(kind=8) :: dcji
16990 theta_s(i)=theta(i)
16994 ! Check theta gradient
16996 "Analytical (upper) and numerical (lower) gradient of theta"
17001 dc(j,i-2)=dcji+aincr
17002 call chainbuild_cart
17003 call int_from_cart1(.false.)
17004 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
17007 dc(j,i-1)=dc(j,i-1)+aincr
17008 call chainbuild_cart
17009 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
17012 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
17013 !el (dtheta(j,2,i),j=1,3)
17014 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
17015 !el (dthetanum(j,2,i),j=1,3)
17016 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
17017 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
17018 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
17021 ! Check gamma gradient
17023 "Analytical (upper) and numerical (lower) gradient of gamma"
17027 dc(j,i-3)=dcji+aincr
17028 call chainbuild_cart
17029 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
17032 dc(j,i-2)=dcji+aincr
17033 call chainbuild_cart
17034 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
17037 dc(j,i-1)=dc(j,i-1)+aincr
17038 call chainbuild_cart
17039 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
17042 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
17043 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
17044 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
17045 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
17046 !el write (iout,'(5x,3(3f10.5,5x))') &
17047 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
17048 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
17049 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
17052 ! Check alpha gradient
17054 "Analytical (upper) and numerical (lower) gradient of alpha"
17056 if(itype(i,1).ne.10) then
17059 dc(j,i-1)=dcji+aincr
17060 call chainbuild_cart
17061 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
17066 call chainbuild_cart
17067 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
17071 dc(j,i+nres)=dc(j,i+nres)+aincr
17072 call chainbuild_cart
17073 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
17078 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
17079 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
17080 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
17081 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
17082 !el write (iout,'(5x,3(3f10.5,5x))') &
17083 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
17084 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
17085 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
17088 ! Check omega gradient
17090 "Analytical (upper) and numerical (lower) gradient of omega"
17092 if(itype(i,1).ne.10) then
17095 dc(j,i-1)=dcji+aincr
17096 call chainbuild_cart
17097 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
17102 call chainbuild_cart
17103 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
17107 dc(j,i+nres)=dc(j,i+nres)+aincr
17108 call chainbuild_cart
17109 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
17114 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
17115 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
17116 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
17117 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
17118 !el write (iout,'(5x,3(3f10.5,5x))') &
17119 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
17120 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
17121 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
17125 end subroutine checkintcartgrad
17126 !-----------------------------------------------------------------------------
17128 !-----------------------------------------------------------------------------
17129 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
17130 ! implicit real*8 (a-h,o-z)
17131 ! include 'DIMENSIONS'
17132 ! include 'COMMON.IOUNITS'
17133 ! include 'COMMON.CHAIN'
17134 ! include 'COMMON.INTERACT'
17135 ! include 'COMMON.VAR'
17136 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
17137 integer :: kkk,nsep=3
17138 real(kind=8) :: qm !dist,
17139 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
17140 logical :: lprn=.false.
17142 ! real(kind=8) :: sigm,x
17144 !el sigm(x)=0.25d0*x ! local function
17150 do il=seg1+nsep,seg2
17153 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
17154 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
17155 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17157 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
17158 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17161 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17162 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17163 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17164 dijCM=dist(il+nres,jl+nres)
17165 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
17167 qq = qq+qqij+qqijCM
17173 if((seg3-il).lt.3) then
17180 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17181 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17182 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17184 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
17185 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17188 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17189 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17190 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17191 dijCM=dist(il+nres,jl+nres)
17192 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
17194 qq = qq+qqij+qqijCM
17199 if (qqmax.le.qq) qqmax=qq
17201 qwolynes=1.0d0-qqmax
17203 end function qwolynes
17204 !-----------------------------------------------------------------------------
17205 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
17206 ! implicit real*8 (a-h,o-z)
17207 ! include 'DIMENSIONS'
17208 ! include 'COMMON.IOUNITS'
17209 ! include 'COMMON.CHAIN'
17210 ! include 'COMMON.INTERACT'
17211 ! include 'COMMON.VAR'
17212 ! include 'COMMON.MD'
17213 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
17214 integer :: nsep=3, kkk
17215 !el real(kind=8) :: dist
17216 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
17217 logical :: lprn=.false.
17219 real(kind=8) :: sim,dd0,fac,ddqij
17220 !el sigm(x)=0.25d0*x ! local function
17230 do il=seg1+nsep,seg2
17233 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17234 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17235 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17237 sim = 1.0d0/sigm(d0ij)
17240 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
17242 ddqij = (c(k,il)-c(k,jl))*fac
17243 dqwol(k,il)=dqwol(k,il)+ddqij
17244 dqwol(k,jl)=dqwol(k,jl)-ddqij
17247 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17250 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17251 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17252 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17253 dijCM=dist(il+nres,jl+nres)
17254 sim = 1.0d0/sigm(d0ijCM)
17257 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17259 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17260 dxqwol(k,il)=dxqwol(k,il)+ddqij
17261 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17268 if((seg3-il).lt.3) then
17275 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17276 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17277 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17279 sim = 1.0d0/sigm(d0ij)
17282 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
17284 ddqij = (c(k,il)-c(k,jl))*fac
17285 dqwol(k,il)=dqwol(k,il)+ddqij
17286 dqwol(k,jl)=dqwol(k,jl)-ddqij
17288 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17291 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17292 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17293 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17294 dijCM=dist(il+nres,jl+nres)
17295 sim = 1.0d0/sigm(d0ijCM)
17298 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17300 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17301 dxqwol(k,il)=dxqwol(k,il)+ddqij
17302 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17311 dqwol(j,i)=dqwol(j,i)/nl
17312 dxqwol(j,i)=dxqwol(j,i)/nl
17316 end subroutine qwolynes_prim
17317 !-----------------------------------------------------------------------------
17318 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
17319 ! implicit real*8 (a-h,o-z)
17320 ! include 'DIMENSIONS'
17321 ! include 'COMMON.IOUNITS'
17322 ! include 'COMMON.CHAIN'
17323 ! include 'COMMON.INTERACT'
17324 ! include 'COMMON.VAR'
17325 integer :: seg1,seg2,seg3,seg4
17327 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
17328 real(kind=8),dimension(3,0:2*nres) :: cdummy
17329 real(kind=8) :: q1,q2
17330 real(kind=8) :: delta=1.0d-10
17335 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
17337 c(j,i)=c(j,i)+delta
17338 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
17339 qwolan(j,i)=(q2-q1)/delta
17345 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
17346 cdummy(j,i+nres)=c(j,i+nres)
17347 c(j,i+nres)=c(j,i+nres)+delta
17348 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
17349 qwolxan(j,i)=(q2-q1)/delta
17350 c(j,i+nres)=cdummy(j,i+nres)
17353 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
17355 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
17357 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
17359 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
17362 end subroutine qwol_num
17363 !-----------------------------------------------------------------------------
17364 subroutine EconstrQ
17365 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
17366 ! implicit real*8 (a-h,o-z)
17367 ! include 'DIMENSIONS'
17368 ! include 'COMMON.CONTROL'
17369 ! include 'COMMON.VAR'
17370 ! include 'COMMON.MD'
17373 ! include 'COMMON.LANGEVIN'
17375 ! include 'COMMON.LANGEVIN.lang0'
17377 ! include 'COMMON.CHAIN'
17378 ! include 'COMMON.DERIV'
17379 ! include 'COMMON.GEO'
17380 ! include 'COMMON.LOCAL'
17381 ! include 'COMMON.INTERACT'
17382 ! include 'COMMON.IOUNITS'
17383 ! include 'COMMON.NAMES'
17384 ! include 'COMMON.TIME1'
17385 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
17386 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
17388 integer :: kstart,kend,lstart,lend,idummy
17389 real(kind=8) :: delta=1.0d-7
17390 integer :: i,j,k,ii
17394 dudconst(j,i)=0.0d0
17395 duxconst(j,i)=0.0d0
17396 dudxconst(j,i)=0.0d0
17401 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
17403 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
17404 ! Calculating the derivatives of Constraint energy with respect to Q
17405 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
17407 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
17408 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
17409 ! hmnum=(hm2-hm1)/delta
17410 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
17411 ! & qinfrag(i,iset))
17412 ! write(iout,*) "harmonicnum frag", hmnum
17413 ! Calculating the derivatives of Q with respect to cartesian coordinates
17414 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
17416 ! write(iout,*) "dqwol "
17418 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17420 ! write(iout,*) "dxqwol "
17422 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17424 ! Calculating numerical gradients of dU/dQi and dQi/dxi
17425 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
17426 ! & ,idummy,idummy)
17427 ! The gradients of Uconst in Cs
17430 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
17431 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
17436 kstart=ifrag(1,ipair(1,i,iset),iset)
17437 kend=ifrag(2,ipair(1,i,iset),iset)
17438 lstart=ifrag(1,ipair(2,i,iset),iset)
17439 lend=ifrag(2,ipair(2,i,iset),iset)
17440 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
17441 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
17442 ! Calculating dU/dQ
17443 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
17444 ! hm1=harmonic(qpair(i),qinpair(i,iset))
17445 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
17446 ! hmnum=(hm2-hm1)/delta
17447 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
17448 ! & qinpair(i,iset))
17449 ! write(iout,*) "harmonicnum pair ", hmnum
17450 ! Calculating dQ/dXi
17451 call qwolynes_prim(kstart,kend,.false.,&
17453 ! write(iout,*) "dqwol "
17455 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17457 ! write(iout,*) "dxqwol "
17459 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17461 ! Calculating numerical gradients
17462 ! call qwol_num(kstart,kend,.false.
17464 ! The gradients of Uconst in Cs
17467 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
17468 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
17472 ! write(iout,*) "Uconst inside subroutine ", Uconst
17473 ! Transforming the gradients from Cs to dCs for the backbone
17477 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
17481 ! Transforming the gradients from Cs to dCs for the side chains
17484 dudxconst(j,i)=duxconst(j,i)
17487 ! write(iout,*) "dU/ddc backbone "
17489 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
17491 ! write(iout,*) "dU/ddX side chain "
17493 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
17495 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
17496 ! call dEconstrQ_num
17498 end subroutine EconstrQ
17499 !-----------------------------------------------------------------------------
17500 subroutine dEconstrQ_num
17501 ! Calculating numerical dUconst/ddc and dUconst/ddx
17502 ! implicit real*8 (a-h,o-z)
17503 ! include 'DIMENSIONS'
17504 ! include 'COMMON.CONTROL'
17505 ! include 'COMMON.VAR'
17506 ! include 'COMMON.MD'
17509 ! include 'COMMON.LANGEVIN'
17511 ! include 'COMMON.LANGEVIN.lang0'
17513 ! include 'COMMON.CHAIN'
17514 ! include 'COMMON.DERIV'
17515 ! include 'COMMON.GEO'
17516 ! include 'COMMON.LOCAL'
17517 ! include 'COMMON.INTERACT'
17518 ! include 'COMMON.IOUNITS'
17519 ! include 'COMMON.NAMES'
17520 ! include 'COMMON.TIME1'
17521 real(kind=8) :: uzap1,uzap2
17522 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
17523 integer :: kstart,kend,lstart,lend,idummy
17524 real(kind=8) :: delta=1.0d-7
17525 !el local variables
17531 dUcartan(j,i)=0.0d0
17532 cdummy(j,i)=dc(j,i)
17533 dc(j,i)=dc(j,i)+delta
17534 call chainbuild_cart
17537 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17539 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17543 kstart=ifrag(1,ipair(1,ii,iset),iset)
17544 kend=ifrag(2,ipair(1,ii,iset),iset)
17545 lstart=ifrag(1,ipair(2,ii,iset),iset)
17546 lend=ifrag(2,ipair(2,ii,iset),iset)
17547 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17548 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17551 dc(j,i)=cdummy(j,i)
17552 call chainbuild_cart
17555 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17557 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17561 kstart=ifrag(1,ipair(1,ii,iset),iset)
17562 kend=ifrag(2,ipair(1,ii,iset),iset)
17563 lstart=ifrag(1,ipair(2,ii,iset),iset)
17564 lend=ifrag(2,ipair(2,ii,iset),iset)
17565 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17566 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17569 ducartan(j,i)=(uzap2-uzap1)/(delta)
17572 ! Calculating numerical gradients for dU/ddx
17574 duxcartan(j,i)=0.0d0
17576 cdummy(j,i)=dc(j,i+nres)
17577 dc(j,i+nres)=dc(j,i+nres)+delta
17578 call chainbuild_cart
17581 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17583 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17587 kstart=ifrag(1,ipair(1,ii,iset),iset)
17588 kend=ifrag(2,ipair(1,ii,iset),iset)
17589 lstart=ifrag(1,ipair(2,ii,iset),iset)
17590 lend=ifrag(2,ipair(2,ii,iset),iset)
17591 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17592 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17595 dc(j,i+nres)=cdummy(j,i)
17596 call chainbuild_cart
17599 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
17600 ifrag(2,ii,iset),.true.,idummy,idummy)
17601 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17605 kstart=ifrag(1,ipair(1,ii,iset),iset)
17606 kend=ifrag(2,ipair(1,ii,iset),iset)
17607 lstart=ifrag(1,ipair(2,ii,iset),iset)
17608 lend=ifrag(2,ipair(2,ii,iset),iset)
17609 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17610 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17613 duxcartan(j,i)=(uzap2-uzap1)/(delta)
17616 write(iout,*) "Numerical dUconst/ddc backbone "
17618 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
17620 ! write(iout,*) "Numerical dUconst/ddx side-chain "
17622 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
17625 end subroutine dEconstrQ_num
17626 !-----------------------------------------------------------------------------
17628 !-----------------------------------------------------------------------------
17629 subroutine check_energies
17631 ! use random, only: ran_number
17635 ! include 'DIMENSIONS'
17636 ! include 'COMMON.CHAIN'
17637 ! include 'COMMON.VAR'
17638 ! include 'COMMON.IOUNITS'
17639 ! include 'COMMON.SBRIDGE'
17640 ! include 'COMMON.LOCAL'
17641 ! include 'COMMON.GEO'
17643 ! External functions
17644 !EL double precision ran_number
17645 !EL external ran_number
17648 integer :: i,j,k,l,lmax,p,pmax
17649 real(kind=8) :: rmin,rmax
17650 real(kind=8) :: eij
17653 real(kind=8) :: wi,rij,tj,pj
17675 !t wi=ran_number(0.0D0,pi)
17676 ! wi=ran_number(0.0D0,pi/6.0D0)
17678 !t tj=ran_number(0.0D0,pi)
17679 !t pj=ran_number(0.0D0,pi)
17680 ! pj=ran_number(0.0D0,pi/6.0D0)
17684 !t rij=ran_number(rmin,rmax)
17686 c(1,j)=d*sin(pj)*cos(tj)
17687 c(2,j)=d*sin(pj)*sin(tj)
17693 c(3,i)=-rij-d*cos(wi)
17696 dc(k,nres+i)=c(k,nres+i)-c(k,i)
17697 dc_norm(k,nres+i)=dc(k,nres+i)/d
17698 dc(k,nres+j)=c(k,nres+j)-c(k,j)
17699 dc_norm(k,nres+j)=dc(k,nres+j)/d
17702 call dyn_ssbond_ene(i,j,eij)
17707 end subroutine check_energies
17708 !-----------------------------------------------------------------------------
17709 subroutine dyn_ssbond_ene(resi,resj,eij)
17714 ! include 'DIMENSIONS'
17715 ! include 'COMMON.SBRIDGE'
17716 ! include 'COMMON.CHAIN'
17717 ! include 'COMMON.DERIV'
17718 ! include 'COMMON.LOCAL'
17719 ! include 'COMMON.INTERACT'
17720 ! include 'COMMON.VAR'
17721 ! include 'COMMON.IOUNITS'
17722 ! include 'COMMON.CALC'
17726 ! include 'COMMON.MD'
17727 ! use MD, only: totT,t_bath
17730 ! External functions
17731 !EL double precision h_base
17732 !EL external h_base
17735 integer :: resi,resj
17738 real(kind=8) :: eij
17741 logical :: havebond
17742 integer itypi,itypj
17743 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
17744 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
17745 real(kind=8),dimension(3) :: dcosom1,dcosom2
17747 real(kind=8) :: pom1,pom2
17748 real(kind=8) :: ljA,ljB,ljXs
17749 real(kind=8),dimension(1:3) :: d_ljB
17750 real(kind=8) :: ssA,ssB,ssC,ssXs
17751 real(kind=8) :: ssxm,ljxm,ssm,ljm
17752 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
17753 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
17754 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
17755 !-------FIRST METHOD
17757 real(kind=8),dimension(1:3) :: d_xm
17758 !-------END FIRST METHOD
17759 !-------SECOND METHOD
17760 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
17761 !-------END SECOND METHOD
17763 !-------TESTING CODE
17764 !el logical :: checkstop,transgrad
17765 !el common /sschecks/ checkstop,transgrad
17767 integer :: icheck,nicheck,jcheck,njcheck
17768 real(kind=8),dimension(-1:1) :: echeck
17769 real(kind=8) :: deps,ssx0,ljx0
17770 !-------END TESTING CODE
17776 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
17777 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
17780 dxi=dc_norm(1,nres+i)
17781 dyi=dc_norm(2,nres+i)
17782 dzi=dc_norm(3,nres+i)
17783 dsci_inv=vbld_inv(i+nres)
17786 xj=c(1,nres+j)-c(1,nres+i)
17787 yj=c(2,nres+j)-c(2,nres+i)
17788 zj=c(3,nres+j)-c(3,nres+i)
17789 dxj=dc_norm(1,nres+j)
17790 dyj=dc_norm(2,nres+j)
17791 dzj=dc_norm(3,nres+j)
17792 dscj_inv=vbld_inv(j+nres)
17794 chi1=chi(itypi,itypj)
17795 chi2=chi(itypj,itypi)
17802 alf12=0.5D0*(alf1+alf2)
17804 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
17805 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
17806 ! The following are set in sc_angular
17810 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
17811 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
17812 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
17814 rij=1.0D0/rij ! Reset this so it makes sense
17816 sig0ij=sigma(itypi,itypj)
17817 sig=sig0ij*dsqrt(1.0D0/sigsq)
17820 ljA=eps1*eps2rt**2*eps3rt**2
17821 ljB=ljA*bb_aq(itypi,itypj)
17822 ljA=ljA*aa_aq(itypi,itypj)
17823 ljxm=ljXs+(-2.0D0*aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
17828 deltat12=om2-om1+2.0d0
17829 cosphi=om12-om1*om2
17833 +akth*(deltat1*deltat1+deltat2*deltat2) &
17834 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
17835 ssxm=ssXs-0.5D0*ssB/ssA
17837 !-------TESTING CODE
17838 !$$$c Some extra output
17839 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
17840 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
17841 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
17842 !$$$ if (ssx0.gt.0.0d0) then
17843 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
17847 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
17848 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
17849 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
17851 !-------END TESTING CODE
17853 !-------TESTING CODE
17854 ! Stop and plot energy and derivative as a function of distance
17855 if (checkstop) then
17856 ssm=ssC-0.25D0*ssB*ssB/ssA
17857 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
17858 if (ssm.lt.ljm .and. &
17859 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
17867 if (.not.checkstop) then
17872 do icheck=0,nicheck
17873 do jcheck=-1,njcheck
17874 if (checkstop) rij=(ssxm-1.0d0)+ &
17875 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
17876 !-------END TESTING CODE
17878 if (rij.gt.ljxm) then
17881 fac=(1.0D0/ljd)**expon
17882 e1=fac*fac*aa_aq(itypi,itypj)
17883 e2=fac*bb_aq(itypi,itypj)
17884 eij=eps1*eps2rt*eps3rt*(e1+e2)
17887 eij=eij*eps2rt*eps3rt
17890 e1=e1*eps1*eps2rt**2*eps3rt**2
17891 ed=-expon*(e1+eij)/ljd
17893 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
17894 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
17895 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
17896 -2.0D0*alf12*eps3der+sigder*sigsq_om12
17897 else if (rij.lt.ssxm) then
17900 eij=ssA*ssd*ssd+ssB*ssd+ssC
17902 ed=2*akcm*ssd+akct*deltat12
17904 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
17905 eom1=-2*akth*deltat1-pom1-om2*pom2
17906 eom2= 2*akth*deltat2+pom1-om1*pom2
17909 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
17911 d_ssxm(1)=0.5D0*akct/ssA
17912 d_ssxm(2)=-d_ssxm(1)
17915 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
17916 d_ljxm(2)=d_ljxm(1)*sigsq_om2
17917 d_ljxm(3)=d_ljxm(1)*sigsq_om12
17918 d_ljxm(1)=d_ljxm(1)*sigsq_om1
17920 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
17921 xm=0.5d0*(ssxm+ljxm)
17923 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
17925 if (rij.lt.xm) then
17927 ssm=ssC-0.25D0*ssB*ssB/ssA
17928 d_ssm(1)=0.5D0*akct*ssB/ssA
17929 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
17930 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
17932 f1=(rij-xm)/(ssxm-xm)
17933 f2=(rij-ssxm)/(xm-ssxm)
17937 delta_inv=1.0d0/(xm-ssxm)
17938 deltasq_inv=delta_inv*delta_inv
17940 fac1=deltasq_inv*fac*(xm-rij)
17941 fac2=deltasq_inv*fac*(rij-ssxm)
17942 ed=delta_inv*(Ht*hd2-ssm*hd1)
17943 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
17944 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
17945 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
17948 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
17949 d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
17950 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
17951 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
17953 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
17954 f1=(rij-ljxm)/(xm-ljxm)
17955 f2=(rij-xm)/(ljxm-xm)
17959 delta_inv=1.0d0/(ljxm-xm)
17960 deltasq_inv=delta_inv*delta_inv
17962 fac1=deltasq_inv*fac*(ljxm-rij)
17963 fac2=deltasq_inv*fac*(rij-xm)
17964 ed=delta_inv*(ljm*hd2-Ht*hd1)
17965 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
17966 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
17967 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
17969 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
17971 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
17977 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
17978 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
17979 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
17981 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
17982 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
17983 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
17984 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
17985 !$$$ d_ssm(3)=omega
17987 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
17989 !$$$ d_ljm(k)=ljm*d_ljB(k)
17993 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
17994 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
17995 !$$$ d_ss(2)=akct*ssd
17996 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
17997 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
18000 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
18001 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
18002 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
18004 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
18005 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
18007 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
18009 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
18010 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
18011 !$$$ h1=h_base(f1,hd1)
18012 !$$$ h2=h_base(f2,hd2)
18013 !$$$ eij=ss*h1+ljf*h2
18014 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
18015 !$$$ deltasq_inv=delta_inv*delta_inv
18016 !$$$ fac=ljf*hd2-ss*hd1
18017 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
18018 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
18019 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
18020 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
18021 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
18022 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
18023 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
18025 !$$$ havebond=.false.
18026 !$$$ if (ed.gt.0.0d0) havebond=.true.
18027 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
18034 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
18035 ! write(iout,'(a15,f12.2,f8.1,2i5)')
18036 ! & "SSBOND_E_FORM",totT,t_bath,i,j
18040 dyn_ssbond_ij(i,j)=eij
18041 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
18042 dyn_ssbond_ij(i,j)=1.0d300
18045 ! write(iout,'(a15,f12.2,f8.1,2i5)')
18046 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
18051 !-------TESTING CODE
18052 !el if (checkstop) then
18053 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
18054 "CHECKSTOP",rij,eij,ed
18058 if (checkstop) then
18059 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
18062 if (checkstop) then
18066 !-------END TESTING CODE
18069 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
18070 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
18073 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
18076 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
18077 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
18078 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
18079 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
18080 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
18081 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
18085 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
18090 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18091 gvdwc(l,j)=gvdwc(l,j)+gg(l)
18095 end subroutine dyn_ssbond_ene
18096 !--------------------------------------------------------------------------
18097 subroutine triple_ssbond_ene(resi,resj,resk,eij)
18102 ! include 'DIMENSIONS'
18103 ! include 'COMMON.SBRIDGE'
18104 ! include 'COMMON.CHAIN'
18105 ! include 'COMMON.DERIV'
18106 ! include 'COMMON.LOCAL'
18107 ! include 'COMMON.INTERACT'
18108 ! include 'COMMON.VAR'
18109 ! include 'COMMON.IOUNITS'
18110 ! include 'COMMON.CALC'
18114 ! include 'COMMON.MD'
18115 ! use MD, only: totT,t_bath
18118 double precision h_base
18122 integer resi,resj,resk,m,itypi,itypj,itypk
18124 !c Output arguments
18125 double precision eij,eij1,eij2,eij3
18129 !c integer itypi,itypj,k,l
18130 double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi
18131 double precision rrik,rrjk,rik,rjk,xi,xk,yi,yk,zi,zk,xij,yij,zij
18132 double precision xik,yik,zik,xjk,yjk,zjk,dxk,dyk,dzk
18133 double precision sig0ij,ljd,sig,fac,e1,e2
18134 double precision dcosom1(3),dcosom2(3),ed
18135 double precision pom1,pom2
18136 double precision ljA,ljB,ljXs
18137 double precision d_ljB(1:3)
18138 double precision ssA,ssB,ssC,ssXs
18139 double precision ssxm,ljxm,ssm,ljm
18140 double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3)
18142 if (dtriss.eq.0) return
18146 !C write(iout,*) resi,resj,resk
18148 dxi=dc_norm(1,nres+i)
18149 dyi=dc_norm(2,nres+i)
18150 dzi=dc_norm(3,nres+i)
18151 dsci_inv=vbld_inv(i+nres)
18160 dxj=dc_norm(1,nres+j)
18161 dyj=dc_norm(2,nres+j)
18162 dzj=dc_norm(3,nres+j)
18163 dscj_inv=vbld_inv(j+nres)
18169 dxk=dc_norm(1,nres+k)
18170 dyk=dc_norm(2,nres+k)
18171 dzk=dc_norm(3,nres+k)
18172 dscj_inv=vbld_inv(k+nres)
18182 rrij=(xij*xij+yij*yij+zij*zij)
18183 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
18184 rrik=(xik*xik+yik*yik+zik*zik)
18186 rrjk=(xjk*xjk+yjk*yjk+zjk*zjk)
18188 !C there are three combination of distances for each trisulfide bonds
18189 !C The first case the ith atom is the center
18190 !C Energy function is E=d/(a*(x-y)**2+b*(x+y)**2+c) where x is first
18191 !C distance y is second distance the a,b,c,d are parameters derived for
18192 !C this problem d parameter was set as a penalty currenlty set to 1.
18193 if ((iabs(j-i).le.2).or.(iabs(i-k).le.2)) then
18196 eij1=dtriss/(atriss*(rij-rik)**2+btriss*(rij+rik)**6+ctriss)
18198 !C second case jth atom is center
18199 if ((iabs(j-i).le.2).or.(iabs(j-k).le.2)) then
18202 eij2=dtriss/(atriss*(rij-rjk)**2+btriss*(rij+rjk)**6+ctriss)
18204 !C the third case kth atom is the center
18205 if ((iabs(i-k).le.2).or.(iabs(j-k).le.2)) then
18208 eij3=dtriss/(atriss*(rik-rjk)**2+btriss*(rik+rjk)**6+ctriss)
18214 !C write(iout,*)i,j,k,eij
18215 !C The energy penalty calculated now time for the gradient part
18216 !C derivative over rij
18217 fac=-eij1**2/dtriss*(2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
18218 -eij2**2/dtriss*(2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)
18223 gvdwx(m,i)=gvdwx(m,i)-gg(m)
18224 gvdwx(m,j)=gvdwx(m,j)+gg(m)
18228 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18229 gvdwc(l,j)=gvdwc(l,j)+gg(l)
18231 !C now derivative over rik
18232 fac=-eij1**2/dtriss* &
18233 (-2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
18234 -eij3**2/dtriss*(2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
18239 gvdwx(m,i)=gvdwx(m,i)-gg(m)
18240 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18243 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18244 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18246 !C now derivative over rjk
18247 fac=-eij2**2/dtriss* &
18248 (-2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)- &
18249 eij3**2/dtriss*(-2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
18254 gvdwx(m,j)=gvdwx(m,j)-gg(m)
18255 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18258 gvdwc(l,j)=gvdwc(l,j)-gg(l)
18259 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18262 end subroutine triple_ssbond_ene
18266 !-----------------------------------------------------------------------------
18267 real(kind=8) function h_base(x,deriv)
18268 ! A smooth function going 0->1 in range [0,1]
18269 ! It should NOT be called outside range [0,1], it will not work there.
18276 real(kind=8) :: deriv
18279 real(kind=8) :: xsq
18282 ! Two parabolas put together. First derivative zero at extrema
18283 !$$$ if (x.lt.0.5D0) then
18284 !$$$ h_base=2.0D0*x*x
18288 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
18289 !$$$ deriv=4.0D0*deriv
18292 ! Third degree polynomial. First derivative zero at extrema
18293 h_base=x*x*(3.0d0-2.0d0*x)
18294 deriv=6.0d0*x*(1.0d0-x)
18296 ! Fifth degree polynomial. First and second derivatives zero at extrema
18298 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
18300 !$$$ deriv=deriv*deriv
18301 !$$$ deriv=30.0d0*xsq*deriv
18304 end function h_base
18305 !-----------------------------------------------------------------------------
18306 subroutine dyn_set_nss
18307 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
18309 use MD_data, only: totT,t_bath
18311 ! include 'DIMENSIONS'
18315 ! include 'COMMON.SBRIDGE'
18316 ! include 'COMMON.CHAIN'
18317 ! include 'COMMON.IOUNITS'
18318 ! include 'COMMON.SETUP'
18319 ! include 'COMMON.MD'
18321 real(kind=8) :: emin
18322 integer :: i,j,imin,ierr
18323 integer :: diff,allnss,newnss
18324 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
18327 integer,dimension(0:nfgtasks) :: i_newnss
18328 integer,dimension(0:nfgtasks) :: displ
18329 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
18330 integer :: g_newnss
18335 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
18344 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
18348 if (allflag(i).eq.0 .and. &
18349 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
18350 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
18354 if (emin.lt.1.0d300) then
18357 if (allflag(i).eq.0 .and. &
18358 (allihpb(i).eq.allihpb(imin) .or. &
18359 alljhpb(i).eq.allihpb(imin) .or. &
18360 allihpb(i).eq.alljhpb(imin) .or. &
18361 alljhpb(i).eq.alljhpb(imin))) then
18368 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
18372 if (allflag(i).eq.1) then
18374 newihpb(newnss)=allihpb(i)
18375 newjhpb(newnss)=alljhpb(i)
18380 if (nfgtasks.gt.1)then
18382 call MPI_Reduce(newnss,g_newnss,1,&
18383 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
18384 call MPI_Gather(newnss,1,MPI_INTEGER,&
18385 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
18387 do i=1,nfgtasks-1,1
18388 displ(i)=i_newnss(i-1)+displ(i-1)
18390 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
18391 g_newihpb,i_newnss,displ,MPI_INTEGER,&
18393 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
18394 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
18396 if(fg_rank.eq.0) then
18397 ! print *,'g_newnss',g_newnss
18398 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
18399 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
18402 newihpb(i)=g_newihpb(i)
18403 newjhpb(i)=g_newjhpb(i)
18411 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
18412 ! print *,newnss,nss,maxdim
18418 if (idssb(i).eq.newihpb(j) .and. &
18419 jdssb(i).eq.newjhpb(j)) found=.true.
18423 ! write(iout,*) "found",found,i,j
18424 if (.not.found.and.fg_rank.eq.0) &
18425 write(iout,'(a15,f12.2,f8.1,2i5)') &
18426 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
18435 if (newihpb(i).eq.idssb(j) .and. &
18436 newjhpb(i).eq.jdssb(j)) found=.true.
18440 ! write(iout,*) "found",found,i,j
18441 if (.not.found.and.fg_rank.eq.0) &
18442 write(iout,'(a15,f12.2,f8.1,2i5)') &
18443 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
18450 idssb(i)=newihpb(i)
18451 jdssb(i)=newjhpb(i)
18455 end subroutine dyn_set_nss
18456 ! Lipid transfer energy function
18457 subroutine Eliptransfer(eliptran)
18458 !C this is done by Adasko
18459 !C print *,"wchodze"
18460 !C structure of box:
18462 !C--bordliptop-- buffore starts
18463 !C--bufliptop--- here true lipid starts
18465 !C--buflipbot--- lipid ends buffore starts
18466 !C--bordlipbot--buffore ends
18467 real(kind=8) :: fracinbuf,eliptran,sslip,positi,ssgradlip
18470 ! print *, "I am in eliptran"
18471 do i=ilip_start,ilip_end
18473 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))&
18476 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
18477 if (positi.le.0.0) positi=positi+boxzsize
18479 !C first for peptide groups
18480 !c for each residue check if it is in lipid or lipid water border area
18481 if ((positi.gt.bordlipbot) &
18482 .and.(positi.lt.bordliptop)) then
18483 !C the energy transfer exist
18484 if (positi.lt.buflipbot) then
18485 !C what fraction I am in
18487 ((positi-bordlipbot)/lipbufthick)
18488 !C lipbufthick is thickenes of lipid buffore
18489 sslip=sscalelip(fracinbuf)
18490 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
18491 eliptran=eliptran+sslip*pepliptran
18492 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
18493 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
18494 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
18496 !C print *,"doing sccale for lower part"
18497 !C print *,i,sslip,fracinbuf,ssgradlip
18498 elseif (positi.gt.bufliptop) then
18499 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
18500 sslip=sscalelip(fracinbuf)
18501 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
18502 eliptran=eliptran+sslip*pepliptran
18503 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
18504 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
18505 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
18506 !C print *, "doing sscalefor top part"
18507 !C print *,i,sslip,fracinbuf,ssgradlip
18509 eliptran=eliptran+pepliptran
18510 !C print *,"I am in true lipid"
18513 !C eliptran=elpitran+0.0 ! I am in water
18515 if (energy_dec) write(iout,*) i,"eliptran=",eliptran,positi,sslip
18517 ! here starts the side chain transfer
18518 do i=ilip_start,ilip_end
18519 if (itype(i,1).eq.ntyp1) cycle
18520 positi=(mod(c(3,i+nres),boxzsize))
18521 if (positi.le.0) positi=positi+boxzsize
18522 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18523 !c for each residue check if it is in lipid or lipid water border area
18524 !C respos=mod(c(3,i+nres),boxzsize)
18525 !C print *,positi,bordlipbot,buflipbot
18526 if ((positi.gt.bordlipbot) &
18527 .and.(positi.lt.bordliptop)) then
18528 !C the energy transfer exist
18529 if (positi.lt.buflipbot) then
18531 ((positi-bordlipbot)/lipbufthick)
18532 !C lipbufthick is thickenes of lipid buffore
18533 sslip=sscalelip(fracinbuf)
18534 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
18535 eliptran=eliptran+sslip*liptranene(itype(i,1))
18536 gliptranx(3,i)=gliptranx(3,i) &
18537 +ssgradlip*liptranene(itype(i,1))
18538 gliptranc(3,i-1)= gliptranc(3,i-1) &
18539 +ssgradlip*liptranene(itype(i,1))
18540 !C print *,"doing sccale for lower part"
18541 elseif (positi.gt.bufliptop) then
18543 ((bordliptop-positi)/lipbufthick)
18544 sslip=sscalelip(fracinbuf)
18545 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
18546 eliptran=eliptran+sslip*liptranene(itype(i,1))
18547 gliptranx(3,i)=gliptranx(3,i) &
18548 +ssgradlip*liptranene(itype(i,1))
18549 gliptranc(3,i-1)= gliptranc(3,i-1) &
18550 +ssgradlip*liptranene(itype(i,1))
18551 !C print *, "doing sscalefor top part",sslip,fracinbuf
18553 eliptran=eliptran+liptranene(itype(i,1))
18554 !C print *,"I am in true lipid"
18556 endif ! if in lipid or buffor
18558 !C eliptran=elpitran+0.0 ! I am in water
18559 if (energy_dec) write(iout,*) i,"eliptran=",eliptran
18562 end subroutine Eliptransfer
18563 !----------------------------------NANO FUNCTIONS
18564 !C-----------------------------------------------------------------------
18565 !C-----------------------------------------------------------
18566 !C This subroutine is to mimic the histone like structure but as well can be
18567 !C utilizet to nanostructures (infinit) small modification has to be used to
18568 !C make it finite (z gradient at the ends has to be changes as well as the x,y
18569 !C gradient has to be modified at the ends
18570 !C The energy function is Kihara potential
18571 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
18572 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
18573 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
18574 !C simple Kihara potential
18575 subroutine calctube(Etube)
18576 real(kind=8),dimension(3) :: vectube
18577 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18578 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi, &
18579 sc_aa_tube,sc_bb_tube
18582 do i=itube_start,itube_end
18584 enetube(i+nres)=0.0d0
18586 !C first we calculate the distance from tube center
18588 do i=itube_start,itube_end
18589 !C lets ommit dummy atoms for now
18590 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18591 !C now calculate distance from center of tube and direction vectors
18594 ! Find minimum distance in periodic box
18596 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18597 vectube(1)=vectube(1)+boxxsize*j
18598 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18599 vectube(2)=vectube(2)+boxysize*j
18600 xminact=abs(vectube(1)-tubecenter(1))
18601 yminact=abs(vectube(2)-tubecenter(2))
18602 if (xmin.gt.xminact) then
18606 if (ymin.gt.yminact) then
18613 vectube(1)=vectube(1)-tubecenter(1)
18614 vectube(2)=vectube(2)-tubecenter(2)
18616 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18617 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18619 !C as the tube is infinity we do not calculate the Z-vector use of Z
18622 !C now calculte the distance
18623 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18624 !C now normalize vector
18625 vectube(1)=vectube(1)/tub_r
18626 vectube(2)=vectube(2)/tub_r
18627 !C calculte rdiffrence between r and r0
18630 rdiff6=rdiff**6.0d0
18631 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18632 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
18633 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18634 !C print *,rdiff,rdiff6,pep_aa_tube
18635 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18636 !C now we calculate gradient
18637 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18638 6.0d0*pep_bb_tube)/rdiff6/rdiff
18639 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18641 !C now direction of gg_tube vector
18643 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18644 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18647 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18648 !C print *,gg_tube(1,0),"TU"
18651 do i=itube_start,itube_end
18652 !C Lets not jump over memory as we use many times iti
18654 !C lets ommit dummy atoms for now
18655 if ((iti.eq.ntyp1) &
18656 !C in UNRES uncomment the line below as GLY has no side-chain...
18662 vectube(1)=mod((c(1,i+nres)),boxxsize)
18663 vectube(1)=vectube(1)+boxxsize*j
18664 vectube(2)=mod((c(2,i+nres)),boxysize)
18665 vectube(2)=vectube(2)+boxysize*j
18667 xminact=abs(vectube(1)-tubecenter(1))
18668 yminact=abs(vectube(2)-tubecenter(2))
18669 if (xmin.gt.xminact) then
18673 if (ymin.gt.yminact) then
18680 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
18682 vectube(1)=vectube(1)-tubecenter(1)
18683 vectube(2)=vectube(2)-tubecenter(2)
18685 !C as the tube is infinity we do not calculate the Z-vector use of Z
18688 !C now calculte the distance
18689 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18690 !C now normalize vector
18691 vectube(1)=vectube(1)/tub_r
18692 vectube(2)=vectube(2)/tub_r
18694 !C calculte rdiffrence between r and r0
18697 rdiff6=rdiff**6.0d0
18698 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18699 sc_aa_tube=sc_aa_tube_par(iti)
18700 sc_bb_tube=sc_bb_tube_par(iti)
18701 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
18702 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
18703 6.0d0*sc_bb_tube/rdiff6/rdiff
18704 !C now direction of gg_tube vector
18706 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
18707 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
18710 do i=itube_start,itube_end
18711 Etube=Etube+enetube(i)+enetube(i+nres)
18713 !C print *,"ETUBE", etube
18715 end subroutine calctube
18716 !C TO DO 1) add to total energy
18717 !C 2) add to gradient summation
18718 !C 3) add reading parameters (AND of course oppening of PARAM file)
18719 !C 4) add reading the center of tube
18721 !C 6) add to zerograd
18722 !C 7) allocate matrices
18725 !C-----------------------------------------------------------------------
18726 !C-----------------------------------------------------------
18727 !C This subroutine is to mimic the histone like structure but as well can be
18728 !C utilizet to nanostructures (infinit) small modification has to be used to
18729 !C make it finite (z gradient at the ends has to be changes as well as the x,y
18730 !C gradient has to be modified at the ends
18731 !C The energy function is Kihara potential
18732 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
18733 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
18734 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
18735 !C simple Kihara potential
18736 subroutine calctube2(Etube)
18737 real(kind=8),dimension(3) :: vectube
18738 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18739 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi,fracinbuf,&
18740 sstube,ssgradtube,sc_aa_tube,sc_bb_tube
18743 do i=itube_start,itube_end
18745 enetube(i+nres)=0.0d0
18747 !C first we calculate the distance from tube center
18748 !C first sugare-phosphate group for NARES this would be peptide group
18750 do i=itube_start,itube_end
18751 !C lets ommit dummy atoms for now
18753 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18754 !C now calculate distance from center of tube and direction vectors
18755 !C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18756 !C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
18757 !C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18758 !C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
18762 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18763 vectube(1)=vectube(1)+boxxsize*j
18764 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18765 vectube(2)=vectube(2)+boxysize*j
18767 xminact=abs(vectube(1)-tubecenter(1))
18768 yminact=abs(vectube(2)-tubecenter(2))
18769 if (xmin.gt.xminact) then
18773 if (ymin.gt.yminact) then
18780 vectube(1)=vectube(1)-tubecenter(1)
18781 vectube(2)=vectube(2)-tubecenter(2)
18783 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18784 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18786 !C as the tube is infinity we do not calculate the Z-vector use of Z
18789 !C now calculte the distance
18790 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18791 !C now normalize vector
18792 vectube(1)=vectube(1)/tub_r
18793 vectube(2)=vectube(2)/tub_r
18794 !C calculte rdiffrence between r and r0
18797 rdiff6=rdiff**6.0d0
18798 !C THIS FRAGMENT MAKES TUBE FINITE
18799 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
18800 if (positi.le.0) positi=positi+boxzsize
18801 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18802 !c for each residue check if it is in lipid or lipid water border area
18803 !C respos=mod(c(3,i+nres),boxzsize)
18804 !C print *,positi,bordtubebot,buftubebot,bordtubetop
18805 if ((positi.gt.bordtubebot) &
18806 .and.(positi.lt.bordtubetop)) then
18807 !C the energy transfer exist
18808 if (positi.lt.buftubebot) then
18810 ((positi-bordtubebot)/tubebufthick)
18811 !C lipbufthick is thickenes of lipid buffore
18812 sstube=sscalelip(fracinbuf)
18813 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
18814 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
18815 enetube(i)=enetube(i)+sstube*tubetranenepep
18816 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18817 !C &+ssgradtube*tubetranene(itype(i,1))
18818 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18819 !C &+ssgradtube*tubetranene(itype(i,1))
18820 !C print *,"doing sccale for lower part"
18821 elseif (positi.gt.buftubetop) then
18823 ((bordtubetop-positi)/tubebufthick)
18824 sstube=sscalelip(fracinbuf)
18825 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
18826 enetube(i)=enetube(i)+sstube*tubetranenepep
18827 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18828 !C &+ssgradtube*tubetranene(itype(i,1))
18829 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18830 !C &+ssgradtube*tubetranene(itype(i,1))
18831 !C print *, "doing sscalefor top part",sslip,fracinbuf
18835 enetube(i)=enetube(i)+sstube*tubetranenepep
18836 !C print *,"I am in true lipid"
18840 !C ssgradtube=0.0d0
18842 endif ! if in lipid or buffor
18844 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18845 enetube(i)=enetube(i)+sstube* &
18846 (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
18847 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18848 !C print *,rdiff,rdiff6,pep_aa_tube
18849 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18850 !C now we calculate gradient
18851 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18852 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
18853 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18856 !C now direction of gg_tube vector
18858 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18859 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18861 gg_tube(3,i)=gg_tube(3,i) &
18862 +ssgradtube*enetube(i)/sstube/2.0d0
18863 gg_tube(3,i-1)= gg_tube(3,i-1) &
18864 +ssgradtube*enetube(i)/sstube/2.0d0
18867 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18868 !C print *,gg_tube(1,0),"TU"
18869 do i=itube_start,itube_end
18870 !C Lets not jump over memory as we use many times iti
18872 !C lets ommit dummy atoms for now
18873 if ((iti.eq.ntyp1) &
18874 !!C in UNRES uncomment the line below as GLY has no side-chain...
18877 vectube(1)=c(1,i+nres)
18878 vectube(1)=mod(vectube(1),boxxsize)
18879 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
18880 vectube(2)=c(2,i+nres)
18881 vectube(2)=mod(vectube(2),boxysize)
18882 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
18884 vectube(1)=vectube(1)-tubecenter(1)
18885 vectube(2)=vectube(2)-tubecenter(2)
18886 !C THIS FRAGMENT MAKES TUBE FINITE
18887 positi=(mod(c(3,i+nres),boxzsize))
18888 if (positi.le.0) positi=positi+boxzsize
18889 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18890 !c for each residue check if it is in lipid or lipid water border area
18891 !C respos=mod(c(3,i+nres),boxzsize)
18892 !C print *,positi,bordtubebot,buftubebot,bordtubetop
18894 if ((positi.gt.bordtubebot) &
18895 .and.(positi.lt.bordtubetop)) then
18896 !C the energy transfer exist
18897 if (positi.lt.buftubebot) then
18899 ((positi-bordtubebot)/tubebufthick)
18900 !C lipbufthick is thickenes of lipid buffore
18901 sstube=sscalelip(fracinbuf)
18902 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
18903 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
18904 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
18905 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18906 !C &+ssgradtube*tubetranene(itype(i,1))
18907 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18908 !C &+ssgradtube*tubetranene(itype(i,1))
18909 !C print *,"doing sccale for lower part"
18910 elseif (positi.gt.buftubetop) then
18912 ((bordtubetop-positi)/tubebufthick)
18914 sstube=sscalelip(fracinbuf)
18915 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
18916 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
18917 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18918 !C &+ssgradtube*tubetranene(itype(i,1))
18919 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18920 !C &+ssgradtube*tubetranene(itype(i,1))
18921 !C print *, "doing sscalefor top part",sslip,fracinbuf
18925 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
18926 !C print *,"I am in true lipid"
18930 !C ssgradtube=0.0d0
18932 endif ! if in lipid or buffor
18933 !CEND OF FINITE FRAGMENT
18934 !C as the tube is infinity we do not calculate the Z-vector use of Z
18937 !C now calculte the distance
18938 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18939 !C now normalize vector
18940 vectube(1)=vectube(1)/tub_r
18941 vectube(2)=vectube(2)/tub_r
18942 !C calculte rdiffrence between r and r0
18945 rdiff6=rdiff**6.0d0
18946 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18947 sc_aa_tube=sc_aa_tube_par(iti)
18948 sc_bb_tube=sc_bb_tube_par(iti)
18949 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)&
18950 *sstube+enetube(i+nres)
18951 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18952 !C now we calculate gradient
18953 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-&
18954 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
18955 !C now direction of gg_tube vector
18957 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
18958 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
18960 gg_tube_SC(3,i)=gg_tube_SC(3,i) &
18961 +ssgradtube*enetube(i+nres)/sstube
18962 gg_tube(3,i-1)= gg_tube(3,i-1) &
18963 +ssgradtube*enetube(i+nres)/sstube
18966 do i=itube_start,itube_end
18967 Etube=Etube+enetube(i)+enetube(i+nres)
18969 !C print *,"ETUBE", etube
18971 end subroutine calctube2
18972 !=====================================================================================================================================
18973 subroutine calcnano(Etube)
18974 real(kind=8),dimension(3) :: vectube
18976 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18977 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,denominator,faccav,&
18978 sc_aa_tube,sc_bb_tube,zmin,ztemp,zminact
18979 integer:: i,j,iti,r
18982 ! print *,itube_start,itube_end,"poczatek"
18983 do i=itube_start,itube_end
18985 enetube(i+nres)=0.0d0
18987 !C first we calculate the distance from tube center
18988 !C first sugare-phosphate group for NARES this would be peptide group
18990 do i=itube_start,itube_end
18991 !C lets ommit dummy atoms for now
18992 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18993 !C now calculate distance from center of tube and direction vectors
18999 vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19000 vectube(1)=vectube(1)+boxxsize*j
19001 vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19002 vectube(2)=vectube(2)+boxysize*j
19003 vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
19004 vectube(3)=vectube(3)+boxzsize*j
19007 xminact=dabs(vectube(1)-tubecenter(1))
19008 yminact=dabs(vectube(2)-tubecenter(2))
19009 zminact=dabs(vectube(3)-tubecenter(3))
19011 if (xmin.gt.xminact) then
19015 if (ymin.gt.yminact) then
19019 if (zmin.gt.zminact) then
19028 vectube(1)=vectube(1)-tubecenter(1)
19029 vectube(2)=vectube(2)-tubecenter(2)
19030 vectube(3)=vectube(3)-tubecenter(3)
19032 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
19033 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
19034 !C as the tube is infinity we do not calculate the Z-vector use of Z
19036 !C vectube(3)=0.0d0
19037 !C now calculte the distance
19038 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19039 !C now normalize vector
19040 vectube(1)=vectube(1)/tub_r
19041 vectube(2)=vectube(2)/tub_r
19042 vectube(3)=vectube(3)/tub_r
19043 !C calculte rdiffrence between r and r0
19046 rdiff6=rdiff**6.0d0
19047 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19048 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
19049 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
19050 !C print *,rdiff,rdiff6,pep_aa_tube
19051 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19052 !C now we calculate gradient
19053 fac=(-12.0d0*pep_aa_tube/rdiff6- &
19054 6.0d0*pep_bb_tube)/rdiff6/rdiff
19055 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
19057 if (acavtubpep.eq.0.0d0) then
19062 denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
19064 (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
19067 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
19068 *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
19069 +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
19070 /denominator**2.0d0
19075 if (energy_dec) write(iout,*),i,rdiff,enetube(i),enecavtube(i)
19077 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
19078 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
19082 do i=itube_start,itube_end
19083 enecavtube(i)=0.0d0
19084 !C Lets not jump over memory as we use many times iti
19086 !C lets ommit dummy atoms for now
19087 if ((iti.eq.ntyp1) &
19088 !C in UNRES uncomment the line below as GLY has no side-chain...
19095 vectube(1)=dmod((c(1,i+nres)),boxxsize)
19096 vectube(1)=vectube(1)+boxxsize*j
19097 vectube(2)=dmod((c(2,i+nres)),boxysize)
19098 vectube(2)=vectube(2)+boxysize*j
19099 vectube(3)=dmod((c(3,i+nres)),boxzsize)
19100 vectube(3)=vectube(3)+boxzsize*j
19103 xminact=dabs(vectube(1)-tubecenter(1))
19104 yminact=dabs(vectube(2)-tubecenter(2))
19105 zminact=dabs(vectube(3)-tubecenter(3))
19107 if (xmin.gt.xminact) then
19111 if (ymin.gt.yminact) then
19115 if (zmin.gt.zminact) then
19124 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
19126 vectube(1)=vectube(1)-tubecenter(1)
19127 vectube(2)=vectube(2)-tubecenter(2)
19128 vectube(3)=vectube(3)-tubecenter(3)
19129 !C now calculte the distance
19130 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19131 !C now normalize vector
19132 vectube(1)=vectube(1)/tub_r
19133 vectube(2)=vectube(2)/tub_r
19134 vectube(3)=vectube(3)/tub_r
19136 !C calculte rdiffrence between r and r0
19139 rdiff6=rdiff**6.0d0
19140 sc_aa_tube=sc_aa_tube_par(iti)
19141 sc_bb_tube=sc_bb_tube_par(iti)
19142 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19143 !C enetube(i+nres)=0.0d0
19144 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19145 !C now we calculate gradient
19146 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
19147 6.0d0*sc_bb_tube/rdiff6/rdiff
19149 !C now direction of gg_tube vector
19150 !C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
19151 if (acavtub(iti).eq.0.0d0) then
19153 enecavtube(i+nres)=0.0d0
19156 denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
19157 enecavtube(i+nres)= &
19158 (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
19160 !C enecavtube(i)=0.0
19161 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
19162 *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
19163 +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
19164 /denominator**2.0d0
19169 !C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
19170 !C & enecavtube(i),faccav
19171 !C print *,"licz=",
19172 !C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
19173 !C print *,"finene=",enetube(i+nres)+enecavtube(i)
19175 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19176 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19178 if (energy_dec) write(iout,*),i,rdiff,enetube(i+nres),enecavtube(i+nres)
19183 do i=itube_start,itube_end
19184 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) &
19185 +enecavtube(i+nres)
19188 ! print *,"begin", i,"a"
19191 ! rdiff6=rdiff**6.0d0
19192 ! sc_aa_tube=sc_aa_tube_par(i)
19193 ! sc_bb_tube=sc_bb_tube_par(i)
19194 ! enetube(i)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19195 ! denominator=(1.0d0+dcavtub(i)*rdiff6*rdiff6)
19197 ! (bcavtub(i)*rdiff+acavtub(i)*dsqrt(rdiff)+ccavtub(i)) &
19200 ! print '(5(f10.3,1x))',rdiff,enetube(i),enecavtube(i),enecavtube(i)+enetube(i)
19202 ! print *,"end",i,"a"
19204 !C print *,"ETUBE", etube
19206 end subroutine calcnano
19208 !===============================================
19209 !--------------------------------------------------------------------------------
19210 !C first for shielding is setting of function of side-chains
19212 subroutine set_shield_fac2
19213 real(kind=8) :: div77_81=0.974996043d0, &
19214 div4_81=0.2222222222d0
19215 real (kind=8) :: dist_pep_side,dist_side_calf,dist_pept_group, &
19216 scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
19217 short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
19218 sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
19219 !C the vector between center of side_chain and peptide group
19220 real(kind=8),dimension(3) :: pep_side_long,side_calf, &
19221 pept_group,costhet_grad,cosphi_grad_long, &
19222 cosphi_grad_loc,pep_side_norm,side_calf_norm, &
19223 sh_frac_dist_grad,pep_side
19225 !C write(2,*) "ivec",ivec_start,ivec_end
19227 fac_shield(i)=0.0d0
19229 grad_shield(j,i)=0.0d0
19232 do i=ivec_start,ivec_end
19234 !C if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
19236 if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
19237 !Cif there two consequtive dummy atoms there is no peptide group between them
19238 !C the line below has to be changed for FGPROC>1
19241 if ((itype(k,1).eq.ntyp1).or.(itype(k,1).eq.10)) cycle
19245 !C first lets set vector conecting the ithe side-chain with kth side-chain
19246 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
19247 !C pep_side(j)=2.0d0
19248 !C and vector conecting the side-chain with its proper calfa
19249 side_calf(j)=c(j,k+nres)-c(j,k)
19250 !C side_calf(j)=2.0d0
19251 pept_group(j)=c(j,i)-c(j,i+1)
19252 !C lets have their lenght
19253 dist_pep_side=pep_side(j)**2+dist_pep_side
19254 dist_side_calf=dist_side_calf+side_calf(j)**2
19255 dist_pept_group=dist_pept_group+pept_group(j)**2
19257 dist_pep_side=sqrt(dist_pep_side)
19258 dist_pept_group=sqrt(dist_pept_group)
19259 dist_side_calf=sqrt(dist_side_calf)
19261 pep_side_norm(j)=pep_side(j)/dist_pep_side
19262 side_calf_norm(j)=dist_side_calf
19264 !C now sscale fraction
19265 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
19266 !C print *,buff_shield,"buff"
19268 if (sh_frac_dist.le.0.0) cycle
19269 !C print *,ishield_list(i),i
19270 !C If we reach here it means that this side chain reaches the shielding sphere
19271 !C Lets add him to the list for gradient
19272 ishield_list(i)=ishield_list(i)+1
19273 !C ishield_list is a list of non 0 side-chain that contribute to factor gradient
19274 !C this list is essential otherwise problem would be O3
19275 shield_list(ishield_list(i),i)=k
19276 !C Lets have the sscale value
19277 if (sh_frac_dist.gt.1.0) then
19278 scale_fac_dist=1.0d0
19280 sh_frac_dist_grad(j)=0.0d0
19283 scale_fac_dist=-sh_frac_dist*sh_frac_dist &
19284 *(2.0d0*sh_frac_dist-3.0d0)
19285 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
19286 /dist_pep_side/buff_shield*0.5d0
19288 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
19289 !C sh_frac_dist_grad(j)=0.0d0
19290 !C scale_fac_dist=1.0d0
19291 !C print *,"jestem",scale_fac_dist,fac_help_scale,
19292 !C & sh_frac_dist_grad(j)
19295 !C this is what is now we have the distance scaling now volume...
19296 short=short_r_sidechain(itype(k,1))
19297 long=long_r_sidechain(itype(k,1))
19298 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
19299 sinthet=short/dist_pep_side*costhet
19300 !C now costhet_grad
19303 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
19304 !C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
19305 !C & -short/dist_pep_side**2/costhet)
19306 !C costhet_fac=0.0d0
19308 costhet_grad(j)=costhet_fac*pep_side(j)
19310 !C remember for the final gradient multiply costhet_grad(j)
19311 !C for side_chain by factor -2 !
19312 !C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
19313 !C pep_side0pept_group is vector multiplication
19314 pep_side0pept_group=0.0d0
19316 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
19318 cosalfa=(pep_side0pept_group/ &
19319 (dist_pep_side*dist_side_calf))
19320 fac_alfa_sin=1.0d0-cosalfa**2
19321 fac_alfa_sin=dsqrt(fac_alfa_sin)
19322 rkprim=fac_alfa_sin*(long-short)+short
19325 !C now costhet_grad
19326 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
19328 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
19329 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ &
19333 cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
19334 +cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
19335 *(long-short)/fac_alfa_sin*cosalfa/ &
19336 ((dist_pep_side*dist_side_calf))* &
19337 ((side_calf(j))-cosalfa* &
19338 ((pep_side(j)/dist_pep_side)*dist_side_calf))
19339 !C cosphi_grad_long(j)=0.0d0
19340 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
19341 *(long-short)/fac_alfa_sin*cosalfa &
19342 /((dist_pep_side*dist_side_calf))* &
19344 cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
19345 !C cosphi_grad_loc(j)=0.0d0
19347 !C print *,sinphi,sinthet
19348 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) &
19351 !C now the gradient...
19353 grad_shield(j,i)=grad_shield(j,i) &
19354 !C gradient po skalowaniu
19355 +(sh_frac_dist_grad(j)*VofOverlap &
19356 !C gradient po costhet
19357 +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
19358 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
19359 sinphi/sinthet*costhet*costhet_grad(j) &
19360 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
19362 !C grad_shield_side is Cbeta sidechain gradient
19363 grad_shield_side(j,ishield_list(i),i)=&
19364 (sh_frac_dist_grad(j)*-2.0d0&
19366 -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
19367 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(&
19368 sinphi/sinthet*costhet*costhet_grad(j)&
19369 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
19372 grad_shield_loc(j,ishield_list(i),i)= &
19373 scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
19374 (1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(&
19375 sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
19379 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
19381 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
19383 !C write(2,*) "TOTAL VOLUME",i,itype(i,1),fac_shield(i)
19386 end subroutine set_shield_fac2
19387 !----------------------------------------------------------------------------
19388 ! SOUBROUTINE FOR AFM
19389 subroutine AFMvel(Eafmforce)
19390 use MD_data, only:totTafm
19391 real(kind=8),dimension(3) :: diffafm
19392 real(kind=8) :: afmdist,Eafmforce
19394 !C Only for check grad COMMENT if not used for checkgrad
19396 !C--------------------------------------------------------
19397 !C print *,"wchodze"
19401 diffafm(i)=c(i,afmend)-c(i,afmbeg)
19402 afmdist=afmdist+diffafm(i)**2
19404 afmdist=dsqrt(afmdist)
19406 Eafmforce=0.5d0*forceAFMconst &
19407 *(distafminit+totTafm*velAFMconst-afmdist)**2
19408 !C Eafmforce=-forceAFMconst*(dist-distafminit)
19410 gradafm(i,afmend-1)=-forceAFMconst* &
19411 (distafminit+totTafm*velAFMconst-afmdist) &
19412 *diffafm(i)/afmdist
19413 gradafm(i,afmbeg-1)=forceAFMconst* &
19414 (distafminit+totTafm*velAFMconst-afmdist) &
19415 *diffafm(i)/afmdist
19417 ! print *,'AFM',Eafmforce,totTafm*velAFMconst,afmdist
19419 end subroutine AFMvel
19420 !---------------------------------------------------------
19421 subroutine AFMforce(Eafmforce)
19423 real(kind=8),dimension(3) :: diffafm
19424 ! real(kind=8) ::afmdist
19425 real(kind=8) :: afmdist,Eafmforce
19430 diffafm(i)=c(i,afmend)-c(i,afmbeg)
19431 afmdist=afmdist+diffafm(i)**2
19433 afmdist=dsqrt(afmdist)
19434 ! print *,afmdist,distafminit
19435 Eafmforce=-forceAFMconst*(afmdist-distafminit)
19437 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/afmdist
19438 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/afmdist
19440 !C print *,'AFM',Eafmforce
19442 end subroutine AFMforce
19444 !-----------------------------------------------------------------------------
19446 subroutine read_ssHist
19449 ! include 'DIMENSIONS'
19450 ! include "DIMENSIONS.FREE"
19451 ! include 'COMMON.FREE'
19454 character(len=80) :: controlcard
19457 call card_concat(controlcard,.true.)
19458 read(controlcard,*) &
19459 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
19463 end subroutine read_ssHist
19465 !-----------------------------------------------------------------------------
19466 integer function indmat(i,j)
19468 ! get the position of the jth ijth fragment of the chain coordinate system
19469 ! in the fromto array.
19472 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
19474 end function indmat
19475 !-----------------------------------------------------------------------------
19476 real(kind=8) function sigm(x)
19482 !-----------------------------------------------------------------------------
19483 !-----------------------------------------------------------------------------
19484 subroutine alloc_ener_arrays
19485 !EL Allocation of arrays used by module energy
19486 use MD_data, only: mset
19487 !el local variables
19490 if(nres.lt.100) then
19492 elseif(nres.lt.200) then
19493 maxconts=0.8*nres ! Max. number of contacts per residue
19495 maxconts=0.6*nres ! (maxconts=maxres/4)
19497 maxcont=12*nres ! Max. number of SC contacts
19498 maxvar=6*nres ! Max. number of variables
19499 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
19500 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
19501 !----------------------
19502 ! arrays in subroutine init_int_table
19504 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
19505 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
19507 allocate(nint_gr(nres))
19508 allocate(nscp_gr(nres))
19509 allocate(ielstart(nres))
19510 allocate(ielend(nres))
19512 allocate(istart(nres,maxint_gr))
19513 allocate(iend(nres,maxint_gr))
19514 !(maxres,maxint_gr)
19515 allocate(iscpstart(nres,maxint_gr))
19516 allocate(iscpend(nres,maxint_gr))
19517 !(maxres,maxint_gr)
19518 allocate(ielstart_vdw(nres))
19519 allocate(ielend_vdw(nres))
19521 allocate(nint_gr_nucl(nres))
19522 allocate(nscp_gr_nucl(nres))
19523 allocate(ielstart_nucl(nres))
19524 allocate(ielend_nucl(nres))
19526 allocate(istart_nucl(nres,maxint_gr))
19527 allocate(iend_nucl(nres,maxint_gr))
19528 !(maxres,maxint_gr)
19529 allocate(iscpstart_nucl(nres,maxint_gr))
19530 allocate(iscpend_nucl(nres,maxint_gr))
19531 !(maxres,maxint_gr)
19532 allocate(ielstart_vdw_nucl(nres))
19533 allocate(ielend_vdw_nucl(nres))
19535 allocate(lentyp(0:nfgtasks-1))
19537 !----------------------
19539 ! common /contacts/
19540 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
19541 allocate(icont(2,maxcont))
19543 ! common /contacts1/
19544 allocate(num_cont(0:nres+4))
19546 allocate(jcont(maxconts,nres))
19548 allocate(facont(maxconts,nres))
19550 allocate(gacont(3,maxconts,nres))
19551 !(3,maxconts,maxres)
19552 ! common /contacts_hb/
19553 allocate(gacontp_hb1(3,maxconts,nres))
19554 allocate(gacontp_hb2(3,maxconts,nres))
19555 allocate(gacontp_hb3(3,maxconts,nres))
19556 allocate(gacontm_hb1(3,maxconts,nres))
19557 allocate(gacontm_hb2(3,maxconts,nres))
19558 allocate(gacontm_hb3(3,maxconts,nres))
19559 allocate(gacont_hbr(3,maxconts,nres))
19560 allocate(grij_hb_cont(3,maxconts,nres))
19561 !(3,maxconts,maxres)
19562 allocate(facont_hb(maxconts,nres))
19564 allocate(ees0p(maxconts,nres))
19565 allocate(ees0m(maxconts,nres))
19566 allocate(d_cont(maxconts,nres))
19567 allocate(ees0plist(maxconts,nres))
19570 allocate(num_cont_hb(nres))
19572 allocate(jcont_hb(maxconts,nres))
19575 allocate(Ug(2,2,nres))
19576 allocate(Ugder(2,2,nres))
19577 allocate(Ug2(2,2,nres))
19578 allocate(Ug2der(2,2,nres))
19580 allocate(obrot(2,nres))
19581 allocate(obrot2(2,nres))
19582 allocate(obrot_der(2,nres))
19583 allocate(obrot2_der(2,nres))
19585 ! common /precomp1/
19586 allocate(mu(2,nres))
19587 allocate(muder(2,nres))
19588 allocate(Ub2(2,nres))
19591 allocate(Ub2der(2,nres))
19592 allocate(Ctobr(2,nres))
19593 allocate(Ctobrder(2,nres))
19594 allocate(Dtobr2(2,nres))
19595 allocate(Dtobr2der(2,nres))
19597 allocate(EUg(2,2,nres))
19598 allocate(EUgder(2,2,nres))
19599 allocate(CUg(2,2,nres))
19600 allocate(CUgder(2,2,nres))
19601 allocate(DUg(2,2,nres))
19602 allocate(Dugder(2,2,nres))
19603 allocate(DtUg2(2,2,nres))
19604 allocate(DtUg2der(2,2,nres))
19606 ! common /precomp2/
19607 allocate(Ug2Db1t(2,nres))
19608 allocate(Ug2Db1tder(2,nres))
19609 allocate(CUgb2(2,nres))
19610 allocate(CUgb2der(2,nres))
19612 allocate(EUgC(2,2,nres))
19613 allocate(EUgCder(2,2,nres))
19614 allocate(EUgD(2,2,nres))
19615 allocate(EUgDder(2,2,nres))
19616 allocate(DtUg2EUg(2,2,nres))
19617 allocate(Ug2DtEUg(2,2,nres))
19619 allocate(Ug2DtEUgder(2,2,2,nres))
19620 allocate(DtUg2EUgder(2,2,2,nres))
19622 ! common /rotat_old/
19623 allocate(costab(nres))
19624 allocate(sintab(nres))
19625 allocate(costab2(nres))
19626 allocate(sintab2(nres))
19629 allocate(a_chuj(2,2,maxconts,nres))
19630 !(2,2,maxconts,maxres)(maxconts=maxres/4)
19631 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
19632 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
19633 ! common /contdistrib/
19634 allocate(ncont_sent(nres))
19635 allocate(ncont_recv(nres))
19637 allocate(iat_sent(nres))
19639 allocate(iint_sent(4,nres,nres))
19640 allocate(iint_sent_local(4,nres,nres))
19642 allocate(iturn3_sent(4,0:nres+4))
19643 allocate(iturn4_sent(4,0:nres+4))
19644 allocate(iturn3_sent_local(4,nres))
19645 allocate(iturn4_sent_local(4,nres))
19647 allocate(itask_cont_from(0:nfgtasks-1))
19648 allocate(itask_cont_to(0:nfgtasks-1))
19649 !(0:max_fg_procs-1)
19653 !----------------------
19656 allocate(dcdv(6,maxdim))
19657 allocate(dxdv(6,maxdim))
19659 allocate(dxds(6,nres))
19661 allocate(gradx(3,-1:nres,0:2))
19662 allocate(gradc(3,-1:nres,0:2))
19664 allocate(gvdwx(3,-1:nres))
19665 allocate(gvdwc(3,-1:nres))
19666 allocate(gelc(3,-1:nres))
19667 allocate(gelc_long(3,-1:nres))
19668 allocate(gvdwpp(3,-1:nres))
19669 allocate(gvdwc_scpp(3,-1:nres))
19670 allocate(gradx_scp(3,-1:nres))
19671 allocate(gvdwc_scp(3,-1:nres))
19672 allocate(ghpbx(3,-1:nres))
19673 allocate(ghpbc(3,-1:nres))
19674 allocate(gradcorr(3,-1:nres))
19675 allocate(gradcorr_long(3,-1:nres))
19676 allocate(gradcorr5_long(3,-1:nres))
19677 allocate(gradcorr6_long(3,-1:nres))
19678 allocate(gcorr6_turn_long(3,-1:nres))
19679 allocate(gradxorr(3,-1:nres))
19680 allocate(gradcorr5(3,-1:nres))
19681 allocate(gradcorr6(3,-1:nres))
19682 allocate(gliptran(3,-1:nres))
19683 allocate(gliptranc(3,-1:nres))
19684 allocate(gliptranx(3,-1:nres))
19685 allocate(gshieldx(3,-1:nres))
19686 allocate(gshieldc(3,-1:nres))
19687 allocate(gshieldc_loc(3,-1:nres))
19688 allocate(gshieldx_ec(3,-1:nres))
19689 allocate(gshieldc_ec(3,-1:nres))
19690 allocate(gshieldc_loc_ec(3,-1:nres))
19691 allocate(gshieldx_t3(3,-1:nres))
19692 allocate(gshieldc_t3(3,-1:nres))
19693 allocate(gshieldc_loc_t3(3,-1:nres))
19694 allocate(gshieldx_t4(3,-1:nres))
19695 allocate(gshieldc_t4(3,-1:nres))
19696 allocate(gshieldc_loc_t4(3,-1:nres))
19697 allocate(gshieldx_ll(3,-1:nres))
19698 allocate(gshieldc_ll(3,-1:nres))
19699 allocate(gshieldc_loc_ll(3,-1:nres))
19700 allocate(grad_shield(3,-1:nres))
19701 allocate(gg_tube_sc(3,-1:nres))
19702 allocate(gg_tube(3,-1:nres))
19703 allocate(gradafm(3,-1:nres))
19704 allocate(gradb_nucl(3,-1:nres))
19705 allocate(gradbx_nucl(3,-1:nres))
19706 allocate(gvdwpsb1(3,-1:nres))
19707 allocate(gelpp(3,-1:nres))
19708 allocate(gvdwpsb(3,-1:nres))
19709 allocate(gelsbc(3,-1:nres))
19710 allocate(gelsbx(3,-1:nres))
19711 allocate(gvdwsbx(3,-1:nres))
19712 allocate(gvdwsbc(3,-1:nres))
19713 allocate(gsbloc(3,-1:nres))
19714 allocate(gsblocx(3,-1:nres))
19715 allocate(gradcorr_nucl(3,-1:nres))
19716 allocate(gradxorr_nucl(3,-1:nres))
19717 allocate(gradcorr3_nucl(3,-1:nres))
19718 allocate(gradxorr3_nucl(3,-1:nres))
19719 allocate(gvdwpp_nucl(3,-1:nres))
19722 allocate(grad_shield_side(3,50,nres))
19723 allocate(grad_shield_loc(3,50,nres))
19724 ! grad for shielding surroing
19725 allocate(gloc(0:maxvar,0:2))
19726 allocate(gloc_x(0:maxvar,2))
19728 allocate(gel_loc(3,-1:nres))
19729 allocate(gel_loc_long(3,-1:nres))
19730 allocate(gcorr3_turn(3,-1:nres))
19731 allocate(gcorr4_turn(3,-1:nres))
19732 allocate(gcorr6_turn(3,-1:nres))
19733 allocate(gradb(3,-1:nres))
19734 allocate(gradbx(3,-1:nres))
19736 allocate(gel_loc_loc(maxvar))
19737 allocate(gel_loc_turn3(maxvar))
19738 allocate(gel_loc_turn4(maxvar))
19739 allocate(gel_loc_turn6(maxvar))
19740 allocate(gcorr_loc(maxvar))
19741 allocate(g_corr5_loc(maxvar))
19742 allocate(g_corr6_loc(maxvar))
19744 allocate(gsccorc(3,-1:nres))
19745 allocate(gsccorx(3,-1:nres))
19747 allocate(gsccor_loc(-1:nres))
19749 allocate(dtheta(3,2,-1:nres))
19751 allocate(gscloc(3,-1:nres))
19752 allocate(gsclocx(3,-1:nres))
19754 allocate(dphi(3,3,-1:nres))
19755 allocate(dalpha(3,3,-1:nres))
19756 allocate(domega(3,3,-1:nres))
19758 ! common /deriv_scloc/
19759 allocate(dXX_C1tab(3,nres))
19760 allocate(dYY_C1tab(3,nres))
19761 allocate(dZZ_C1tab(3,nres))
19762 allocate(dXX_Ctab(3,nres))
19763 allocate(dYY_Ctab(3,nres))
19764 allocate(dZZ_Ctab(3,nres))
19765 allocate(dXX_XYZtab(3,nres))
19766 allocate(dYY_XYZtab(3,nres))
19767 allocate(dZZ_XYZtab(3,nres))
19770 allocate(jgrad_start(nres))
19771 allocate(jgrad_end(nres))
19773 !----------------------
19776 allocate(ibond_displ(0:nfgtasks-1))
19777 allocate(ibond_count(0:nfgtasks-1))
19778 allocate(ithet_displ(0:nfgtasks-1))
19779 allocate(ithet_count(0:nfgtasks-1))
19780 allocate(iphi_displ(0:nfgtasks-1))
19781 allocate(iphi_count(0:nfgtasks-1))
19782 allocate(iphi1_displ(0:nfgtasks-1))
19783 allocate(iphi1_count(0:nfgtasks-1))
19784 allocate(ivec_displ(0:nfgtasks-1))
19785 allocate(ivec_count(0:nfgtasks-1))
19786 allocate(iset_displ(0:nfgtasks-1))
19787 allocate(iset_count(0:nfgtasks-1))
19788 allocate(iint_count(0:nfgtasks-1))
19789 allocate(iint_displ(0:nfgtasks-1))
19790 !(0:max_fg_procs-1)
19791 !----------------------
19794 allocate(gcart(3,-1:nres))
19795 allocate(gxcart(3,-1:nres))
19797 allocate(gradcag(3,-1:nres))
19798 allocate(gradxag(3,-1:nres))
19800 ! common /back_constr/
19801 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
19802 allocate(dutheta(nres))
19803 allocate(dugamma(nres))
19805 allocate(duscdiff(3,nres))
19806 allocate(duscdiffx(3,nres))
19808 !el i io:read_fragments
19809 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
19810 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
19812 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
19813 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
19814 allocate(mset(0:nprocs)) !(maxprocs/20)
19816 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
19817 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
19818 allocate(dUdconst(3,0:nres))
19819 allocate(dUdxconst(3,0:nres))
19820 allocate(dqwol(3,0:nres))
19821 allocate(dxqwol(3,0:nres))
19823 !----------------------
19825 ! common /sbridge/ in io_common: read_bridge
19826 !el allocate((:),allocatable :: iss !(maxss)
19827 ! common /links/ in io_common: read_bridge
19828 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
19829 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
19830 ! common /dyn_ssbond/
19831 ! and side-chain vectors in theta or phi.
19832 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
19836 dyn_ssbond_ij(:,:)=1.0d300
19840 ! if (nss.gt.0) then
19841 allocate(idssb(maxdim),jdssb(maxdim))
19842 ! allocate(newihpb(nss),newjhpb(nss))
19845 allocate(ishield_list(nres))
19846 allocate(shield_list(50,nres))
19847 allocate(dyn_ss_mask(nres))
19848 allocate(fac_shield(nres))
19849 allocate(enetube(nres*2))
19850 allocate(enecavtube(nres*2))
19853 dyn_ss_mask(:)=.false.
19854 !----------------------
19856 ! Parameters of the SCCOR term
19858 !el in io_conf: parmread
19859 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
19860 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
19861 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
19862 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
19863 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
19864 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
19865 ! allocate(vlor1sccor(maxterm_sccor,20,20))
19866 ! allocate(vlor2sccor(maxterm_sccor,20,20))
19867 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
19869 allocate(gloc_sc(3,0:2*nres,0:10))
19870 !(3,0:maxres2,10)maxres2=2*maxres
19871 allocate(dcostau(3,3,3,2*nres))
19872 allocate(dsintau(3,3,3,2*nres))
19873 allocate(dtauangle(3,3,3,2*nres))
19874 allocate(dcosomicron(3,3,3,2*nres))
19875 allocate(domicron(3,3,3,2*nres))
19876 !(3,3,3,maxres2)maxres2=2*maxres
19877 !----------------------
19880 allocate(varall(maxvar))
19881 !(maxvar)(maxvar=6*maxres)
19882 allocate(mask_theta(nres))
19883 allocate(mask_phi(nres))
19884 allocate(mask_side(nres))
19886 !----------------------
19889 allocate(uy(3,nres))
19890 allocate(uz(3,nres))
19892 allocate(uygrad(3,3,2,nres))
19893 allocate(uzgrad(3,3,2,nres))
19897 end subroutine alloc_ener_arrays
19898 !-----------------------------------------------------------------
19899 subroutine ebond_nucl(estr_nucl)
19901 !c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
19904 real(kind=8),dimension(3) :: u,ud
19905 real(kind=8) :: usum,uprod,uprod1,uprod2,usumsqder
19906 real(kind=8) :: estr_nucl,diff
19907 integer :: iti,i,j,k,nbi
19909 !C print *,"I enter ebond"
19911 write (iout,*) "ibondp_start,ibondp_end",&
19912 ibondp_nucl_start,ibondp_nucl_end
19913 do i=ibondp_nucl_start,ibondp_nucl_end
19914 if (itype(i-1,2).eq.ntyp1_molec(2) .or. &
19915 itype(i,2).eq.ntyp1_molec(2)) cycle
19916 ! estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
19918 ! gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
19919 ! & *dc(j,i-1)/vbld(i)
19921 ! if (energy_dec) write(iout,*)
19922 ! & "estr1",i,vbld(i),distchainmax,
19923 ! & gnmr1(vbld(i),-1.0d0,distchainmax)
19925 diff = vbld(i)-vbldp0_nucl
19926 if(energy_dec)write(iout,*) "estr_nucl_bb" , i,vbld(i),&
19927 vbldp0_nucl,diff,AKP_nucl*diff*diff
19928 estr_nucl=estr_nucl+diff*diff
19929 ! print *,estr_nucl
19931 gradb_nucl(j,i-1)=AKP_nucl*diff*dc(j,i-1)/vbld(i)
19933 !c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
19935 estr_nucl=0.5d0*AKP_nucl*estr_nucl
19936 ! print *,"partial sum", estr_nucl,AKP_nucl
19939 write (iout,*) "ibondp_start,ibondp_end",&
19940 ibond_nucl_start,ibond_nucl_end
19942 do i=ibond_nucl_start,ibond_nucl_end
19943 !C print *, "I am stuck",i
19945 if (iti.eq.ntyp1_molec(2)) cycle
19946 nbi=nbondterm_nucl(iti)
19949 diff=vbld(i+nres)-vbldsc0_nucl(1,iti)
19952 write (iout,*) "estr_nucl_sc", i,iti,vbld(i+nres),vbldsc0_nucl(1,iti),diff, &
19953 AKSC_nucl(1,iti),AKSC_nucl(1,iti)*diff*diff
19954 estr_nucl=estr_nucl+0.5d0*AKSC_nucl(1,iti)*diff*diff
19955 ! print *,estr_nucl
19957 gradbx_nucl(j,i)=AKSC_nucl(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
19961 diff=vbld(i+nres)-vbldsc0_nucl(j,iti)
19962 ud(j)=aksc_nucl(j,iti)*diff
19963 u(j)=abond0_nucl(j,iti)+0.5d0*ud(j)*diff
19977 uprod2=uprod2*u(k)*u(k)
19981 usumsqder=usumsqder+ud(j)*uprod2
19983 estr_nucl=estr_nucl+uprod/usum
19985 gradbx_nucl(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
19989 !C print *,"I am about to leave ebond"
19991 end subroutine ebond_nucl
19993 !-----------------------------------------------------------------------------
19994 subroutine ebend_nucl(etheta_nucl)
19995 real(kind=8),dimension(nntheterm_nucl+1) :: coskt,sinkt !mmaxtheterm
19996 real(kind=8),dimension(nsingle_nucl+1) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
19997 real(kind=8),dimension(ndouble_nucl+1,ndouble_nucl+1) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
19998 logical :: lprn=.false., lprn1=.false.
19999 !el local variables
20000 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
20001 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
20002 real(kind=8) :: aux,etheta_nucl,ccl,ssl,scl,csl,ethetacnstr
20003 ! local variables for constrains
20004 real(kind=8) :: difi,thetiii
20007 ! print *,"ithet_start",ithet_nucl_start," ithet_end",ithet_nucl_end,nres
20008 do i=ithet_nucl_start,ithet_nucl_end
20009 if ((itype(i-1,2).eq.ntyp1_molec(2)).or.&
20010 (itype(i-2,2).eq.ntyp1_molec(2)).or. &
20011 (itype(i,2).eq.ntyp1_molec(2))) cycle
20015 theti2=0.5d0*theta(i)
20016 ityp2=ithetyp_nucl(itype(i-1,2))
20017 do k=1,nntheterm_nucl
20018 coskt(k)=dcos(k*theti2)
20019 sinkt(k)=dsin(k*theti2)
20021 if (i.gt.3 .and. itype(i-2,2).ne.ntyp1_molec(2)) then
20024 if (phii.ne.phii) phii=150.0
20028 ityp1=ithetyp_nucl(itype(i-2,2))
20029 do k=1,nsingle_nucl
20030 cosph1(k)=dcos(k*phii)
20031 sinph1(k)=dsin(k*phii)
20035 ityp1=nthetyp_nucl+1
20036 do k=1,nsingle_nucl
20042 if (i.lt.nres .and. itype(i,2).ne.ntyp1_molec(2)) then
20045 if (phii1.ne.phii1) phii1=150.0
20046 phii1=pinorm(phii1)
20050 ityp3=ithetyp_nucl(itype(i,2))
20051 do k=1,nsingle_nucl
20052 cosph2(k)=dcos(k*phii1)
20053 sinph2(k)=dsin(k*phii1)
20057 ityp3=nthetyp_nucl+1
20058 do k=1,nsingle_nucl
20063 ethetai=aa0thet_nucl(ityp1,ityp2,ityp3)
20064 do k=1,ndouble_nucl
20066 ccl=cosph1(l)*cosph2(k-l)
20067 ssl=sinph1(l)*sinph2(k-l)
20068 scl=sinph1(l)*cosph2(k-l)
20069 csl=cosph1(l)*sinph2(k-l)
20070 cosph1ph2(l,k)=ccl-ssl
20071 cosph1ph2(k,l)=ccl+ssl
20072 sinph1ph2(l,k)=scl+csl
20073 sinph1ph2(k,l)=scl-csl
20077 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
20078 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
20079 write (iout,*) "coskt and sinkt",nntheterm_nucl
20080 do k=1,nntheterm_nucl
20081 write (iout,*) k,coskt(k),sinkt(k)
20084 do k=1,ntheterm_nucl
20085 ethetai=ethetai+aathet_nucl(k,ityp1,ityp2,ityp3)*sinkt(k)
20086 dethetai=dethetai+0.5d0*k*aathet_nucl(k,ityp1,ityp2,ityp3)&
20089 write (iout,*) "k",k," aathet",aathet_nucl(k,ityp1,ityp2,ityp3),&
20093 write (iout,*) "cosph and sinph"
20094 do k=1,nsingle_nucl
20095 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
20097 write (iout,*) "cosph1ph2 and sinph2ph2"
20098 do k=2,ndouble_nucl
20100 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
20101 sinph1ph2(l,k),sinph1ph2(k,l)
20104 write(iout,*) "ethetai",ethetai
20106 do m=1,ntheterm2_nucl
20107 do k=1,nsingle_nucl
20108 aux=bbthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)&
20109 +ccthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k)&
20110 +ddthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)&
20111 +eethet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k)
20112 ethetai=ethetai+sinkt(m)*aux
20113 dethetai=dethetai+0.5d0*m*aux*coskt(m)
20114 dephii=dephii+k*sinkt(m)*(&
20115 ccthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)-&
20116 bbthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k))
20117 dephii1=dephii1+k*sinkt(m)*(&
20118 eethet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)-&
20119 ddthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k))
20121 write (iout,*) "m",m," k",k," bbthet",&
20122 bbthet_nucl(k,m,ityp1,ityp2,ityp3)," ccthet",&
20123 ccthet_nucl(k,m,ityp1,ityp2,ityp3)," ddthet",&
20124 ddthet_nucl(k,m,ityp1,ityp2,ityp3)," eethet",&
20125 eethet_nucl(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
20129 write(iout,*) "ethetai",ethetai
20130 do m=1,ntheterm3_nucl
20131 do k=2,ndouble_nucl
20133 aux=ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
20134 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+&
20135 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
20136 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
20137 ethetai=ethetai+sinkt(m)*aux
20138 dethetai=dethetai+0.5d0*m*coskt(m)*aux
20139 dephii=dephii+l*sinkt(m)*(&
20140 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-&
20141 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
20142 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
20143 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
20144 dephii1=dephii1+(k-l)*sinkt(m)*( &
20145 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
20146 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
20147 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-&
20148 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
20150 write (iout,*) "m",m," k",k," l",l," ffthet", &
20151 ffthet_nucl(l,k,m,ityp1,ityp2,ityp3), &
20152 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ggthet",&
20153 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3),&
20154 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
20155 write (iout,*) cosph1ph2(l,k)*sinkt(m), &
20156 cosph1ph2(k,l)*sinkt(m),&
20157 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
20163 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
20164 i,theta(i)*rad2deg,phii*rad2deg, &
20165 phii1*rad2deg,ethetai
20166 etheta_nucl=etheta_nucl+ethetai
20167 ! print *,i,"partial sum",etheta_nucl
20168 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang_nucl*dephii
20169 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang_nucl*dephii1
20170 gloc(nphi+i-2,icg)=wang_nucl*dethetai
20173 end subroutine ebend_nucl
20174 !----------------------------------------------------
20175 subroutine etor_nucl(etors_nucl)
20176 ! implicit real*8 (a-h,o-z)
20177 ! include 'DIMENSIONS'
20178 ! include 'COMMON.VAR'
20179 ! include 'COMMON.GEO'
20180 ! include 'COMMON.LOCAL'
20181 ! include 'COMMON.TORSION'
20182 ! include 'COMMON.INTERACT'
20183 ! include 'COMMON.DERIV'
20184 ! include 'COMMON.CHAIN'
20185 ! include 'COMMON.NAMES'
20186 ! include 'COMMON.IOUNITS'
20187 ! include 'COMMON.FFIELD'
20188 ! include 'COMMON.TORCNSTR'
20189 ! include 'COMMON.CONTROL'
20190 real(kind=8) :: etors_nucl,edihcnstr
20192 !el local variables
20193 integer :: i,j,iblock,itori,itori1
20194 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
20195 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
20196 ! Set lprn=.true. for debugging
20200 ! print *,"iphi_nucl_start/end", iphi_nucl_start,iphi_nucl_end
20201 do i=iphi_nucl_start,iphi_nucl_end
20202 if (itype(i-2,2).eq.ntyp1_molec(2) .or. itype(i-1,2).eq.ntyp1_molec(2) &
20203 .or. itype(i-3,2).eq.ntyp1_molec(2) &
20204 .or. itype(i,2).eq.ntyp1_molec(2)) cycle
20206 itori=itortyp_nucl(itype(i-2,2))
20207 itori1=itortyp_nucl(itype(i-1,2))
20209 ! print *,i,itori,itori1
20211 !C Regular cosine and sine terms
20212 do j=1,nterm_nucl(itori,itori1)
20213 v1ij=v1_nucl(j,itori,itori1)
20214 v2ij=v2_nucl(j,itori,itori1)
20215 cosphi=dcos(j*phii)
20216 sinphi=dsin(j*phii)
20217 etors_nucl=etors_nucl+v1ij*cosphi+v2ij*sinphi
20218 if (energy_dec) etors_ii=etors_ii+&
20219 v1ij*cosphi+v2ij*sinphi
20220 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
20224 !C E = SUM ----------------------------------- - v1
20225 !C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
20227 cosphi=dcos(0.5d0*phii)
20228 sinphi=dsin(0.5d0*phii)
20229 do j=1,nlor_nucl(itori,itori1)
20230 vl1ij=vlor1_nucl(j,itori,itori1)
20231 vl2ij=vlor2_nucl(j,itori,itori1)
20232 vl3ij=vlor3_nucl(j,itori,itori1)
20233 pom=vl2ij*cosphi+vl3ij*sinphi
20234 pom1=1.0d0/(pom*pom+1.0d0)
20235 etors_nucl=etors_nucl+vl1ij*pom1
20236 if (energy_dec) etors_ii=etors_ii+ &
20239 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
20241 !C Subtract the constant term
20242 etors_nucl=etors_nucl-v0_nucl(itori,itori1)
20243 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
20244 'etor',i,etors_ii-v0_nucl(itori,itori1)
20246 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
20247 restyp(itype(i-2,2),2),i-2,restyp(itype(i-1,2),2),i-1,itori,itori1, &
20248 (v1_nucl(j,itori,itori1),j=1,6),(v2_nucl(j,itori,itori1),j=1,6)
20249 gloc(i-3,icg)=gloc(i-3,icg)+wtor_nucl*gloci
20250 !c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
20253 end subroutine etor_nucl
20254 !------------------------------------------------------------
20255 subroutine epp_nucl_sub(evdw1,ees)
20257 !C This subroutine calculates the average interaction energy and its gradient
20258 !C in the virtual-bond vectors between non-adjacent peptide groups, based on
20259 !C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
20260 !C The potential depends both on the distance of peptide-group centers and on
20261 !C the orientation of the CA-CA virtual bonds.
20263 integer :: i,j,k,iteli,itelj,num_conti,isubchap,ind
20264 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
20265 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
20266 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
20267 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
20268 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20269 dist_temp, dist_init,sss_grad,fac,evdw1ij
20270 integer xshift,yshift,zshift
20271 real(kind=8),dimension(3):: ggg,gggp,gggm,erij
20272 real(kind=8) :: ees,eesij
20273 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
20274 real(kind=8) scal_el /0.5d0/
20280 !c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
20282 ! print *,"iatel_s_nucl,iatel_e_nucl",iatel_s_nucl,iatel_e_nucl
20283 do i=iatel_s_nucl,iatel_e_nucl
20284 if (itype(i,2).eq.ntyp1_molec(2) .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
20288 dx_normi=dc_norm(1,i)
20289 dy_normi=dc_norm(2,i)
20290 dz_normi=dc_norm(3,i)
20291 xmedi=c(1,i)+0.5d0*dxi
20292 ymedi=c(2,i)+0.5d0*dyi
20293 zmedi=c(3,i)+0.5d0*dzi
20294 xmedi=dmod(xmedi,boxxsize)
20295 if (xmedi.lt.0) xmedi=xmedi+boxxsize
20296 ymedi=dmod(ymedi,boxysize)
20297 if (ymedi.lt.0) ymedi=ymedi+boxysize
20298 zmedi=dmod(zmedi,boxzsize)
20299 if (zmedi.lt.0) zmedi=zmedi+boxzsize
20301 do j=ielstart_nucl(i),ielend_nucl(i)
20302 if (itype(j,2).eq.ntyp1_molec(2) .or. itype(j+1,2).eq.ntyp1_molec(2)) cycle
20307 ! xj=c(1,j)+0.5D0*dxj-xmedi
20308 ! yj=c(2,j)+0.5D0*dyj-ymedi
20309 ! zj=c(3,j)+0.5D0*dzj-zmedi
20310 xj=c(1,j)+0.5D0*dxj
20311 yj=c(2,j)+0.5D0*dyj
20312 zj=c(3,j)+0.5D0*dzj
20313 xj=mod(xj,boxxsize)
20314 if (xj.lt.0) xj=xj+boxxsize
20315 yj=mod(yj,boxysize)
20316 if (yj.lt.0) yj=yj+boxysize
20317 zj=mod(zj,boxzsize)
20318 if (zj.lt.0) zj=zj+boxzsize
20320 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
20327 xj=xj_safe+xshift*boxxsize
20328 yj=yj_safe+yshift*boxysize
20329 zj=zj_safe+zshift*boxzsize
20330 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
20331 if(dist_temp.lt.dist_init) then
20332 dist_init=dist_temp
20341 if (isubchap.eq.1) then
20352 rij=xj*xj+yj*yj+zj*zj
20353 !c write (2,*)"ij",i,j," r0pp",r0pp," rij",rij," epspp",epspp
20354 fac=(r0pp**2/rij)**3
20358 fac=(-ev1-evdw1ij)/rij
20359 ! write (2,*)"fac",fac," ev1",ev1," ev2",ev2," evdw1ij",evdw1ij
20360 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"evdw1ij",evdw1ij
20361 evdw1=evdw1+evdw1ij
20363 !C Calculate contributions to the Cartesian gradient.
20369 gvdwpp_nucl(k,i)=gvdwpp_nucl(k,i)-ggg(k)
20370 gvdwpp_nucl(k,j)=gvdwpp_nucl(k,j)+ggg(k)
20372 !c phoshate-phosphate electrostatic interactions
20375 eesij=dexp(-BEES*rij)*fac
20376 ! write (2,*)"fac",fac," eesijpp",eesij
20377 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"eesijpp",eesij
20380 fac=-(fac+BEES)*eesij*fac
20384 !c write(2,*) "ggg",i,j,ggg(1),ggg(2),ggg(3)
20385 !c write(2,*) "gelpp",i,(gelpp(k,i),k=1,3)
20386 !c write(2,*) "gelpp",j,(gelpp(k,j),k=1,3)
20388 gelpp(k,i)=gelpp(k,i)-ggg(k)
20389 gelpp(k,j)=gelpp(k,j)+ggg(k)
20396 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
20398 gvdwpp_nucl(k,i)=6*gvdwpp_nucl(k,i)
20399 !c gelpp(k,i)=332.0d0*gelpp(k,i)
20400 gelpp(k,i)=AEES*gelpp(k,i)
20402 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
20404 !c write (2,*) "total EES",ees
20406 end subroutine epp_nucl_sub
20407 !---------------------------------------------------------------------
20408 subroutine epsb(evdwpsb,eelpsb)
20411 !C This subroutine calculates the excluded-volume interaction energy between
20412 !C peptide-group centers and side chains and its gradient in virtual-bond and
20413 !C side-chain vectors.
20415 real(kind=8),dimension(3):: ggg
20416 integer :: i,iint,j,k,iteli,itypj,subchap
20417 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
20418 e1,e2,evdwij,rij,evdwpsb,eelpsb
20419 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20420 dist_temp, dist_init
20421 integer xshift,yshift,zshift
20423 !cd print '(a)','Enter ESCP'
20424 !cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
20427 ! print *,"iatscp_s_nucl,iatscp_e_nucl",iatscp_s_nucl,iatscp_e_nucl
20428 do i=iatscp_s_nucl,iatscp_e_nucl
20429 if (itype(i,2).eq.ntyp1_molec(2) &
20430 .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
20431 xi=0.5D0*(c(1,i)+c(1,i+1))
20432 yi=0.5D0*(c(2,i)+c(2,i+1))
20433 zi=0.5D0*(c(3,i)+c(3,i+1))
20434 xi=mod(xi,boxxsize)
20435 if (xi.lt.0) xi=xi+boxxsize
20436 yi=mod(yi,boxysize)
20437 if (yi.lt.0) yi=yi+boxysize
20438 zi=mod(zi,boxzsize)
20439 if (zi.lt.0) zi=zi+boxzsize
20441 do iint=1,nscp_gr_nucl(i)
20443 do j=iscpstart_nucl(i,iint),iscpend_nucl(i,iint)
20445 if (itypj.eq.ntyp1_molec(2)) cycle
20446 !C Uncomment following three lines for SC-p interactions
20447 !c xj=c(1,nres+j)-xi
20448 !c yj=c(2,nres+j)-yi
20449 !c zj=c(3,nres+j)-zi
20450 !C Uncomment following three lines for Ca-p interactions
20457 xj=mod(xj,boxxsize)
20458 if (xj.lt.0) xj=xj+boxxsize
20459 yj=mod(yj,boxysize)
20460 if (yj.lt.0) yj=yj+boxysize
20461 zj=mod(zj,boxzsize)
20462 if (zj.lt.0) zj=zj+boxzsize
20463 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20471 xj=xj_safe+xshift*boxxsize
20472 yj=yj_safe+yshift*boxysize
20473 zj=zj_safe+zshift*boxzsize
20474 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20475 if(dist_temp.lt.dist_init) then
20476 dist_init=dist_temp
20485 if (subchap.eq.1) then
20495 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
20497 e1=fac*fac*aad_nucl(itypj)
20498 e2=fac*bad_nucl(itypj)
20499 if (iabs(j-i) .le. 2) then
20504 evdwpsb=evdwpsb+evdwij
20505 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a4)') &
20506 'evdw2',i,j,evdwij,"tu4"
20508 !C Calculate contributions to the gradient in the virtual-bond and SC vectors.
20510 fac=-(evdwij+e1)*rrij
20515 gvdwpsb1(k,i)=gvdwpsb1(k,i)-ggg(k)
20516 gvdwpsb(k,j)=gvdwpsb(k,j)+ggg(k)
20524 gvdwpsb(j,i)=expon*gvdwpsb(j,i)
20525 gvdwpsb1(j,i)=expon*gvdwpsb1(j,i)
20529 end subroutine epsb
20531 !------------------------------------------------------
20532 subroutine esb_gb(evdwsb,eelsb)
20535 integer :: iint,itypi,itypi1,itypj,subchap,num_conti2
20536 real(kind=8) :: xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
20537 real(kind=8) :: evdw,sig0iji,evdwsb,eelsb,ecorr,eelij
20538 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20539 dist_temp, dist_init,aa,bb,faclip,sig0ij
20548 ! print *,"iastsc_nucl",iatsc_s_nucl,iatsc_e_nucl
20549 do i=iatsc_s_nucl,iatsc_e_nucl
20553 ! PRINT *,"I=",i,itypi
20554 if (itypi.eq.ntyp1_molec(2)) cycle
20555 itypi1=itype(i+1,2)
20559 xi=dmod(xi,boxxsize)
20560 if (xi.lt.0) xi=xi+boxxsize
20561 yi=dmod(yi,boxysize)
20562 if (yi.lt.0) yi=yi+boxysize
20563 zi=dmod(zi,boxzsize)
20564 if (zi.lt.0) zi=zi+boxzsize
20566 dxi=dc_norm(1,nres+i)
20567 dyi=dc_norm(2,nres+i)
20568 dzi=dc_norm(3,nres+i)
20569 dsci_inv=vbld_inv(i+nres)
20571 !C Calculate SC interaction energy.
20573 do iint=1,nint_gr_nucl(i)
20574 ! print *,"tu?",i,istart_nucl(i,iint),iend_nucl(i,iint)
20575 do j=istart_nucl(i,iint),iend_nucl(i,iint)
20579 if (itypj.eq.ntyp1_molec(2)) cycle
20580 dscj_inv=vbld_inv(j+nres)
20581 sig0ij=sigma_nucl(itypi,itypj)
20582 chi1=chi_nucl(itypi,itypj)
20583 chi2=chi_nucl(itypj,itypi)
20585 chip1=chip_nucl(itypi,itypj)
20586 chip2=chip_nucl(itypj,itypi)
20588 ! xj=c(1,nres+j)-xi
20589 ! yj=c(2,nres+j)-yi
20590 ! zj=c(3,nres+j)-zi
20594 xj=dmod(xj,boxxsize)
20595 if (xj.lt.0) xj=xj+boxxsize
20596 yj=dmod(yj,boxysize)
20597 if (yj.lt.0) yj=yj+boxysize
20598 zj=dmod(zj,boxzsize)
20599 if (zj.lt.0) zj=zj+boxzsize
20600 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20608 xj=xj_safe+xshift*boxxsize
20609 yj=yj_safe+yshift*boxysize
20610 zj=zj_safe+zshift*boxzsize
20611 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
20612 if(dist_temp.lt.dist_init) then
20613 dist_init=dist_temp
20622 if (subchap.eq.1) then
20632 dxj=dc_norm(1,nres+j)
20633 dyj=dc_norm(2,nres+j)
20634 dzj=dc_norm(3,nres+j)
20635 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
20637 !C Calculate angle-dependent terms of energy and contributions to their
20642 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
20643 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
20644 om12=dxi*dxj+dyi*dyj+dzi*dzj
20645 call sc_angular_nucl
20647 sig=sig0ij*dsqrt(sigsq)
20648 rij_shift=1.0D0/rij-sig+sig0ij
20649 ! print *,rij_shift,"rij_shift"
20650 !c write (2,*) " rij",1.0D0/rij," sig",sig," sig0ij",sig0ij,
20651 !c & " rij_shift",rij_shift
20652 if (rij_shift.le.0.0D0) then
20657 !c---------------------------------------------------------------
20658 rij_shift=1.0D0/rij_shift
20659 fac=rij_shift**expon
20660 e1=fac*fac*aa_nucl(itypi,itypj)
20661 e2=fac*bb_nucl(itypi,itypj)
20662 evdwij=eps1*eps2rt*(e1+e2)
20663 !c write (2,*) "eps1",eps1," eps2rt",eps2rt,
20664 !c & " e1",e1," e2",e2," evdwij",evdwij
20666 evdwij=evdwij*eps2rt
20667 evdwsb=evdwsb+evdwij
20669 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
20670 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
20671 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
20672 restyp(itypi,2),i,restyp(itypj,2),j, &
20673 epsi,sigm,chi1,chi2,chip1,chip2, &
20674 eps1,eps2rt**2,sig,sig0ij, &
20675 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
20677 write (iout,*) "aa",aa_nucl(itypi,itypj)," bb",bb_nucl(itypi,itypj)
20680 if (energy_dec) write (iout,'(a6,2i5,e15.3,a4)') &
20681 'evdw',i,j,evdwij,"tu3"
20684 !C Calculate gradient components.
20685 e1=e1*eps1*eps2rt**2
20686 fac=-expon*(e1+evdwij)*rij_shift
20690 !C Calculate the radial part of the gradient
20694 !C Calculate angular part of the gradient.
20696 call eelsbij(eelij,num_conti2)
20697 if (energy_dec .and. &
20698 (j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2)) &
20699 write (istat,'(e14.5)') evdwij
20703 num_cont_hb(i)=num_conti2
20705 !c write (iout,*) "Number of loop steps in EGB:",ind
20706 !cccc energy_dec=.false.
20708 end subroutine esb_gb
20709 !-------------------------------------------------------------------------------
20710 subroutine eelsbij(eesij,num_conti2)
20713 real(kind=8),dimension(3) :: ggg,gggp,gggm,dcosb,dcosg
20714 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
20715 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
20716 dist_temp, dist_init,rlocshield,fracinbuf
20717 integer xshift,yshift,zshift,ilist,iresshield,num_conti2
20719 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
20720 real(kind=8) scal_el /0.5d0/
20721 integer :: iteli,itelj,kkk,kkll,m,isubchap
20722 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp,facfac
20723 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i,ael63i,ael32i
20724 real(kind=8) :: dx_normj,dy_normj,dz_normj,&
20725 r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,fac5,fac6,&
20726 el1,el2,el3,el4,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
20727 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
20728 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
20729 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
20730 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
20731 ecosgp,ecosam,ecosbm,ecosgm,ghalf,itypi,itypj
20735 ! print *,i,j,itypi,itypj,istype(i),istype(j),"????"
20736 ael6i=ael6_nucl(itypi,itypj)
20737 ael3i=ael3_nucl(itypi,itypj)
20738 ael63i=ael63_nucl(itypi,itypj)
20739 ael32i=ael32_nucl(itypi,itypj)
20740 !c write (iout,*) "eelecij",i,j,itype(i),itype(j),
20741 !c & ael6i,ael3i,ael63i,al32i,rij,rrij
20745 dx_normi=dc_norm(1,i+nres)
20746 dy_normi=dc_norm(2,i+nres)
20747 dz_normi=dc_norm(3,i+nres)
20748 dx_normj=dc_norm(1,j+nres)
20749 dy_normj=dc_norm(2,j+nres)
20750 dz_normj=dc_norm(3,j+nres)
20751 !c xj=c(1,j)+0.5D0*dxj-xmedi
20752 !c yj=c(2,j)+0.5D0*dyj-ymedi
20753 !c zj=c(3,j)+0.5D0*dzj-zmedi
20754 if (ipot_nucl.ne.2) then
20755 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
20756 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
20757 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
20765 fac=cosa-3.0D0*cosb*cosg
20767 fac1=3.0d0*(cosb*cosb+cosg*cosg)
20772 !c write (iout,*) "r3ij",r3ij," r6ij",r6ij," fac",fac," fac1",fac1,
20773 !c & " fac2",fac2," fac3",fac3," fac4",fac4," fac5",fac5," fac6",fac6
20774 el1=fac3*(4.0D0+facfac-fac1)
20776 el3=fac5*(2.0d0-2.0d0*facfac+fac1)
20778 eesij=el1+el2+el3+el4
20779 !C 12/26/95 - for the evaluation of multi-body H-bonding interactions
20780 ees0ij=4.0D0+facfac-fac1
20782 if (energy_dec) then
20783 if(j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2) &
20784 write (istat,'(2a1,i4,1x,2a1,i4,4f10.5,3e12.5,$)') &
20785 sugartyp(istype(i)),restyp(itypi,2),i,sugartyp(istype(j)),&
20786 restyp(itypj,2),j,1.0d0/rij,cosa,cosb,cosg,fac*r3ij, &
20787 (4.0D0+facfac-fac1)*r6ij,(2.0d0-2.0d0*facfac+fac1)*r6ij
20788 write (iout,'(a6,2i5,e15.3)') 'ees',i,j,eesij
20792 !C Calculate contributions to the Cartesian gradient.
20794 facel=-3.0d0*rrij*(eesij+el1+el3+el4)
20800 !* Radial derivatives. First process both termini of the fragment (i,j)
20806 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
20807 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
20808 gelsbx(k,j)=gelsbx(k,j)+ggg(k)
20809 gelsbx(k,i)=gelsbx(k,i)-ggg(k)
20814 ecosa=2.0D0*fac3*fac1+fac4+(-4.0d0*fac5+2.0d0*fac6)*fac1
20819 ecosb=fac3*(fac1*cosg+cosb)+cosg*fac4+(cosb+2*fac1*cosg)*fac5+&
20821 ecosg=fac3*(fac1*cosb+cosg)+cosb*fac4+(cosg+2*fac1*cosb)*fac5+&
20824 dcosb(k)=rij*(dc_norm(k,i+nres)-erij(k)*cosb)
20825 dcosg(k)=rij*(dc_norm(k,j+nres)-erij(k)*cosg)
20828 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
20831 gelsbx(k,i)=gelsbx(k,i)-ggg(k) &
20832 +(ecosa*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres))&
20833 + ecosb*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
20834 gelsbx(k,j)=gelsbx(k,j)+ggg(k) &
20835 +(ecosa*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
20836 + ecosg*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
20837 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
20838 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
20840 ! IF ( (wcorr_nucl.gt.0.0d0.or.wcorr3_nucl.gt.0.0d0) .and.
20841 IF ( j.gt.i+1 .and.&
20842 num_conti.le.maxconts) THEN
20844 !C Calculate the contact function. The ith column of the array JCONT will
20845 !C contain the numbers of atoms that make contacts with the atom I (of numbers
20846 !C greater than I). The arrays FACONT and GACONT will contain the values of
20847 !C the contact function and its derivative.
20848 r0ij=2.20D0*sigma(itypi,itypj)
20849 !c write (2,*) "ij",i,j," rij",1.0d0/rij," r0ij",r0ij
20850 call gcont(rij,r0ij,1.0D0,0.2d0/r0ij,fcont,fprimcont)
20851 !c write (2,*) "fcont",fcont
20852 if (fcont.gt.0.0D0) then
20853 num_conti=num_conti+1
20854 num_conti2=num_conti2+1
20856 if (num_conti.gt.maxconts) then
20857 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
20858 ' will skip next contacts for this conf.'
20860 jcont_hb(num_conti,i)=j
20861 !c write (iout,*) "num_conti",num_conti,
20862 !c & " jcont_hb",jcont_hb(num_conti,i)
20863 !C Calculate contact energies
20865 wij=cosa-3.0D0*cosb*cosg
20868 fac3=dsqrt(-ael6i)*r3ij
20869 !c write (2,*) "ael6i",ael6i," r3ij",r3ij," fac3",fac3
20870 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
20871 if (ees0tmp.gt.0) then
20872 ees0pij=dsqrt(ees0tmp)
20876 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
20877 if (ees0tmp.gt.0) then
20878 ees0mij=dsqrt(ees0tmp)
20882 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
20883 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
20884 !c write (iout,*) "i",i," j",j,
20885 !c & " ees0m",ees0m(num_conti,i)," ees0p",ees0p(num_conti,i)
20886 ees0pij1=fac3/ees0pij
20887 ees0mij1=fac3/ees0mij
20888 fac3p=-3.0D0*fac3*rrij
20889 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
20890 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
20891 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
20892 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
20893 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
20894 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
20895 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
20896 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
20897 ecosap=ecosa1+ecosa2
20898 ecosbp=ecosb1+ecosb2
20899 ecosgp=ecosg1+ecosg2
20900 ecosam=ecosa1-ecosa2
20901 ecosbm=ecosb1-ecosb2
20902 ecosgm=ecosg1-ecosg2
20904 facont_hb(num_conti,i)=fcont
20905 fprimcont=fprimcont/rij
20907 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
20908 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
20910 gggp(1)=gggp(1)+ees0pijp*xj
20911 gggp(2)=gggp(2)+ees0pijp*yj
20912 gggp(3)=gggp(3)+ees0pijp*zj
20913 gggm(1)=gggm(1)+ees0mijp*xj
20914 gggm(2)=gggm(2)+ees0mijp*yj
20915 gggm(3)=gggm(3)+ees0mijp*zj
20916 !C Derivatives due to the contact function
20917 gacont_hbr(1,num_conti,i)=fprimcont*xj
20918 gacont_hbr(2,num_conti,i)=fprimcont*yj
20919 gacont_hbr(3,num_conti,i)=fprimcont*zj
20922 !c Gradient of the correlation terms
20924 gacontp_hb1(k,num_conti,i)= &
20925 (ecosap*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
20926 + ecosbp*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
20927 gacontp_hb2(k,num_conti,i)= &
20928 (ecosap*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres)) &
20929 + ecosgp*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
20930 gacontp_hb3(k,num_conti,i)=gggp(k)
20931 gacontm_hb1(k,num_conti,i)= &
20932 (ecosam*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
20933 + ecosbm*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
20934 gacontm_hb2(k,num_conti,i)= &
20935 (ecosam*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
20936 + ecosgm*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
20937 gacontm_hb3(k,num_conti,i)=gggm(k)
20943 end subroutine eelsbij
20944 !------------------------------------------------------------------
20945 subroutine sc_grad_nucl
20948 real(kind=8),dimension(3) :: dcosom1,dcosom2
20949 eom1=eps2der*eps2rt_om1+sigder*sigsq_om1
20950 eom2=eps2der*eps2rt_om2+sigder*sigsq_om2
20951 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12+sigder*sigsq_om12
20953 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
20954 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
20957 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
20960 gvdwsbx(k,i)=gvdwsbx(k,i)-gg(k) &
20961 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
20962 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
20963 gvdwsbx(k,j)=gvdwsbx(k,j)+gg(k) &
20964 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
20965 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
20968 !C Calculate the components of the gradient in DC and X
20971 gvdwsbc(l,i)=gvdwsbc(l,i)-gg(l)
20972 gvdwsbc(l,j)=gvdwsbc(l,j)+gg(l)
20975 end subroutine sc_grad_nucl
20976 !-----------------------------------------------------------------------
20977 subroutine esb(esbloc)
20978 !C Calculate the local energy of a side chain and its derivatives in the
20979 !C corresponding virtual-bond valence angles THETA and the spherical angles
20980 !C ALPHA and OMEGA derived from AM1 all-atom calculations.
20981 !C added by Urszula Kozlowska. 07/11/2007
20983 real(kind=8),dimension(3):: x_prime,y_prime,z_prime
20984 real(kind=8),dimension(9):: x
20985 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1, &
20986 sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,&
20987 de_dxx,de_dyy,de_dzz,de_dt,s1_t,s1_6_t,s2_t,s2_6_t
20988 real(kind=8),dimension(3):: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,&
20989 dYY_Ci,dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
20990 real(kind=8) :: esbloc,delta,cosfac2,cosfac,sinfac2,sinfac,de_dtt,&
20991 cossc,cossc1,cosfac2xx,sinfac2yy,pom1,pom
20992 integer::it,nlobit,i,j,k
20993 ! common /sccalc/ time11,time12,time112,theti,it,nlobit
20996 do i=loc_start_nucl,loc_end_nucl
20997 if (itype(i,2).eq.ntyp1_molec(2)) cycle
20998 costtab(i+1) =dcos(theta(i+1))
20999 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
21000 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
21001 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
21002 cosfac2=0.5d0/(1.0d0+costtab(i+1))
21003 cosfac=dsqrt(cosfac2)
21004 sinfac2=0.5d0/(1.0d0-costtab(i+1))
21005 sinfac=dsqrt(sinfac2)
21007 if (it.eq.10) goto 1
21010 !C Compute the axes of tghe local cartesian coordinates system; store in
21011 !c x_prime, y_prime and z_prime
21018 !C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
21019 !C & dc_norm(3,i+nres)
21021 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
21022 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
21025 z_prime(j) = -uz(j,i-1)
21033 xx = xx + x_prime(j)*dc_norm(j,i+nres)
21034 yy = yy + y_prime(j)*dc_norm(j,i+nres)
21035 zz = zz + z_prime(j)*dc_norm(j,i+nres)
21043 x(j) = sc_parmin_nucl(j,it)
21046 !Cc diagnostics - remove later
21047 xx1 = dcos(alph(2))
21048 yy1 = dsin(alph(2))*dcos(omeg(2))
21049 zz1 = -dsin(alph(2))*dsin(omeg(2))
21050 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
21051 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
21053 !C," --- ", xx_w,yy_w,zz_w
21056 sumene = enesc_nucl(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21057 esbloc = esbloc + sumene
21058 sumene2= enesc_nucl(x,xx,yy,0.0d0,cost2tab(i+1),sint2tab(i+1))
21059 ! print *,"enecomp",sumene,sumene2
21060 ! if (energy_dec) write(iout,*) "i",i," esbloc",sumene,esbloc,xx,yy,zz
21061 ! if (energy_dec) write(iout,*) "x",(x(k),k=1,9)
21063 write (2,*) "x",(x(k),k=1,9)
21065 !C This section to check the numerical derivatives of the energy of ith side
21066 !C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
21067 !C #define DEBUG in the code to turn it on.
21069 write (2,*) "sumene =",sumene
21073 write (2,*) xx,yy,zz
21074 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21075 de_dxx_num=(sumenep-sumene)/aincr
21077 write (2,*) "xx+ sumene from enesc=",sumenep,sumene
21080 write (2,*) xx,yy,zz
21081 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21082 de_dyy_num=(sumenep-sumene)/aincr
21084 write (2,*) "yy+ sumene from enesc=",sumenep,sumene
21087 write (2,*) xx,yy,zz
21088 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21089 de_dzz_num=(sumenep-sumene)/aincr
21091 write (2,*) "zz+ sumene from enesc=",sumenep,sumene
21092 costsave=cost2tab(i+1)
21093 sintsave=sint2tab(i+1)
21094 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
21095 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
21096 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21097 de_dt_num=(sumenep-sumene)/aincr
21098 write (2,*) " t+ sumene from enesc=",sumenep,sumene
21099 cost2tab(i+1)=costsave
21100 sint2tab(i+1)=sintsave
21101 !C End of diagnostics section.
21104 !C Compute the gradient of esc
21106 de_dxx=x(1)+2*x(4)*xx+x(7)*zz+x(8)*yy
21107 de_dyy=x(2)+2*x(5)*yy+x(8)*xx+x(9)*zz
21108 de_dzz=x(3)+2*x(6)*zz+x(7)*xx+x(9)*yy
21111 write (2,*) "x",(x(k),k=1,9)
21112 write (2,*) "xx",xx," yy",yy," zz",zz
21113 write (2,*) "de_xx ",de_xx," de_yy ",de_yy,&
21114 " de_zz ",de_zz," de_tt ",de_tt
21115 write (2,*) "de_xx_num",de_dxx_num," de_yy_num",de_dyy_num,&
21116 " de_zz_num",de_dzz_num," de_dt_num",de_dt_num
21119 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
21120 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
21121 cosfac2xx=cosfac2*xx
21122 sinfac2yy=sinfac2*yy
21124 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*&
21126 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*&
21128 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
21129 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
21130 !c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
21131 !c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
21132 !c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
21133 !c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
21134 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
21135 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
21136 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
21137 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
21141 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
21142 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
21145 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
21146 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
21147 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
21149 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
21150 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
21154 dXX_Ctab(k,i)=dXX_Ci(k)
21155 dXX_C1tab(k,i)=dXX_Ci1(k)
21156 dYY_Ctab(k,i)=dYY_Ci(k)
21157 dYY_C1tab(k,i)=dYY_Ci1(k)
21158 dZZ_Ctab(k,i)=dZZ_Ci(k)
21159 dZZ_C1tab(k,i)=dZZ_Ci1(k)
21160 dXX_XYZtab(k,i)=dXX_XYZ(k)
21161 dYY_XYZtab(k,i)=dYY_XYZ(k)
21162 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
21165 !c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
21166 !c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
21167 !c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
21168 !c & dyy_ci(k)," dzz_ci",dzz_ci(k)
21169 !c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
21171 !c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
21172 !c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
21173 gsbloc(k,i-1)=gsbloc(k,i-1)+(de_dxx*dxx_ci1(k) &
21174 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k))
21175 gsbloc(k,i)=gsbloc(k,i)+(de_dxx*dxx_Ci(k) &
21176 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k))
21177 gsblocx(k,i)= de_dxx*dxx_XYZ(k)&
21178 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
21179 ! print *,i,de_dxx*dxx_ci1(k)+de_dyy*dyy_ci1(k),de_dzz*dzz_ci1(k)*2
21181 !c write(iout,*) "ENERGY GRAD = ", (gsbloc(k,i-1),k=1,3),
21182 !c & (gsbloc(k,i),k=1,3),(gsblocx(k,i),k=1,3)
21184 !C to check gradient call subroutine check_grad
21190 !=-------------------------------------------------------
21191 real(kind=8) function enesc_nucl(x,xx,yy,zz,cost2,sint2)
21193 real(kind=8),dimension(9):: x(9)
21194 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2, &
21195 sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
21197 !c write (2,*) "enesc"
21198 !c write (2,*) "x",(x(i),i=1,9)
21199 !c write(2,*)"xx",xx," yy",yy," zz",zz," cost2",cost2," sint2",sint2
21200 sumene=x(1)*xx+x(2)*yy+x(3)*zz+x(4)*xx**2 &
21201 + x(5)*yy**2+x(6)*zz**2+x(7)*xx*zz+x(8)*xx*yy &
21205 end function enesc_nucl
21206 !-----------------------------------------------------------------------------
21207 subroutine multibody_hb_nucl(ecorr,ecorr3,n_corr,n_corr1)
21210 integer,parameter :: max_cont=2000
21211 integer,parameter:: max_dim=2*(8*3+6)
21212 integer, parameter :: msglen1=max_cont*max_dim
21213 integer,parameter :: msglen2=2*msglen1
21214 integer source,CorrelType,CorrelID,Error
21215 real(kind=8) :: buffer(max_cont,max_dim)
21216 integer status(MPI_STATUS_SIZE)
21217 integer :: ierror,nbytes
21219 real(kind=8),dimension(3):: gx(3),gx1(3)
21220 real(kind=8) :: time00
21222 integer i,j,i1,j1,jj,kk,num_conti,num_conti1,nn
21223 real(kind=8) ecorr,ecorr3
21224 integer :: n_corr,n_corr1,mm,msglen
21225 !C Set lprn=.true. for debugging
21230 if(.not.allocated(zapas2)) allocate(zapas2(3,maxconts,nres,8))
21232 if (nfgtasks.le.1) goto 30
21234 write (iout,'(a)') 'Contact function values:'
21236 write (iout,'(2i3,50(1x,i2,f5.2))') &
21237 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
21238 j=1,num_cont_hb(i))
21241 !C Caution! Following code assumes that electrostatic interactions concerning
21242 !C a given atom are split among at most two processors!
21252 !c write (*,*) 'MyRank',MyRank,' mm',mm
21255 !c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
21256 if (fg_rank.gt.0) then
21257 !C Send correlation contributions to the preceding processor
21259 nn=num_cont_hb(iatel_s_nucl)
21260 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
21261 !c write (*,*) 'The BUFFER array:'
21263 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
21265 if (ielstart_nucl(iatel_s_nucl).gt.iatel_s_nucl+ispp) then
21267 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
21268 !C Clear the contacts of the atom passed to the neighboring processor
21269 nn=num_cont_hb(iatel_s_nucl+1)
21271 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
21273 num_cont_hb(iatel_s_nucl)=0
21275 !cd write (iout,*) 'Processor ',fg_rank,MyRank,
21276 !cd & ' is sending correlation contribution to processor',fg_rank-1,
21277 !cd & ' msglen=',msglen
21278 !c write (*,*) 'Processor ',fg_rank,MyRank,
21279 !c & ' is sending correlation contribution to processor',fg_rank-1,
21280 !c & ' msglen=',msglen,' CorrelType=',CorrelType
21282 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, &
21283 CorrelType,FG_COMM,IERROR)
21284 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
21285 !cd write (iout,*) 'Processor ',fg_rank,
21286 !cd & ' has sent correlation contribution to processor',fg_rank-1,
21287 !cd & ' msglen=',msglen,' CorrelID=',CorrelID
21288 !c write (*,*) 'Processor ',fg_rank,
21289 !c & ' has sent correlation contribution to processor',fg_rank-1,
21290 !c & ' msglen=',msglen,' CorrelID=',CorrelID
21292 endif ! (fg_rank.gt.0)
21296 !c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
21297 if (fg_rank.lt.nfgtasks-1) then
21298 !C Receive correlation contributions from the next processor
21300 if (ielend_nucl(iatel_e_nucl).lt.nct_molec(2)-1) msglen=msglen2
21301 !cd write (iout,*) 'Processor',fg_rank,
21302 !cd & ' is receiving correlation contribution from processor',fg_rank+1,
21303 !cd & ' msglen=',msglen,' CorrelType=',CorrelType
21304 !c write (*,*) 'Processor',fg_rank,
21305 !c &' is receiving correlation contribution from processor',fg_rank+1,
21306 !c & ' msglen=',msglen,' CorrelType=',CorrelType
21309 do while (nbytes.le.0)
21310 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
21311 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
21313 !c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
21314 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, &
21315 fg_rank+1,CorrelType,FG_COMM,status,IERROR)
21316 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
21317 !c write (*,*) 'Processor',fg_rank,
21318 !c &' has received correlation contribution from processor',fg_rank+1,
21319 !c & ' msglen=',msglen,' nbytes=',nbytes
21320 !c write (*,*) 'The received BUFFER array:'
21322 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
21324 if (msglen.eq.msglen1) then
21325 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,0,buffer)
21326 else if (msglen.eq.msglen2) then
21327 call unpack_buffer(max_cont,max_dim,iatel_e_nucl,0,buffer)
21328 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,30,buffer)
21331 'ERROR!!!! message length changed while processing correlations.'
21333 'ERROR!!!! message length changed while processing correlations.'
21334 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
21335 endif ! msglen.eq.msglen1
21336 endif ! fg_rank.lt.nfgtasks-1
21343 write (iout,'(a)') 'Contact function values:'
21344 do i=nnt_molec(2),nct_molec(2)-1
21345 write (iout,'(2i3,50(1x,i2,f5.2))') &
21346 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
21347 j=1,num_cont_hb(i))
21352 !C Remove the loop below after debugging !!!
21353 ! do i=nnt_molec(2),nct_molec(2)
21355 ! gradcorr_nucl(j,i)=0.0D0
21356 ! gradxorr_nucl(j,i)=0.0D0
21357 ! gradcorr3_nucl(j,i)=0.0D0
21358 ! gradxorr3_nucl(j,i)=0.0D0
21361 ! print *,"iatsc_s_nucl,iatsc_e_nucl",iatsc_s_nucl,iatsc_e_nucl
21362 !C Calculate the local-electrostatic correlation terms
21363 do i=iatsc_s_nucl,iatsc_e_nucl
21365 num_conti=num_cont_hb(i)
21366 num_conti1=num_cont_hb(i+1)
21367 ! print *,i,num_conti,num_conti1
21372 !c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
21373 !c & ' jj=',jj,' kk=',kk
21374 if (j1.eq.j+1 .or. j1.eq.j-1) then
21376 !C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
21377 !C The system gains extra energy.
21378 !C Tentative expression & coefficients; assumed d(stacking)=4.5 A,
21379 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
21380 !C Need to implement full formulas 34 and 35 from Liwo et al., 1998.
21382 ecorr=ecorr+ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
21383 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
21384 'ecorrh',i,j,ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
21386 else if (j1.eq.j) then
21388 !C Contacts I-J and I-(J+1) occur simultaneously.
21389 !C The system loses extra energy.
21390 !C Tentative expression & c?oefficients; assumed d(stacking)=4.5 A,
21391 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
21392 !C Need to implement full formulas 32 from Liwo et al., 1998.
21394 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
21395 !c & ' jj=',jj,' kk=',kk
21396 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i+1,j,jj,kk,0.310D0,-0.155D0)
21401 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
21402 !c & ' jj=',jj,' kk=',kk
21403 if (j1.eq.j+1) then
21404 !C Contacts I-J and (I+1)-J occur simultaneously.
21405 !C The system loses extra energy.
21406 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i,j+1,jj,kk,0.310D0,-0.155D0)
21412 end subroutine multibody_hb_nucl
21413 !-----------------------------------------------------------
21414 real(kind=8) function ehbcorr_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
21415 ! implicit real*8 (a-h,o-z)
21416 ! include 'DIMENSIONS'
21417 ! include 'COMMON.IOUNITS'
21418 ! include 'COMMON.DERIV'
21419 ! include 'COMMON.INTERACT'
21420 ! include 'COMMON.CONTACTS'
21421 real(kind=8),dimension(3) :: gx,gx1
21423 !el local variables
21424 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
21425 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
21426 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
21427 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
21431 eij=facont_hb(jj,i)
21432 ekl=facont_hb(kk,k)
21433 ees0pij=ees0p(jj,i)
21434 ees0pkl=ees0p(kk,k)
21435 ees0mij=ees0m(jj,i)
21436 ees0mkl=ees0m(kk,k)
21438 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
21439 ! print *,"ehbcorr_nucl",ekont,ees
21440 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
21441 !C Following 4 lines for diagnostics.
21446 !cd write (iout,*)'Contacts have occurred for nucleic bases',
21447 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
21448 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
21449 !C Calculate the multi-body contribution to energy.
21450 ! ecorr_nucl=ecorr_nucl+ekont*ees
21451 !C Calculate multi-body contributions to the gradient.
21452 coeffpees0pij=coeffp*ees0pij
21453 coeffmees0mij=coeffm*ees0mij
21454 coeffpees0pkl=coeffp*ees0pkl
21455 coeffmees0mkl=coeffm*ees0mkl
21457 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i) &
21458 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
21459 coeffmees0mkl*gacontm_hb1(ll,jj,i))
21460 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j) &
21461 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+&
21462 coeffmees0mkl*gacontm_hb2(ll,jj,i))
21463 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k) &
21464 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
21465 coeffmees0mij*gacontm_hb1(ll,kk,k))
21466 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l) &
21467 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
21468 coeffmees0mij*gacontm_hb2(ll,kk,k))
21469 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
21470 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
21471 coeffmees0mkl*gacontm_hb3(ll,jj,i))
21472 gradcorr_nucl(ll,j)=gradcorr_nucl(ll,j)+gradlongij
21473 gradcorr_nucl(ll,i)=gradcorr_nucl(ll,i)-gradlongij
21474 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
21475 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
21476 coeffmees0mij*gacontm_hb3(ll,kk,k))
21477 gradcorr_nucl(ll,l)=gradcorr_nucl(ll,l)+gradlongkl
21478 gradcorr_nucl(ll,k)=gradcorr_nucl(ll,k)-gradlongkl
21479 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i)-gradlongij
21480 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j)+gradlongij
21481 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k)-gradlongkl
21482 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l)+gradlongkl
21484 ehbcorr_nucl=ekont*ees
21486 end function ehbcorr_nucl
21487 !-------------------------------------------------------------------------
21489 real(kind=8) function ehbcorr3_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
21490 ! implicit real*8 (a-h,o-z)
21491 ! include 'DIMENSIONS'
21492 ! include 'COMMON.IOUNITS'
21493 ! include 'COMMON.DERIV'
21494 ! include 'COMMON.INTERACT'
21495 ! include 'COMMON.CONTACTS'
21496 real(kind=8),dimension(3) :: gx,gx1
21498 !el local variables
21499 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
21500 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
21501 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
21502 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
21506 eij=facont_hb(jj,i)
21507 ekl=facont_hb(kk,k)
21508 ees0pij=ees0p(jj,i)
21509 ees0pkl=ees0p(kk,k)
21510 ees0mij=ees0m(jj,i)
21511 ees0mkl=ees0m(kk,k)
21513 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
21514 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
21515 !C Following 4 lines for diagnostics.
21520 !cd write (iout,*)'Contacts have occurred for nucleic bases',
21521 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
21522 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
21523 !C Calculate the multi-body contribution to energy.
21524 ! ecorr=ecorr+ekont*ees
21525 !C Calculate multi-body contributions to the gradient.
21526 coeffpees0pij=coeffp*ees0pij
21527 coeffmees0mij=coeffm*ees0mij
21528 coeffpees0pkl=coeffp*ees0pkl
21529 coeffmees0mkl=coeffm*ees0mkl
21531 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i) &
21532 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
21533 coeffmees0mkl*gacontm_hb1(ll,jj,i))
21534 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j) &
21535 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
21536 coeffmees0mkl*gacontm_hb2(ll,jj,i))
21537 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k) &
21538 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ &
21539 coeffmees0mij*gacontm_hb1(ll,kk,k))
21540 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l) &
21541 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
21542 coeffmees0mij*gacontm_hb2(ll,kk,k))
21543 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
21544 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
21545 coeffmees0mkl*gacontm_hb3(ll,jj,i))
21546 gradcorr3_nucl(ll,j)=gradcorr3_nucl(ll,j)+gradlongij
21547 gradcorr3_nucl(ll,i)=gradcorr3_nucl(ll,i)-gradlongij
21548 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
21549 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
21550 coeffmees0mij*gacontm_hb3(ll,kk,k))
21551 gradcorr3_nucl(ll,l)=gradcorr3_nucl(ll,l)+gradlongkl
21552 gradcorr3_nucl(ll,k)=gradcorr3_nucl(ll,k)-gradlongkl
21553 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i)-gradlongij
21554 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j)+gradlongij
21555 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k)-gradlongkl
21556 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l)+gradlongkl
21558 ehbcorr3_nucl=ekont*ees
21560 end function ehbcorr3_nucl
21562 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
21563 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
21564 real(kind=8):: buffer(dimen1,dimen2)
21565 num_kont=num_cont_hb(atom)
21569 buffer(i,indx+(k-1)*3+j)=zapas2(j,i,atom,k)
21572 buffer(i,indx+25)=facont_hb(i,atom)
21573 buffer(i,indx+26)=ees0p(i,atom)
21574 buffer(i,indx+27)=ees0m(i,atom)
21575 buffer(i,indx+28)=d_cont(i,atom)
21576 buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
21578 buffer(1,indx+30)=dfloat(num_kont)
21580 end subroutine pack_buffer
21581 !c------------------------------------------------------------------------------
21582 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
21583 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
21584 real(kind=8):: buffer(dimen1,dimen2)
21585 ! double precision zapas
21586 ! common /contacts_hb/ zapas(3,maxconts,maxres,8),
21587 ! & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
21588 ! & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
21589 ! & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
21590 num_kont=buffer(1,indx+30)
21591 num_kont_old=num_cont_hb(atom)
21592 num_cont_hb(atom)=num_kont+num_kont_old
21597 zapas2(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
21600 facont_hb(ii,atom)=buffer(i,indx+25)
21601 ees0p(ii,atom)=buffer(i,indx+26)
21602 ees0m(ii,atom)=buffer(i,indx+27)
21603 d_cont(i,atom)=buffer(i,indx+28)
21604 jcont_hb(ii,atom)=buffer(i,indx+29)
21607 end subroutine unpack_buffer
21608 !c------------------------------------------------------------------------------
21610 subroutine ecatcat(ecationcation)
21611 integer :: i,j,itmp,xshift,yshift,zshift,subchap,k
21612 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
21613 r7,r4,ecationcation,k0,rcal
21614 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
21615 dist_init,dist_temp,Evan1cat,Evan2cat,Eeleccat
21616 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
21619 ecationcation=0.0d0
21620 if (nres_molec(5).eq.0) return
21628 itmp=itmp+nres_molec(i)
21630 do i=itmp+1,itmp+nres_molec(i)-1
21634 xi=mod(xi,boxxsize)
21635 if (xi.lt.0) xi=xi+boxxsize
21636 yi=mod(yi,boxysize)
21637 if (yi.lt.0) yi=yi+boxysize
21638 zi=mod(zi,boxzsize)
21639 if (zi.lt.0) zi=zi+boxzsize
21641 do j=i+1,itmp+nres_molec(i)
21645 xj=dmod(xj,boxxsize)
21646 if (xj.lt.0) xj=xj+boxxsize
21647 yj=dmod(yj,boxysize)
21648 if (yj.lt.0) yj=yj+boxysize
21649 zj=dmod(zj,boxzsize)
21650 if (zj.lt.0) zj=zj+boxzsize
21651 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21659 xj=xj_safe+xshift*boxxsize
21660 yj=yj_safe+yshift*boxysize
21661 zj=zj_safe+zshift*boxzsize
21662 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21663 if(dist_temp.lt.dist_init) then
21664 dist_init=dist_temp
21673 if (subchap.eq.1) then
21682 rcal =xj**2+yj**2+zj**2
21688 ! k0 = 332*(2*2)/80
21689 Evan1cat=epscalc*(r012/rcal**6)
21690 Evan2cat=epscalc*2*(r06/rcal**3)
21698 dEvan1Cmcat(k)=-12*r(k)*epscalc*r012/r7
21699 dEvan2Cmcat(k)=-12*r(k)*epscalc*r06/r4
21700 dEeleccat(k)=-k0*r(k)/ract**3
21703 gg(k) = dEvan1Cmcat(k)+dEvan2Cmcat(k)+dEeleccat(k)
21704 gradcatcat(k,i)=gradcatcat(k,i)+gg(k)
21705 gradcatcat(k,j)=gradcatcat(k,j)-gg(k)
21708 ecationcation=ecationcation+Evan1cat+Evan2cat+Eeleccat
21712 end subroutine ecatcat
21713 !---------------------------------------------------------------------------
21714 subroutine ecat_prot(ecation_prot)
21715 integer i,j,k,subchap,itmp
21716 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
21717 r7,r4,ecationcation
21718 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
21719 dist_init,dist_temp,ecation_prot
21720 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
21722 ! first lets calculate interaction with peptide groups
21723 if (nres_molec(5).eq.0) return
21726 itmp=itmp+nres_molec(i)
21728 do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
21729 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle ! leave dummy atoms
21730 xi=0.5d0*(c(1,i)+c(1,i+1))
21731 yi=0.5d0*(c(2,i)+c(2,i+1))
21732 zi=0.5d0*(c(3,i)+c(3,i+1))
21733 xi=mod(xi,boxxsize)
21734 if (xi.lt.0) xi=xi+boxxsize
21735 yi=mod(yi,boxysize)
21736 if (yi.lt.0) yi=yi+boxysize
21737 zi=mod(zi,boxzsize)
21738 if (zi.lt.0) zi=zi+boxzsize
21740 do j=itmp+1,itmp+nres_molec(5)
21744 xj=dmod(xj,boxxsize)
21745 if (xj.lt.0) xj=xj+boxxsize
21746 yj=dmod(yj,boxysize)
21747 if (yj.lt.0) yj=yj+boxysize
21748 zj=dmod(zj,boxzsize)
21749 if (zj.lt.0) zj=zj+boxzsize
21750 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21758 xj=xj_safe+xshift*boxxsize
21759 yj=yj_safe+yshift*boxysize
21760 zj=zj_safe+zshift*boxzsize
21761 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21762 if(dist_temp.lt.dist_init) then
21763 dist_init=dist_temp
21772 if (subchap.eq.1) then
21786 end subroutine ecat_prot
21788 !----------------------------------------------------------------------------
21789 !-----------------------------------------------------------------------------
21790 !-----------------------------------------------------------------------------