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 ! real(kind=8),dimension(:,:),allocatable :: gloc,gloc_x !(maxvar,2)
131 real(kind=8),dimension(:,:),allocatable :: gel_loc,gel_loc_long,&
132 gcorr3_turn,gcorr4_turn,gcorr6_turn,gradb,gradbx !(3,maxres)
133 real(kind=8),dimension(:),allocatable :: gel_loc_loc,&
134 gel_loc_turn3,gel_loc_turn4,gel_loc_turn6,gcorr_loc,g_corr5_loc,&
135 g_corr6_loc !(maxvar)
136 real(kind=8),dimension(:,:),allocatable :: gsccorc,gsccorx !(3,maxres)
137 real(kind=8),dimension(:),allocatable :: gsccor_loc !(maxres)
138 ! real(kind=8),dimension(:,:,:),allocatable :: dtheta !(3,2,maxres)
139 real(kind=8),dimension(:,:),allocatable :: gscloc,gsclocx !(3,maxres)
140 ! real(kind=8),dimension(:,:,:),allocatable :: dphi,dalpha,domega !(3,3,maxres)
141 real(kind=8),dimension(:,:,:),allocatable :: grad_shield_side, &
142 grad_shield_loc ! (3,maxcontsshileding,maxnres)
145 real(kind=8), dimension(:),allocatable :: fac_shield
146 real(kind=8),dimension(3,5,2) :: derx,derx_turn
147 ! common /deriv_scloc/
148 real(kind=8),dimension(:,:),allocatable :: dXX_C1tab,dYY_C1tab,&
149 dZZ_C1tab,dXX_Ctab,dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,&
150 dZZ_XYZtab !(3,maxres)
151 !-----------------------------------------------------------------------------
154 real(kind=8) :: gvdwc_max,gvdwc_scp_max,gelc_max,gvdwpp_max,&
155 gradb_max,ghpbc_max,&
156 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
157 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
158 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
159 gsccorx_max,gsclocx_max
160 !-----------------------------------------------------------------------------
162 ! common /back_constr/
163 real(kind=8),dimension(:),allocatable :: dutheta,dugamma !(maxres)
164 real(kind=8),dimension(:,:),allocatable :: duscdiff,duscdiffx !(3,maxres)
166 real(kind=8) :: Ucdfrag,Ucdpair
167 real(kind=8),dimension(:,:),allocatable :: dUdconst,dUdxconst,&
168 dqwol,dxqwol !(3,0:MAXRES)
169 !-----------------------------------------------------------------------------
171 ! common /dyn_ssbond/
172 real(kind=8),dimension(:,:),allocatable :: dyn_ssbond_ij !(maxres,maxres)
173 !-----------------------------------------------------------------------------
175 ! Parameters of the SCCOR term
177 real(kind=8),dimension(:,:,:,:),allocatable :: dcostau,dsintau,&
178 dcosomicron,domicron !(3,3,3,maxres2)
179 !-----------------------------------------------------------------------------
182 real(kind=8),dimension(:,:),allocatable :: uy,uz !(3,maxres)
183 real(kind=8),dimension(:,:,:,:),allocatable :: uygrad,uzgrad !(3,3,2,maxres)
184 !-----------------------------------------------------------------------------
185 ! common /przechowalnia/
186 real(kind=8),dimension(:,:,:),allocatable :: zapas !(max_dim,maxconts,max_fg_procs)
187 real(kind=8),dimension(:,:,:),allocatable :: fromto !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
188 !-----------------------------------------------------------------------------
189 !-----------------------------------------------------------------------------
192 !-----------------------------------------------------------------------------
194 !-----------------------------------------------------------------------------
195 ! energy_p_new_barrier.F
196 !-----------------------------------------------------------------------------
197 subroutine etotal(energia)
198 ! implicit real*8 (a-h,o-z)
199 ! include 'DIMENSIONS'
204 !MS$ATTRIBUTES C :: proc_proc
210 ! include 'COMMON.SETUP'
211 ! include 'COMMON.IOUNITS'
212 real(kind=8),dimension(0:n_ene) :: energia
213 ! include 'COMMON.LOCAL'
214 ! include 'COMMON.FFIELD'
215 ! include 'COMMON.DERIV'
216 ! include 'COMMON.INTERACT'
217 ! include 'COMMON.SBRIDGE'
218 ! include 'COMMON.CHAIN'
219 ! include 'COMMON.VAR'
220 ! include 'COMMON.MD'
221 ! include 'COMMON.CONTROL'
222 ! include 'COMMON.TIME1'
223 real(kind=8) :: time00
225 integer :: n_corr,n_corr1,ierror
226 real(kind=8) :: etors,edihcnstr,etors_d,esccor,ehpb
227 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,escloc,ees,eel_loc
228 real(kind=8) :: eello_turn3,eello_turn4,estr,ebe,eliptran,etube, &
229 Eafmforce,ethetacnstr
230 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
231 ! now energies for nulceic alone parameters
232 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
233 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
236 real(kind=8) :: weights_(n_ene) !,time_Bcast,time_Bcastw
237 ! shielding effect varibles for MPI
238 ! real(kind=8) fac_shieldbuf(maxres),
239 ! & grad_shield_locbuf(3,maxcontsshi,-1:maxres),
240 ! & grad_shield_sidebuf(3,maxcontsshi,-1:maxres),
241 ! & grad_shieldbuf(3,-1:maxres)
242 ! integer ishield_listbuf(maxres),
243 ! &shield_listbuf(maxcontsshi,maxres)
245 ! print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
246 ! & " nfgtasks",nfgtasks
247 if (nfgtasks.gt.1) then
249 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
250 if (fg_rank.eq.0) then
251 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
252 ! print *,"Processor",myrank," BROADCAST iorder"
253 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
254 ! FG slaves as WEIGHTS array.
274 ! FG Master broadcasts the WEIGHTS_ array
275 call MPI_Bcast(weights_(1),n_ene,&
276 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
278 ! FG slaves receive the WEIGHTS array
279 call MPI_Bcast(weights(1),n_ene,&
280 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
301 time_Bcast=time_Bcast+MPI_Wtime()-time00
302 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
303 ! call chainbuild_cart
305 ! print *,'Processor',myrank,' calling etotal ipot=',ipot
306 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
308 ! if (modecalc.eq.12.or.modecalc.eq.14) then
309 ! call int_from_cart1(.false.)
316 ! Compute the side-chain and electrostatic interaction energy
317 ! print *, "Before EVDW"
318 ! goto (101,102,103,104,105,106) ipot
320 ! Lennard-Jones potential.
324 !d print '(a)','Exit ELJcall el'
326 ! Lennard-Jones-Kihara potential (shifted).
327 ! 102 call eljk(evdw)
331 ! Berne-Pechukas potential (dilated LJ, angular dependence).
336 ! Gay-Berne potential (shifted LJ, angular dependence).
341 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
342 ! 105 call egbv(evdw)
346 ! Soft-sphere potential
347 ! 106 call e_softsphere(evdw)
349 call e_softsphere(evdw)
351 ! Calculate electrostatic (H-bonding) energy of the main chain.
355 write(iout,*)"Wrong ipot"
360 ! print *,"after EGB"
362 if (shield_mode.eq.2) then
365 print *,"AFTER EGB",ipot,evdw
367 !mc Sep-06: egb takes care of dynamic ss bonds too
369 ! if (dyn_ss) call dyn_set_nss
370 ! print *,"Processor",myrank," computed USCSC"
376 time_vec=time_vec+MPI_Wtime()-time01
378 ! print *,"Processor",myrank," left VEC_AND_DERIV"
381 ! print *,"after ipot if", ipot
382 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
383 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
384 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
385 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
387 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
388 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
389 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
390 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
392 ! print *,"just befor eelec call"
393 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
394 ! write (iout,*) "ELEC calc"
403 ! write (iout,*) "Soft-spheer ELEC potential"
404 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
407 ! print *,"Processor",myrank," computed UELEC"
409 ! Calculate excluded-volume interaction energy between peptide groups
412 !elwrite(iout,*) "in etotal calc exc;luded",ipot
416 call escp(evdw2,evdw2_14)
422 ! write (iout,*) "Soft-sphere SCP potential"
423 call escp_soft_sphere(evdw2,evdw2_14)
425 ! write(iout,*) "in etotal before ebond",ipot
428 ! Calculate the bond-stretching energy
432 ! write(iout,*) "in etotal afer ebond",ipot
435 ! Calculate the disulfide-bridge and other energy and the contributions
436 ! from other distance constraints.
437 ! print *,'Calling EHPB'
439 !elwrite(iout,*) "in etotal afer edis",ipot
440 ! print *,'EHPB exitted succesfully.'
442 ! Calculate the virtual-bond-angle energy.
444 if (wang.gt.0d0) then
445 call ebend(ebe,ethetacnstr)
449 ! print *,"Processor",myrank," computed UB"
451 ! Calculate the SC local energy.
454 !elwrite(iout,*) "in etotal afer esc",ipot
455 ! print *,"Processor",myrank," computed USC"
457 ! Calculate the virtual-bond torsional energy.
459 !d print *,'nterm=',nterm
461 call etor(etors,edihcnstr)
466 ! print *,"Processor",myrank," computed Utor"
468 ! 6/23/01 Calculate double-torsional energy
470 !elwrite(iout,*) "in etotal",ipot
471 if (wtor_d.gt.0) then
476 ! print *,"Processor",myrank," computed Utord"
478 ! 21/5/07 Calculate local sicdechain correlation energy
480 if (wsccor.gt.0.0d0) then
481 call eback_sc_corr(esccor)
485 ! print *,"Processor",myrank," computed Usccorr"
487 ! 12/1/95 Multi-body terms
491 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
492 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
493 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
494 !d write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
495 !d &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
502 !elwrite(iout,*) "in etotal",ipot
503 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
504 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
505 !d write (iout,*) "multibody_hb ecorr",ecorr
507 !elwrite(iout,*) "afeter multibody hb"
509 ! print *,"Processor",myrank," computed Ucorr"
511 ! If performing constraint dynamics, call the constraint energy
512 ! after the equilibration time
513 if(usampl.and.totT.gt.eq_time) then
514 !elwrite(iout,*) "afeter multibody hb"
516 !elwrite(iout,*) "afeter multibody hb"
518 !elwrite(iout,*) "afeter multibody hb"
524 ! write(iout,*) "after Econstr"
526 if (wliptran.gt.0) then
527 ! print *,"PRZED WYWOLANIEM"
528 call Eliptransfer(eliptran)
532 if (fg_rank.eq.0) then
533 if (AFMlog.gt.0) then
534 call AFMforce(Eafmforce)
535 else if (selfguide.gt.0) then
536 call AFMvel(Eafmforce)
539 if (tubemode.eq.1) then
541 else if (tubemode.eq.2) then
542 call calctube2(etube)
543 elseif (tubemode.eq.3) then
548 !--------------------------------------------------------
549 call ebond_nucl(estr_nucl)
550 call ebend_nucl(ebe_nucl)
551 call etor_nucl(etors_nucl)
552 print *,"after ebend", ebe_nucl
554 time_enecalc=time_enecalc+MPI_Wtime()-time00
556 ! print *,"Processor",myrank," computed Uconstr"
565 energia(2)=evdw2-evdw2_14
582 energia(8)=eello_turn3
583 energia(9)=eello_turn4
590 energia(19)=edihcnstr
592 energia(20)=Uconst+Uconst_back
595 energia(23)=Eafmforce
596 energia(24)=ethetacnstr
598 !---------------------------------------------------------------
605 energia(32)=estr_nucl
608 energia(35)=etors_nucl
609 energia(36)=etors_d_nucl
610 energia(37)=ecorr_nucl
611 energia(38)=ecorr3_nucl
612 !----------------------------------------------------------------------
613 ! Here are the energies showed per procesor if the are more processors
614 ! per molecule then we sum it up in sum_energy subroutine
615 ! print *," Processor",myrank," calls SUM_ENERGY"
616 call sum_energy(energia,.true.)
617 if (dyn_ss) call dyn_set_nss
618 ! print *," Processor",myrank," left SUM_ENERGY"
620 time_sumene=time_sumene+MPI_Wtime()-time00
622 !el call enerprint(energia)
623 !elwrite(iout,*)"finish etotal"
625 end subroutine etotal
626 !-----------------------------------------------------------------------------
627 subroutine sum_energy(energia,reduce)
628 ! implicit real*8 (a-h,o-z)
629 ! include 'DIMENSIONS'
633 !MS$ATTRIBUTES C :: proc_proc
639 ! include 'COMMON.SETUP'
640 ! include 'COMMON.IOUNITS'
641 real(kind=8) :: energia(0:n_ene),enebuff(0:n_ene+1)
642 ! include 'COMMON.FFIELD'
643 ! include 'COMMON.DERIV'
644 ! include 'COMMON.INTERACT'
645 ! include 'COMMON.SBRIDGE'
646 ! include 'COMMON.CHAIN'
647 ! include 'COMMON.VAR'
648 ! include 'COMMON.CONTROL'
649 ! include 'COMMON.TIME1'
651 real(kind=8) :: evdw,evdw2,evdw2_14,ees,evdw1,ecorr,ecorr5,ecorr6
652 real(kind=8) :: eel_loc,eello_turn3,eello_turn4,eturn6,ebe,escloc
653 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,esccor,etot, &
654 eliptran,etube, Eafmforce,ethetacnstr
655 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
656 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
662 real(kind=8) :: time00
663 if (nfgtasks.gt.1 .and. reduce) then
666 write (iout,*) "energies before REDUCE"
667 call enerprint(energia)
671 enebuff(i)=energia(i)
674 call MPI_Barrier(FG_COMM,IERR)
675 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
677 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,&
678 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
680 write (iout,*) "energies after REDUCE"
681 call enerprint(energia)
684 time_Reduce=time_Reduce+MPI_Wtime()-time00
686 if (fg_rank.eq.0) then
690 evdw2=energia(2)+energia(18)
706 eello_turn3=energia(8)
707 eello_turn4=energia(9)
714 edihcnstr=energia(19)
719 Eafmforce=energia(23)
720 ethetacnstr=energia(24)
728 estr_nucl=energia(32)
731 etors_nucl=energia(35)
732 etors_d_nucl=energia(36)
733 ecorr_nucl=energia(37)
734 ecorr3_nucl=energia(38)
738 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 &
739 +wang*ebe+wtor*etors+wscloc*escloc &
740 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
741 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
742 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
743 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
744 +Eafmforce+ethetacnstr &
745 +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
746 +wvdwpp*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
747 +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
748 +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl
750 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) &
751 +wang*ebe+wtor*etors+wscloc*escloc &
752 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
753 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
754 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
755 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
756 +Eafmforce+ethetacnstr &
757 +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
758 +wvdwpp*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
759 +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
760 +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl
766 if (isnan(etot).ne.0) energia(0)=1.0d+99
768 if (isnan(etot)) energia(0)=1.0d+99
773 idumm=proc_proc(etot,i)
775 call proc_proc(etot,i)
777 if(i.eq.1)energia(0)=1.0d+99
782 ! call enerprint(energia)
785 end subroutine sum_energy
786 !-----------------------------------------------------------------------------
787 subroutine rescale_weights(t_bath)
788 ! implicit real*8 (a-h,o-z)
792 ! include 'DIMENSIONS'
793 ! include 'COMMON.IOUNITS'
794 ! include 'COMMON.FFIELD'
795 ! include 'COMMON.SBRIDGE'
796 real(kind=8) :: kfac=2.4d0
797 real(kind=8) :: x,x2,x3,x4,x5,licznik=1.12692801104297249644
799 real(kind=8) :: t_bath,facT(6) !,facT2,facT3,facT4,facT5,facT6
800 real(kind=8) :: T0=3.0d2
803 ! facT=2*temp0/(t_bath+temp0)
804 if (rescale_mode.eq.0) then
811 else if (rescale_mode.eq.1) then
812 facT(1)=kfac/(kfac-1.0d0+t_bath/temp0)
813 facT(2)=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
814 facT(3)=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
815 facT(4)=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
816 facT(5)=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
818 !#if defined(WHAM_RUN) || defined(CLUSTER)
820 ! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
821 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
828 else if (rescale_mode.eq.2) then
834 facT(1)=licznik/dlog(dexp(x)+dexp(-x))
835 facT(2)=licznik/dlog(dexp(x2)+dexp(-x2))
836 facT(3)=licznik/dlog(dexp(x3)+dexp(-x3))
837 facT(4)=licznik/dlog(dexp(x4)+dexp(-x4))
838 facT(5)=licznik/dlog(dexp(x5)+dexp(-x5))
840 !#if defined(WHAM_RUN) || defined(CLUSTER)
842 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
850 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
851 write (*,*) "Wrong RESCALE_MODE",rescale_mode
853 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
857 welec=weights(3)*fact(1)
858 wcorr=weights(4)*fact(3)
859 wcorr5=weights(5)*fact(4)
860 wcorr6=weights(6)*fact(5)
861 wel_loc=weights(7)*fact(2)
862 wturn3=weights(8)*fact(2)
863 wturn4=weights(9)*fact(3)
864 wturn6=weights(10)*fact(5)
865 wtor=weights(13)*fact(1)
866 wtor_d=weights(14)*fact(2)
867 wsccor=weights(21)*fact(1)
870 end subroutine rescale_weights
871 !-----------------------------------------------------------------------------
872 subroutine enerprint(energia)
873 ! implicit real*8 (a-h,o-z)
874 ! include 'DIMENSIONS'
875 ! include 'COMMON.IOUNITS'
876 ! include 'COMMON.FFIELD'
877 ! include 'COMMON.SBRIDGE'
878 ! include 'COMMON.MD'
879 real(kind=8) :: energia(0:n_ene)
881 real(kind=8) :: etot,evdw,evdw2,ees,evdw1,ecorr,ecorr5,ecorr6,eel_loc
882 real(kind=8) :: eello_turn6,eello_turn3,eello_turn4,ebe,escloc
883 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,Uconst,esccor,eliptran,&
884 etube,ethetacnstr,Eafmforce
885 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
886 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
893 evdw2=energia(2)+energia(18)
905 eello_turn3=energia(8)
906 eello_turn4=energia(9)
907 eello_turn6=energia(10)
913 edihcnstr=energia(19)
918 Eafmforce=energia(23)
919 ethetacnstr=energia(24)
927 estr_nucl=energia(32)
930 etors_nucl=energia(35)
931 etors_d_nucl=energia(36)
932 ecorr_nucl=energia(37)
933 ecorr3_nucl=energia(38)
936 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,&
937 estr,wbond,ebe,wang,&
938 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
940 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
941 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,&
942 edihcnstr,ethetacnstr,ebr*nss,&
943 Uconst,eliptran,wliptran,Eafmforce,etube,wtube, & ! till now protein
944 estr_nucl,wbond_nucl,ebe_nucl,wang_nucl, &
945 evdwpp,wvdwpp,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb,&
946 evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl,&
947 etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
948 ecorr3_nucl,wcorr3_nucl, &
950 10 format (/'Virtual-chain energies:'// &
951 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
952 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
953 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
954 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ &
955 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
956 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
957 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
958 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
959 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
960 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
961 ' (SS bridges & dist. cnstr.)'/ &
962 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
963 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
964 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
965 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
966 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
967 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
968 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
969 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
970 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
971 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
972 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
973 'UCONST= ',1pE16.6,' (Constraint energy)'/ &
974 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/&
975 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
976 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
977 'ESTR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
978 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
979 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
980 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
981 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
982 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
983 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
984 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
985 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
986 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
987 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
988 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
989 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
990 'ETOT= ',1pE16.6,' (total)')
992 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,&
993 estr,wbond,ebe,wang,&
994 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
996 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
997 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,&
998 ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc, &
1000 estr_nucl,wbond_nucl, ebe_nucl,wang_nucl,&
1001 evdwpp,wvdwpp,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb&
1002 evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl&
1003 etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
1004 ecorr3_nucl,wcorr3_nucl, &
1006 10 format (/'Virtual-chain energies:'// &
1007 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
1008 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
1009 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
1010 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
1011 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
1012 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
1013 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
1014 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
1015 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
1016 ' (SS bridges & dist. cnstr.)'/ &
1017 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1018 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1019 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1020 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
1021 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
1022 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
1023 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
1024 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
1025 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
1026 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
1027 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
1028 'UCONST=',1pE16.6,' (Constraint energy)'/ &
1029 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ &
1030 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
1031 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
1032 'ESTR_nucl= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
1033 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
1034 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
1035 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
1036 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
1037 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
1038 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
1039 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
1040 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
1041 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
1042 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
1043 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
1044 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
1045 'ETOT= ',1pE16.6,' (total)')
1048 end subroutine enerprint
1049 !-----------------------------------------------------------------------------
1050 subroutine elj(evdw)
1052 ! This subroutine calculates the interaction energy of nonbonded side chains
1053 ! assuming the LJ potential of interaction.
1055 ! implicit real*8 (a-h,o-z)
1056 ! include 'DIMENSIONS'
1057 real(kind=8),parameter :: accur=1.0d-10
1058 ! include 'COMMON.GEO'
1059 ! include 'COMMON.VAR'
1060 ! include 'COMMON.LOCAL'
1061 ! include 'COMMON.CHAIN'
1062 ! include 'COMMON.DERIV'
1063 ! include 'COMMON.INTERACT'
1064 ! include 'COMMON.TORSION'
1065 ! include 'COMMON.SBRIDGE'
1066 ! include 'COMMON.NAMES'
1067 ! include 'COMMON.IOUNITS'
1068 ! include 'COMMON.CONTACTS'
1069 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1070 integer :: num_conti
1072 integer :: i,itypi,iint,j,itypi1,itypj,k
1073 real(kind=8) :: rij,rcut,fcont,fprimcont,rrij
1074 real(kind=8) :: evdw,xi,yi,zi,xj,yj,zj
1075 real(kind=8) :: eps0ij,fac,e1,e2,evdwij,sigij,r0ij
1077 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1079 ! allocate(num_cont(iatsc_s:iatsc_e)) !(maxres) nnt,nct-2
1080 ! allocate(jcont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres) (maxconts=maxres/4)
1081 ! allocate(facont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres)
1082 ! allocate(gacont(3,nres/4,iatsc_s:iatsc_e)) !(3,maxconts,maxres)
1084 do i=iatsc_s,iatsc_e
1085 itypi=iabs(itype(i,1))
1086 if (itypi.eq.ntyp1) cycle
1087 itypi1=iabs(itype(i+1,1))
1094 ! Calculate SC interaction energy.
1096 do iint=1,nint_gr(i)
1097 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1098 !d & 'iend=',iend(i,iint)
1099 do j=istart(i,iint),iend(i,iint)
1100 itypj=iabs(itype(j,1))
1101 if (itypj.eq.ntyp1) cycle
1105 ! Change 12/1/95 to calculate four-body interactions
1106 rij=xj*xj+yj*yj+zj*zj
1108 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1109 eps0ij=eps(itypi,itypj)
1111 e1=fac*fac*aa_aq(itypi,itypj)
1112 e2=fac*bb_aq(itypi,itypj)
1114 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1115 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1116 !d write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1117 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1118 !d & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1119 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1122 ! Calculate the components of the gradient in DC and X
1124 fac=-rrij*(e1+evdwij)
1129 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1130 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1131 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1132 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1136 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1140 ! 12/1/95, revised on 5/20/97
1142 ! Calculate the contact function. The ith column of the array JCONT will
1143 ! contain the numbers of atoms that make contacts with the atom I (of numbers
1144 ! greater than I). The arrays FACONT and GACONT will contain the values of
1145 ! the contact function and its derivative.
1147 ! Uncomment next line, if the correlation interactions include EVDW explicitly.
1148 ! if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1149 ! Uncomment next line, if the correlation interactions are contact function only
1150 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1152 sigij=sigma(itypi,itypj)
1153 r0ij=rs0(itypi,itypj)
1155 ! Check whether the SC's are not too far to make a contact.
1158 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1159 ! Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1161 if (fcont.gt.0.0D0) then
1162 ! If the SC-SC distance if close to sigma, apply spline.
1163 !Adam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1164 !Adam & fcont1,fprimcont1)
1165 !Adam fcont1=1.0d0-fcont1
1166 !Adam if (fcont1.gt.0.0d0) then
1167 !Adam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1168 !Adam fcont=fcont*fcont1
1170 ! Uncomment following 4 lines to have the geometric average of the epsilon0's
1171 !ga eps0ij=1.0d0/dsqrt(eps0ij)
1173 !ga gg(k)=gg(k)*eps0ij
1175 !ga eps0ij=-evdwij*eps0ij
1176 ! Uncomment for AL's type of SC correlation interactions.
1177 !adam eps0ij=-evdwij
1178 num_conti=num_conti+1
1179 jcont(num_conti,i)=j
1180 facont(num_conti,i)=fcont*eps0ij
1181 fprimcont=eps0ij*fprimcont/rij
1183 !Adam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1184 !Adam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1185 !Adam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1186 ! Uncomment following 3 lines for Skolnick's type of SC correlation.
1187 gacont(1,num_conti,i)=-fprimcont*xj
1188 gacont(2,num_conti,i)=-fprimcont*yj
1189 gacont(3,num_conti,i)=-fprimcont*zj
1190 !d write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1191 !d write (iout,'(2i3,3f10.5)')
1192 !d & i,j,(gacont(kk,num_conti,i),kk=1,3)
1198 num_cont(i)=num_conti
1202 gvdwc(j,i)=expon*gvdwc(j,i)
1203 gvdwx(j,i)=expon*gvdwx(j,i)
1206 !******************************************************************************
1210 ! To save time, the factor of EXPON has been extracted from ALL components
1211 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
1214 !******************************************************************************
1217 !-----------------------------------------------------------------------------
1218 subroutine eljk(evdw)
1220 ! This subroutine calculates the interaction energy of nonbonded side chains
1221 ! assuming the LJK potential of interaction.
1223 ! implicit real*8 (a-h,o-z)
1224 ! include 'DIMENSIONS'
1225 ! include 'COMMON.GEO'
1226 ! include 'COMMON.VAR'
1227 ! include 'COMMON.LOCAL'
1228 ! include 'COMMON.CHAIN'
1229 ! include 'COMMON.DERIV'
1230 ! include 'COMMON.INTERACT'
1231 ! include 'COMMON.IOUNITS'
1232 ! include 'COMMON.NAMES'
1233 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1236 integer :: i,iint,j,itypi,itypi1,k,itypj
1237 real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij
1238 real(kind=8) :: evdw,rij,r_shift_inv,fac,e1,e2,evdwij
1240 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1242 do i=iatsc_s,iatsc_e
1243 itypi=iabs(itype(i,1))
1244 if (itypi.eq.ntyp1) cycle
1245 itypi1=iabs(itype(i+1,1))
1250 ! Calculate SC interaction energy.
1252 do iint=1,nint_gr(i)
1253 do j=istart(i,iint),iend(i,iint)
1254 itypj=iabs(itype(j,1))
1255 if (itypj.eq.ntyp1) cycle
1259 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1260 fac_augm=rrij**expon
1261 e_augm=augm(itypi,itypj)*fac_augm
1262 r_inv_ij=dsqrt(rrij)
1264 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1265 fac=r_shift_inv**expon
1266 e1=fac*fac*aa_aq(itypi,itypj)
1267 e2=fac*bb_aq(itypi,itypj)
1269 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1270 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1271 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1272 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1273 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1274 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1275 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1278 ! Calculate the components of the gradient in DC and X
1280 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1285 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1286 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1287 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1288 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1292 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1300 gvdwc(j,i)=expon*gvdwc(j,i)
1301 gvdwx(j,i)=expon*gvdwx(j,i)
1306 !-----------------------------------------------------------------------------
1307 subroutine ebp(evdw)
1309 ! This subroutine calculates the interaction energy of nonbonded side chains
1310 ! assuming the Berne-Pechukas potential of interaction.
1314 ! implicit real*8 (a-h,o-z)
1315 ! include 'DIMENSIONS'
1316 ! include 'COMMON.GEO'
1317 ! include 'COMMON.VAR'
1318 ! include 'COMMON.LOCAL'
1319 ! include 'COMMON.CHAIN'
1320 ! include 'COMMON.DERIV'
1321 ! include 'COMMON.NAMES'
1322 ! include 'COMMON.INTERACT'
1323 ! include 'COMMON.IOUNITS'
1324 ! include 'COMMON.CALC'
1326 !el integer :: icall
1327 !el common /srutu/ icall
1328 ! double precision rrsave(maxdim)
1331 integer :: iint,itypi,itypi1,itypj
1332 real(kind=8) :: rrij,xi,yi,zi
1333 real(kind=8) :: evdw,fac,e1,e2,sigm,epsi
1335 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1337 ! if (icall.eq.0) then
1343 do i=iatsc_s,iatsc_e
1344 itypi=iabs(itype(i,1))
1345 if (itypi.eq.ntyp1) cycle
1346 itypi1=iabs(itype(i+1,1))
1350 dxi=dc_norm(1,nres+i)
1351 dyi=dc_norm(2,nres+i)
1352 dzi=dc_norm(3,nres+i)
1353 ! dsci_inv=dsc_inv(itypi)
1354 dsci_inv=vbld_inv(i+nres)
1356 ! Calculate SC interaction energy.
1358 do iint=1,nint_gr(i)
1359 do j=istart(i,iint),iend(i,iint)
1361 itypj=iabs(itype(j,1))
1362 if (itypj.eq.ntyp1) cycle
1363 ! dscj_inv=dsc_inv(itypj)
1364 dscj_inv=vbld_inv(j+nres)
1365 chi1=chi(itypi,itypj)
1366 chi2=chi(itypj,itypi)
1373 alf12=0.5D0*(alf1+alf2)
1374 ! For diagnostics only!!!
1387 dxj=dc_norm(1,nres+j)
1388 dyj=dc_norm(2,nres+j)
1389 dzj=dc_norm(3,nres+j)
1390 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1391 !d if (icall.eq.0) then
1397 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
1399 ! Calculate whole angle-dependent part of epsilon and contributions
1400 ! to its derivatives
1401 fac=(rrij*sigsq)**expon2
1402 e1=fac*fac*aa_aq(itypi,itypj)
1403 e2=fac*bb_aq(itypi,itypj)
1404 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1405 eps2der=evdwij*eps3rt
1406 eps3der=evdwij*eps2rt
1407 evdwij=evdwij*eps2rt*eps3rt
1410 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1411 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1412 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1413 !d & restyp(itypi,1),i,restyp(itypj,1),j,
1414 !d & epsi,sigm,chi1,chi2,chip1,chip2,
1415 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1416 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
1419 ! Calculate gradient components.
1420 e1=e1*eps1*eps2rt**2*eps3rt**2
1421 fac=-expon*(e1+evdwij)
1424 ! Calculate radial part of the gradient
1428 ! Calculate the angular part of the gradient and sum add the contributions
1429 ! to the appropriate components of the Cartesian gradient.
1437 !-----------------------------------------------------------------------------
1438 subroutine egb(evdw)
1440 ! This subroutine calculates the interaction energy of nonbonded side chains
1441 ! assuming the Gay-Berne potential of interaction.
1444 ! implicit real*8 (a-h,o-z)
1445 ! include 'DIMENSIONS'
1446 ! include 'COMMON.GEO'
1447 ! include 'COMMON.VAR'
1448 ! include 'COMMON.LOCAL'
1449 ! include 'COMMON.CHAIN'
1450 ! include 'COMMON.DERIV'
1451 ! include 'COMMON.NAMES'
1452 ! include 'COMMON.INTERACT'
1453 ! include 'COMMON.IOUNITS'
1454 ! include 'COMMON.CALC'
1455 ! include 'COMMON.CONTROL'
1456 ! include 'COMMON.SBRIDGE'
1459 integer :: iint,itypi,itypi1,itypj,subchap
1460 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
1461 real(kind=8) :: evdw,sig0ij
1462 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
1463 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
1464 sslipi,sslipj,faclip
1466 real(kind=8) :: fracinbuf
1468 !cccc energy_dec=.false.
1469 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1472 ! if (icall.eq.0) lprn=.false.
1474 do i=iatsc_s,iatsc_e
1475 !C print *,"I am in EVDW",i
1476 itypi=iabs(itype(i,1))
1477 ! if (i.ne.47) cycle
1478 if (itypi.eq.ntyp1) cycle
1479 itypi1=iabs(itype(i+1,1))
1483 xi=dmod(xi,boxxsize)
1484 if (xi.lt.0) xi=xi+boxxsize
1485 yi=dmod(yi,boxysize)
1486 if (yi.lt.0) yi=yi+boxysize
1487 zi=dmod(zi,boxzsize)
1488 if (zi.lt.0) zi=zi+boxzsize
1490 if ((zi.gt.bordlipbot) &
1491 .and.(zi.lt.bordliptop)) then
1492 !C the energy transfer exist
1493 if (zi.lt.buflipbot) then
1494 !C what fraction I am in
1496 ((zi-bordlipbot)/lipbufthick)
1497 !C lipbufthick is thickenes of lipid buffore
1498 sslipi=sscalelip(fracinbuf)
1499 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1500 elseif (zi.gt.bufliptop) then
1501 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1502 sslipi=sscalelip(fracinbuf)
1503 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1512 ! print *, sslipi,ssgradlipi
1513 dxi=dc_norm(1,nres+i)
1514 dyi=dc_norm(2,nres+i)
1515 dzi=dc_norm(3,nres+i)
1516 ! dsci_inv=dsc_inv(itypi)
1517 dsci_inv=vbld_inv(i+nres)
1518 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1519 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1521 ! Calculate SC interaction energy.
1523 do iint=1,nint_gr(i)
1524 do j=istart(i,iint),iend(i,iint)
1525 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1526 call dyn_ssbond_ene(i,j,evdwij)
1528 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1529 'evdw',i,j,evdwij,' ss'
1530 ! if (energy_dec) write (iout,*) &
1531 ! 'evdw',i,j,evdwij,' ss'
1532 do k=j+1,iend(i,iint)
1533 !C search over all next residues
1534 if (dyn_ss_mask(k)) then
1535 !C check if they are cysteins
1536 !C write(iout,*) 'k=',k
1538 !c write(iout,*) "PRZED TRI", evdwij
1539 ! evdwij_przed_tri=evdwij
1540 call triple_ssbond_ene(i,j,k,evdwij)
1541 !c if(evdwij_przed_tri.ne.evdwij) then
1542 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1545 !c write(iout,*) "PO TRI", evdwij
1546 !C call the energy function that removes the artifical triple disulfide
1547 !C bond the soubroutine is located in ssMD.F
1549 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1550 'evdw',i,j,evdwij,'tss'
1551 endif!dyn_ss_mask(k)
1555 itypj=iabs(itype(j,1))
1556 if (itypj.eq.ntyp1) cycle
1557 ! if (j.ne.78) cycle
1558 ! dscj_inv=dsc_inv(itypj)
1559 dscj_inv=vbld_inv(j+nres)
1560 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,&
1561 ! 1.0d0/vbld(j+nres) !d
1562 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
1563 sig0ij=sigma(itypi,itypj)
1564 chi1=chi(itypi,itypj)
1565 chi2=chi(itypj,itypi)
1572 alf12=0.5D0*(alf1+alf2)
1573 ! For diagnostics only!!!
1586 xj=dmod(xj,boxxsize)
1587 if (xj.lt.0) xj=xj+boxxsize
1588 yj=dmod(yj,boxysize)
1589 if (yj.lt.0) yj=yj+boxysize
1590 zj=dmod(zj,boxzsize)
1591 if (zj.lt.0) zj=zj+boxzsize
1592 ! print *,"tu",xi,yi,zi,xj,yj,zj
1593 ! print *,"tu2",j,j+nres,c(1,j),c(1,j+nres)
1594 ! this fragment set correct epsilon for lipid phase
1595 if ((zj.gt.bordlipbot) &
1596 .and.(zj.lt.bordliptop)) then
1597 !C the energy transfer exist
1598 if (zj.lt.buflipbot) then
1599 !C what fraction I am in
1601 ((zj-bordlipbot)/lipbufthick)
1602 !C lipbufthick is thickenes of lipid buffore
1603 sslipj=sscalelip(fracinbuf)
1604 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1605 elseif (zj.gt.bufliptop) then
1606 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1607 sslipj=sscalelip(fracinbuf)
1608 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1617 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1618 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1619 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1620 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1621 !------------------------------------------------
1622 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1630 xj=xj_safe+xshift*boxxsize
1631 yj=yj_safe+yshift*boxysize
1632 zj=zj_safe+zshift*boxzsize
1633 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1634 if(dist_temp.lt.dist_init) then
1644 if (subchap.eq.1) then
1653 dxj=dc_norm(1,nres+j)
1654 dyj=dc_norm(2,nres+j)
1655 dzj=dc_norm(3,nres+j)
1656 ! write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1657 ! write (iout,*) "j",j," dc_norm",& !d
1658 ! dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1659 ! write(iout,*)"rrij ",rrij
1660 ! write(iout,*)"xj yj zj ", xj, yj, zj
1661 ! write(iout,*)"xi yi zi ", xi, yi, zi
1662 ! write(iout,*)"c ", c(1,:), c(2,:), c(3,:)
1663 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1665 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
1666 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
1667 ! print *,sss_ele_cut,sss_ele_grad,&
1668 ! 1.0d0/(rij),r_cut_ele,rlamb_ele
1669 if (sss_ele_cut.le.0.0) cycle
1670 ! Calculate angle-dependent terms of energy and contributions to their
1674 sig=sig0ij*dsqrt(sigsq)
1675 rij_shift=1.0D0/rij-sig+sig0ij
1676 ! write(iout,*)" rij_shift",rij_shift," rij",rij," sig",sig,&
1678 ! for diagnostics; uncomment
1679 ! rij_shift=1.2*sig0ij
1680 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1681 if (rij_shift.le.0.0D0) then
1683 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1684 !d & restyp(itypi,1),i,restyp(itypj,1),j,
1685 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1689 !---------------------------------------------------------------
1690 rij_shift=1.0D0/rij_shift
1691 fac=rij_shift**expon
1693 e1=fac*fac*aa!(itypi,itypj)
1694 e2=fac*bb!(itypi,itypj)
1695 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1696 eps2der=evdwij*eps3rt
1697 eps3der=evdwij*eps2rt
1698 ! write(iout,*)"aa, bb ",aa(:,:),bb(:,:)
1699 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,& !d
1700 ! " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2," fac",fac !d
1701 evdwij=evdwij*eps2rt*eps3rt
1702 evdw=evdw+evdwij*sss_ele_cut
1704 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1705 epsi=bb**2/aa!(itypi,itypj)
1706 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1707 restyp(itypi,1),i,restyp(itypj,1),j, &
1708 epsi,sigm,chi1,chi2,chip1,chip2, &
1709 eps1,eps2rt**2,eps3rt**2,sig,sig0ij, &
1710 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, &
1714 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2e10.2,e11.3)')&
1715 'evdw',i,j,evdwij,xi,xj,rij !,"egb"
1716 !C print *,i,j,c(1,i),c(1,j),c(2,i),c(2,j),c(3,i),c(3,j)
1717 ! if (energy_dec) write (iout,*) &
1719 ! print *,"ZALAMKA", evdw
1721 ! Calculate gradient components.
1722 e1=e1*eps1*eps2rt**2*eps3rt**2
1723 fac=-expon*(e1+evdwij)*rij_shift
1726 ! print *,'before fac',fac,rij,evdwij
1727 fac=fac+evdwij*sss_ele_grad/sss_ele_cut&
1728 /sigma(itypi,itypj)*rij
1729 ! print *,'grad part scale',fac, &
1730 ! evdwij*sss_ele_grad/sss_ele_cut &
1731 ! /sigma(itypi,itypj)*rij
1733 ! Calculate the radial part of the gradient
1737 !C Calculate the radial part of the gradient
1738 gg_lipi(3)=eps1*(eps2rt*eps2rt)&
1739 *(eps3rt*eps3rt)*sss_ele_cut/2.0d0*(faclip*faclip*&
1740 (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))&
1741 +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1742 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1743 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1745 ! print *,'before sc_grad', gg(1),gg(2),gg(3)
1746 ! Calculate angular part of the gradient.
1752 ! print *,"ZALAMKA", evdw
1753 ! write (iout,*) "Number of loop steps in EGB:",ind
1754 !ccc energy_dec=.false.
1757 !-----------------------------------------------------------------------------
1758 subroutine egbv(evdw)
1760 ! This subroutine calculates the interaction energy of nonbonded side chains
1761 ! assuming the Gay-Berne-Vorobjev potential of interaction.
1765 ! implicit real*8 (a-h,o-z)
1766 ! include 'DIMENSIONS'
1767 ! include 'COMMON.GEO'
1768 ! include 'COMMON.VAR'
1769 ! include 'COMMON.LOCAL'
1770 ! include 'COMMON.CHAIN'
1771 ! include 'COMMON.DERIV'
1772 ! include 'COMMON.NAMES'
1773 ! include 'COMMON.INTERACT'
1774 ! include 'COMMON.IOUNITS'
1775 ! include 'COMMON.CALC'
1777 !el integer :: icall
1778 !el common /srutu/ icall
1781 integer :: iint,itypi,itypi1,itypj
1782 real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2,sigm
1783 real(kind=8) :: evdw,sig0ij,sig,rij_shift,epsi
1785 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1788 ! if (icall.eq.0) lprn=.true.
1790 do i=iatsc_s,iatsc_e
1791 itypi=iabs(itype(i,1))
1792 if (itypi.eq.ntyp1) cycle
1793 itypi1=iabs(itype(i+1,1))
1797 dxi=dc_norm(1,nres+i)
1798 dyi=dc_norm(2,nres+i)
1799 dzi=dc_norm(3,nres+i)
1800 ! dsci_inv=dsc_inv(itypi)
1801 dsci_inv=vbld_inv(i+nres)
1803 ! Calculate SC interaction energy.
1805 do iint=1,nint_gr(i)
1806 do j=istart(i,iint),iend(i,iint)
1808 itypj=iabs(itype(j,1))
1809 if (itypj.eq.ntyp1) cycle
1810 ! dscj_inv=dsc_inv(itypj)
1811 dscj_inv=vbld_inv(j+nres)
1812 sig0ij=sigma(itypi,itypj)
1813 r0ij=r0(itypi,itypj)
1814 chi1=chi(itypi,itypj)
1815 chi2=chi(itypj,itypi)
1822 alf12=0.5D0*(alf1+alf2)
1823 ! For diagnostics only!!!
1836 dxj=dc_norm(1,nres+j)
1837 dyj=dc_norm(2,nres+j)
1838 dzj=dc_norm(3,nres+j)
1839 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1841 ! Calculate angle-dependent terms of energy and contributions to their
1845 sig=sig0ij*dsqrt(sigsq)
1846 rij_shift=1.0D0/rij-sig+r0ij
1847 ! I hate to put IF's in the loops, but here don't have another choice!!!!
1848 if (rij_shift.le.0.0D0) then
1853 !---------------------------------------------------------------
1854 rij_shift=1.0D0/rij_shift
1855 fac=rij_shift**expon
1856 e1=fac*fac*aa_aq(itypi,itypj)
1857 e2=fac*bb_aq(itypi,itypj)
1858 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1859 eps2der=evdwij*eps3rt
1860 eps3der=evdwij*eps2rt
1861 fac_augm=rrij**expon
1862 e_augm=augm(itypi,itypj)*fac_augm
1863 evdwij=evdwij*eps2rt*eps3rt
1864 evdw=evdw+evdwij+e_augm
1866 sigm=dabs(aa_aq(itypi,itypj)/&
1867 bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1868 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1869 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
1870 restyp(itypi,1),i,restyp(itypj,1),j,&
1871 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
1872 chi1,chi2,chip1,chip2,&
1873 eps1,eps2rt**2,eps3rt**2,&
1874 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
1877 ! Calculate gradient components.
1878 e1=e1*eps1*eps2rt**2*eps3rt**2
1879 fac=-expon*(e1+evdwij)*rij_shift
1881 fac=rij*fac-2*expon*rrij*e_augm
1882 ! Calculate the radial part of the gradient
1886 ! Calculate angular part of the gradient.
1892 !-----------------------------------------------------------------------------
1893 !el subroutine sc_angular in module geometry
1894 !-----------------------------------------------------------------------------
1895 subroutine e_softsphere(evdw)
1897 ! This subroutine calculates the interaction energy of nonbonded side chains
1898 ! assuming the LJ potential of interaction.
1900 ! implicit real*8 (a-h,o-z)
1901 ! include 'DIMENSIONS'
1902 real(kind=8),parameter :: accur=1.0d-10
1903 ! include 'COMMON.GEO'
1904 ! include 'COMMON.VAR'
1905 ! include 'COMMON.LOCAL'
1906 ! include 'COMMON.CHAIN'
1907 ! include 'COMMON.DERIV'
1908 ! include 'COMMON.INTERACT'
1909 ! include 'COMMON.TORSION'
1910 ! include 'COMMON.SBRIDGE'
1911 ! include 'COMMON.NAMES'
1912 ! include 'COMMON.IOUNITS'
1913 ! include 'COMMON.CONTACTS'
1914 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1915 !d print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1917 integer :: i,iint,j,itypi,itypi1,itypj,k
1918 real(kind=8) :: evdw,xj,yj,zj,xi,yi,zi,rij,r0ij,r0ijsq,evdwij
1922 do i=iatsc_s,iatsc_e
1923 itypi=iabs(itype(i,1))
1924 if (itypi.eq.ntyp1) cycle
1925 itypi1=iabs(itype(i+1,1))
1930 ! Calculate SC interaction energy.
1932 do iint=1,nint_gr(i)
1933 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1934 !d & 'iend=',iend(i,iint)
1935 do j=istart(i,iint),iend(i,iint)
1936 itypj=iabs(itype(j,1))
1937 if (itypj.eq.ntyp1) cycle
1941 rij=xj*xj+yj*yj+zj*zj
1942 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1943 r0ij=r0(itypi,itypj)
1945 ! print *,i,j,r0ij,dsqrt(rij)
1946 if (rij.lt.r0ijsq) then
1947 evdwij=0.25d0*(rij-r0ijsq)**2
1955 ! Calculate the components of the gradient in DC and X
1961 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1962 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1963 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1964 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1968 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1975 end subroutine e_softsphere
1976 !-----------------------------------------------------------------------------
1977 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
1979 ! Soft-sphere potential of p-p interaction
1981 ! implicit real*8 (a-h,o-z)
1982 ! include 'DIMENSIONS'
1983 ! include 'COMMON.CONTROL'
1984 ! include 'COMMON.IOUNITS'
1985 ! include 'COMMON.GEO'
1986 ! include 'COMMON.VAR'
1987 ! include 'COMMON.LOCAL'
1988 ! include 'COMMON.CHAIN'
1989 ! include 'COMMON.DERIV'
1990 ! include 'COMMON.INTERACT'
1991 ! include 'COMMON.CONTACTS'
1992 ! include 'COMMON.TORSION'
1993 ! include 'COMMON.VECTORS'
1994 ! include 'COMMON.FFIELD'
1995 real(kind=8),dimension(3) :: ggg
1996 !d write(iout,*) 'In EELEC_soft_sphere'
1998 integer :: i,j,k,num_conti,iteli,itelj
1999 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
2000 real(kind=8) :: dxi,dyi,dzi,xmedi,ymedi,zmedi,r0ij,r0ijsq
2001 real(kind=8) :: dxj,dyj,dzj,xj,yj,zj,rij,evdw1ij,fac
2009 do i=iatel_s,iatel_e
2010 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
2014 xmedi=c(1,i)+0.5d0*dxi
2015 ymedi=c(2,i)+0.5d0*dyi
2016 zmedi=c(3,i)+0.5d0*dzi
2018 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2019 do j=ielstart(i),ielend(i)
2020 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
2024 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2025 r0ij=rpp(iteli,itelj)
2030 xj=c(1,j)+0.5D0*dxj-xmedi
2031 yj=c(2,j)+0.5D0*dyj-ymedi
2032 zj=c(3,j)+0.5D0*dzj-zmedi
2033 rij=xj*xj+yj*yj+zj*zj
2034 if (rij.lt.r0ijsq) then
2035 evdw1ij=0.25d0*(rij-r0ijsq)**2
2043 ! Calculate contributions to the Cartesian gradient.
2049 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2050 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2053 ! Loop over residues i+1 thru j-1.
2057 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2062 !grad do i=nnt,nct-1
2064 !grad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2066 !grad do j=i+1,nct-1
2068 !grad gelc(k,i)=gelc(k,i)+gelc(k,j)
2073 end subroutine eelec_soft_sphere
2074 !-----------------------------------------------------------------------------
2075 subroutine vec_and_deriv
2076 ! implicit real*8 (a-h,o-z)
2077 ! include 'DIMENSIONS'
2081 ! include 'COMMON.IOUNITS'
2082 ! include 'COMMON.GEO'
2083 ! include 'COMMON.VAR'
2084 ! include 'COMMON.LOCAL'
2085 ! include 'COMMON.CHAIN'
2086 ! include 'COMMON.VECTORS'
2087 ! include 'COMMON.SETUP'
2088 ! include 'COMMON.TIME1'
2089 real(kind=8),dimension(3,3,2) :: uyder,uzder
2090 real(kind=8),dimension(2) :: vbld_inv_temp
2091 ! Compute the local reference systems. For reference system (i), the
2092 ! X-axis points from CA(i) to CA(i+1), the Y axis is in the
2093 ! CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2096 real(kind=8) :: facy,fac,costh
2099 do i=ivec_start,ivec_end
2103 if (i.eq.nres-1) then
2104 ! Case of the last full residue
2105 ! Compute the Z-axis
2106 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2107 costh=dcos(pi-theta(nres))
2108 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2112 ! Compute the derivatives of uz
2114 uzder(2,1,1)=-dc_norm(3,i-1)
2115 uzder(3,1,1)= dc_norm(2,i-1)
2116 uzder(1,2,1)= dc_norm(3,i-1)
2118 uzder(3,2,1)=-dc_norm(1,i-1)
2119 uzder(1,3,1)=-dc_norm(2,i-1)
2120 uzder(2,3,1)= dc_norm(1,i-1)
2123 uzder(2,1,2)= dc_norm(3,i)
2124 uzder(3,1,2)=-dc_norm(2,i)
2125 uzder(1,2,2)=-dc_norm(3,i)
2127 uzder(3,2,2)= dc_norm(1,i)
2128 uzder(1,3,2)= dc_norm(2,i)
2129 uzder(2,3,2)=-dc_norm(1,i)
2131 ! Compute the Y-axis
2134 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2136 ! Compute the derivatives of uy
2139 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) &
2140 -dc_norm(k,i)*dc_norm(j,i-1)
2141 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2143 uyder(j,j,1)=uyder(j,j,1)-costh
2144 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2149 uygrad(l,k,j,i)=uyder(l,k,j)
2150 uzgrad(l,k,j,i)=uzder(l,k,j)
2154 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2155 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2156 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2157 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2160 ! Compute the Z-axis
2161 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2162 costh=dcos(pi-theta(i+2))
2163 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2167 ! Compute the derivatives of uz
2169 uzder(2,1,1)=-dc_norm(3,i+1)
2170 uzder(3,1,1)= dc_norm(2,i+1)
2171 uzder(1,2,1)= dc_norm(3,i+1)
2173 uzder(3,2,1)=-dc_norm(1,i+1)
2174 uzder(1,3,1)=-dc_norm(2,i+1)
2175 uzder(2,3,1)= dc_norm(1,i+1)
2178 uzder(2,1,2)= dc_norm(3,i)
2179 uzder(3,1,2)=-dc_norm(2,i)
2180 uzder(1,2,2)=-dc_norm(3,i)
2182 uzder(3,2,2)= dc_norm(1,i)
2183 uzder(1,3,2)= dc_norm(2,i)
2184 uzder(2,3,2)=-dc_norm(1,i)
2186 ! Compute the Y-axis
2189 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2191 ! Compute the derivatives of uy
2194 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) &
2195 -dc_norm(k,i)*dc_norm(j,i+1)
2196 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2198 uyder(j,j,1)=uyder(j,j,1)-costh
2199 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2204 uygrad(l,k,j,i)=uyder(l,k,j)
2205 uzgrad(l,k,j,i)=uzder(l,k,j)
2209 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2210 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2211 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2212 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2216 vbld_inv_temp(1)=vbld_inv(i+1)
2217 if (i.lt.nres-1) then
2218 vbld_inv_temp(2)=vbld_inv(i+2)
2220 vbld_inv_temp(2)=vbld_inv(i)
2225 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2226 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2231 #if defined(PARVEC) && defined(MPI)
2232 if (nfgtasks1.gt.1) then
2234 ! print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2235 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2236 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2237 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),&
2238 MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2240 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),&
2241 MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2243 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),&
2244 ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),&
2245 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2246 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),&
2247 ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),&
2248 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2249 time_gather=time_gather+MPI_Wtime()-time00
2251 ! if (fg_rank.eq.0) then
2252 ! write (iout,*) "Arrays UY and UZ"
2254 ! write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2260 end subroutine vec_and_deriv
2261 !-----------------------------------------------------------------------------
2262 subroutine check_vecgrad
2263 ! implicit real*8 (a-h,o-z)
2264 ! include 'DIMENSIONS'
2265 ! include 'COMMON.IOUNITS'
2266 ! include 'COMMON.GEO'
2267 ! include 'COMMON.VAR'
2268 ! include 'COMMON.LOCAL'
2269 ! include 'COMMON.CHAIN'
2270 ! include 'COMMON.VECTORS'
2271 real(kind=8),dimension(3,3,2,nres) :: uygradt,uzgradt !(3,3,2,maxres)
2272 real(kind=8),dimension(3,nres) :: uyt,uzt !(3,maxres)
2273 real(kind=8),dimension(3,3,2) :: uygradn,uzgradn
2274 real(kind=8),dimension(3) :: erij
2275 real(kind=8) :: delta=1.0d-7
2281 !rc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2282 !rc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2283 !rc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2284 !d write(iout,'(2i5,2(3f10.5,5x))') i,1,
2285 !d & (dc_norm(if90,i),if90=1,3)
2286 !d write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2287 !d write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2288 !d write(iout,'(a)')
2294 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2295 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2308 !d write (iout,*) 'i=',i
2310 erij(k)=dc_norm(k,i)
2314 dc_norm(k,i)=erij(k)
2316 dc_norm(j,i)=dc_norm(j,i)+delta
2317 ! fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2319 ! dc_norm(k,i)=dc_norm(k,i)/fac
2321 ! write (iout,*) (dc_norm(k,i),k=1,3)
2322 ! write (iout,*) (erij(k),k=1,3)
2325 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2326 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2327 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2328 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2330 ! write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2331 ! & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2332 ! & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2335 dc_norm(k,i)=erij(k)
2338 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2339 !d & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2340 !d & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2341 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2342 !d & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2343 !d & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2344 !d write (iout,'(a)')
2348 end subroutine check_vecgrad
2349 !-----------------------------------------------------------------------------
2350 subroutine set_matrices
2351 ! implicit real*8 (a-h,o-z)
2352 ! include 'DIMENSIONS'
2355 ! include "COMMON.SETUP"
2357 integer :: status(MPI_STATUS_SIZE)
2359 ! include 'COMMON.IOUNITS'
2360 ! include 'COMMON.GEO'
2361 ! include 'COMMON.VAR'
2362 ! include 'COMMON.LOCAL'
2363 ! include 'COMMON.CHAIN'
2364 ! include 'COMMON.DERIV'
2365 ! include 'COMMON.INTERACT'
2366 ! include 'COMMON.CONTACTS'
2367 ! include 'COMMON.TORSION'
2368 ! include 'COMMON.VECTORS'
2369 ! include 'COMMON.FFIELD'
2370 real(kind=8) :: auxvec(2),auxmat(2,2)
2371 integer :: i,iti1,iti,k,l
2372 real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2
2373 ! print *,"in set matrices"
2375 ! Compute the virtual-bond-torsional-angle dependent quantities needed
2376 ! to calculate the el-loc multibody terms of various order.
2380 do i=ivec_start+2,ivec_end+2
2385 if (i .lt. nres+1) then
2422 if (i .gt. 3 .and. i .lt. nres+1) then
2423 obrot_der(1,i-2)=-sin1
2424 obrot_der(2,i-2)= cos1
2425 Ugder(1,1,i-2)= sin1
2426 Ugder(1,2,i-2)=-cos1
2427 Ugder(2,1,i-2)=-cos1
2428 Ugder(2,2,i-2)=-sin1
2431 obrot2_der(1,i-2)=-dwasin2
2432 obrot2_der(2,i-2)= dwacos2
2433 Ug2der(1,1,i-2)= dwasin2
2434 Ug2der(1,2,i-2)=-dwacos2
2435 Ug2der(2,1,i-2)=-dwacos2
2436 Ug2der(2,2,i-2)=-dwasin2
2438 obrot_der(1,i-2)=0.0d0
2439 obrot_der(2,i-2)=0.0d0
2440 Ugder(1,1,i-2)=0.0d0
2441 Ugder(1,2,i-2)=0.0d0
2442 Ugder(2,1,i-2)=0.0d0
2443 Ugder(2,2,i-2)=0.0d0
2444 obrot2_der(1,i-2)=0.0d0
2445 obrot2_der(2,i-2)=0.0d0
2446 Ug2der(1,1,i-2)=0.0d0
2447 Ug2der(1,2,i-2)=0.0d0
2448 Ug2der(2,1,i-2)=0.0d0
2449 Ug2der(2,2,i-2)=0.0d0
2451 ! if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2452 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2453 iti = itortyp(itype(i-2,1))
2457 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2458 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2459 iti1 = itortyp(itype(i-1,1))
2463 ! print *,iti,i,"iti",iti1,itype(i-1,1),itype(i-2,1)
2464 !d write (iout,*) '*******i',i,' iti1',iti
2465 !d write (iout,*) 'b1',b1(:,iti)
2466 !d write (iout,*) 'b2',b2(:,iti)
2467 !d write (iout,*) 'Ug',Ug(:,:,i-2)
2468 ! if (i .gt. iatel_s+2) then
2469 if (i .gt. nnt+2) then
2470 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2471 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2472 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2474 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2475 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2476 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2477 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2478 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2489 DtUg2(l,k,i-2)=0.0d0
2493 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2494 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2496 muder(k,i-2)=Ub2der(k,i-2)
2498 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2499 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2500 if (itype(i-1,1).le.ntyp) then
2501 iti1 = itortyp(itype(i-1,1))
2509 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2511 ! if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2)
2512 ! if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,iti1)
2513 ! if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2)
2514 !d write (iout,*) 'mu1',mu1(:,i-2)
2515 !d write (iout,*) 'mu2',mu2(:,i-2)
2516 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2518 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2519 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2520 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2521 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2522 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2523 ! Vectors and matrices dependent on a single virtual-bond dihedral.
2524 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2525 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2526 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2527 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2528 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2529 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2530 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2531 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2532 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2535 ! Matrices dependent on two consecutive virtual-bond dihedrals.
2536 ! The order of matrices is from left to right.
2537 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
2539 ! do i=max0(ivec_start,2),ivec_end
2541 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2542 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2543 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2544 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2545 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2546 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2547 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2548 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2551 #if defined(MPI) && defined(PARMAT)
2553 ! if (fg_rank.eq.0) then
2554 write (iout,*) "Arrays UG and UGDER before GATHER"
2556 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2557 ((ug(l,k,i),l=1,2),k=1,2),&
2558 ((ugder(l,k,i),l=1,2),k=1,2)
2560 write (iout,*) "Arrays UG2 and UG2DER"
2562 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2563 ((ug2(l,k,i),l=1,2),k=1,2),&
2564 ((ug2der(l,k,i),l=1,2),k=1,2)
2566 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2568 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2569 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2570 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2572 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2574 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2575 costab(i),sintab(i),costab2(i),sintab2(i)
2577 write (iout,*) "Array MUDER"
2579 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2583 if (nfgtasks.gt.1) then
2585 ! write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2586 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2587 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2589 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),&
2590 MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2592 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),&
2593 MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2595 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),&
2596 MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2598 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),&
2599 MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2601 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),&
2602 MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2604 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),&
2605 MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2607 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),&
2608 MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),&
2609 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2610 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),&
2611 MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),&
2612 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2613 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),&
2614 MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),&
2615 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2616 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),&
2617 MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),&
2618 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2619 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2621 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),&
2622 MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2624 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),&
2625 MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2627 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),&
2628 MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2630 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),&
2631 MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2633 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),&
2634 MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2636 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),&
2637 ivec_count(fg_rank1),&
2638 MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2640 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),&
2641 MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2643 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),&
2644 MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
2646 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),&
2647 MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2649 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),&
2650 MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2652 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),&
2653 MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2655 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),&
2656 MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2658 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),&
2659 MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2661 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),&
2662 ivec_count(fg_rank1),&
2663 MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2665 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),&
2666 MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2668 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),&
2669 MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2671 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),&
2672 MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2674 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),&
2675 MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2677 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),&
2678 ivec_count(fg_rank1),&
2679 MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2681 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),&
2682 ivec_count(fg_rank1),&
2683 MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
2685 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),&
2686 ivec_count(fg_rank1),&
2687 MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2688 MPI_MAT2,FG_COMM1,IERR)
2689 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),&
2690 ivec_count(fg_rank1),&
2691 MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
2692 MPI_MAT2,FG_COMM1,IERR)
2695 ! Passes matrix info through the ring
2698 if (irecv.lt.0) irecv=nfgtasks1-1
2701 if (inext.ge.nfgtasks1) inext=0
2703 ! write (iout,*) "isend",isend," irecv",irecv
2705 lensend=lentyp(isend)
2706 lenrecv=lentyp(irecv)
2707 ! write (iout,*) "lensend",lensend," lenrecv",lenrecv
2708 ! call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2709 ! & MPI_ROTAT1(lensend),inext,2200+isend,
2710 ! & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2711 ! & iprev,2200+irecv,FG_COMM,status,IERR)
2712 ! write (iout,*) "Gather ROTAT1"
2714 ! call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2715 ! & MPI_ROTAT2(lensend),inext,3300+isend,
2716 ! & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2717 ! & iprev,3300+irecv,FG_COMM,status,IERR)
2718 ! write (iout,*) "Gather ROTAT2"
2720 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,&
2721 MPI_ROTAT_OLD(lensend),inext,4400+isend,&
2722 costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),&
2723 iprev,4400+irecv,FG_COMM,status,IERR)
2724 ! write (iout,*) "Gather ROTAT_OLD"
2726 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,&
2727 MPI_PRECOMP11(lensend),inext,5500+isend,&
2728 mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),&
2729 iprev,5500+irecv,FG_COMM,status,IERR)
2730 ! write (iout,*) "Gather PRECOMP11"
2732 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,&
2733 MPI_PRECOMP12(lensend),inext,6600+isend,&
2734 Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),&
2735 iprev,6600+irecv,FG_COMM,status,IERR)
2736 ! write (iout,*) "Gather PRECOMP12"
2738 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2740 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,&
2741 MPI_ROTAT2(lensend),inext,7700+isend,&
2742 ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),&
2743 iprev,7700+irecv,FG_COMM,status,IERR)
2744 ! write (iout,*) "Gather PRECOMP21"
2746 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,&
2747 MPI_PRECOMP22(lensend),inext,8800+isend,&
2748 EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),&
2749 iprev,8800+irecv,FG_COMM,status,IERR)
2750 ! write (iout,*) "Gather PRECOMP22"
2752 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,&
2753 MPI_PRECOMP23(lensend),inext,9900+isend,&
2754 Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,&
2755 MPI_PRECOMP23(lenrecv),&
2756 iprev,9900+irecv,FG_COMM,status,IERR)
2757 ! write (iout,*) "Gather PRECOMP23"
2762 if (irecv.lt.0) irecv=nfgtasks1-1
2765 time_gather=time_gather+MPI_Wtime()-time00
2768 ! if (fg_rank.eq.0) then
2769 write (iout,*) "Arrays UG and UGDER"
2771 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2772 ((ug(l,k,i),l=1,2),k=1,2),&
2773 ((ugder(l,k,i),l=1,2),k=1,2)
2775 write (iout,*) "Arrays UG2 and UG2DER"
2777 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2778 ((ug2(l,k,i),l=1,2),k=1,2),&
2779 ((ug2der(l,k,i),l=1,2),k=1,2)
2781 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2783 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2784 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
2785 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2787 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2789 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
2790 costab(i),sintab(i),costab2(i),sintab2(i)
2792 write (iout,*) "Array MUDER"
2794 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2800 !d iti = itortyp(itype(i,1))
2803 !d write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2804 !d & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2808 end subroutine set_matrices
2809 !-----------------------------------------------------------------------------
2810 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2812 ! This subroutine calculates the average interaction energy and its gradient
2813 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
2814 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2815 ! The potential depends both on the distance of peptide-group centers and on
2816 ! the orientation of the CA-CA virtual bonds.
2819 ! implicit real*8 (a-h,o-z)
2823 ! include 'DIMENSIONS'
2824 ! include 'COMMON.CONTROL'
2825 ! include 'COMMON.SETUP'
2826 ! include 'COMMON.IOUNITS'
2827 ! include 'COMMON.GEO'
2828 ! include 'COMMON.VAR'
2829 ! include 'COMMON.LOCAL'
2830 ! include 'COMMON.CHAIN'
2831 ! include 'COMMON.DERIV'
2832 ! include 'COMMON.INTERACT'
2833 ! include 'COMMON.CONTACTS'
2834 ! include 'COMMON.TORSION'
2835 ! include 'COMMON.VECTORS'
2836 ! include 'COMMON.FFIELD'
2837 ! include 'COMMON.TIME1'
2838 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
2839 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
2840 real(kind=8),dimension(2,2) :: acipa !el,a_temp
2841 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
2842 real(kind=8),dimension(4) :: muij
2843 !el integer :: num_conti,j1,j2
2844 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
2845 !el dz_normi,xmedi,ymedi,zmedi
2847 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
2848 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
2851 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2853 real(kind=8) :: scal_el=1.0d0
2855 real(kind=8) :: scal_el=0.5d0
2858 ! 13-go grudnia roku pamietnego...
2859 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
2861 0.0d0,0.0d0,1.0d0/),shape(unmat))
2864 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
2865 real(kind=8) :: fac,t_eelecij,fracinbuf
2868 !d write(iout,*) 'In EELEC'
2869 ! print *,"IN EELEC"
2871 !d write(iout,*) 'Type',i
2872 !d write(iout,*) 'B1',B1(:,i)
2873 !d write(iout,*) 'B2',B2(:,i)
2874 !d write(iout,*) 'CC',CC(:,:,i)
2875 !d write(iout,*) 'DD',DD(:,:,i)
2876 !d write(iout,*) 'EE',EE(:,:,i)
2878 !d call check_vecgrad
2893 if (icheckgrad.eq.1) then
2896 ! dc_norm(1,i)=0.0d0
2897 ! dc_norm(2,i)=0.0d0
2898 ! dc_norm(3,i)=0.0d0
2901 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2903 dc_norm(k,i)=dc(k,i)*fac
2905 ! write (iout,*) 'i',i,' fac',fac
2908 ! print *,wel_loc,"wel_loc",wcorr4,wcorr5,wcorr6,wturn3,wturn4, &
2910 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
2911 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
2912 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2913 ! call vec_and_deriv
2917 ! print *, "before set matrices"
2919 ! print *, "after set matrices"
2922 time_mat=time_mat+MPI_Wtime()-time01
2925 ! print *, "after set matrices"
2927 !d write (iout,*) 'i=',i
2929 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2932 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2933 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2946 !d print '(a)','Enter EELEC'
2947 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2948 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
2949 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
2951 gel_loc_loc(i)=0.0d0
2956 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2958 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
2962 ! print *,"before iturn3 loop"
2963 do i=iturn3_start,iturn3_end
2964 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
2965 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
2969 dx_normi=dc_norm(1,i)
2970 dy_normi=dc_norm(2,i)
2971 dz_normi=dc_norm(3,i)
2972 xmedi=c(1,i)+0.5d0*dxi
2973 ymedi=c(2,i)+0.5d0*dyi
2974 zmedi=c(3,i)+0.5d0*dzi
2975 xmedi=dmod(xmedi,boxxsize)
2976 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2977 ymedi=dmod(ymedi,boxysize)
2978 if (ymedi.lt.0) ymedi=ymedi+boxysize
2979 zmedi=dmod(zmedi,boxzsize)
2980 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2982 if ((zmedi.gt.bordlipbot) &
2983 .and.(zmedi.lt.bordliptop)) then
2984 !C the energy transfer exist
2985 if (zmedi.lt.buflipbot) then
2986 !C what fraction I am in
2988 ((zmedi-bordlipbot)/lipbufthick)
2989 !C lipbufthick is thickenes of lipid buffore
2990 sslipi=sscalelip(fracinbuf)
2991 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
2992 elseif (zmedi.gt.bufliptop) then
2993 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
2994 sslipi=sscalelip(fracinbuf)
2995 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3004 ! print *,i,sslipi,ssgradlipi
3005 call eelecij(i,i+2,ees,evdw1,eel_loc)
3006 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3007 num_cont_hb(i)=num_conti
3009 do i=iturn4_start,iturn4_end
3010 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
3011 .or. itype(i+3,1).eq.ntyp1 &
3012 .or. itype(i+4,1).eq.ntyp1) cycle
3016 dx_normi=dc_norm(1,i)
3017 dy_normi=dc_norm(2,i)
3018 dz_normi=dc_norm(3,i)
3019 xmedi=c(1,i)+0.5d0*dxi
3020 ymedi=c(2,i)+0.5d0*dyi
3021 zmedi=c(3,i)+0.5d0*dzi
3022 xmedi=dmod(xmedi,boxxsize)
3023 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3024 ymedi=dmod(ymedi,boxysize)
3025 if (ymedi.lt.0) ymedi=ymedi+boxysize
3026 zmedi=dmod(zmedi,boxzsize)
3027 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3028 if ((zmedi.gt.bordlipbot) &
3029 .and.(zmedi.lt.bordliptop)) then
3030 !C the energy transfer exist
3031 if (zmedi.lt.buflipbot) then
3032 !C what fraction I am in
3034 ((zmedi-bordlipbot)/lipbufthick)
3035 !C lipbufthick is thickenes of lipid buffore
3036 sslipi=sscalelip(fracinbuf)
3037 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3038 elseif (zmedi.gt.bufliptop) then
3039 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3040 sslipi=sscalelip(fracinbuf)
3041 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3051 num_conti=num_cont_hb(i)
3052 call eelecij(i,i+3,ees,evdw1,eel_loc)
3053 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
3054 call eturn4(i,eello_turn4)
3055 num_cont_hb(i)=num_conti
3058 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3060 do i=iatel_s,iatel_e
3061 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
3065 dx_normi=dc_norm(1,i)
3066 dy_normi=dc_norm(2,i)
3067 dz_normi=dc_norm(3,i)
3068 xmedi=c(1,i)+0.5d0*dxi
3069 ymedi=c(2,i)+0.5d0*dyi
3070 zmedi=c(3,i)+0.5d0*dzi
3071 xmedi=dmod(xmedi,boxxsize)
3072 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3073 ymedi=dmod(ymedi,boxysize)
3074 if (ymedi.lt.0) ymedi=ymedi+boxysize
3075 zmedi=dmod(zmedi,boxzsize)
3076 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3077 if ((zmedi.gt.bordlipbot) &
3078 .and.(zmedi.lt.bordliptop)) then
3079 !C the energy transfer exist
3080 if (zmedi.lt.buflipbot) then
3081 !C what fraction I am in
3083 ((zmedi-bordlipbot)/lipbufthick)
3084 !C lipbufthick is thickenes of lipid buffore
3085 sslipi=sscalelip(fracinbuf)
3086 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3087 elseif (zmedi.gt.bufliptop) then
3088 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3089 sslipi=sscalelip(fracinbuf)
3090 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3100 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3101 num_conti=num_cont_hb(i)
3102 do j=ielstart(i),ielend(i)
3103 ! write (iout,*) i,j,itype(i,1),itype(j,1)
3104 if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
3105 call eelecij(i,j,ees,evdw1,eel_loc)
3107 num_cont_hb(i)=num_conti
3109 ! write (iout,*) "Number of loop steps in EELEC:",ind
3111 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
3112 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3114 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3115 !cc eel_loc=eel_loc+eello_turn3
3116 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
3118 end subroutine eelec
3119 !-----------------------------------------------------------------------------
3120 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3123 ! implicit real*8 (a-h,o-z)
3124 ! include 'DIMENSIONS'
3128 ! include 'COMMON.CONTROL'
3129 ! include 'COMMON.IOUNITS'
3130 ! include 'COMMON.GEO'
3131 ! include 'COMMON.VAR'
3132 ! include 'COMMON.LOCAL'
3133 ! include 'COMMON.CHAIN'
3134 ! include 'COMMON.DERIV'
3135 ! include 'COMMON.INTERACT'
3136 ! include 'COMMON.CONTACTS'
3137 ! include 'COMMON.TORSION'
3138 ! include 'COMMON.VECTORS'
3139 ! include 'COMMON.FFIELD'
3140 ! include 'COMMON.TIME1'
3141 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
3142 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
3143 real(kind=8),dimension(2,2) :: acipa !el,a_temp
3144 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3145 real(kind=8),dimension(4) :: muij
3146 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
3147 dist_temp, dist_init,rlocshield,fracinbuf
3148 integer xshift,yshift,zshift,ilist,iresshield
3149 !el integer :: num_conti,j1,j2
3150 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3151 !el dz_normi,xmedi,ymedi,zmedi
3153 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3154 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3157 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3159 real(kind=8) :: scal_el=1.0d0
3161 real(kind=8) :: scal_el=0.5d0
3164 ! 13-go grudnia roku pamietnego...
3165 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
3167 0.0d0,0.0d0,1.0d0/),shape(unmat))
3168 ! integer :: maxconts=nres/4
3170 integer :: k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap
3171 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
3172 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
3173 real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
3174 rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
3175 evdwij,el1,el2,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
3176 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
3177 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
3178 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
3179 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
3180 ecosgp,ecosam,ecosbm,ecosgm,ghalf
3182 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
3183 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
3185 ! time00=MPI_Wtime()
3186 !d write (iout,*) "eelecij",i,j
3190 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3191 aaa=app(iteli,itelj)
3192 bbb=bpp(iteli,itelj)
3193 ael6i=ael6(iteli,itelj)
3194 ael3i=ael3(iteli,itelj)
3198 dx_normj=dc_norm(1,j)
3199 dy_normj=dc_norm(2,j)
3200 dz_normj=dc_norm(3,j)
3201 ! xj=c(1,j)+0.5D0*dxj-xmedi
3202 ! yj=c(2,j)+0.5D0*dyj-ymedi
3203 ! zj=c(3,j)+0.5D0*dzj-zmedi
3208 if (xj.lt.0) xj=xj+boxxsize
3210 if (yj.lt.0) yj=yj+boxysize
3212 if (zj.lt.0) zj=zj+boxzsize
3213 if ((zj.gt.bordlipbot) &
3214 .and.(zj.lt.bordliptop)) then
3215 !C the energy transfer exist
3216 if (zj.lt.buflipbot) then
3217 !C what fraction I am in
3219 ((zj-bordlipbot)/lipbufthick)
3220 !C lipbufthick is thickenes of lipid buffore
3221 sslipj=sscalelip(fracinbuf)
3222 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
3223 elseif (zj.gt.bufliptop) then
3224 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
3225 sslipj=sscalelip(fracinbuf)
3226 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
3237 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3244 xj=xj_safe+xshift*boxxsize
3245 yj=yj_safe+yshift*boxysize
3246 zj=zj_safe+zshift*boxzsize
3247 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3248 if(dist_temp.lt.dist_init) then
3258 if (isubchap.eq.1) then
3269 rij=xj*xj+yj*yj+zj*zj
3272 !C print *,xmedi,ymedi,zmedi,xj,yj,zj,boxxsize,rij
3273 sss_ele_cut=sscale_ele(rij)
3274 sss_ele_grad=sscagrad_ele(rij)
3276 ! sss_ele_grad=0.0d0
3277 ! print *,sss_ele_cut,sss_ele_grad,&
3278 ! (rij),r_cut_ele,rlamb_ele
3279 ! if (sss_ele_cut.le.0.0) go to 128
3284 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3285 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3286 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3287 fac=cosa-3.0D0*cosb*cosg
3289 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3290 if (j.eq.i+2) ev1=scal_el*ev1
3295 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3298 if (shield_mode.gt.0) then
3299 !C fac_shield(i)=0.4
3300 !C fac_shield(j)=0.6
3301 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3302 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3304 ees=ees+eesij*sss_ele_cut
3305 !C FOR NOW SHIELD IS NOT USED WITH LIPSCALE
3306 !C & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3312 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)*sss_ele_cut
3313 !C print *,"TUCC",(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
3316 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
3317 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3318 ! ees=ees+eesij*sss_ele_cut
3319 evdw1=evdw1+evdwij*sss_ele_cut &
3320 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3321 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3322 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3323 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3324 !d & xmedi,ymedi,zmedi,xj,yj,zj
3326 if (energy_dec) then
3327 ! write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') &
3328 ! 'evdw1',i,j,evdwij,&
3329 ! iteli,itelj,aaa,evdw1
3330 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3331 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3334 ! Calculate contributions to the Cartesian gradient.
3337 facvdw=-6*rrmij*(ev1+evdwij)*sss_ele_cut &
3338 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3339 facel=-3*rrmij*(el1+eesij)*sss_ele_cut &
3340 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3346 ! Radial derivatives. First process both termini of the fragment (i,j)
3348 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj* &
3349 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3350 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj* &
3351 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3352 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj* &
3353 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3355 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3356 (shield_mode.gt.0)) then
3358 do ilist=1,ishield_list(i)
3359 iresshield=shield_list(ilist,i)
3361 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)&
3363 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3365 +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0 &
3367 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3370 do ilist=1,ishield_list(j)
3371 iresshield=shield_list(ilist,j)
3373 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j) &
3375 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3377 +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0 &
3379 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3383 gshieldc(k,i)=gshieldc(k,i)+ &
3384 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3387 gshieldc(k,j)=gshieldc(k,j)+ &
3388 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3391 gshieldc(k,i-1)=gshieldc(k,i-1)+ &
3392 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3395 gshieldc(k,j-1)=gshieldc(k,j-1)+ &
3396 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3404 ! ghalf=0.5D0*ggg(k)
3405 ! gelc(k,i)=gelc(k,i)+ghalf
3406 ! gelc(k,j)=gelc(k,j)+ghalf
3408 ! 9/28/08 AL Gradient compotents will be summed only at the end
3410 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3411 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3413 gelc_long(3,j)=gelc_long(3,j)+ &
3414 ssgradlipj*eesij/2.0d0*lipscale**2&
3417 gelc_long(3,i)=gelc_long(3,i)+ &
3418 ssgradlipi*eesij/2.0d0*lipscale**2&
3423 ! Loop over residues i+1 thru j-1.
3427 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3430 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj &
3431 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3432 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj &
3433 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3434 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj &
3435 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3438 ! ghalf=0.5D0*ggg(k)
3439 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3440 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3442 ! 9/28/08 AL Gradient compotents will be summed only at the end
3444 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3445 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3448 !C Lipidic part for scaling weight
3449 gvdwpp(3,j)=gvdwpp(3,j)+ &
3450 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3451 gvdwpp(3,i)=gvdwpp(3,i)+ &
3452 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3453 !! Loop over residues i+1 thru j-1.
3457 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3461 facvdw=(ev1+evdwij)*sss_ele_cut &
3462 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3464 facel=(el1+eesij)*sss_ele_cut
3466 fac=-3*rrmij*(facvdw+facvdw+facel)
3471 ! Radial derivatives. First process both termini of the fragment (i,j)
3473 ggg(1)=fac*xj+sss_ele_grad*rmij*(eesij+evdwij)*xj
3474 ggg(2)=fac*yj+sss_ele_grad*rmij*(eesij+evdwij)*yj
3475 ggg(3)=fac*zj+sss_ele_grad*rmij*(eesij+evdwij)*zj
3477 ! ghalf=0.5D0*ggg(k)
3478 ! gelc(k,i)=gelc(k,i)+ghalf
3479 ! gelc(k,j)=gelc(k,j)+ghalf
3481 ! 9/28/08 AL Gradient compotents will be summed only at the end
3483 gelc_long(k,j)=gelc(k,j)+ggg(k)
3484 gelc_long(k,i)=gelc(k,i)-ggg(k)
3487 ! Loop over residues i+1 thru j-1.
3491 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3494 ! 9/28/08 AL Gradient compotents will be summed only at the end
3496 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3498 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3500 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3503 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3504 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3506 gvdwpp(3,j)=gvdwpp(3,j)+ &
3507 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3508 gvdwpp(3,i)=gvdwpp(3,i)+ &
3509 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3515 ecosa=2.0D0*fac3*fac1+fac4
3518 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3519 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3521 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3522 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3524 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3525 !d & (dcosg(k),k=1,3)
3527 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*sss_ele_cut &
3528 *fac_shield(i)**2*fac_shield(j)**2 &
3529 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3533 ! ghalf=0.5D0*ggg(k)
3534 ! gelc(k,i)=gelc(k,i)+ghalf
3535 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3536 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3537 ! gelc(k,j)=gelc(k,j)+ghalf
3538 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3539 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3543 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3547 gelc(k,i)=gelc(k,i) &
3548 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
3549 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
3551 *fac_shield(i)**2*fac_shield(j)**2 &
3552 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3554 gelc(k,j)=gelc(k,j) &
3555 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
3556 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
3558 *fac_shield(i)**2*fac_shield(j)**2 &
3559 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3561 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3562 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3565 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3566 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
3567 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3569 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3570 ! energy of a peptide unit is assumed in the form of a second-order
3571 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3572 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3573 ! are computed for EVERY pair of non-contiguous peptide groups.
3575 if (j.lt.nres-1) then
3586 muij(kkk)=mu(k,i)*mu(l,j)
3589 !d write (iout,*) 'EELEC: i',i,' j',j
3590 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
3591 !d write(iout,*) 'muij',muij
3592 ury=scalar(uy(1,i),erij)
3593 urz=scalar(uz(1,i),erij)
3594 vry=scalar(uy(1,j),erij)
3595 vrz=scalar(uz(1,j),erij)
3596 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3597 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3598 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3599 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3600 fac=dsqrt(-ael6i)*r3ij
3605 !d write (iout,'(4i5,4f10.5)')
3606 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
3607 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3608 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3609 !d & uy(:,j),uz(:,j)
3610 !d write (iout,'(4f10.5)')
3611 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3612 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3613 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
3614 !d write (iout,'(9f10.5/)')
3615 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3616 ! Derivatives of the elements of A in virtual-bond vectors
3617 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3619 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3620 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3621 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3622 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3623 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3624 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3625 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3626 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3627 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3628 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3629 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3630 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3632 ! Compute radial contributions to the gradient
3650 ! Add the contributions coming from er
3653 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3654 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3655 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3656 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3659 ! Derivatives in DC(i)
3660 !grad ghalf1=0.5d0*agg(k,1)
3661 !grad ghalf2=0.5d0*agg(k,2)
3662 !grad ghalf3=0.5d0*agg(k,3)
3663 !grad ghalf4=0.5d0*agg(k,4)
3664 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
3665 -3.0d0*uryg(k,2)*vry)!+ghalf1
3666 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
3667 -3.0d0*uryg(k,2)*vrz)!+ghalf2
3668 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
3669 -3.0d0*urzg(k,2)*vry)!+ghalf3
3670 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
3671 -3.0d0*urzg(k,2)*vrz)!+ghalf4
3672 ! Derivatives in DC(i+1)
3673 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
3674 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3675 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
3676 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3677 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
3678 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3679 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
3680 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3681 ! Derivatives in DC(j)
3682 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
3683 -3.0d0*vryg(k,2)*ury)!+ghalf1
3684 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
3685 -3.0d0*vrzg(k,2)*ury)!+ghalf2
3686 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
3687 -3.0d0*vryg(k,2)*urz)!+ghalf3
3688 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
3689 -3.0d0*vrzg(k,2)*urz)!+ghalf4
3690 ! Derivatives in DC(j+1) or DC(nres-1)
3691 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
3692 -3.0d0*vryg(k,3)*ury)
3693 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
3694 -3.0d0*vrzg(k,3)*ury)
3695 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
3696 -3.0d0*vryg(k,3)*urz)
3697 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
3698 -3.0d0*vrzg(k,3)*urz)
3699 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
3701 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3714 aggi(k,l)=-aggi(k,l)
3715 aggi1(k,l)=-aggi1(k,l)
3716 aggj(k,l)=-aggj(k,l)
3717 aggj1(k,l)=-aggj1(k,l)
3720 if (j.lt.nres-1) then
3726 aggi(k,l)=-aggi(k,l)
3727 aggi1(k,l)=-aggi1(k,l)
3728 aggj(k,l)=-aggj(k,l)
3729 aggj1(k,l)=-aggj1(k,l)
3740 aggi(k,l)=-aggi(k,l)
3741 aggi1(k,l)=-aggi1(k,l)
3742 aggj(k,l)=-aggj(k,l)
3743 aggj1(k,l)=-aggj1(k,l)
3748 IF (wel_loc.gt.0.0d0) THEN
3749 ! Contribution to the local-electrostatic energy coming from the i-j pair
3750 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
3752 if (shield_mode.eq.0) then
3756 eel_loc_ij=eel_loc_ij &
3757 *fac_shield(i)*fac_shield(j) &
3758 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3759 !C Now derivative over eel_loc
3760 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3761 (shield_mode.gt.0)) then
3764 do ilist=1,ishield_list(i)
3765 iresshield=shield_list(ilist,i)
3767 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij &
3770 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
3772 +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i) &
3775 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
3779 do ilist=1,ishield_list(j)
3780 iresshield=shield_list(ilist,j)
3782 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij &
3785 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
3787 +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j) &
3790 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
3797 gshieldc_ll(k,i)=gshieldc_ll(k,i)+ &
3798 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
3800 gshieldc_ll(k,j)=gshieldc_ll(k,j)+ &
3801 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
3803 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+ &
3804 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
3806 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+ &
3807 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
3814 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3816 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
3817 'eelloc',i,j,eel_loc_ij
3818 ! if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33
3819 ! if (energy_dec) write (iout,*) "muij",muij
3820 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3822 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
3823 ! Partial derivatives in virtual-bond dihedral angles gamma
3825 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
3826 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
3827 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
3829 *fac_shield(i)*fac_shield(j) &
3830 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3832 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
3833 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
3834 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
3836 *fac_shield(i)*fac_shield(j) &
3837 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3838 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3840 ! ggg(1)=(agg(1,1)*muij(1)+ &
3841 ! agg(1,2)*muij(2)+agg(1,3)*muij(3)+agg(1,4)*muij(4)) &
3843 ! +eel_loc_ij*sss_ele_grad*rmij*xj
3844 ! ggg(2)=(agg(2,1)*muij(1)+ &
3845 ! agg(2,2)*muij(2)+agg(2,3)*muij(3)+agg(2,4)*muij(4)) &
3847 ! +eel_loc_ij*sss_ele_grad*rmij*yj
3848 ! ggg(3)=(agg(3,1)*muij(1)+ &
3849 ! agg(3,2)*muij(2)+agg(3,3)*muij(3)+agg(3,4)*muij(4)) &
3851 ! +eel_loc_ij*sss_ele_grad*rmij*zj
3857 ggg(l)=(agg(l,1)*muij(1)+ &
3858 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
3860 *fac_shield(i)*fac_shield(j) &
3861 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) &
3862 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3865 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3866 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3867 !grad ghalf=0.5d0*ggg(l)
3868 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
3869 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
3871 gel_loc_long(3,j)=gel_loc_long(3,j)+ &
3872 ssgradlipj*eel_loc_ij/2.0d0*lipscale/ &
3873 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
3875 gel_loc_long(3,i)=gel_loc_long(3,i)+ &
3876 ssgradlipi*eel_loc_ij/2.0d0*lipscale/ &
3877 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
3881 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3884 ! Remaining derivatives of eello
3886 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
3887 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
3889 *fac_shield(i)*fac_shield(j) &
3890 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3892 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3893 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
3894 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3) &
3895 +aggi1(l,4)*muij(4))&
3897 *fac_shield(i)*fac_shield(j) &
3898 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3900 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3901 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
3902 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
3904 *fac_shield(i)*fac_shield(j) &
3905 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3907 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3908 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
3909 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3) &
3910 +aggj1(l,4)*muij(4))&
3912 *fac_shield(i)*fac_shield(j) &
3913 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
3915 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
3918 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
3919 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
3920 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
3921 .and. num_conti.le.maxconts) then
3922 ! write (iout,*) i,j," entered corr"
3924 ! Calculate the contact function. The ith column of the array JCONT will
3925 ! contain the numbers of atoms that make contacts with the atom I (of numbers
3926 ! greater than I). The arrays FACONT and GACONT will contain the values of
3927 ! the contact function and its derivative.
3928 ! r0ij=1.02D0*rpp(iteli,itelj)
3929 ! r0ij=1.11D0*rpp(iteli,itelj)
3930 r0ij=2.20D0*rpp(iteli,itelj)
3931 ! r0ij=1.55D0*rpp(iteli,itelj)
3932 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3933 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
3934 if (fcont.gt.0.0D0) then
3935 num_conti=num_conti+1
3936 if (num_conti.gt.maxconts) then
3937 !el write (iout,*) "esrgresgdsrgdfsrgdswrgaresfgaerwgae"
3938 !el write (iout,*) "num_conti",num_conti, "maxconts",maxconts
3939 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
3940 ' will skip next contacts for this conf.', num_conti
3942 jcont_hb(num_conti,i)=j
3943 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
3944 !d & " jcont_hb",jcont_hb(num_conti,i)
3945 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
3946 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3947 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3949 d_cont(num_conti,i)=rij
3950 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3951 ! --- Electrostatic-interaction matrix ---
3952 a_chuj(1,1,num_conti,i)=a22
3953 a_chuj(1,2,num_conti,i)=a23
3954 a_chuj(2,1,num_conti,i)=a32
3955 a_chuj(2,2,num_conti,i)=a33
3956 ! --- Gradient of rij
3958 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3965 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3966 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3967 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3968 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3969 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3974 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3975 ! Calculate contact energies
3977 wij=cosa-3.0D0*cosb*cosg
3980 ! fac3=dsqrt(-ael6i)/r0ij**3
3981 fac3=dsqrt(-ael6i)*r3ij
3982 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3983 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3984 if (ees0tmp.gt.0) then
3985 ees0pij=dsqrt(ees0tmp)
3989 if (shield_mode.eq.0) then
3993 ees0plist(num_conti,i)=j
3995 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3996 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3997 if (ees0tmp.gt.0) then
3998 ees0mij=dsqrt(ees0tmp)
4003 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
4005 *fac_shield(i)*fac_shield(j)
4007 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
4009 *fac_shield(i)*fac_shield(j)
4011 ! Diagnostics. Comment out or remove after debugging!
4012 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4013 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4014 ! ees0m(num_conti,i)=0.0D0
4016 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4017 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4018 ! Angular derivatives of the contact function
4019 ees0pij1=fac3/ees0pij
4020 ees0mij1=fac3/ees0mij
4021 fac3p=-3.0D0*fac3*rrmij
4022 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4023 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4025 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4026 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4027 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4028 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4029 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4030 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4031 ecosap=ecosa1+ecosa2
4032 ecosbp=ecosb1+ecosb2
4033 ecosgp=ecosg1+ecosg2
4034 ecosam=ecosa1-ecosa2
4035 ecosbm=ecosb1-ecosb2
4036 ecosgm=ecosg1-ecosg2
4045 facont_hb(num_conti,i)=fcont
4046 fprimcont=fprimcont/rij
4047 !d facont_hb(num_conti,i)=1.0D0
4048 ! Following line is for diagnostics.
4051 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4052 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4055 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4056 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4058 gggp(1)=gggp(1)+ees0pijp*xj &
4059 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
4060 gggp(2)=gggp(2)+ees0pijp*yj &
4061 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
4062 gggp(3)=gggp(3)+ees0pijp*zj &
4063 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
4065 gggm(1)=gggm(1)+ees0mijp*xj &
4066 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
4068 gggm(2)=gggm(2)+ees0mijp*yj &
4069 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
4071 gggm(3)=gggm(3)+ees0mijp*zj &
4072 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
4074 ! Derivatives due to the contact function
4075 gacont_hbr(1,num_conti,i)=fprimcont*xj
4076 gacont_hbr(2,num_conti,i)=fprimcont*yj
4077 gacont_hbr(3,num_conti,i)=fprimcont*zj
4080 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
4081 ! following the change of gradient-summation algorithm.
4083 !grad ghalfp=0.5D0*gggp(k)
4084 !grad ghalfm=0.5D0*gggm(k)
4085 gacontp_hb1(k,num_conti,i)= & !ghalfp+
4086 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4087 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
4088 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4090 gacontp_hb2(k,num_conti,i)= & !ghalfp+
4091 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4092 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
4093 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4095 gacontp_hb3(k,num_conti,i)=gggp(k) &
4096 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4098 gacontm_hb1(k,num_conti,i)= & !ghalfm+
4099 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4100 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
4101 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4103 gacontm_hb2(k,num_conti,i)= & !ghalfm+
4104 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4105 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
4106 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4108 gacontm_hb3(k,num_conti,i)=gggm(k) &
4109 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4112 ! Diagnostics. Comment out or remove after debugging!
4114 !diag gacontp_hb1(k,num_conti,i)=0.0D0
4115 !diag gacontp_hb2(k,num_conti,i)=0.0D0
4116 !diag gacontp_hb3(k,num_conti,i)=0.0D0
4117 !diag gacontm_hb1(k,num_conti,i)=0.0D0
4118 !diag gacontm_hb2(k,num_conti,i)=0.0D0
4119 !diag gacontm_hb3(k,num_conti,i)=0.0D0
4122 endif ! num_conti.le.maxconts
4125 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4128 ghalf=0.5d0*agg(l,k)
4129 aggi(l,k)=aggi(l,k)+ghalf
4130 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4131 aggj(l,k)=aggj(l,k)+ghalf
4134 if (j.eq.nres-1 .and. i.lt.j-2) then
4137 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4143 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
4145 end subroutine eelecij
4146 !-----------------------------------------------------------------------------
4147 subroutine eturn3(i,eello_turn3)
4148 ! Third- and fourth-order contributions from turns
4151 ! implicit real*8 (a-h,o-z)
4152 ! include 'DIMENSIONS'
4153 ! include 'COMMON.IOUNITS'
4154 ! include 'COMMON.GEO'
4155 ! include 'COMMON.VAR'
4156 ! include 'COMMON.LOCAL'
4157 ! include 'COMMON.CHAIN'
4158 ! include 'COMMON.DERIV'
4159 ! include 'COMMON.INTERACT'
4160 ! include 'COMMON.CONTACTS'
4161 ! include 'COMMON.TORSION'
4162 ! include 'COMMON.VECTORS'
4163 ! include 'COMMON.FFIELD'
4164 ! include 'COMMON.CONTROL'
4165 real(kind=8),dimension(3) :: ggg
4166 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4167 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
4168 real(kind=8),dimension(2) :: auxvec,auxvec1
4169 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4170 real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
4171 !el integer :: num_conti,j1,j2
4172 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4173 !el dz_normi,xmedi,ymedi,zmedi
4175 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4176 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4179 integer :: i,j,l,k,ilist,iresshield
4180 real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield
4183 ! write (iout,*) "eturn3",i,j,j1,j2
4184 zj=(c(3,j)+c(3,j+1))/2.0d0
4186 if (zj.lt.0) zj=zj+boxzsize
4187 if ((zj.lt.0)) write (*,*) "CHUJ"
4188 if ((zj.gt.bordlipbot) &
4189 .and.(zj.lt.bordliptop)) then
4190 !C the energy transfer exist
4191 if (zj.lt.buflipbot) then
4192 !C what fraction I am in
4194 ((zj-bordlipbot)/lipbufthick)
4195 !C lipbufthick is thickenes of lipid buffore
4196 sslipj=sscalelip(fracinbuf)
4197 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4198 elseif (zj.gt.bufliptop) then
4199 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4200 sslipj=sscalelip(fracinbuf)
4201 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4215 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4217 ! Third-order contributions
4224 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4225 !d call checkint_turn3(i,a_temp,eello_turn3_num)
4226 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4227 call transpose2(auxmat(1,1),auxmat1(1,1))
4228 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4229 if (shield_mode.eq.0) then
4234 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) &
4235 *fac_shield(i)*fac_shield(j) &
4236 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4238 0.5d0*(pizda(1,1)+pizda(2,2)) &
4239 *fac_shield(i)*fac_shield(j)
4241 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4242 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4243 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4244 (shield_mode.gt.0)) then
4247 do ilist=1,ishield_list(i)
4248 iresshield=shield_list(ilist,i)
4250 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4251 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4253 +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4254 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4258 do ilist=1,ishield_list(j)
4259 iresshield=shield_list(ilist,j)
4261 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4262 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4264 +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4265 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4272 gshieldc_t3(k,i)=gshieldc_t3(k,i)+ &
4273 grad_shield(k,i)*eello_t3/fac_shield(i)
4274 gshieldc_t3(k,j)=gshieldc_t3(k,j)+ &
4275 grad_shield(k,j)*eello_t3/fac_shield(j)
4276 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+ &
4277 grad_shield(k,i)*eello_t3/fac_shield(i)
4278 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+ &
4279 grad_shield(k,j)*eello_t3/fac_shield(j)
4283 !d write (2,*) 'i,',i,' j',j,'eello_turn3',
4284 !d & 0.5d0*(pizda(1,1)+pizda(2,2)),
4285 !d & ' eello_turn3_num',4*eello_turn3_num
4286 ! Derivatives in gamma(i)
4287 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4288 call transpose2(auxmat2(1,1),auxmat3(1,1))
4289 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4290 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))&
4291 *fac_shield(i)*fac_shield(j) &
4292 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4293 ! Derivatives in gamma(i+1)
4294 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4295 call transpose2(auxmat2(1,1),auxmat3(1,1))
4296 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4297 gel_loc_turn3(i+1)=gel_loc_turn3(i+1) &
4298 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4299 *fac_shield(i)*fac_shield(j) &
4300 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4302 ! Cartesian derivatives
4304 ! ghalf1=0.5d0*agg(l,1)
4305 ! ghalf2=0.5d0*agg(l,2)
4306 ! ghalf3=0.5d0*agg(l,3)
4307 ! ghalf4=0.5d0*agg(l,4)
4308 a_temp(1,1)=aggi(l,1)!+ghalf1
4309 a_temp(1,2)=aggi(l,2)!+ghalf2
4310 a_temp(2,1)=aggi(l,3)!+ghalf3
4311 a_temp(2,2)=aggi(l,4)!+ghalf4
4312 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4313 gcorr3_turn(l,i)=gcorr3_turn(l,i) &
4314 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4315 *fac_shield(i)*fac_shield(j) &
4316 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4318 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4319 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4320 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4321 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4322 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4323 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) &
4324 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4325 *fac_shield(i)*fac_shield(j) &
4326 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4328 a_temp(1,1)=aggj(l,1)!+ghalf1
4329 a_temp(1,2)=aggj(l,2)!+ghalf2
4330 a_temp(2,1)=aggj(l,3)!+ghalf3
4331 a_temp(2,2)=aggj(l,4)!+ghalf4
4332 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4333 gcorr3_turn(l,j)=gcorr3_turn(l,j) &
4334 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4335 *fac_shield(i)*fac_shield(j) &
4336 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4338 a_temp(1,1)=aggj1(l,1)
4339 a_temp(1,2)=aggj1(l,2)
4340 a_temp(2,1)=aggj1(l,3)
4341 a_temp(2,2)=aggj1(l,4)
4342 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4343 gcorr3_turn(l,j1)=gcorr3_turn(l,j1) &
4344 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4345 *fac_shield(i)*fac_shield(j) &
4346 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4348 gshieldc_t3(3,i)=gshieldc_t3(3,i)+ &
4349 ssgradlipi*eello_t3/4.0d0*lipscale
4350 gshieldc_t3(3,j)=gshieldc_t3(3,j)+ &
4351 ssgradlipj*eello_t3/4.0d0*lipscale
4352 gshieldc_t3(3,i-1)=gshieldc_t3(3,i-1)+ &
4353 ssgradlipi*eello_t3/4.0d0*lipscale
4354 gshieldc_t3(3,j-1)=gshieldc_t3(3,j-1)+ &
4355 ssgradlipj*eello_t3/4.0d0*lipscale
4358 end subroutine eturn3
4359 !-----------------------------------------------------------------------------
4360 subroutine eturn4(i,eello_turn4)
4361 ! Third- and fourth-order contributions from turns
4364 ! implicit real*8 (a-h,o-z)
4365 ! include 'DIMENSIONS'
4366 ! include 'COMMON.IOUNITS'
4367 ! include 'COMMON.GEO'
4368 ! include 'COMMON.VAR'
4369 ! include 'COMMON.LOCAL'
4370 ! include 'COMMON.CHAIN'
4371 ! include 'COMMON.DERIV'
4372 ! include 'COMMON.INTERACT'
4373 ! include 'COMMON.CONTACTS'
4374 ! include 'COMMON.TORSION'
4375 ! include 'COMMON.VECTORS'
4376 ! include 'COMMON.FFIELD'
4377 ! include 'COMMON.CONTROL'
4378 real(kind=8),dimension(3) :: ggg
4379 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4380 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2
4381 real(kind=8),dimension(2) :: auxvec,auxvec1
4382 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4383 real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
4384 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4385 !el dz_normi,xmedi,ymedi,zmedi
4386 !el integer :: num_conti,j1,j2
4387 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4388 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4391 integer :: i,j,iti1,iti2,iti3,l,k,ilist,iresshield
4392 real(kind=8) :: eello_turn4,s1,s2,s3,zj,fracinbuf,eello_t4,&
4396 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4398 ! Fourth-order contributions
4406 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4407 !d call checkint_turn4(i,a_temp,eello_turn4_num)
4408 ! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4409 zj=(c(3,j)+c(3,j+1))/2.0d0
4411 if (zj.lt.0) zj=zj+boxzsize
4412 if ((zj.gt.bordlipbot) &
4413 .and.(zj.lt.bordliptop)) then
4414 !C the energy transfer exist
4415 if (zj.lt.buflipbot) then
4416 !C what fraction I am in
4418 ((zj-bordlipbot)/lipbufthick)
4419 !C lipbufthick is thickenes of lipid buffore
4420 sslipj=sscalelip(fracinbuf)
4421 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4422 elseif (zj.gt.bufliptop) then
4423 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4424 sslipj=sscalelip(fracinbuf)
4425 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4439 iti1=itortyp(itype(i+1,1))
4440 iti2=itortyp(itype(i+2,1))
4441 iti3=itortyp(itype(i+3,1))
4442 ! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4443 call transpose2(EUg(1,1,i+1),e1t(1,1))
4444 call transpose2(Eug(1,1,i+2),e2t(1,1))
4445 call transpose2(Eug(1,1,i+3),e3t(1,1))
4446 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4447 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4448 s1=scalar2(b1(1,iti2),auxvec(1))
4449 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4450 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4451 s2=scalar2(b1(1,iti1),auxvec(1))
4452 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4453 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4454 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4455 if (shield_mode.eq.0) then
4460 eello_turn4=eello_turn4-(s1+s2+s3) &
4461 *fac_shield(i)*fac_shield(j) &
4462 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4463 eello_t4=-(s1+s2+s3) &
4464 *fac_shield(i)*fac_shield(j)
4465 !C Now derivative over shield:
4466 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4467 (shield_mode.gt.0)) then
4470 do ilist=1,ishield_list(i)
4471 iresshield=shield_list(ilist,i)
4473 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
4474 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
4476 +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
4477 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
4481 do ilist=1,ishield_list(j)
4482 iresshield=shield_list(ilist,j)
4484 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
4485 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
4487 +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
4488 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
4495 gshieldc_t4(k,i)=gshieldc_t4(k,i)+ &
4496 grad_shield(k,i)*eello_t4/fac_shield(i)
4497 gshieldc_t4(k,j)=gshieldc_t4(k,j)+ &
4498 grad_shield(k,j)*eello_t4/fac_shield(j)
4499 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+ &
4500 grad_shield(k,i)*eello_t4/fac_shield(i)
4501 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+ &
4502 grad_shield(k,j)*eello_t4/fac_shield(j)
4506 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4507 'eturn4',i,j,-(s1+s2+s3)
4508 !d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4509 !d & ' eello_turn4_num',8*eello_turn4_num
4510 ! Derivatives in gamma(i)
4511 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4512 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4513 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4514 s1=scalar2(b1(1,iti2),auxvec(1))
4515 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4516 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4517 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) &
4518 *fac_shield(i)*fac_shield(j) &
4519 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4521 ! Derivatives in gamma(i+1)
4522 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4523 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4524 s2=scalar2(b1(1,iti1),auxvec(1))
4525 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4526 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4527 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4528 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) &
4529 *fac_shield(i)*fac_shield(j) &
4530 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4532 ! Derivatives in gamma(i+2)
4533 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4534 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4535 s1=scalar2(b1(1,iti2),auxvec(1))
4536 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4537 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4538 s2=scalar2(b1(1,iti1),auxvec(1))
4539 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4540 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4541 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4542 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) &
4543 *fac_shield(i)*fac_shield(j) &
4544 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4546 ! Cartesian derivatives
4547 ! Derivatives of this turn contributions in DC(i+2)
4548 if (j.lt.nres-1) then
4550 a_temp(1,1)=agg(l,1)
4551 a_temp(1,2)=agg(l,2)
4552 a_temp(2,1)=agg(l,3)
4553 a_temp(2,2)=agg(l,4)
4554 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4555 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4556 s1=scalar2(b1(1,iti2),auxvec(1))
4557 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4558 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4559 s2=scalar2(b1(1,iti1),auxvec(1))
4560 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4561 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4562 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4564 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)&
4565 *fac_shield(i)*fac_shield(j) &
4566 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4570 ! Remaining derivatives of this turn contribution
4572 a_temp(1,1)=aggi(l,1)
4573 a_temp(1,2)=aggi(l,2)
4574 a_temp(2,1)=aggi(l,3)
4575 a_temp(2,2)=aggi(l,4)
4576 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4577 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4578 s1=scalar2(b1(1,iti2),auxvec(1))
4579 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4580 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4581 s2=scalar2(b1(1,iti1),auxvec(1))
4582 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4583 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4584 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4585 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) &
4586 *fac_shield(i)*fac_shield(j) &
4587 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4590 a_temp(1,1)=aggi1(l,1)
4591 a_temp(1,2)=aggi1(l,2)
4592 a_temp(2,1)=aggi1(l,3)
4593 a_temp(2,2)=aggi1(l,4)
4594 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4595 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4596 s1=scalar2(b1(1,iti2),auxvec(1))
4597 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4598 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4599 s2=scalar2(b1(1,iti1),auxvec(1))
4600 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4601 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4602 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4603 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) &
4604 *fac_shield(i)*fac_shield(j) &
4605 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4608 a_temp(1,1)=aggj(l,1)
4609 a_temp(1,2)=aggj(l,2)
4610 a_temp(2,1)=aggj(l,3)
4611 a_temp(2,2)=aggj(l,4)
4612 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4613 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4614 s1=scalar2(b1(1,iti2),auxvec(1))
4615 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4616 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4617 s2=scalar2(b1(1,iti1),auxvec(1))
4618 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4619 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4620 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4621 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) &
4622 *fac_shield(i)*fac_shield(j) &
4623 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4626 a_temp(1,1)=aggj1(l,1)
4627 a_temp(1,2)=aggj1(l,2)
4628 a_temp(2,1)=aggj1(l,3)
4629 a_temp(2,2)=aggj1(l,4)
4630 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4631 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4632 s1=scalar2(b1(1,iti2),auxvec(1))
4633 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4634 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4635 s2=scalar2(b1(1,iti1),auxvec(1))
4636 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4637 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4638 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4639 ! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4640 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) &
4641 *fac_shield(i)*fac_shield(j) &
4642 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4645 gshieldc_t4(3,i)=gshieldc_t4(3,i)+ &
4646 ssgradlipi*eello_t4/4.0d0*lipscale
4647 gshieldc_t4(3,j)=gshieldc_t4(3,j)+ &
4648 ssgradlipj*eello_t4/4.0d0*lipscale
4649 gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+ &
4650 ssgradlipi*eello_t4/4.0d0*lipscale
4651 gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+ &
4652 ssgradlipj*eello_t4/4.0d0*lipscale
4655 end subroutine eturn4
4656 !-----------------------------------------------------------------------------
4657 subroutine unormderiv(u,ugrad,unorm,ungrad)
4658 ! This subroutine computes the derivatives of a normalized vector u, given
4659 ! the derivatives computed without normalization conditions, ugrad. Returns
4662 real(kind=8),dimension(3) :: u,vec
4663 real(kind=8),dimension(3,3) ::ugrad,ungrad
4664 real(kind=8) :: unorm !,scalar
4666 ! write (2,*) 'ugrad',ugrad
4669 vec(i)=scalar(ugrad(1,i),u(1))
4671 ! write (2,*) 'vec',vec
4674 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4677 ! write (2,*) 'ungrad',ungrad
4679 end subroutine unormderiv
4680 !-----------------------------------------------------------------------------
4681 subroutine escp_soft_sphere(evdw2,evdw2_14)
4683 ! This subroutine calculates the excluded-volume interaction energy between
4684 ! peptide-group centers and side chains and its gradient in virtual-bond and
4685 ! side-chain vectors.
4687 ! implicit real*8 (a-h,o-z)
4688 ! include 'DIMENSIONS'
4689 ! include 'COMMON.GEO'
4690 ! include 'COMMON.VAR'
4691 ! include 'COMMON.LOCAL'
4692 ! include 'COMMON.CHAIN'
4693 ! include 'COMMON.DERIV'
4694 ! include 'COMMON.INTERACT'
4695 ! include 'COMMON.FFIELD'
4696 ! include 'COMMON.IOUNITS'
4697 ! include 'COMMON.CONTROL'
4698 real(kind=8),dimension(3) :: ggg
4700 integer :: i,iint,j,k,iteli,itypj
4701 real(kind=8) :: evdw2,evdw2_14,r0_scp,xi,yi,zi,xj,yj,zj,&
4702 fac,rij,r0ij,r0ijsq,evdwij,e1,e2
4707 !d print '(a)','Enter ESCP'
4708 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4709 do i=iatscp_s,iatscp_e
4710 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
4712 xi=0.5D0*(c(1,i)+c(1,i+1))
4713 yi=0.5D0*(c(2,i)+c(2,i+1))
4714 zi=0.5D0*(c(3,i)+c(3,i+1))
4716 do iint=1,nscp_gr(i)
4718 do j=iscpstart(i,iint),iscpend(i,iint)
4719 if (itype(j,1).eq.ntyp1) cycle
4720 itypj=iabs(itype(j,1))
4721 ! Uncomment following three lines for SC-p interactions
4725 ! Uncomment following three lines for Ca-p interactions
4729 rij=xj*xj+yj*yj+zj*zj
4732 if (rij.lt.r0ijsq) then
4733 evdwij=0.25d0*(rij-r0ijsq)**2
4741 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
4746 !grad if (j.lt.i) then
4747 !d write (iout,*) 'j<i'
4748 ! Uncomment following three lines for SC-p interactions
4750 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4753 !d write (iout,*) 'j>i'
4755 !grad ggg(k)=-ggg(k)
4756 ! Uncomment following line for SC-p interactions
4757 ! gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4761 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4763 !grad kstart=min0(i+1,j)
4764 !grad kend=max0(i-1,j-1)
4765 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4766 !d write (iout,*) ggg(1),ggg(2),ggg(3)
4767 !grad do k=kstart,kend
4769 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4773 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4774 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4781 end subroutine escp_soft_sphere
4782 !-----------------------------------------------------------------------------
4783 subroutine escp(evdw2,evdw2_14)
4785 ! This subroutine calculates the excluded-volume interaction energy between
4786 ! peptide-group centers and side chains and its gradient in virtual-bond and
4787 ! side-chain vectors.
4789 ! implicit real*8 (a-h,o-z)
4790 ! include 'DIMENSIONS'
4791 ! include 'COMMON.GEO'
4792 ! include 'COMMON.VAR'
4793 ! include 'COMMON.LOCAL'
4794 ! include 'COMMON.CHAIN'
4795 ! include 'COMMON.DERIV'
4796 ! include 'COMMON.INTERACT'
4797 ! include 'COMMON.FFIELD'
4798 ! include 'COMMON.IOUNITS'
4799 ! include 'COMMON.CONTROL'
4800 real(kind=8),dimension(3) :: ggg
4802 integer :: i,iint,j,k,iteli,itypj,subchap
4803 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
4805 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
4806 dist_temp, dist_init
4807 integer xshift,yshift,zshift
4811 !d print '(a)','Enter ESCP'
4812 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4813 do i=iatscp_s,iatscp_e
4814 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
4816 xi=0.5D0*(c(1,i)+c(1,i+1))
4817 yi=0.5D0*(c(2,i)+c(2,i+1))
4818 zi=0.5D0*(c(3,i)+c(3,i+1))
4820 if (xi.lt.0) xi=xi+boxxsize
4822 if (yi.lt.0) yi=yi+boxysize
4824 if (zi.lt.0) zi=zi+boxzsize
4826 do iint=1,nscp_gr(i)
4828 do j=iscpstart(i,iint),iscpend(i,iint)
4829 itypj=iabs(itype(j,1))
4830 if (itypj.eq.ntyp1) cycle
4831 ! Uncomment following three lines for SC-p interactions
4835 ! Uncomment following three lines for Ca-p interactions
4843 if (xj.lt.0) xj=xj+boxxsize
4845 if (yj.lt.0) yj=yj+boxysize
4847 if (zj.lt.0) zj=zj+boxzsize
4848 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4856 xj=xj_safe+xshift*boxxsize
4857 yj=yj_safe+yshift*boxysize
4858 zj=zj_safe+zshift*boxzsize
4859 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4860 if(dist_temp.lt.dist_init) then
4870 if (subchap.eq.1) then
4880 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4881 rij=dsqrt(1.0d0/rrij)
4882 sss_ele_cut=sscale_ele(rij)
4883 sss_ele_grad=sscagrad_ele(rij)
4884 ! print *,sss_ele_cut,sss_ele_grad,&
4885 ! (rij),r_cut_ele,rlamb_ele
4886 if (sss_ele_cut.le.0.0) cycle
4888 e1=fac*fac*aad(itypj,iteli)
4889 e2=fac*bad(itypj,iteli)
4890 if (iabs(j-i) .le. 2) then
4893 evdw2_14=evdw2_14+(e1+e2)*sss_ele_cut
4896 evdw2=evdw2+evdwij*sss_ele_cut
4897 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') &
4898 ! 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),&
4899 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4902 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
4904 fac=-(evdwij+e1)*rrij*sss_ele_cut
4905 fac=fac+evdwij*sss_ele_grad/rij/expon
4909 !grad if (j.lt.i) then
4910 !d write (iout,*) 'j<i'
4911 ! Uncomment following three lines for SC-p interactions
4913 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4916 !d write (iout,*) 'j>i'
4918 !grad ggg(k)=-ggg(k)
4919 ! Uncomment following line for SC-p interactions
4920 !cgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4921 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4925 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4927 !grad kstart=min0(i+1,j)
4928 !grad kend=max0(i-1,j-1)
4929 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4930 !d write (iout,*) ggg(1),ggg(2),ggg(3)
4931 !grad do k=kstart,kend
4933 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4937 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4938 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4946 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4947 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4948 gradx_scp(j,i)=expon*gradx_scp(j,i)
4951 !******************************************************************************
4955 ! To save time the factor EXPON has been extracted from ALL components
4956 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
4959 !******************************************************************************
4962 !-----------------------------------------------------------------------------
4963 subroutine edis(ehpb)
4965 ! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4967 ! implicit real*8 (a-h,o-z)
4968 ! include 'DIMENSIONS'
4969 ! include 'COMMON.SBRIDGE'
4970 ! include 'COMMON.CHAIN'
4971 ! include 'COMMON.DERIV'
4972 ! include 'COMMON.VAR'
4973 ! include 'COMMON.INTERACT'
4974 ! include 'COMMON.IOUNITS'
4975 real(kind=8),dimension(3) :: ggg
4977 integer :: i,j,ii,jj,iii,jjj,k
4978 real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
4981 !d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4982 !d write(iout,*)'link_start=',link_start,' link_end=',link_end
4983 if (link_end.eq.0) return
4984 do i=link_start,link_end
4985 ! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4986 ! CA-CA distance used in regularization of structure.
4989 ! iii and jjj point to the residues for which the distance is assigned.
4990 if (ii.gt.nres) then
4997 ! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4998 ! & dhpb(i),dhpb1(i),forcon(i)
4999 ! 24/11/03 AL: SS bridges handled separately because of introducing a specific
5000 ! distance and angle dependent SS bond potential.
5001 !mc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5002 ! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5003 if (.not.dyn_ss .and. i.le.nss) then
5004 ! 15/02/13 CC dynamic SSbond - additional check
5005 if (ii.gt.nres .and. iabs(itype(iii,1)).eq.1 .and. &
5006 iabs(itype(jjj,1)).eq.1) then
5007 call ssbond_ene(iii,jjj,eij)
5009 !d write (iout,*) "eij",eij
5011 else if (ii.gt.nres .and. jj.gt.nres) then
5012 !c Restraints from contact prediction
5014 if (constr_dist.eq.11) then
5015 ehpb=ehpb+fordepth(i)**4.0d0 &
5016 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5017 fac=fordepth(i)**4.0d0 &
5018 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5019 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
5022 if (dhpb1(i).gt.0.0d0) then
5023 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5024 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5025 !c write (iout,*) "beta nmr",
5026 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5030 !C Get the force constant corresponding to this distance.
5032 !C Calculate the contribution to energy.
5033 ehpb=ehpb+waga*rdis*rdis
5034 !c write (iout,*) "beta reg",dd,waga*rdis*rdis
5036 !C Evaluate gradient.
5042 ggg(j)=fac*(c(j,jj)-c(j,ii))
5045 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5046 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5049 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5050 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5054 if (constr_dist.eq.11) then
5055 ehpb=ehpb+fordepth(i)**4.0d0 &
5056 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5057 fac=fordepth(i)**4.0d0 &
5058 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5059 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
5062 if (dhpb1(i).gt.0.0d0) then
5063 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5064 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5065 !c write (iout,*) "alph nmr",
5066 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5069 !C Get the force constant corresponding to this distance.
5071 !C Calculate the contribution to energy.
5072 ehpb=ehpb+waga*rdis*rdis
5073 !c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5075 !C Evaluate gradient.
5082 ggg(j)=fac*(c(j,jj)-c(j,ii))
5084 !cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5085 !C If this is a SC-SC distance, we need to calculate the contributions to the
5086 !C Cartesian gradient in the SC vectors (ghpbx).
5089 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5090 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5093 !cgrad do j=iii,jjj-1
5095 !cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5099 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5100 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5104 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5108 !-----------------------------------------------------------------------------
5109 subroutine ssbond_ene(i,j,eij)
5111 ! Calculate the distance and angle dependent SS-bond potential energy
5112 ! using a free-energy function derived based on RHF/6-31G** ab initio
5113 ! calculations of diethyl disulfide.
5115 ! A. Liwo and U. Kozlowska, 11/24/03
5117 ! implicit real*8 (a-h,o-z)
5118 ! include 'DIMENSIONS'
5119 ! include 'COMMON.SBRIDGE'
5120 ! include 'COMMON.CHAIN'
5121 ! include 'COMMON.DERIV'
5122 ! include 'COMMON.LOCAL'
5123 ! include 'COMMON.INTERACT'
5124 ! include 'COMMON.VAR'
5125 ! include 'COMMON.IOUNITS'
5126 real(kind=8),dimension(3) :: erij,dcosom1,dcosom2,gg
5128 integer :: i,j,itypi,itypj,k
5129 real(kind=8) :: eij,rij,rrij,xi,yi,zi,dxi,dyi,dzi,dsci_inv,&
5130 xj,yj,zj,dxj,dyj,dzj,om1,om2,om12,deltad,dscj_inv,&
5131 deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,&
5134 itypi=iabs(itype(i,1))
5138 dxi=dc_norm(1,nres+i)
5139 dyi=dc_norm(2,nres+i)
5140 dzi=dc_norm(3,nres+i)
5141 ! dsci_inv=dsc_inv(itypi)
5142 dsci_inv=vbld_inv(nres+i)
5143 itypj=iabs(itype(j,1))
5144 ! dscj_inv=dsc_inv(itypj)
5145 dscj_inv=vbld_inv(nres+j)
5149 dxj=dc_norm(1,nres+j)
5150 dyj=dc_norm(2,nres+j)
5151 dzj=dc_norm(3,nres+j)
5152 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5157 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5158 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5159 om12=dxi*dxj+dyi*dyj+dzi*dzj
5161 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5162 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5168 deltat12=om2-om1+2.0d0
5170 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
5171 +akct*deltad*deltat12 &
5172 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5173 ! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5174 ! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5175 ! & " deltat12",deltat12," eij",eij
5176 ed=2*akcm*deltad+akct*deltat12
5178 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5179 eom1=-2*akth*deltat1-pom1-om2*pom2
5180 eom2= 2*akth*deltat2+pom1-om1*pom2
5183 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5184 ghpbx(k,i)=ghpbx(k,i)-ggk &
5185 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
5186 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5187 ghpbx(k,j)=ghpbx(k,j)+ggk &
5188 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
5189 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5190 ghpbc(k,i)=ghpbc(k,i)-ggk
5191 ghpbc(k,j)=ghpbc(k,j)+ggk
5194 ! Calculate the components of the gradient in DC and X
5198 !grad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5202 end subroutine ssbond_ene
5203 !-----------------------------------------------------------------------------
5204 subroutine ebond(estr)
5206 ! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5208 ! implicit real*8 (a-h,o-z)
5209 ! include 'DIMENSIONS'
5210 ! include 'COMMON.LOCAL'
5211 ! include 'COMMON.GEO'
5212 ! include 'COMMON.INTERACT'
5213 ! include 'COMMON.DERIV'
5214 ! include 'COMMON.VAR'
5215 ! include 'COMMON.CHAIN'
5216 ! include 'COMMON.IOUNITS'
5217 ! include 'COMMON.NAMES'
5218 ! include 'COMMON.FFIELD'
5219 ! include 'COMMON.CONTROL'
5220 ! include 'COMMON.SETUP'
5221 real(kind=8),dimension(3) :: u,ud
5223 integer :: i,j,iti,nbi,k
5224 real(kind=8) :: estr,estr1,diff,uprod,usum,usumsqder,&
5229 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
5230 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
5232 do i=ibondp_start,ibondp_end
5233 if (itype(i-1,1).eq.ntyp1 .and. itype(i,1).eq.ntyp1) cycle
5234 if (itype(i-1,1).eq.ntyp1 .or. itype(i,1).eq.ntyp1) then
5235 !C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5237 !C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) &
5238 !C *dc(j,i-1)/vbld(i)
5240 !C if (energy_dec) write(iout,*) &
5241 !C "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5242 diff = vbld(i)-vbldpDUM
5244 diff = vbld(i)-vbldp0
5246 if (energy_dec) write (iout,'(a7,i5,4f7.3)') &
5247 "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5250 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5252 ! write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5255 estr=0.5d0*AKP*estr+estr1
5256 ! print *,"estr_bb",estr,AKP
5258 ! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5260 do i=ibond_start,ibond_end
5261 iti=iabs(itype(i,1))
5262 if (iti.eq.0) print *,"WARNING WRONG SETTTING",i
5263 if (iti.ne.10 .and. iti.ne.ntyp1) then
5266 diff=vbld(i+nres)-vbldsc0(1,iti)
5267 if (energy_dec) write (iout,*) &
5268 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5269 AKSC(1,iti),AKSC(1,iti)*diff*diff
5270 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5271 ! print *,"estr_sc",estr
5273 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5277 diff=vbld(i+nres)-vbldsc0(j,iti)
5278 ud(j)=aksc(j,iti)*diff
5279 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5293 uprod2=uprod2*u(k)*u(k)
5297 usumsqder=usumsqder+ud(j)*uprod2
5299 estr=estr+uprod/usum
5300 ! print *,"estr_sc",estr,i
5302 if (energy_dec) write (iout,*) &
5303 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5304 AKSC(1,iti),uprod/usum
5306 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5312 end subroutine ebond
5314 !-----------------------------------------------------------------------------
5315 subroutine ebend(etheta)
5317 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5318 ! angles gamma and its derivatives in consecutive thetas and gammas.
5321 ! implicit real*8 (a-h,o-z)
5322 ! include 'DIMENSIONS'
5323 ! include 'COMMON.LOCAL'
5324 ! include 'COMMON.GEO'
5325 ! include 'COMMON.INTERACT'
5326 ! include 'COMMON.DERIV'
5327 ! include 'COMMON.VAR'
5328 ! include 'COMMON.CHAIN'
5329 ! include 'COMMON.IOUNITS'
5330 ! include 'COMMON.NAMES'
5331 ! include 'COMMON.FFIELD'
5332 ! include 'COMMON.CONTROL'
5333 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5334 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5335 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5337 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5338 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5339 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5341 integer :: i,k,ichir1,ichir2,itype1,ichir11,ichir12,itype2,&
5343 real(kind=8) :: etheta,delta,ss,ssd,phii,phii1,thet_pred_mean,&
5344 athetk,bthetk,dthett,dthetg1,dthetg2,f0,fprim0,E_tc0,fprim_tc0,&
5345 f1,fprim1,E_tc1,ethetai,E_theta,E_tc
5346 real(kind=8),dimension(2) :: y,z
5349 ! time11=dexp(-2*time)
5352 ! write (*,'(a,i2)') 'EBEND ICG=',icg
5353 do i=ithet_start,ithet_end
5354 if (itype(i-1,1).eq.ntyp1) cycle
5355 ! Zero the energy function and its derivative at 0 or pi.
5356 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5358 ichir1=isign(1,itype(i-2,1))
5359 ichir2=isign(1,itype(i,1))
5360 if (itype(i-2,1).eq.10) ichir1=isign(1,itype(i-1,1))
5361 if (itype(i,1).eq.10) ichir2=isign(1,itype(i-1,1))
5362 if (itype(i-1,1).eq.10) then
5363 itype1=isign(10,itype(i-2,1))
5364 ichir11=isign(1,itype(i-2,1))
5365 ichir12=isign(1,itype(i-2,1))
5366 itype2=isign(10,itype(i,1))
5367 ichir21=isign(1,itype(i,1))
5368 ichir22=isign(1,itype(i,1))
5371 if (i.gt.3 .and. itype(i-2,1).ne.ntyp1) then
5374 if (phii.ne.phii) phii=150.0
5384 if (i.lt.nres .and. itype(i,1).ne.ntyp1) then
5387 if (phii1.ne.phii1) phii1=150.0
5399 ! Calculate the "mean" value of theta from the part of the distribution
5400 ! dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5401 ! In following comments this theta will be referred to as t_c.
5402 thet_pred_mean=0.0d0
5404 athetk=athet(k,it,ichir1,ichir2)
5405 bthetk=bthet(k,it,ichir1,ichir2)
5407 athetk=athet(k,itype1,ichir11,ichir12)
5408 bthetk=bthet(k,itype2,ichir21,ichir22)
5410 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5412 dthett=thet_pred_mean*ssd
5413 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5414 ! Derivatives of the "mean" values in gamma1 and gamma2.
5415 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) &
5416 +athet(2,it,ichir1,ichir2)*y(1))*ss
5417 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) &
5418 +bthet(2,it,ichir1,ichir2)*z(1))*ss
5420 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) &
5421 +athet(2,itype1,ichir11,ichir12)*y(1))*ss
5422 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) &
5423 +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5425 if (theta(i).gt.pi-delta) then
5426 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,&
5428 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5429 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5430 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,&
5432 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,&
5434 else if (theta(i).lt.delta) then
5435 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5436 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5437 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,&
5439 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5440 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,&
5443 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,&
5446 etheta=etheta+ethetai
5447 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5449 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5450 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5451 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
5453 ! Ufff.... We've done all this!!!
5455 end subroutine ebend
5456 !-----------------------------------------------------------------------------
5457 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
5460 ! implicit real*8 (a-h,o-z)
5461 ! include 'DIMENSIONS'
5462 ! include 'COMMON.LOCAL'
5463 ! include 'COMMON.IOUNITS'
5464 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
5465 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5466 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
5468 real(kind=8) :: thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc
5470 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
5471 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
5472 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5474 real(kind=8) :: sig,fac,escloci0,escloci1,esclocbi0,dersc12,&
5475 esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5477 ! Calculate the contributions to both Gaussian lobes.
5478 ! 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5479 ! The "polynomial part" of the "standard deviation" of this part of
5483 sig=sig*thet_pred_mean+polthet(j,it)
5485 ! Derivative of the "interior part" of the "standard deviation of the"
5486 ! gamma-dependent Gaussian lobe in t_c.
5487 sigtc=3*polthet(3,it)
5489 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5492 ! Set the parameters of both Gaussian lobes of the distribution.
5493 ! "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5494 fac=sig*sig+sigc0(it)
5497 ! Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5498 sigsqtc=-4.0D0*sigcsq*sigtc
5499 ! print *,i,sig,sigtc,sigsqtc
5500 ! Following variable (sigtc) is d[sigma(t_c)]/dt_c
5501 sigtc=-sigtc/(fac*fac)
5502 ! Following variable is sigma(t_c)**(-2)
5503 sigcsq=sigcsq*sigcsq
5505 sig0inv=1.0D0/sig0i**2
5506 delthec=thetai-thet_pred_mean
5507 delthe0=thetai-theta0i
5508 term1=-0.5D0*sigcsq*delthec*delthec
5509 term2=-0.5D0*sig0inv*delthe0*delthe0
5510 ! Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5511 ! NaNs in taking the logarithm. We extract the largest exponent which is added
5512 ! to the energy (this being the log of the distribution) at the end of energy
5513 ! term evaluation for this virtual-bond angle.
5514 if (term1.gt.term2) then
5516 term2=dexp(term2-termm)
5520 term1=dexp(term1-termm)
5523 ! The ratio between the gamma-independent and gamma-dependent lobes of
5524 ! the distribution is a Gaussian function of thet_pred_mean too.
5525 diffak=gthet(2,it)-thet_pred_mean
5526 ratak=diffak/gthet(3,it)**2
5527 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5528 ! Let's differentiate it in thet_pred_mean NOW.
5530 ! Now put together the distribution terms to make complete distribution.
5531 termexp=term1+ak*term2
5532 termpre=sigc+ak*sig0i
5533 ! Contribution of the bending energy from this theta is just the -log of
5534 ! the sum of the contributions from the two lobes and the pre-exponential
5535 ! factor. Simple enough, isn't it?
5536 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5537 ! NOW the derivatives!!!
5538 ! 6/6/97 Take into account the deformation.
5539 E_theta=(delthec*sigcsq*term1 &
5540 +ak*delthe0*sig0inv*term2)/termexp
5541 E_tc=((sigtc+aktc*sig0i)/termpre &
5542 -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ &
5543 aktc*term2)/termexp)
5545 end subroutine theteng
5547 !-----------------------------------------------------------------------------
5548 subroutine ebend(etheta,ethetacnstr)
5550 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5551 ! angles gamma and its derivatives in consecutive thetas and gammas.
5552 ! ab initio-derived potentials from
5553 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5555 ! implicit real*8 (a-h,o-z)
5556 ! include 'DIMENSIONS'
5557 ! include 'COMMON.LOCAL'
5558 ! include 'COMMON.GEO'
5559 ! include 'COMMON.INTERACT'
5560 ! include 'COMMON.DERIV'
5561 ! include 'COMMON.VAR'
5562 ! include 'COMMON.CHAIN'
5563 ! include 'COMMON.IOUNITS'
5564 ! include 'COMMON.NAMES'
5565 ! include 'COMMON.FFIELD'
5566 ! include 'COMMON.CONTROL'
5567 real(kind=8),dimension(nntheterm) :: coskt,sinkt !mmaxtheterm
5568 real(kind=8),dimension(nsingle) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
5569 real(kind=8),dimension(ndouble,ndouble) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
5570 logical :: lprn=.false., lprn1=.false.
5572 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
5573 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
5574 real(kind=8) :: aux,etheta,ccl,ssl,scl,csl,ethetacnstr
5575 ! local variables for constrains
5576 real(kind=8) :: difi,thetiii
5580 do i=ithet_start,ithet_end
5581 if (itype(i-1,1).eq.ntyp1) cycle
5582 if (itype(i-2,1).eq.ntyp1.or.itype(i,1).eq.ntyp1) cycle
5583 if (iabs(itype(i+1,1)).eq.20) iblock=2
5584 if (iabs(itype(i+1,1)).ne.20) iblock=1
5588 theti2=0.5d0*theta(i)
5589 ityp2=ithetyp((itype(i-1,1)))
5591 coskt(k)=dcos(k*theti2)
5592 sinkt(k)=dsin(k*theti2)
5594 if (i.gt.3 .and. itype(max0(i-3,1),1).ne.ntyp1) then
5597 if (phii.ne.phii) phii=150.0
5601 ityp1=ithetyp((itype(i-2,1)))
5602 ! propagation of chirality for glycine type
5604 cosph1(k)=dcos(k*phii)
5605 sinph1(k)=dsin(k*phii)
5609 ityp1=ithetyp(itype(i-2,1))
5615 if (i.lt.nres .and. itype(i+1,1).ne.ntyp1) then
5618 if (phii1.ne.phii1) phii1=150.0
5623 ityp3=ithetyp((itype(i,1)))
5625 cosph2(k)=dcos(k*phii1)
5626 sinph2(k)=dsin(k*phii1)
5630 ityp3=ithetyp(itype(i,1))
5636 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5639 ccl=cosph1(l)*cosph2(k-l)
5640 ssl=sinph1(l)*sinph2(k-l)
5641 scl=sinph1(l)*cosph2(k-l)
5642 csl=cosph1(l)*sinph2(k-l)
5643 cosph1ph2(l,k)=ccl-ssl
5644 cosph1ph2(k,l)=ccl+ssl
5645 sinph1ph2(l,k)=scl+csl
5646 sinph1ph2(k,l)=scl-csl
5650 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
5651 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5652 write (iout,*) "coskt and sinkt"
5654 write (iout,*) k,coskt(k),sinkt(k)
5658 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5659 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) &
5662 write (iout,*) "k",k,&
5663 "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),&
5667 write (iout,*) "cosph and sinph"
5669 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5671 write (iout,*) "cosph1ph2 and sinph2ph2"
5674 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
5675 sinph1ph2(l,k),sinph1ph2(k,l)
5678 write(iout,*) "ethetai",ethetai
5682 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) &
5683 +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) &
5684 +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) &
5685 +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5686 ethetai=ethetai+sinkt(m)*aux
5687 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5688 dephii=dephii+k*sinkt(m)* &
5689 (ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- &
5690 bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5691 dephii1=dephii1+k*sinkt(m)* &
5692 (eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- &
5693 ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5695 write (iout,*) "m",m," k",k," bbthet", &
5696 bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", &
5697 ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", &
5698 ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", &
5699 eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5703 write(iout,*) "ethetai",ethetai
5707 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
5708 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ &
5709 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
5710 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5711 ethetai=ethetai+sinkt(m)*aux
5712 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5713 dephii=dephii+l*sinkt(m)* &
5714 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- &
5715 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
5716 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
5717 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5718 dephii1=dephii1+(k-l)*sinkt(m)* &
5719 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
5720 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
5721 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- &
5722 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5724 write (iout,*) "m",m," k",k," l",l," ffthet",&
5725 ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
5726 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",&
5727 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
5728 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),&
5730 write (iout,*) cosph1ph2(l,k)*sinkt(m),&
5731 cosph1ph2(k,l)*sinkt(m),&
5732 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5740 write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
5741 i,theta(i)*rad2deg,phii*rad2deg,&
5742 phii1*rad2deg,ethetai
5744 etheta=etheta+ethetai
5745 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5747 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5748 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5749 gloc(nphi+i-2,icg)=wang*dethetai
5751 !-----------thete constrains
5752 ! if (tor_mode.ne.2) then
5754 !C print *,ithetaconstr_start,ithetaconstr_end,"TU"
5755 do i=ithetaconstr_start,ithetaconstr_end
5756 itheta=itheta_constr(i)
5757 thetiii=theta(itheta)
5758 difi=pinorm(thetiii-theta_constr0(i))
5759 if (difi.gt.theta_drange(i)) then
5760 difi=difi-theta_drange(i)
5761 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5762 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
5763 +for_thet_constr(i)*difi**3
5764 else if (difi.lt.-drange(i)) then
5766 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5767 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
5768 +for_thet_constr(i)*difi**3
5772 if (energy_dec) then
5773 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc", &
5774 i,itheta,rad2deg*thetiii, &
5775 rad2deg*theta_constr0(i), rad2deg*theta_drange(i), &
5776 rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4, &
5777 gloc(itheta+nphi-2,icg)
5783 end subroutine ebend
5786 !-----------------------------------------------------------------------------
5787 subroutine esc(escloc)
5788 ! Calculate the local energy of a side chain and its derivatives in the
5789 ! corresponding virtual-bond valence angles THETA and the spherical angles
5793 ! implicit real*8 (a-h,o-z)
5794 ! include 'DIMENSIONS'
5795 ! include 'COMMON.GEO'
5796 ! include 'COMMON.LOCAL'
5797 ! include 'COMMON.VAR'
5798 ! include 'COMMON.INTERACT'
5799 ! include 'COMMON.DERIV'
5800 ! include 'COMMON.CHAIN'
5801 ! include 'COMMON.IOUNITS'
5802 ! include 'COMMON.NAMES'
5803 ! include 'COMMON.FFIELD'
5804 ! include 'COMMON.CONTROL'
5805 real(kind=8),dimension(3) :: x,dersc,xemp,dersc0,dersc1,&
5806 ddersc0,ddummy,xtemp,temp
5807 !el real(kind=8) :: time11,time12,time112,theti
5808 real(kind=8) :: escloc,delta
5809 !el integer :: it,nlobit
5810 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5813 real(kind=8) :: escloci0,escloci1,escloci,esclocbi0,&
5814 dersc12,esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
5817 ! write (iout,'(a)') 'ESC'
5818 do i=loc_start,loc_end
5820 if (it.eq.ntyp1) cycle
5821 if (it.eq.10) goto 1
5822 nlobit=nlob(iabs(it))
5823 ! print *,'i=',i,' it=',it,' nlobit=',nlobit
5824 ! write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5825 theti=theta(i+1)-pipol
5830 if (x(2).gt.pi-delta) then
5834 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5836 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5837 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),&
5839 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
5840 ddersc0(1),dersc(1))
5841 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),&
5842 ddersc0(3),dersc(3))
5844 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5846 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5847 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,&
5848 dersc0(2),esclocbi,dersc02)
5849 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
5851 call splinthet(x(2),0.5d0*delta,ss,ssd)
5856 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5858 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5859 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5861 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5863 ! write (iout,*) escloci
5864 else if (x(2).lt.delta) then
5868 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5870 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5871 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),&
5873 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
5874 ddersc0(1),dersc(1))
5875 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),&
5876 ddersc0(3),dersc(3))
5878 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5880 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5881 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,&
5882 dersc0(2),esclocbi,dersc02)
5883 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
5888 call splinthet(x(2),0.5d0*delta,ss,ssd)
5890 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5892 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5893 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5895 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5896 ! write (iout,*) escloci
5898 call enesc(x,escloci,dersc,ddummy,.false.)
5901 escloc=escloc+escloci
5902 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
5904 ! write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5906 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ &
5908 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5909 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5914 !-----------------------------------------------------------------------------
5915 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5918 ! implicit real*8 (a-h,o-z)
5919 ! include 'DIMENSIONS'
5920 ! include 'COMMON.GEO'
5921 ! include 'COMMON.LOCAL'
5922 ! include 'COMMON.IOUNITS'
5923 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
5924 real(kind=8),dimension(3) :: x,z,dersc,ddersc
5925 real(kind=8),dimension(3,nlobit,-1:1) :: Ax !(3,maxlob,-1:1)
5926 real(kind=8),dimension(nlobit,-1:1) :: contr !(maxlob,-1:1)
5927 real(kind=8) :: escloci
5930 integer :: j,iii,l,k !el,it,nlobit
5931 real(kind=8) :: escloc_i,x3,Axk,expfac,emin !el,theti,&
5932 !el time11,time12,time112
5933 ! write (iout,*) 'it=',it,' nlobit=',nlobit
5937 if (mixed) ddersc(j)=0.0d0
5941 ! Because of periodicity of the dependence of the SC energy in omega we have
5942 ! to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5943 ! To avoid underflows, first compute & store the exponents.
5951 z(k)=x(k)-censc(k,j,it)
5956 Axk=Axk+gaussc(l,k,j,it)*z(l)
5962 expfac=expfac+Ax(k,j,iii)*z(k)
5970 ! As in the case of ebend, we want to avoid underflows in exponentiation and
5971 ! subsequent NaNs and INFs in energy calculation.
5972 ! Find the largest exponent
5976 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5980 !d print *,'it=',it,' emin=',emin
5982 ! Compute the contribution to SC energy and derivatives
5987 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5988 if(adexp.ne.adexp) adexp=1.0
5991 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5993 !d print *,'j=',j,' expfac=',expfac
5994 escloc_i=escloc_i+expfac
5996 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6000 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) &
6001 +gaussc(k,2,j,it))*expfac
6008 dersc(1)=dersc(1)/cos(theti)**2
6009 ddersc(1)=ddersc(1)/cos(theti)**2
6012 escloci=-(dlog(escloc_i)-emin)
6014 dersc(j)=dersc(j)/escloc_i
6018 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6022 end subroutine enesc
6023 !-----------------------------------------------------------------------------
6024 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6027 ! implicit real*8 (a-h,o-z)
6028 ! include 'DIMENSIONS'
6029 ! include 'COMMON.GEO'
6030 ! include 'COMMON.LOCAL'
6031 ! include 'COMMON.IOUNITS'
6032 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6033 real(kind=8),dimension(3) :: x,z,dersc
6034 real(kind=8),dimension(3,nlobit) :: Ax !(3,maxlob)
6035 real(kind=8),dimension(nlobit) :: contr !(maxlob)
6036 real(kind=8) :: escloci,dersc12,emin
6039 integer :: j,k,l !el,it,nlobit
6040 real(kind=8) :: escloc_i,Axk,expfac !el,time11,time12,time112,theti
6050 z(k)=x(k)-censc(k,j,it)
6056 Axk=Axk+gaussc(l,k,j,it)*z(l)
6062 expfac=expfac+Ax(k,j)*z(k)
6067 ! As in the case of ebend, we want to avoid underflows in exponentiation and
6068 ! subsequent NaNs and INFs in energy calculation.
6069 ! Find the largest exponent
6072 if (emin.gt.contr(j)) emin=contr(j)
6076 ! Compute the contribution to SC energy and derivatives
6080 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6081 escloc_i=escloc_i+expfac
6083 dersc(k)=dersc(k)+Ax(k,j)*expfac
6085 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) &
6086 +gaussc(1,2,j,it))*expfac
6090 dersc(1)=dersc(1)/cos(theti)**2
6091 dersc12=dersc12/cos(theti)**2
6092 escloci=-(dlog(escloc_i)-emin)
6094 dersc(j)=dersc(j)/escloc_i
6096 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6098 end subroutine enesc_bound
6100 !-----------------------------------------------------------------------------
6101 subroutine esc(escloc)
6102 ! Calculate the local energy of a side chain and its derivatives in the
6103 ! corresponding virtual-bond valence angles THETA and the spherical angles
6104 ! ALPHA and OMEGA derived from AM1 all-atom calculations.
6105 ! added by Urszula Kozlowska. 07/11/2007
6108 ! implicit real*8 (a-h,o-z)
6109 ! include 'DIMENSIONS'
6110 ! include 'COMMON.GEO'
6111 ! include 'COMMON.LOCAL'
6112 ! include 'COMMON.VAR'
6113 ! include 'COMMON.SCROT'
6114 ! include 'COMMON.INTERACT'
6115 ! include 'COMMON.DERIV'
6116 ! include 'COMMON.CHAIN'
6117 ! include 'COMMON.IOUNITS'
6118 ! include 'COMMON.NAMES'
6119 ! include 'COMMON.FFIELD'
6120 ! include 'COMMON.CONTROL'
6121 ! include 'COMMON.VECTORS'
6122 real(kind=8),dimension(3) :: x_prime,y_prime,z_prime
6123 real(kind=8),dimension(65) :: x
6124 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1,sumene2,sumene3,&
6125 sumene4,s1,s1_6,s2,s2_6,de_dxx,de_dyy,de_dzz,de_dt
6126 real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
6127 real(kind=8),dimension(3) :: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,dYY_Ci,&
6128 dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
6130 integer :: i,j,k !el,it,nlobit
6131 real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
6132 !el real(kind=8) :: time11,time12,time112,theti
6133 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6134 real(kind=8) :: dscp1,dscp2,pom_s1,pom_s16,pom_s2,pom_s26,&
6135 pom,pom_dx,pom_dy,pom_dt1,pom_dt2,pom1,pom2,&
6136 sumene1x,sumene2x,sumene3x,sumene4x,&
6137 sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,&
6140 real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,&
6141 de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,&
6144 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
6148 do i=loc_start,loc_end
6149 if (itype(i,1).eq.ntyp1) cycle
6150 costtab(i+1) =dcos(theta(i+1))
6151 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6152 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6153 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6154 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6155 cosfac=dsqrt(cosfac2)
6156 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6157 sinfac=dsqrt(sinfac2)
6159 if (it.eq.10) goto 1
6161 ! Compute the axes of tghe local cartesian coordinates system; store in
6162 ! x_prime, y_prime and z_prime
6169 ! write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6170 ! & dc_norm(3,i+nres)
6172 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6173 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6176 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i,1)))
6179 ! write (2,*) "x_prime",(x_prime(j),j=1,3)
6180 ! write (2,*) "y_prime",(y_prime(j),j=1,3)
6181 ! write (2,*) "z_prime",(z_prime(j),j=1,3)
6182 ! write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6183 ! & " xy",scalar(x_prime(1),y_prime(1)),
6184 ! & " xz",scalar(x_prime(1),z_prime(1)),
6185 ! & " yy",scalar(y_prime(1),y_prime(1)),
6186 ! & " yz",scalar(y_prime(1),z_prime(1)),
6187 ! & " zz",scalar(z_prime(1),z_prime(1))
6189 ! Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6190 ! to local coordinate system. Store in xx, yy, zz.
6196 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6197 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6198 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6205 ! Compute the energy of the ith side cbain
6207 ! write (2,*) "xx",xx," yy",yy," zz",zz
6210 x(j) = sc_parmin(j,it)
6213 !c diagnostics - remove later
6215 yy1 = dsin(alph(2))*dcos(omeg(2))
6216 zz1 = -dsign(1.0,dfloat(itype(i,1)))*dsin(alph(2))*dsin(omeg(2))
6217 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
6218 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
6220 !," --- ", xx_w,yy_w,zz_w
6223 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6224 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6226 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6227 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6229 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6230 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6231 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6232 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6233 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6235 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6236 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6237 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6238 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6239 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6241 dsc_i = 0.743d0+x(61)
6243 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6244 *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6245 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6246 *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6247 s1=(1+x(63))/(0.1d0 + dscp1)
6248 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6249 s2=(1+x(65))/(0.1d0 + dscp2)
6250 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6251 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) &
6252 + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6253 ! write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6255 ! & dscp1,dscp2,sumene
6256 ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6257 escloc = escloc + sumene
6258 ! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i,1)
6263 ! This section to check the numerical derivatives of the energy of ith side
6264 ! chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6265 ! #define DEBUG in the code to turn it on.
6267 write (2,*) "sumene =",sumene
6271 write (2,*) xx,yy,zz
6272 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6273 de_dxx_num=(sumenep-sumene)/aincr
6275 write (2,*) "xx+ sumene from enesc=",sumenep
6278 write (2,*) xx,yy,zz
6279 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6280 de_dyy_num=(sumenep-sumene)/aincr
6282 write (2,*) "yy+ sumene from enesc=",sumenep
6285 write (2,*) xx,yy,zz
6286 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6287 de_dzz_num=(sumenep-sumene)/aincr
6289 write (2,*) "zz+ sumene from enesc=",sumenep
6290 costsave=cost2tab(i+1)
6291 sintsave=sint2tab(i+1)
6292 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6293 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6294 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6295 de_dt_num=(sumenep-sumene)/aincr
6296 write (2,*) " t+ sumene from enesc=",sumenep
6297 cost2tab(i+1)=costsave
6298 sint2tab(i+1)=sintsave
6299 ! End of diagnostics section.
6302 ! Compute the gradient of esc
6304 ! zz=zz*dsign(1.0,dfloat(itype(i,1)))
6305 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6306 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6307 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6308 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6309 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6310 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6311 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6312 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6313 pom1=(sumene3*sint2tab(i+1)+sumene1) &
6314 *(pom_s1/dscp1+pom_s16*dscp1**4)
6315 pom2=(sumene4*cost2tab(i+1)+sumene2) &
6316 *(pom_s2/dscp2+pom_s26*dscp2**4)
6317 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6318 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 &
6319 +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) &
6321 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6322 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 &
6323 +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) &
6325 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) &
6326 +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
6329 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i,1)
6332 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6333 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 &
6334 +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) &
6336 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6337 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz &
6338 +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz &
6339 +x(59)*zz**2 +x(60)*xx*zz
6340 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) &
6341 +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
6344 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i,1)
6347 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
6348 +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx &
6349 +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) &
6350 +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) &
6351 +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 &
6352 +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy &
6353 +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
6354 + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6356 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i,1)
6359 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
6360 -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
6361 +pom1*pom_dt1+pom2*pom_dt2
6363 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i,1)
6367 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6368 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6369 cosfac2xx=cosfac2*xx
6370 sinfac2yy=sinfac2*yy
6372 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* &
6374 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* &
6376 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6377 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6378 ! write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6379 ! & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6380 ! write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6381 ! & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6382 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6383 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6384 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6385 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6389 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
6390 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
6391 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
6392 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
6395 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6396 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6397 dZZ_XYZ(k)=vbld_inv(i+nres)* &
6398 (z_prime(k)-zz*dC_norm(k,i+nres))
6400 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6401 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6405 dXX_Ctab(k,i)=dXX_Ci(k)
6406 dXX_C1tab(k,i)=dXX_Ci1(k)
6407 dYY_Ctab(k,i)=dYY_Ci(k)
6408 dYY_C1tab(k,i)=dYY_Ci1(k)
6409 dZZ_Ctab(k,i)=dZZ_Ci(k)
6410 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6411 dXX_XYZtab(k,i)=dXX_XYZ(k)
6412 dYY_XYZtab(k,i)=dYY_XYZ(k)
6413 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6417 ! write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6418 ! & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6419 ! write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6420 ! & dyy_ci(k)," dzz_ci",dzz_ci(k)
6421 ! write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6423 ! write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6424 ! & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6425 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) &
6426 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6427 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) &
6428 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6429 gsclocx(k,i)= de_dxx*dxx_XYZ(k) &
6430 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6432 ! write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6433 ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6435 ! to check gradient call subroutine check_grad
6441 !-----------------------------------------------------------------------------
6442 real(kind=8) function enesc(x,xx,yy,zz,cost2,sint2)
6444 real(kind=8),dimension(65) :: x
6445 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2,sumene3,&
6446 sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6448 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6449 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6451 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6452 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6454 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6455 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6456 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6457 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6458 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6460 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6461 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6462 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6463 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6464 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6466 dsc_i = 0.743d0+x(61)
6468 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6469 *(xx*cost2+yy*sint2))
6470 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6471 *(xx*cost2-yy*sint2))
6472 s1=(1+x(63))/(0.1d0 + dscp1)
6473 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6474 s2=(1+x(65))/(0.1d0 + dscp2)
6475 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6476 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) &
6477 + (sumene4*cost2 +sumene2)*(s2+s2_6)
6482 !-----------------------------------------------------------------------------
6483 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6485 ! This procedure calculates two-body contact function g(rij) and its derivative:
6488 ! g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6491 ! where x=(rij-r0ij)/delta
6493 ! rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6496 real(kind=8) :: rij,r0ij,eps0ij,fcont,fprimcont
6497 real(kind=8) :: x,x2,x4,delta
6501 if (x.lt.-1.0D0) then
6504 else if (x.le.1.0D0) then
6507 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6508 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6514 end subroutine gcont
6515 !-----------------------------------------------------------------------------
6516 subroutine splinthet(theti,delta,ss,ssder)
6517 ! implicit real*8 (a-h,o-z)
6518 ! include 'DIMENSIONS'
6519 ! include 'COMMON.VAR'
6520 ! include 'COMMON.GEO'
6521 real(kind=8) :: theti,delta,ss,ssder
6522 real(kind=8) :: thetup,thetlow
6525 if (theti.gt.pipol) then
6526 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6528 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6532 end subroutine splinthet
6533 !-----------------------------------------------------------------------------
6534 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6536 real(kind=8) :: x,x0,delta,f0,f1,fprim0,f,fprim
6537 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6538 a1=fprim0*delta/(f1-f0)
6544 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6545 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6547 end subroutine spline1
6548 !-----------------------------------------------------------------------------
6549 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6551 real(kind=8) :: x,x0,delta,f0x,f1x,fprim0x,fx
6552 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
6557 a2=3*(f1x-f0x)-2*fprim0x*delta
6558 a3=fprim0x*delta-2*(f1x-f0x)
6559 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6561 end subroutine spline2
6562 !-----------------------------------------------------------------------------
6564 !-----------------------------------------------------------------------------
6565 subroutine etor(etors,edihcnstr)
6566 ! implicit real*8 (a-h,o-z)
6567 ! include 'DIMENSIONS'
6568 ! include 'COMMON.VAR'
6569 ! include 'COMMON.GEO'
6570 ! include 'COMMON.LOCAL'
6571 ! include 'COMMON.TORSION'
6572 ! include 'COMMON.INTERACT'
6573 ! include 'COMMON.DERIV'
6574 ! include 'COMMON.CHAIN'
6575 ! include 'COMMON.NAMES'
6576 ! include 'COMMON.IOUNITS'
6577 ! include 'COMMON.FFIELD'
6578 ! include 'COMMON.TORCNSTR'
6579 ! include 'COMMON.CONTROL'
6580 real(kind=8) :: etors,edihcnstr
6584 real(kind=8) :: phii,fac,etors_ii
6586 ! Set lprn=.true. for debugging
6590 do i=iphi_start,iphi_end
6592 if (itype(i-2,1).eq.ntyp1.or. itype(i-1,1).eq.ntyp1 &
6593 .or. itype(i,1).eq.ntyp1) cycle
6594 itori=itortyp(itype(i-2,1))
6595 itori1=itortyp(itype(i-1,1))
6598 ! Proline-Proline pair is a special case...
6599 if (itori.eq.3 .and. itori1.eq.3) then
6600 if (phii.gt.-dwapi3) then
6602 fac=1.0D0/(1.0D0-cosphi)
6603 etorsi=v1(1,3,3)*fac
6604 etorsi=etorsi+etorsi
6605 etors=etors+etorsi-v1(1,3,3)
6606 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6607 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6610 v1ij=v1(j+1,itori,itori1)
6611 v2ij=v2(j+1,itori,itori1)
6614 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6615 if (energy_dec) etors_ii=etors_ii+ &
6616 v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6617 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6621 v1ij=v1(j,itori,itori1)
6622 v2ij=v2(j,itori,itori1)
6625 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6626 if (energy_dec) etors_ii=etors_ii+ &
6627 v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6628 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6631 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6634 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6635 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
6636 (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6637 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6638 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6640 ! 6/20/98 - dihedral angle constraints
6643 itori=idih_constr(i)
6646 if (difi.gt.drange(i)) then
6648 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6649 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6650 else if (difi.lt.-drange(i)) then
6652 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6653 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6655 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6656 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6658 ! write (iout,*) 'edihcnstr',edihcnstr
6661 !-----------------------------------------------------------------------------
6662 subroutine etor_d(etors_d)
6663 real(kind=8) :: etors_d
6666 end subroutine etor_d
6668 !-----------------------------------------------------------------------------
6669 subroutine etor(etors,edihcnstr)
6670 ! implicit real*8 (a-h,o-z)
6671 ! include 'DIMENSIONS'
6672 ! include 'COMMON.VAR'
6673 ! include 'COMMON.GEO'
6674 ! include 'COMMON.LOCAL'
6675 ! include 'COMMON.TORSION'
6676 ! include 'COMMON.INTERACT'
6677 ! include 'COMMON.DERIV'
6678 ! include 'COMMON.CHAIN'
6679 ! include 'COMMON.NAMES'
6680 ! include 'COMMON.IOUNITS'
6681 ! include 'COMMON.FFIELD'
6682 ! include 'COMMON.TORCNSTR'
6683 ! include 'COMMON.CONTROL'
6684 real(kind=8) :: etors,edihcnstr
6687 integer :: i,j,iblock,itori,itori1
6688 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
6689 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
6690 ! Set lprn=.true. for debugging
6694 do i=iphi_start,iphi_end
6695 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
6696 .or. itype(i-3,1).eq.ntyp1 &
6697 .or. itype(i,1).eq.ntyp1) cycle
6699 if (iabs(itype(i,1)).eq.20) then
6704 itori=itortyp(itype(i-2,1))
6705 itori1=itortyp(itype(i-1,1))
6708 ! Regular cosine and sine terms
6709 do j=1,nterm(itori,itori1,iblock)
6710 v1ij=v1(j,itori,itori1,iblock)
6711 v2ij=v2(j,itori,itori1,iblock)
6714 etors=etors+v1ij*cosphi+v2ij*sinphi
6715 if (energy_dec) etors_ii=etors_ii+ &
6716 v1ij*cosphi+v2ij*sinphi
6717 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6721 ! E = SUM ----------------------------------- - v1
6722 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6724 cosphi=dcos(0.5d0*phii)
6725 sinphi=dsin(0.5d0*phii)
6726 do j=1,nlor(itori,itori1,iblock)
6727 vl1ij=vlor1(j,itori,itori1)
6728 vl2ij=vlor2(j,itori,itori1)
6729 vl3ij=vlor3(j,itori,itori1)
6730 pom=vl2ij*cosphi+vl3ij*sinphi
6731 pom1=1.0d0/(pom*pom+1.0d0)
6732 etors=etors+vl1ij*pom1
6733 if (energy_dec) etors_ii=etors_ii+ &
6736 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6738 ! Subtract the constant term
6739 etors=etors-v0(itori,itori1,iblock)
6740 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6741 'etor',i,etors_ii-v0(itori,itori1,iblock)
6743 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6744 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
6745 (v1(j,itori,itori1,iblock),j=1,6),&
6746 (v2(j,itori,itori1,iblock),j=1,6)
6747 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6748 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6750 ! 6/20/98 - dihedral angle constraints
6752 ! do i=1,ndih_constr
6753 do i=idihconstr_start,idihconstr_end
6754 itori=idih_constr(i)
6756 difi=pinorm(phii-phi0(i))
6757 if (difi.gt.drange(i)) then
6759 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6760 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6761 else if (difi.lt.-drange(i)) then
6763 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6764 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6768 !d write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6769 !d & rad2deg*phi0(i), rad2deg*drange(i),
6770 !d & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6772 !d write (iout,*) 'edihcnstr',edihcnstr
6775 !-----------------------------------------------------------------------------
6776 subroutine etor_d(etors_d)
6777 ! 6/23/01 Compute double torsional energy
6778 ! implicit real*8 (a-h,o-z)
6779 ! include 'DIMENSIONS'
6780 ! include 'COMMON.VAR'
6781 ! include 'COMMON.GEO'
6782 ! include 'COMMON.LOCAL'
6783 ! include 'COMMON.TORSION'
6784 ! include 'COMMON.INTERACT'
6785 ! include 'COMMON.DERIV'
6786 ! include 'COMMON.CHAIN'
6787 ! include 'COMMON.NAMES'
6788 ! include 'COMMON.IOUNITS'
6789 ! include 'COMMON.FFIELD'
6790 ! include 'COMMON.TORCNSTR'
6791 real(kind=8) :: etors_d,etors_d_ii
6794 integer :: i,j,k,l,itori,itori1,itori2,iblock
6795 real(kind=8) :: phii,phii1,gloci1,gloci2,&
6796 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
6797 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
6798 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
6799 ! Set lprn=.true. for debugging
6803 ! write(iout,*) "a tu??"
6804 do i=iphid_start,iphid_end
6806 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
6807 .or. itype(i-3,1).eq.ntyp1 &
6808 .or. itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
6809 itori=itortyp(itype(i-2,1))
6810 itori1=itortyp(itype(i-1,1))
6811 itori2=itortyp(itype(i,1))
6817 if (iabs(itype(i+1,1)).eq.20) iblock=2
6819 ! Regular cosine and sine terms
6820 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6821 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6822 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6823 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6824 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6825 cosphi1=dcos(j*phii)
6826 sinphi1=dsin(j*phii)
6827 cosphi2=dcos(j*phii1)
6828 sinphi2=dsin(j*phii1)
6829 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
6830 v2cij*cosphi2+v2sij*sinphi2
6831 if (energy_dec) etors_d_ii=etors_d_ii+ &
6832 v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
6833 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6834 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6836 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6838 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6839 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6840 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6841 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6842 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6843 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6844 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6845 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6846 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
6847 v1sdij*sinphi1p2+v2sdij*sinphi1m2
6848 if (energy_dec) etors_d_ii=etors_d_ii+ &
6849 v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
6850 v1sdij*sinphi1p2+v2sdij*sinphi1m2
6851 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
6852 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6853 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
6854 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6857 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6858 'etor_d',i,etors_d_ii
6859 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6860 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6863 end subroutine etor_d
6865 !-----------------------------------------------------------------------------
6866 subroutine eback_sc_corr(esccor)
6867 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
6868 ! conformational states; temporarily implemented as differences
6869 ! between UNRES torsional potentials (dependent on three types of
6870 ! residues) and the torsional potentials dependent on all 20 types
6871 ! of residues computed from AM1 energy surfaces of terminally-blocked
6872 ! amino-acid residues.
6873 ! implicit real*8 (a-h,o-z)
6874 ! include 'DIMENSIONS'
6875 ! include 'COMMON.VAR'
6876 ! include 'COMMON.GEO'
6877 ! include 'COMMON.LOCAL'
6878 ! include 'COMMON.TORSION'
6879 ! include 'COMMON.SCCOR'
6880 ! include 'COMMON.INTERACT'
6881 ! include 'COMMON.DERIV'
6882 ! include 'COMMON.CHAIN'
6883 ! include 'COMMON.NAMES'
6884 ! include 'COMMON.IOUNITS'
6885 ! include 'COMMON.FFIELD'
6886 ! include 'COMMON.CONTROL'
6887 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
6890 integer :: i,interty,j,isccori,isccori1,intertyp
6891 ! Set lprn=.true. for debugging
6894 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6896 do i=itau_start,itau_end
6897 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1)) cycle
6899 isccori=isccortyp(itype(i-2,1))
6900 isccori1=isccortyp(itype(i-1,1))
6902 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6904 do intertyp=1,3 !intertyp
6906 !c Added 09 May 2012 (Adasko)
6907 !c Intertyp means interaction type of backbone mainchain correlation:
6908 ! 1 = SC...Ca...Ca...Ca
6909 ! 2 = Ca...Ca...Ca...SC
6910 ! 3 = SC...Ca...Ca...SCi
6912 if (((intertyp.eq.3).and.((itype(i-2,1).eq.10).or. &
6913 (itype(i-1,1).eq.10).or.(itype(i-2,1).eq.ntyp1).or. &
6914 (itype(i-1,1).eq.ntyp1))) &
6915 .or. ((intertyp.eq.1).and.((itype(i-2,1).eq.10) &
6916 .or.(itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1) &
6917 .or.(itype(i,1).eq.ntyp1))) &
6918 .or.((intertyp.eq.2).and.((itype(i-1,1).eq.10).or. &
6919 (itype(i-1,1).eq.ntyp1).or.(itype(i-2,1).eq.ntyp1).or. &
6920 (itype(i-3,1).eq.ntyp1)))) cycle
6921 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1,1).eq.ntyp1)) cycle
6922 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres,1).eq.ntyp1)) &
6924 do j=1,nterm_sccor(isccori,isccori1)
6925 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6926 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6927 cosphi=dcos(j*tauangle(intertyp,i))
6928 sinphi=dsin(j*tauangle(intertyp,i))
6929 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
6930 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6931 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6933 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
6934 'esccor',i,intertyp,esccor_ii
6935 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6936 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6938 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
6939 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,isccori,isccori1,&
6940 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
6941 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6942 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6947 end subroutine eback_sc_corr
6948 !-----------------------------------------------------------------------------
6949 subroutine multibody(ecorr)
6950 ! This subroutine calculates multi-body contributions to energy following
6951 ! the idea of Skolnick et al. If side chains I and J make a contact and
6952 ! at the same time side chains I+1 and J+1 make a contact, an extra
6953 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6954 ! implicit real*8 (a-h,o-z)
6955 ! include 'DIMENSIONS'
6956 ! include 'COMMON.IOUNITS'
6957 ! include 'COMMON.DERIV'
6958 ! include 'COMMON.INTERACT'
6959 ! include 'COMMON.CONTACTS'
6960 real(kind=8),dimension(3) :: gx,gx1
6962 real(kind=8) :: ecorr
6963 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
6964 ! Set lprn=.true. for debugging
6968 write (iout,'(a)') 'Contact function values:'
6970 write (iout,'(i2,20(1x,i2,f10.5))') &
6971 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6976 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
6977 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
6989 num_conti=num_cont(i)
6990 num_conti1=num_cont(i1)
6995 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6996 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6997 !d & ' ishift=',ishift
6998 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6999 ! The system gains extra energy.
7000 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7001 endif ! j1==j+-ishift
7009 end subroutine multibody
7010 !-----------------------------------------------------------------------------
7011 real(kind=8) function esccorr(i,j,k,l,jj,kk)
7012 ! implicit real*8 (a-h,o-z)
7013 ! include 'DIMENSIONS'
7014 ! include 'COMMON.IOUNITS'
7015 ! include 'COMMON.DERIV'
7016 ! include 'COMMON.INTERACT'
7017 ! include 'COMMON.CONTACTS'
7018 real(kind=8),dimension(3) :: gx,gx1
7020 integer :: i,j,k,l,jj,kk,m,ll
7021 real(kind=8) :: eij,ekl
7025 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7026 ! Calculate the multi-body contribution to energy.
7027 ! Calculate multi-body contributions to the gradient.
7028 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7029 !d & k,l,(gacont(m,kk,k),m=1,3)
7031 gx(m) =ekl*gacont(m,jj,i)
7032 gx1(m)=eij*gacont(m,kk,k)
7033 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7034 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7035 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7036 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7040 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7045 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7050 end function esccorr
7051 !-----------------------------------------------------------------------------
7052 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7053 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7054 ! implicit real*8 (a-h,o-z)
7055 ! include 'DIMENSIONS'
7056 ! include 'COMMON.IOUNITS'
7059 ! integer :: maxconts !max_cont=maxconts =nres/4
7060 integer,parameter :: max_dim=26
7061 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7062 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7063 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7064 !el common /przechowalnia/ zapas
7065 integer :: status(MPI_STATUS_SIZE)
7066 integer,dimension((nres/4)*2) :: req !maxconts*2
7067 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
7069 ! include 'COMMON.SETUP'
7070 ! include 'COMMON.FFIELD'
7071 ! include 'COMMON.DERIV'
7072 ! include 'COMMON.INTERACT'
7073 ! include 'COMMON.CONTACTS'
7074 ! include 'COMMON.CONTROL'
7075 ! include 'COMMON.LOCAL'
7076 real(kind=8),dimension(3) :: gx,gx1
7077 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
7078 logical :: lprn,ldone
7080 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
7081 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
7083 ! Set lprn=.true. for debugging
7087 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7090 if (nfgtasks.le.1) goto 30
7092 write (iout,'(a)') 'Contact function values before RECEIVE:'
7094 write (iout,'(2i3,50(1x,i2,f5.2))') &
7095 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7100 do i=1,ntask_cont_from
7103 do i=1,ntask_cont_to
7106 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7108 ! Make the list of contacts to send to send to other procesors
7109 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7111 do i=iturn3_start,iturn3_end
7112 ! write (iout,*) "make contact list turn3",i," num_cont",
7114 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7116 do i=iturn4_start,iturn4_end
7117 ! write (iout,*) "make contact list turn4",i," num_cont",
7119 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7123 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7125 do j=1,num_cont_hb(i)
7128 iproc=iint_sent_local(k,jjc,ii)
7129 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7130 if (iproc.gt.0) then
7131 ncont_sent(iproc)=ncont_sent(iproc)+1
7132 nn=ncont_sent(iproc)
7134 zapas(2,nn,iproc)=jjc
7135 zapas(3,nn,iproc)=facont_hb(j,i)
7136 zapas(4,nn,iproc)=ees0p(j,i)
7137 zapas(5,nn,iproc)=ees0m(j,i)
7138 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7139 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7140 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7141 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7142 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7143 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7144 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7145 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7146 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7147 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7148 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7149 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7150 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7151 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7152 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7153 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7154 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7155 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7156 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7157 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7158 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7165 "Numbers of contacts to be sent to other processors",&
7166 (ncont_sent(i),i=1,ntask_cont_to)
7167 write (iout,*) "Contacts sent"
7168 do ii=1,ntask_cont_to
7170 iproc=itask_cont_to(ii)
7171 write (iout,*) nn," contacts to processor",iproc,&
7172 " of CONT_TO_COMM group"
7174 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7182 CorrelID1=nfgtasks+fg_rank+1
7184 ! Receive the numbers of needed contacts from other processors
7185 do ii=1,ntask_cont_from
7186 iproc=itask_cont_from(ii)
7188 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7189 FG_COMM,req(ireq),IERR)
7191 ! write (iout,*) "IRECV ended"
7193 ! Send the number of contacts needed by other processors
7194 do ii=1,ntask_cont_to
7195 iproc=itask_cont_to(ii)
7197 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7198 FG_COMM,req(ireq),IERR)
7200 ! write (iout,*) "ISEND ended"
7201 ! write (iout,*) "number of requests (nn)",ireq
7204 call MPI_Waitall(ireq,req,status_array,ierr)
7206 ! & "Numbers of contacts to be received from other processors",
7207 ! & (ncont_recv(i),i=1,ntask_cont_from)
7211 do ii=1,ntask_cont_from
7212 iproc=itask_cont_from(ii)
7214 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7215 ! & " of CONT_TO_COMM group"
7219 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7220 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7221 ! write (iout,*) "ireq,req",ireq,req(ireq)
7224 ! Send the contacts to processors that need them
7225 do ii=1,ntask_cont_to
7226 iproc=itask_cont_to(ii)
7228 ! write (iout,*) nn," contacts to processor",iproc,
7229 ! & " of CONT_TO_COMM group"
7232 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7233 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7234 ! write (iout,*) "ireq,req",ireq,req(ireq)
7236 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7240 ! write (iout,*) "number of requests (contacts)",ireq
7241 ! write (iout,*) "req",(req(i),i=1,4)
7244 call MPI_Waitall(ireq,req,status_array,ierr)
7245 do iii=1,ntask_cont_from
7246 iproc=itask_cont_from(iii)
7249 write (iout,*) "Received",nn," contacts from processor",iproc,&
7250 " of CONT_FROM_COMM group"
7253 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7258 ii=zapas_recv(1,i,iii)
7259 ! Flag the received contacts to prevent double-counting
7260 jj=-zapas_recv(2,i,iii)
7261 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7263 nnn=num_cont_hb(ii)+1
7266 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7267 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7268 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7269 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7270 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7271 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7272 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7273 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7274 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7275 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7276 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7277 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7278 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7279 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7280 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7281 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7282 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7283 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7284 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7285 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7286 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7287 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7288 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7289 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7294 write (iout,'(a)') 'Contact function values after receive:'
7296 write (iout,'(2i3,50(1x,i3,f5.2))') &
7297 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7305 write (iout,'(a)') 'Contact function values:'
7307 write (iout,'(2i3,50(1x,i3,f5.2))') &
7308 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7314 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7315 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7316 ! Remove the loop below after debugging !!!
7323 ! Calculate the local-electrostatic correlation terms
7324 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7326 num_conti=num_cont_hb(i)
7327 num_conti1=num_cont_hb(i+1)
7334 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
7335 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
7336 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7337 .or. j.lt.0 .and. j1.gt.0) .and. &
7338 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7339 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7340 ! The system gains extra energy.
7341 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7342 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
7343 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7345 else if (j1.eq.j) then
7346 ! Contacts I-J and I-(J+1) occur simultaneously.
7347 ! The system loses extra energy.
7348 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7353 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7354 ! & ' jj=',jj,' kk=',kk
7356 ! Contacts I-J and (I+1)-J occur simultaneously.
7357 ! The system loses extra energy.
7358 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7364 end subroutine multibody_hb
7365 !-----------------------------------------------------------------------------
7366 subroutine add_hb_contact(ii,jj,itask)
7367 ! implicit real*8 (a-h,o-z)
7368 ! include "DIMENSIONS"
7369 ! include "COMMON.IOUNITS"
7370 ! include "COMMON.CONTACTS"
7371 ! integer,parameter :: maxconts=nres/4
7372 integer,parameter :: max_dim=26
7373 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7374 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7375 ! common /przechowalnia/ zapas
7376 integer :: i,j,ii,jj,iproc,nn,jjc
7377 integer,dimension(4) :: itask
7378 ! write (iout,*) "itask",itask
7381 if (iproc.gt.0) then
7382 do j=1,num_cont_hb(ii)
7384 ! write (iout,*) "i",ii," j",jj," jjc",jjc
7386 ncont_sent(iproc)=ncont_sent(iproc)+1
7387 nn=ncont_sent(iproc)
7388 zapas(1,nn,iproc)=ii
7389 zapas(2,nn,iproc)=jjc
7390 zapas(3,nn,iproc)=facont_hb(j,ii)
7391 zapas(4,nn,iproc)=ees0p(j,ii)
7392 zapas(5,nn,iproc)=ees0m(j,ii)
7393 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7394 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7395 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7396 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7397 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7398 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7399 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7400 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7401 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7402 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7403 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7404 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7405 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7406 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7407 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7408 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7409 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7410 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7411 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7412 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7413 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7420 end subroutine add_hb_contact
7421 !-----------------------------------------------------------------------------
7422 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
7423 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7424 ! implicit real*8 (a-h,o-z)
7425 ! include 'DIMENSIONS'
7426 ! include 'COMMON.IOUNITS'
7427 integer,parameter :: max_dim=70
7430 ! integer :: maxconts !max_cont=maxconts=nres/4
7431 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7432 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7433 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7434 ! common /przechowalnia/ zapas
7435 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
7436 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
7439 ! include 'COMMON.SETUP'
7440 ! include 'COMMON.FFIELD'
7441 ! include 'COMMON.DERIV'
7442 ! include 'COMMON.LOCAL'
7443 ! include 'COMMON.INTERACT'
7444 ! include 'COMMON.CONTACTS'
7445 ! include 'COMMON.CHAIN'
7446 ! include 'COMMON.CONTROL'
7447 real(kind=8),dimension(3) :: gx,gx1
7448 integer,dimension(nres) :: num_cont_hb_old
7449 logical :: lprn,ldone
7450 !EL double precision eello4,eello5,eelo6,eello_turn6
7451 !EL external eello4,eello5,eello6,eello_turn6
7453 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
7454 j1,jp1,i1,num_conti1
7455 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
7456 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
7458 ! Set lprn=.true. for debugging
7463 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7465 num_cont_hb_old(i)=num_cont_hb(i)
7469 if (nfgtasks.le.1) goto 30
7471 write (iout,'(a)') 'Contact function values before RECEIVE:'
7473 write (iout,'(2i3,50(1x,i2,f5.2))') &
7474 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7479 do i=1,ntask_cont_from
7482 do i=1,ntask_cont_to
7485 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7487 ! Make the list of contacts to send to send to other procesors
7488 do i=iturn3_start,iturn3_end
7489 ! write (iout,*) "make contact list turn3",i," num_cont",
7491 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7493 do i=iturn4_start,iturn4_end
7494 ! write (iout,*) "make contact list turn4",i," num_cont",
7496 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7500 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
7502 do j=1,num_cont_hb(i)
7505 iproc=iint_sent_local(k,jjc,ii)
7506 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7507 if (iproc.ne.0) then
7508 ncont_sent(iproc)=ncont_sent(iproc)+1
7509 nn=ncont_sent(iproc)
7511 zapas(2,nn,iproc)=jjc
7512 zapas(3,nn,iproc)=d_cont(j,i)
7516 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7521 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7529 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7540 "Numbers of contacts to be sent to other processors",&
7541 (ncont_sent(i),i=1,ntask_cont_to)
7542 write (iout,*) "Contacts sent"
7543 do ii=1,ntask_cont_to
7545 iproc=itask_cont_to(ii)
7546 write (iout,*) nn," contacts to processor",iproc,&
7547 " of CONT_TO_COMM group"
7549 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7557 CorrelID1=nfgtasks+fg_rank+1
7559 ! Receive the numbers of needed contacts from other processors
7560 do ii=1,ntask_cont_from
7561 iproc=itask_cont_from(ii)
7563 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
7564 FG_COMM,req(ireq),IERR)
7566 ! write (iout,*) "IRECV ended"
7568 ! Send the number of contacts needed by other processors
7569 do ii=1,ntask_cont_to
7570 iproc=itask_cont_to(ii)
7572 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
7573 FG_COMM,req(ireq),IERR)
7575 ! write (iout,*) "ISEND ended"
7576 ! write (iout,*) "number of requests (nn)",ireq
7579 call MPI_Waitall(ireq,req,status_array,ierr)
7581 ! & "Numbers of contacts to be received from other processors",
7582 ! & (ncont_recv(i),i=1,ntask_cont_from)
7586 do ii=1,ntask_cont_from
7587 iproc=itask_cont_from(ii)
7589 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
7590 ! & " of CONT_TO_COMM group"
7594 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
7595 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7596 ! write (iout,*) "ireq,req",ireq,req(ireq)
7599 ! Send the contacts to processors that need them
7600 do ii=1,ntask_cont_to
7601 iproc=itask_cont_to(ii)
7603 ! write (iout,*) nn," contacts to processor",iproc,
7604 ! & " of CONT_TO_COMM group"
7607 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
7608 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7609 ! write (iout,*) "ireq,req",ireq,req(ireq)
7611 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7615 ! write (iout,*) "number of requests (contacts)",ireq
7616 ! write (iout,*) "req",(req(i),i=1,4)
7619 call MPI_Waitall(ireq,req,status_array,ierr)
7620 do iii=1,ntask_cont_from
7621 iproc=itask_cont_from(iii)
7624 write (iout,*) "Received",nn," contacts from processor",iproc,&
7625 " of CONT_FROM_COMM group"
7628 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7633 ii=zapas_recv(1,i,iii)
7634 ! Flag the received contacts to prevent double-counting
7635 jj=-zapas_recv(2,i,iii)
7636 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7638 nnn=num_cont_hb(ii)+1
7641 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7645 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7650 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7658 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7667 write (iout,'(a)') 'Contact function values after receive:'
7669 write (iout,'(2i3,50(1x,i3,5f6.3))') &
7670 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
7671 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7678 write (iout,'(a)') 'Contact function values:'
7680 write (iout,'(2i3,50(1x,i2,5f6.3))') &
7681 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
7682 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7689 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7690 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7691 ! Remove the loop below after debugging !!!
7698 ! Calculate the dipole-dipole interaction energies
7699 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7700 do i=iatel_s,iatel_e+1
7701 num_conti=num_cont_hb(i)
7710 ! Calculate the local-electrostatic correlation terms
7711 ! write (iout,*) "gradcorr5 in eello5 before loop"
7713 ! write (iout,'(i5,3f10.5)')
7714 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7716 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7717 ! write (iout,*) "corr loop i",i
7719 num_conti=num_cont_hb(i)
7720 num_conti1=num_cont_hb(i+1)
7727 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7728 ! & ' jj=',jj,' kk=',kk
7729 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
7730 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
7731 .or. j.lt.0 .and. j1.gt.0) .and. &
7732 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7733 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7734 ! The system gains extra energy.
7736 sqd1=dsqrt(d_cont(jj,i))
7737 sqd2=dsqrt(d_cont(kk,i1))
7738 sred_geom = sqd1*sqd2
7739 IF (sred_geom.lt.cutoff_corr) THEN
7740 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
7742 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7743 !d & ' jj=',jj,' kk=',kk
7744 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7745 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7747 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7748 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7751 !d write (iout,*) 'sred_geom=',sred_geom,
7752 !d & ' ekont=',ekont,' fprim=',fprimcont,
7753 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7754 !d write (iout,*) "g_contij",g_contij
7755 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7756 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7757 call calc_eello(i,jp,i+1,jp1,jj,kk)
7758 if (wcorr4.gt.0.0d0) &
7759 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7760 if (energy_dec.and.wcorr4.gt.0.0d0) &
7761 write (iout,'(a6,4i5,0pf7.3)') &
7762 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7763 ! write (iout,*) "gradcorr5 before eello5"
7765 ! write (iout,'(i5,3f10.5)')
7766 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7768 if (wcorr5.gt.0.0d0) &
7769 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7770 ! write (iout,*) "gradcorr5 after eello5"
7772 ! write (iout,'(i5,3f10.5)')
7773 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7775 if (energy_dec.and.wcorr5.gt.0.0d0) &
7776 write (iout,'(a6,4i5,0pf7.3)') &
7777 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7778 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7779 !d write(2,*)'ijkl',i,jp,i+1,jp1
7780 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
7781 .or. wturn6.eq.0.0d0))then
7782 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7783 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7784 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
7785 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7786 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7787 !d & 'ecorr6=',ecorr6
7788 !d write (iout,'(4e15.5)') sred_geom,
7789 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7790 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7791 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7792 else if (wturn6.gt.0.0d0 &
7793 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7794 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7795 eturn6=eturn6+eello_turn6(i,jj,kk)
7796 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
7797 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7798 !d write (2,*) 'multibody_eello:eturn6',eturn6
7807 num_cont_hb(i)=num_cont_hb_old(i)
7809 ! write (iout,*) "gradcorr5 in eello5"
7811 ! write (iout,'(i5,3f10.5)')
7812 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
7815 end subroutine multibody_eello
7816 !-----------------------------------------------------------------------------
7817 subroutine add_hb_contact_eello(ii,jj,itask)
7818 ! implicit real*8 (a-h,o-z)
7819 ! include "DIMENSIONS"
7820 ! include "COMMON.IOUNITS"
7821 ! include "COMMON.CONTACTS"
7822 ! integer,parameter :: maxconts=nres/4
7823 integer,parameter :: max_dim=70
7824 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
7825 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7826 ! common /przechowalnia/ zapas
7828 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
7829 integer,dimension(4) ::itask
7830 ! write (iout,*) "itask",itask
7833 if (iproc.gt.0) then
7834 do j=1,num_cont_hb(ii)
7836 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7838 ncont_sent(iproc)=ncont_sent(iproc)+1
7839 nn=ncont_sent(iproc)
7840 zapas(1,nn,iproc)=ii
7841 zapas(2,nn,iproc)=jjc
7842 zapas(3,nn,iproc)=d_cont(j,ii)
7846 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7851 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7859 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7870 end subroutine add_hb_contact_eello
7871 !-----------------------------------------------------------------------------
7872 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7873 ! implicit real*8 (a-h,o-z)
7874 ! include 'DIMENSIONS'
7875 ! include 'COMMON.IOUNITS'
7876 ! include 'COMMON.DERIV'
7877 ! include 'COMMON.INTERACT'
7878 ! include 'COMMON.CONTACTS'
7879 real(kind=8),dimension(3) :: gx,gx1
7882 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
7883 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
7884 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
7885 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
7896 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7897 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7898 ! Following 4 lines for diagnostics.
7903 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7904 ! & 'Contacts ',i,j,
7905 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7906 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7908 ! Calculate the multi-body contribution to energy.
7909 ! ecorr=ecorr+ekont*ees
7910 ! Calculate multi-body contributions to the gradient.
7911 coeffpees0pij=coeffp*ees0pij
7912 coeffmees0mij=coeffm*ees0mij
7913 coeffpees0pkl=coeffp*ees0pkl
7914 coeffmees0mkl=coeffm*ees0mkl
7916 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7917 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
7918 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
7919 coeffmees0mkl*gacontm_hb1(ll,jj,i))
7920 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
7921 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
7922 coeffmees0mkl*gacontm_hb2(ll,jj,i))
7923 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7924 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
7925 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
7926 coeffmees0mij*gacontm_hb1(ll,kk,k))
7927 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
7928 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
7929 coeffmees0mij*gacontm_hb2(ll,kk,k))
7930 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
7931 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
7932 coeffmees0mkl*gacontm_hb3(ll,jj,i))
7933 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7934 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7935 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
7936 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
7937 coeffmees0mij*gacontm_hb3(ll,kk,k))
7938 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7939 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7940 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7945 !grad gradcorr(ll,m)=gradcorr(ll,m)+
7946 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
7947 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7948 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7953 !grad gradcorr(ll,m)=gradcorr(ll,m)+
7954 !grad & ees*eij*gacont_hbr(ll,kk,k)-
7955 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7956 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7959 ! write (iout,*) "ehbcorr",ekont*ees
7961 if (shield_mode.gt.0) then
7964 !C print *,i,j,fac_shield(i),fac_shield(j),
7965 !C &fac_shield(k),fac_shield(l)
7966 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
7967 (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
7968 do ilist=1,ishield_list(i)
7969 iresshield=shield_list(ilist,i)
7971 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
7972 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
7974 +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
7975 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
7979 do ilist=1,ishield_list(j)
7980 iresshield=shield_list(ilist,j)
7982 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
7983 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
7985 +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
7986 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
7991 do ilist=1,ishield_list(k)
7992 iresshield=shield_list(ilist,k)
7994 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
7995 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
7997 +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
7998 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8002 do ilist=1,ishield_list(l)
8003 iresshield=shield_list(ilist,l)
8005 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
8006 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8008 +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
8009 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8014 gshieldc_ec(m,i)=gshieldc_ec(m,i)+ &
8015 grad_shield(m,i)*ehbcorr/fac_shield(i)
8016 gshieldc_ec(m,j)=gshieldc_ec(m,j)+ &
8017 grad_shield(m,j)*ehbcorr/fac_shield(j)
8018 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ &
8019 grad_shield(m,i)*ehbcorr/fac_shield(i)
8020 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ &
8021 grad_shield(m,j)*ehbcorr/fac_shield(j)
8023 gshieldc_ec(m,k)=gshieldc_ec(m,k)+ &
8024 grad_shield(m,k)*ehbcorr/fac_shield(k)
8025 gshieldc_ec(m,l)=gshieldc_ec(m,l)+ &
8026 grad_shield(m,l)*ehbcorr/fac_shield(l)
8027 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ &
8028 grad_shield(m,k)*ehbcorr/fac_shield(k)
8029 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ &
8030 grad_shield(m,l)*ehbcorr/fac_shield(l)
8036 end function ehbcorr
8038 !-----------------------------------------------------------------------------
8039 subroutine dipole(i,j,jj)
8040 ! implicit real*8 (a-h,o-z)
8041 ! include 'DIMENSIONS'
8042 ! include 'COMMON.IOUNITS'
8043 ! include 'COMMON.CHAIN'
8044 ! include 'COMMON.FFIELD'
8045 ! include 'COMMON.DERIV'
8046 ! include 'COMMON.INTERACT'
8047 ! include 'COMMON.CONTACTS'
8048 ! include 'COMMON.TORSION'
8049 ! include 'COMMON.VAR'
8050 ! include 'COMMON.GEO'
8051 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
8052 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
8053 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
8055 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
8056 allocate(dipderx(3,5,4,maxconts,nres))
8059 iti1 = itortyp(itype(i+1,1))
8060 if (j.lt.nres-1) then
8061 itj1 = itortyp(itype(j+1,1))
8066 dipi(iii,1)=Ub2(iii,i)
8067 dipderi(iii)=Ub2der(iii,i)
8068 dipi(iii,2)=b1(iii,iti1)
8069 dipj(iii,1)=Ub2(iii,j)
8070 dipderj(iii)=Ub2der(iii,j)
8071 dipj(iii,2)=b1(iii,itj1)
8075 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8078 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8085 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
8089 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8094 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8095 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8097 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8099 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8101 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8104 end subroutine dipole
8106 !-----------------------------------------------------------------------------
8107 subroutine calc_eello(i,j,k,l,jj,kk)
8109 ! This subroutine computes matrices and vectors needed to calculate
8110 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
8113 ! implicit real*8 (a-h,o-z)
8114 ! include 'DIMENSIONS'
8115 ! include 'COMMON.IOUNITS'
8116 ! include 'COMMON.CHAIN'
8117 ! include 'COMMON.DERIV'
8118 ! include 'COMMON.INTERACT'
8119 ! include 'COMMON.CONTACTS'
8120 ! include 'COMMON.TORSION'
8121 ! include 'COMMON.VAR'
8122 ! include 'COMMON.GEO'
8123 ! include 'COMMON.FFIELD'
8124 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
8125 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
8126 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
8129 !el common /kutas/ lprn
8130 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8131 !d & ' jj=',jj,' kk=',kk
8132 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8133 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8134 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8137 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8138 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8141 call transpose2(aa1(1,1),aa1t(1,1))
8142 call transpose2(aa2(1,1),aa2t(1,1))
8145 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
8146 aa1tder(1,1,lll,kkk))
8147 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
8148 aa2tder(1,1,lll,kkk))
8152 ! parallel orientation of the two CA-CA-CA frames.
8154 iti=itortyp(itype(i,1))
8158 itk1=itortyp(itype(k+1,1))
8159 itj=itortyp(itype(j,1))
8160 if (l.lt.nres-1) then
8161 itl1=itortyp(itype(l+1,1))
8165 ! A1 kernel(j+1) A2T
8167 !d write (iout,'(3f10.5,5x,3f10.5)')
8168 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8170 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8171 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
8172 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8173 ! Following matrices are needed only for 6-th order cumulants
8174 IF (wcorr6.gt.0.0d0) THEN
8175 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8176 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
8177 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8178 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8179 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
8180 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8181 ADtEAderx(1,1,1,1,1,1))
8183 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8184 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
8185 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8186 ADtEA1derx(1,1,1,1,1,1))
8188 ! End 6-th order cumulants
8191 !d write (2,*) 'In calc_eello6'
8193 !d write (2,*) 'iii=',iii
8195 !d write (2,*) 'kkk=',kkk
8197 !d write (2,'(3(2f10.5),5x)')
8198 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8203 call transpose2(EUgder(1,1,k),auxmat(1,1))
8204 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8205 call transpose2(EUg(1,1,k),auxmat(1,1))
8206 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8207 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8211 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8212 EAEAderx(1,1,lll,kkk,iii,1))
8216 ! A1T kernel(i+1) A2
8217 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8218 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
8219 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8220 ! Following matrices are needed only for 6-th order cumulants
8221 IF (wcorr6.gt.0.0d0) THEN
8222 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8223 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
8224 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8225 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8226 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
8227 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8228 ADtEAderx(1,1,1,1,1,2))
8229 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
8230 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
8231 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8232 ADtEA1derx(1,1,1,1,1,2))
8234 ! End 6-th order cumulants
8235 call transpose2(EUgder(1,1,l),auxmat(1,1))
8236 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8237 call transpose2(EUg(1,1,l),auxmat(1,1))
8238 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8239 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8243 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8244 EAEAderx(1,1,lll,kkk,iii,2))
8249 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8250 ! They are needed only when the fifth- or the sixth-order cumulants are
8252 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8253 call transpose2(AEA(1,1,1),auxmat(1,1))
8254 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8255 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8256 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8257 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8258 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8259 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8260 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8261 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8262 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8263 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8264 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8265 call transpose2(AEA(1,1,2),auxmat(1,1))
8266 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
8267 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8268 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8269 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8270 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
8271 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8272 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
8273 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
8274 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8275 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8276 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8277 ! Calculate the Cartesian derivatives of the vectors.
8281 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8282 call matvec2(auxmat(1,1),b1(1,iti),&
8283 AEAb1derx(1,lll,kkk,iii,1,1))
8284 call matvec2(auxmat(1,1),Ub2(1,i),&
8285 AEAb2derx(1,lll,kkk,iii,1,1))
8286 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8287 AEAb1derx(1,lll,kkk,iii,2,1))
8288 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8289 AEAb2derx(1,lll,kkk,iii,2,1))
8290 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8291 call matvec2(auxmat(1,1),b1(1,itj),&
8292 AEAb1derx(1,lll,kkk,iii,1,2))
8293 call matvec2(auxmat(1,1),Ub2(1,j),&
8294 AEAb2derx(1,lll,kkk,iii,1,2))
8295 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
8296 AEAb1derx(1,lll,kkk,iii,2,2))
8297 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
8298 AEAb2derx(1,lll,kkk,iii,2,2))
8305 ! Antiparallel orientation of the two CA-CA-CA frames.
8307 iti=itortyp(itype(i,1))
8311 itk1=itortyp(itype(k+1,1))
8312 itl=itortyp(itype(l,1))
8313 itj=itortyp(itype(j,1))
8314 if (j.lt.nres-1) then
8315 itj1=itortyp(itype(j+1,1))
8319 ! A2 kernel(j-1)T A1T
8320 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8321 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
8322 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8323 ! Following matrices are needed only for 6-th order cumulants
8324 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8325 j.eq.i+4 .and. l.eq.i+3)) THEN
8326 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8327 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
8328 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8329 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8330 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
8331 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
8332 ADtEAderx(1,1,1,1,1,1))
8333 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
8334 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
8335 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
8336 ADtEA1derx(1,1,1,1,1,1))
8338 ! End 6-th order cumulants
8339 call transpose2(EUgder(1,1,k),auxmat(1,1))
8340 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8341 call transpose2(EUg(1,1,k),auxmat(1,1))
8342 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8343 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8347 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8348 EAEAderx(1,1,lll,kkk,iii,1))
8352 ! A2T kernel(i+1)T A1
8353 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8354 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
8355 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8356 ! Following matrices are needed only for 6-th order cumulants
8357 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
8358 j.eq.i+4 .and. l.eq.i+3)) THEN
8359 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8360 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
8361 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8362 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8363 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
8364 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
8365 ADtEAderx(1,1,1,1,1,2))
8366 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
8367 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
8368 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
8369 ADtEA1derx(1,1,1,1,1,2))
8371 ! End 6-th order cumulants
8372 call transpose2(EUgder(1,1,j),auxmat(1,1))
8373 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8374 call transpose2(EUg(1,1,j),auxmat(1,1))
8375 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8376 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8380 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8381 EAEAderx(1,1,lll,kkk,iii,2))
8386 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8387 ! They are needed only when the fifth- or the sixth-order cumulants are
8389 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
8390 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8391 call transpose2(AEA(1,1,1),auxmat(1,1))
8392 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8393 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8394 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8395 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8396 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8397 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8398 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8399 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8400 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8401 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8402 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8403 call transpose2(AEA(1,1,2),auxmat(1,1))
8404 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
8405 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8406 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8407 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8408 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
8409 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8410 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
8411 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
8412 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8413 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8414 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8415 ! Calculate the Cartesian derivatives of the vectors.
8419 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8420 call matvec2(auxmat(1,1),b1(1,iti),&
8421 AEAb1derx(1,lll,kkk,iii,1,1))
8422 call matvec2(auxmat(1,1),Ub2(1,i),&
8423 AEAb2derx(1,lll,kkk,iii,1,1))
8424 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
8425 AEAb1derx(1,lll,kkk,iii,2,1))
8426 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
8427 AEAb2derx(1,lll,kkk,iii,2,1))
8428 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8429 call matvec2(auxmat(1,1),b1(1,itl),&
8430 AEAb1derx(1,lll,kkk,iii,1,2))
8431 call matvec2(auxmat(1,1),Ub2(1,l),&
8432 AEAb2derx(1,lll,kkk,iii,1,2))
8433 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
8434 AEAb1derx(1,lll,kkk,iii,2,2))
8435 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
8436 AEAb2derx(1,lll,kkk,iii,2,2))
8444 end subroutine calc_eello
8445 !-----------------------------------------------------------------------------
8446 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
8451 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
8452 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
8453 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
8454 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
8455 integer :: iii,kkk,lll
8458 !el common /kutas/ lprn
8459 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8461 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
8464 !d if (lprn) write (2,*) 'In kernel'
8466 !d if (lprn) write (2,*) 'kkk=',kkk
8468 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
8469 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8471 !d write (2,*) 'lll=',lll
8472 !d write (2,*) 'iii=1'
8474 !d write (2,'(3(2f10.5),5x)')
8475 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8478 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
8479 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8481 !d write (2,*) 'lll=',lll
8482 !d write (2,*) 'iii=2'
8484 !d write (2,'(3(2f10.5),5x)')
8485 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8491 end subroutine kernel
8492 !-----------------------------------------------------------------------------
8493 real(kind=8) function eello4(i,j,k,l,jj,kk)
8494 ! implicit real*8 (a-h,o-z)
8495 ! include 'DIMENSIONS'
8496 ! include 'COMMON.IOUNITS'
8497 ! include 'COMMON.CHAIN'
8498 ! include 'COMMON.DERIV'
8499 ! include 'COMMON.INTERACT'
8500 ! include 'COMMON.CONTACTS'
8501 ! include 'COMMON.TORSION'
8502 ! include 'COMMON.VAR'
8503 ! include 'COMMON.GEO'
8504 real(kind=8),dimension(2,2) :: pizda
8505 real(kind=8),dimension(3) :: ggg1,ggg2
8506 real(kind=8) :: eel4,glongij,glongkl
8507 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
8508 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8512 !d print *,'eello4:',i,j,k,l,jj,kk
8513 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
8514 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
8515 !old eij=facont_hb(jj,i)
8516 !old ekl=facont_hb(kk,k)
8518 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8519 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8520 gcorr_loc(k-1)=gcorr_loc(k-1) &
8521 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8523 gcorr_loc(l-1)=gcorr_loc(l-1) &
8524 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8526 gcorr_loc(j-1)=gcorr_loc(j-1) &
8527 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8532 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
8533 -EAEAderx(2,2,lll,kkk,iii,1)
8534 !d derx(lll,kkk,iii)=0.0d0
8538 !d gcorr_loc(l-1)=0.0d0
8539 !d gcorr_loc(j-1)=0.0d0
8540 !d gcorr_loc(k-1)=0.0d0
8542 !d write (iout,*)'Contacts have occurred for peptide groups',
8543 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
8544 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8545 if (j.lt.nres-1) then
8552 if (l.lt.nres-1) then
8560 !grad ggg1(ll)=eel4*g_contij(ll,1)
8561 !grad ggg2(ll)=eel4*g_contij(ll,2)
8562 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8563 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8564 !grad ghalf=0.5d0*ggg1(ll)
8565 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8566 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8567 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8568 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8569 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8570 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8571 !grad ghalf=0.5d0*ggg2(ll)
8572 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8573 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8574 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8575 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8576 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8577 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8581 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8586 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8591 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8596 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8600 !d write (2,*) iii,gcorr_loc(iii)
8603 !d write (2,*) 'ekont',ekont
8604 !d write (iout,*) 'eello4',ekont*eel4
8607 !-----------------------------------------------------------------------------
8608 real(kind=8) function eello5(i,j,k,l,jj,kk)
8609 ! implicit real*8 (a-h,o-z)
8610 ! include 'DIMENSIONS'
8611 ! include 'COMMON.IOUNITS'
8612 ! include 'COMMON.CHAIN'
8613 ! include 'COMMON.DERIV'
8614 ! include 'COMMON.INTERACT'
8615 ! include 'COMMON.CONTACTS'
8616 ! include 'COMMON.TORSION'
8617 ! include 'COMMON.VAR'
8618 ! include 'COMMON.GEO'
8619 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
8620 real(kind=8),dimension(2) :: vv
8621 real(kind=8),dimension(3) :: ggg1,ggg2
8622 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
8623 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
8624 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
8625 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8630 ! /l\ / \ \ / \ / \ / C
8631 ! / \ / \ \ / \ / \ / C
8632 ! j| o |l1 | o | o| o | | o |o C
8633 ! \ |/k\| |/ \| / |/ \| |/ \| C
8634 ! \i/ \ / \ / / \ / \ C
8636 ! (I) (II) (III) (IV) C
8638 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8640 ! Antiparallel chains C
8643 ! /j\ / \ \ / \ / \ / C
8644 ! / \ / \ \ / \ / \ / C
8645 ! j1| o |l | o | o| o | | o |o C
8646 ! \ |/k\| |/ \| / |/ \| |/ \| C
8647 ! \i/ \ / \ / / \ / \ C
8649 ! (I) (II) (III) (IV) C
8651 ! eello5_1 eello5_2 eello5_3 eello5_4 C
8653 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
8655 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8656 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8661 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8663 itk=itortyp(itype(k,1))
8664 itl=itortyp(itype(l,1))
8665 itj=itortyp(itype(j,1))
8670 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8671 !d & eel5_3_num,eel5_4_num)
8675 derx(lll,kkk,iii)=0.0d0
8679 !d eij=facont_hb(jj,i)
8680 !d ekl=facont_hb(kk,k)
8682 !d write (iout,*)'Contacts have occurred for peptide groups',
8683 !d & i,j,' fcont:',eij,' eij',' and ',k,l
8685 ! Contribution from the graph I.
8686 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8687 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8688 call transpose2(EUg(1,1,k),auxmat(1,1))
8689 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8690 vv(1)=pizda(1,1)-pizda(2,2)
8691 vv(2)=pizda(1,2)+pizda(2,1)
8692 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
8693 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8694 ! Explicit gradient in virtual-dihedral angles.
8695 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
8696 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
8697 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8698 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8699 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8700 vv(1)=pizda(1,1)-pizda(2,2)
8701 vv(2)=pizda(1,2)+pizda(2,1)
8702 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8703 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
8704 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8705 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8706 vv(1)=pizda(1,1)-pizda(2,2)
8707 vv(2)=pizda(1,2)+pizda(2,1)
8709 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8710 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
8711 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8713 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8714 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
8715 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8717 ! Cartesian gradient
8721 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
8723 vv(1)=pizda(1,1)-pizda(2,2)
8724 vv(2)=pizda(1,2)+pizda(2,1)
8725 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8726 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
8727 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8733 ! Contribution from graph II
8734 call transpose2(EE(1,1,itk),auxmat(1,1))
8735 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8736 vv(1)=pizda(1,1)+pizda(2,2)
8737 vv(2)=pizda(2,1)-pizda(1,2)
8738 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
8739 -0.5d0*scalar2(vv(1),Ctobr(1,k))
8740 ! Explicit gradient in virtual-dihedral angles.
8741 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8742 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8743 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8744 vv(1)=pizda(1,1)+pizda(2,2)
8745 vv(2)=pizda(2,1)-pizda(1,2)
8747 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8748 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
8749 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8751 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8752 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
8753 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8755 ! Cartesian gradient
8759 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
8761 vv(1)=pizda(1,1)+pizda(2,2)
8762 vv(2)=pizda(2,1)-pizda(1,2)
8763 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8764 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
8765 -0.5d0*scalar2(vv(1),Ctobr(1,k))
8773 ! Parallel orientation
8774 ! Contribution from graph III
8775 call transpose2(EUg(1,1,l),auxmat(1,1))
8776 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8777 vv(1)=pizda(1,1)-pizda(2,2)
8778 vv(2)=pizda(1,2)+pizda(2,1)
8779 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
8780 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8781 ! Explicit gradient in virtual-dihedral angles.
8782 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8783 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
8784 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8785 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8786 vv(1)=pizda(1,1)-pizda(2,2)
8787 vv(2)=pizda(1,2)+pizda(2,1)
8788 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8789 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
8790 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8791 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8792 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8793 vv(1)=pizda(1,1)-pizda(2,2)
8794 vv(2)=pizda(1,2)+pizda(2,1)
8795 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8796 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
8797 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8798 ! Cartesian gradient
8802 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
8804 vv(1)=pizda(1,1)-pizda(2,2)
8805 vv(2)=pizda(1,2)+pizda(2,1)
8806 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8807 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
8808 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8813 ! Contribution from graph IV
8815 call transpose2(EE(1,1,itl),auxmat(1,1))
8816 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8817 vv(1)=pizda(1,1)+pizda(2,2)
8818 vv(2)=pizda(2,1)-pizda(1,2)
8819 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
8820 -0.5d0*scalar2(vv(1),Ctobr(1,l))
8821 ! Explicit gradient in virtual-dihedral angles.
8822 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8823 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8824 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8825 vv(1)=pizda(1,1)+pizda(2,2)
8826 vv(2)=pizda(2,1)-pizda(1,2)
8827 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8828 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
8829 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8830 ! Cartesian gradient
8834 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8836 vv(1)=pizda(1,1)+pizda(2,2)
8837 vv(2)=pizda(2,1)-pizda(1,2)
8838 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
8839 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
8840 -0.5d0*scalar2(vv(1),Ctobr(1,l))
8845 ! Antiparallel orientation
8846 ! Contribution from graph III
8848 call transpose2(EUg(1,1,j),auxmat(1,1))
8849 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8850 vv(1)=pizda(1,1)-pizda(2,2)
8851 vv(2)=pizda(1,2)+pizda(2,1)
8852 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
8853 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8854 ! Explicit gradient in virtual-dihedral angles.
8855 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
8856 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
8857 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8858 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8859 vv(1)=pizda(1,1)-pizda(2,2)
8860 vv(2)=pizda(1,2)+pizda(2,1)
8861 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8862 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
8863 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8864 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8865 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8866 vv(1)=pizda(1,1)-pizda(2,2)
8867 vv(2)=pizda(1,2)+pizda(2,1)
8868 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8869 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
8870 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8871 ! Cartesian gradient
8875 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
8877 vv(1)=pizda(1,1)-pizda(2,2)
8878 vv(2)=pizda(1,2)+pizda(2,1)
8879 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
8880 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
8881 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8886 ! Contribution from graph IV
8888 call transpose2(EE(1,1,itj),auxmat(1,1))
8889 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8890 vv(1)=pizda(1,1)+pizda(2,2)
8891 vv(2)=pizda(2,1)-pizda(1,2)
8892 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
8893 -0.5d0*scalar2(vv(1),Ctobr(1,j))
8894 ! Explicit gradient in virtual-dihedral angles.
8895 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
8896 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8897 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8898 vv(1)=pizda(1,1)+pizda(2,2)
8899 vv(2)=pizda(2,1)-pizda(1,2)
8900 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
8901 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
8902 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8903 ! Cartesian gradient
8907 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
8909 vv(1)=pizda(1,1)+pizda(2,2)
8910 vv(2)=pizda(2,1)-pizda(1,2)
8911 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
8912 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
8913 -0.5d0*scalar2(vv(1),Ctobr(1,j))
8919 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8920 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8921 !d write (2,*) 'ijkl',i,j,k,l
8922 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8923 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
8925 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8926 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8927 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8928 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8929 if (j.lt.nres-1) then
8936 if (l.lt.nres-1) then
8946 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8947 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
8948 ! summed up outside the subrouine as for the other subroutines
8949 ! handling long-range interactions. The old code is commented out
8950 ! with "cgrad" to keep track of changes.
8952 !grad ggg1(ll)=eel5*g_contij(ll,1)
8953 !grad ggg2(ll)=eel5*g_contij(ll,2)
8954 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8955 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8956 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8957 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8958 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8959 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8960 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8961 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8963 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8964 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8965 !grad ghalf=0.5d0*ggg1(ll)
8967 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8968 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8969 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8970 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8971 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8972 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8973 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8974 !grad ghalf=0.5d0*ggg2(ll)
8976 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8977 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8978 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8979 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8980 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8981 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8986 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8987 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8992 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8993 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8999 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9004 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9008 !d write (2,*) iii,g_corr5_loc(iii)
9011 !d write (2,*) 'ekont',ekont
9012 !d write (iout,*) 'eello5',ekont*eel5
9015 !-----------------------------------------------------------------------------
9016 real(kind=8) function eello6(i,j,k,l,jj,kk)
9017 ! implicit real*8 (a-h,o-z)
9018 ! include 'DIMENSIONS'
9019 ! include 'COMMON.IOUNITS'
9020 ! include 'COMMON.CHAIN'
9021 ! include 'COMMON.DERIV'
9022 ! include 'COMMON.INTERACT'
9023 ! include 'COMMON.CONTACTS'
9024 ! include 'COMMON.TORSION'
9025 ! include 'COMMON.VAR'
9026 ! include 'COMMON.GEO'
9027 ! include 'COMMON.FFIELD'
9028 real(kind=8),dimension(3) :: ggg1,ggg2
9029 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
9031 real(kind=8) :: gradcorr6ij,gradcorr6kl
9032 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
9033 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9038 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9046 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9047 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9051 derx(lll,kkk,iii)=0.0d0
9055 !d eij=facont_hb(jj,i)
9056 !d ekl=facont_hb(kk,k)
9062 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9063 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9064 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9065 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9066 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9067 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9069 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9070 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9071 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9072 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9073 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9074 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9078 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9080 ! If turn contributions are considered, they will be handled separately.
9081 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9082 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9083 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9084 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9085 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9086 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9087 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9089 if (j.lt.nres-1) then
9096 if (l.lt.nres-1) then
9104 !grad ggg1(ll)=eel6*g_contij(ll,1)
9105 !grad ggg2(ll)=eel6*g_contij(ll,2)
9106 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9107 !grad ghalf=0.5d0*ggg1(ll)
9109 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9110 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9111 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9112 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9113 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9114 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9115 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9116 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9117 !grad ghalf=0.5d0*ggg2(ll)
9118 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9120 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9121 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9122 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9123 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9124 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9125 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9130 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9131 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9136 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9137 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9143 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9148 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9152 !d write (2,*) iii,g_corr6_loc(iii)
9155 !d write (2,*) 'ekont',ekont
9156 !d write (iout,*) 'eello6',ekont*eel6
9159 !-----------------------------------------------------------------------------
9160 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
9162 ! implicit real*8 (a-h,o-z)
9163 ! include 'DIMENSIONS'
9164 ! include 'COMMON.IOUNITS'
9165 ! include 'COMMON.CHAIN'
9166 ! include 'COMMON.DERIV'
9167 ! include 'COMMON.INTERACT'
9168 ! include 'COMMON.CONTACTS'
9169 ! include 'COMMON.TORSION'
9170 ! include 'COMMON.VAR'
9171 ! include 'COMMON.GEO'
9172 real(kind=8),dimension(2) :: vv,vv1
9173 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
9176 !el common /kutas/ lprn
9177 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
9178 real(kind=8) :: s1,s2,s3,s4,s5
9179 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9181 ! Parallel Antiparallel C
9187 ! \ j|/k\| / \ |/k\|l / C
9192 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9193 itk=itortyp(itype(k,1))
9194 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9195 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9196 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9197 call transpose2(EUgC(1,1,k),auxmat(1,1))
9198 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9199 vv1(1)=pizda1(1,1)-pizda1(2,2)
9200 vv1(2)=pizda1(1,2)+pizda1(2,1)
9201 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9202 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
9203 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
9204 s5=scalar2(vv(1),Dtobr2(1,i))
9205 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9206 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9207 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
9208 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
9209 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
9210 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
9211 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
9212 +scalar2(vv(1),Dtobr2der(1,i)))
9213 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9214 vv1(1)=pizda1(1,1)-pizda1(2,2)
9215 vv1(2)=pizda1(1,2)+pizda1(2,1)
9216 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
9217 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
9219 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
9220 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
9221 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
9222 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
9223 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9225 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
9226 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
9227 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
9228 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
9229 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9231 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9232 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9233 vv1(1)=pizda1(1,1)-pizda1(2,2)
9234 vv1(2)=pizda1(1,2)+pizda1(2,1)
9235 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
9236 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
9237 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
9238 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9247 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9248 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9249 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9250 call transpose2(EUgC(1,1,k),auxmat(1,1))
9251 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
9253 vv1(1)=pizda1(1,1)-pizda1(2,2)
9254 vv1(2)=pizda1(1,2)+pizda1(2,1)
9255 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9256 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
9257 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
9258 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
9259 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
9260 s5=scalar2(vv(1),Dtobr2(1,i))
9261 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9266 end function eello6_graph1
9267 !-----------------------------------------------------------------------------
9268 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
9270 ! implicit real*8 (a-h,o-z)
9271 ! include 'DIMENSIONS'
9272 ! include 'COMMON.IOUNITS'
9273 ! include 'COMMON.CHAIN'
9274 ! include 'COMMON.DERIV'
9275 ! include 'COMMON.INTERACT'
9276 ! include 'COMMON.CONTACTS'
9277 ! include 'COMMON.TORSION'
9278 ! include 'COMMON.VAR'
9279 ! include 'COMMON.GEO'
9281 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
9282 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9284 !el common /kutas/ lprn
9285 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
9286 real(kind=8) :: s2,s3,s4
9287 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9289 ! Parallel Antiparallel C
9295 ! \ j|/k\| \ |/k\|l C
9300 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9301 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9302 ! AL 7/4/01 s1 would occur in the sixth-order moment,
9303 ! but not in a cluster cumulant
9305 s1=dip(1,jj,i)*dip(1,kk,k)
9307 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9308 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9309 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9310 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9311 call transpose2(EUg(1,1,k),auxmat(1,1))
9312 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9313 vv(1)=pizda(1,1)-pizda(2,2)
9314 vv(2)=pizda(1,2)+pizda(2,1)
9315 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9316 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9318 eello6_graph2=-(s1+s2+s3+s4)
9320 eello6_graph2=-(s2+s3+s4)
9323 ! Derivatives in gamma(i-1)
9326 s1=dipderg(1,jj,i)*dip(1,kk,k)
9328 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9329 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9330 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9331 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9333 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9335 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9337 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9339 ! Derivatives in gamma(k-1)
9341 s1=dip(1,jj,i)*dipderg(1,kk,k)
9343 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9344 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9345 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9346 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9347 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9348 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9349 vv(1)=pizda(1,1)-pizda(2,2)
9350 vv(2)=pizda(1,2)+pizda(2,1)
9351 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9353 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9355 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9357 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9358 ! Derivatives in gamma(j-1) or gamma(l-1)
9361 s1=dipderg(3,jj,i)*dip(1,kk,k)
9363 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9364 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9365 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9366 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9367 vv(1)=pizda(1,1)-pizda(2,2)
9368 vv(2)=pizda(1,2)+pizda(2,1)
9369 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9372 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9374 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9377 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9378 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9380 ! Derivatives in gamma(l-1) or gamma(j-1)
9383 s1=dip(1,jj,i)*dipderg(3,kk,k)
9385 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9386 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9387 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9388 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9389 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9390 vv(1)=pizda(1,1)-pizda(2,2)
9391 vv(2)=pizda(1,2)+pizda(2,1)
9392 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9395 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9397 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9400 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9401 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9403 ! Cartesian derivatives.
9405 write (2,*) 'In eello6_graph2'
9407 write (2,*) 'iii=',iii
9409 write (2,*) 'kkk=',kkk
9411 write (2,'(3(2f10.5),5x)') &
9412 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9422 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9424 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9427 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
9429 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9430 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
9432 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9433 call transpose2(EUg(1,1,k),auxmat(1,1))
9434 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
9436 vv(1)=pizda(1,1)-pizda(2,2)
9437 vv(2)=pizda(1,2)+pizda(2,1)
9438 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9439 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9441 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9443 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9446 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9448 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9454 end function eello6_graph2
9455 !-----------------------------------------------------------------------------
9456 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
9457 ! implicit real*8 (a-h,o-z)
9458 ! include 'DIMENSIONS'
9459 ! include 'COMMON.IOUNITS'
9460 ! include 'COMMON.CHAIN'
9461 ! include 'COMMON.DERIV'
9462 ! include 'COMMON.INTERACT'
9463 ! include 'COMMON.CONTACTS'
9464 ! include 'COMMON.TORSION'
9465 ! include 'COMMON.VAR'
9466 ! include 'COMMON.GEO'
9467 real(kind=8),dimension(2) :: vv,auxvec
9468 real(kind=8),dimension(2,2) :: pizda,auxmat
9470 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
9471 real(kind=8) :: s1,s2,s3,s4
9472 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9474 ! Parallel Antiparallel C
9480 ! j|/k\| / |/k\|l / C
9485 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9487 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9488 ! energy moment and not to the cluster cumulant.
9489 iti=itortyp(itype(i,1))
9490 if (j.lt.nres-1) then
9491 itj1=itortyp(itype(j+1,1))
9495 itk=itortyp(itype(k,1))
9496 itk1=itortyp(itype(k+1,1))
9497 if (l.lt.nres-1) then
9498 itl1=itortyp(itype(l+1,1))
9503 s1=dip(4,jj,i)*dip(4,kk,k)
9505 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
9506 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9507 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
9508 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9509 call transpose2(EE(1,1,itk),auxmat(1,1))
9510 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9511 vv(1)=pizda(1,1)+pizda(2,2)
9512 vv(2)=pizda(2,1)-pizda(1,2)
9513 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9514 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9515 !d & "sum",-(s2+s3+s4)
9517 eello6_graph3=-(s1+s2+s3+s4)
9519 eello6_graph3=-(s2+s3+s4)
9522 ! Derivatives in gamma(k-1)
9523 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
9524 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9525 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9526 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9527 ! Derivatives in gamma(l-1)
9528 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
9529 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9530 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9531 vv(1)=pizda(1,1)+pizda(2,2)
9532 vv(2)=pizda(2,1)-pizda(1,2)
9533 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9534 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9535 ! Cartesian derivatives.
9541 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9543 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9546 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
9548 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
9549 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
9551 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
9552 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
9554 vv(1)=pizda(1,1)+pizda(2,2)
9555 vv(2)=pizda(2,1)-pizda(1,2)
9556 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9558 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9560 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9563 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9565 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9567 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9572 end function eello6_graph3
9573 !-----------------------------------------------------------------------------
9574 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9575 ! implicit real*8 (a-h,o-z)
9576 ! include 'DIMENSIONS'
9577 ! include 'COMMON.IOUNITS'
9578 ! include 'COMMON.CHAIN'
9579 ! include 'COMMON.DERIV'
9580 ! include 'COMMON.INTERACT'
9581 ! include 'COMMON.CONTACTS'
9582 ! include 'COMMON.TORSION'
9583 ! include 'COMMON.VAR'
9584 ! include 'COMMON.GEO'
9585 ! include 'COMMON.FFIELD'
9586 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
9587 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9589 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
9591 real(kind=8) :: s1,s2,s3,s4
9592 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9594 ! Parallel Antiparallel C
9600 ! \ j|/k\| \ |/k\|l C
9605 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9607 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
9608 ! energy moment and not to the cluster cumulant.
9609 !d write (2,*) 'eello_graph4: wturn6',wturn6
9610 iti=itortyp(itype(i,1))
9611 itj=itortyp(itype(j,1))
9612 if (j.lt.nres-1) then
9613 itj1=itortyp(itype(j+1,1))
9617 itk=itortyp(itype(k,1))
9618 if (k.lt.nres-1) then
9619 itk1=itortyp(itype(k+1,1))
9623 itl=itortyp(itype(l,1))
9624 if (l.lt.nres-1) then
9625 itl1=itortyp(itype(l+1,1))
9629 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9630 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9631 !d & ' itl',itl,' itl1',itl1
9634 s1=dip(3,jj,i)*dip(3,kk,k)
9636 s1=dip(2,jj,j)*dip(2,kk,l)
9639 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9640 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9642 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9643 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9645 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9646 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9648 call transpose2(EUg(1,1,k),auxmat(1,1))
9649 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9650 vv(1)=pizda(1,1)-pizda(2,2)
9651 vv(2)=pizda(2,1)+pizda(1,2)
9652 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9653 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9655 eello6_graph4=-(s1+s2+s3+s4)
9657 eello6_graph4=-(s2+s3+s4)
9659 ! Derivatives in gamma(i-1)
9663 s1=dipderg(2,jj,i)*dip(3,kk,k)
9665 s1=dipderg(4,jj,j)*dip(2,kk,l)
9668 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9670 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9671 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9673 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9674 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9676 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9677 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9678 !d write (2,*) 'turn6 derivatives'
9680 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9682 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9686 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9688 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9692 ! Derivatives in gamma(k-1)
9695 s1=dip(3,jj,i)*dipderg(2,kk,k)
9697 s1=dip(2,jj,j)*dipderg(4,kk,l)
9700 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9701 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9703 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9704 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9706 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9707 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9709 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9710 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9711 vv(1)=pizda(1,1)-pizda(2,2)
9712 vv(2)=pizda(2,1)+pizda(1,2)
9713 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9714 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9716 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9718 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9722 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9724 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9727 ! Derivatives in gamma(j-1) or gamma(l-1)
9728 if (l.eq.j+1 .and. l.gt.1) then
9729 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9730 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9731 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9732 vv(1)=pizda(1,1)-pizda(2,2)
9733 vv(2)=pizda(2,1)+pizda(1,2)
9734 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9735 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9736 else if (j.gt.1) then
9737 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9738 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9739 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9740 vv(1)=pizda(1,1)-pizda(2,2)
9741 vv(2)=pizda(2,1)+pizda(1,2)
9742 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9743 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9744 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9746 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9749 ! Cartesian derivatives.
9756 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9758 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9762 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9764 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9768 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
9770 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9772 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
9773 b1(1,itj1),auxvec(1))
9774 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9776 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
9777 b1(1,itl1),auxvec(1))
9778 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9780 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
9782 vv(1)=pizda(1,1)-pizda(2,2)
9783 vv(2)=pizda(2,1)+pizda(1,2)
9784 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9786 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9788 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
9791 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
9794 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9797 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9799 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9801 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9805 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9807 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9810 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9812 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9819 end function eello6_graph4
9820 !-----------------------------------------------------------------------------
9821 real(kind=8) function eello_turn6(i,jj,kk)
9822 ! implicit real*8 (a-h,o-z)
9823 ! include 'DIMENSIONS'
9824 ! include 'COMMON.IOUNITS'
9825 ! include 'COMMON.CHAIN'
9826 ! include 'COMMON.DERIV'
9827 ! include 'COMMON.INTERACT'
9828 ! include 'COMMON.CONTACTS'
9829 ! include 'COMMON.TORSION'
9830 ! include 'COMMON.VAR'
9831 ! include 'COMMON.GEO'
9832 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
9833 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
9834 real(kind=8),dimension(3) :: ggg1,ggg2
9835 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
9836 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
9837 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9838 ! the respective energy moment and not to the cluster cumulant.
9840 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
9841 integer :: j1,j2,l1,l2,ll
9842 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
9843 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
9852 iti=itortyp(itype(i,1))
9853 itk=itortyp(itype(k,1))
9854 itk1=itortyp(itype(k+1,1))
9855 itl=itortyp(itype(l,1))
9856 itj=itortyp(itype(j,1))
9857 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9858 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
9859 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9864 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9866 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
9870 derx_turn(lll,kkk,iii)=0.0d0
9877 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9879 !d write (2,*) 'eello6_5',eello6_5
9881 call transpose2(AEA(1,1,1),auxmat(1,1))
9882 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9883 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9884 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9886 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9887 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9888 s2 = scalar2(b1(1,itk),vtemp1(1))
9890 call transpose2(AEA(1,1,2),atemp(1,1))
9891 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9892 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9893 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9895 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9896 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9897 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9899 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9900 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9901 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9902 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9903 ss13 = scalar2(b1(1,itk),vtemp4(1))
9904 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9906 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9912 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9913 ! Derivatives in gamma(i+2)
9917 call transpose2(AEA(1,1,1),auxmatd(1,1))
9918 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9919 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9920 call transpose2(AEAderg(1,1,2),atempd(1,1))
9921 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9922 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9924 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9925 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9926 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9932 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9933 ! Derivatives in gamma(i+3)
9935 call transpose2(AEA(1,1,1),auxmatd(1,1))
9936 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9937 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9938 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9940 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9941 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9942 s2d = scalar2(b1(1,itk),vtemp1d(1))
9944 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9945 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9947 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9949 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9950 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9951 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9959 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
9960 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9962 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
9963 -0.5d0*ekont*(s2d+s12d)
9965 ! Derivatives in gamma(i+4)
9966 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9967 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9968 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9970 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9971 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9972 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9980 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9982 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9984 ! Derivatives in gamma(i+5)
9986 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9987 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9988 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9990 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9991 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9992 s2d = scalar2(b1(1,itk),vtemp1d(1))
9994 call transpose2(AEA(1,1,2),atempd(1,1))
9995 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9996 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9998 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9999 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10001 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10002 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10003 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10011 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
10012 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10014 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
10015 -0.5d0*ekont*(s2d+s12d)
10017 ! Cartesian derivatives
10022 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10023 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10024 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10026 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
10027 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
10029 s2d = scalar2(b1(1,itk),vtemp1d(1))
10031 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10032 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10033 s8d = -(atempd(1,1)+atempd(2,2))* &
10034 scalar2(cc(1,1,itl),vtemp2(1))
10036 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
10038 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10039 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10046 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
10049 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
10053 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
10056 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
10065 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
10067 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10068 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10069 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10070 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10071 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
10073 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10074 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10075 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10079 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10080 !d & 16*eel_turn6_num
10082 if (j.lt.nres-1) then
10089 if (l.lt.nres-1) then
10097 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
10098 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
10099 !grad ghalf=0.5d0*ggg1(ll)
10101 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10102 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10103 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
10104 +ekont*derx_turn(ll,2,1)
10105 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10106 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
10107 +ekont*derx_turn(ll,4,1)
10108 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10109 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10110 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10111 !grad ghalf=0.5d0*ggg2(ll)
10113 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
10114 +ekont*derx_turn(ll,2,2)
10115 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10116 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
10117 +ekont*derx_turn(ll,4,2)
10118 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10119 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10120 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10125 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10130 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10136 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10141 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10145 !d write (2,*) iii,g_corr6_loc(iii)
10147 eello_turn6=ekont*eel_turn6
10148 !d write (2,*) 'ekont',ekont
10149 !d write (2,*) 'eel_turn6',ekont*eel_turn6
10151 end function eello_turn6
10152 !-----------------------------------------------------------------------------
10153 subroutine MATVEC2(A1,V1,V2)
10154 !DIR$ INLINEALWAYS MATVEC2
10156 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10158 ! implicit real*8 (a-h,o-z)
10159 ! include 'DIMENSIONS'
10160 real(kind=8),dimension(2) :: V1,V2
10161 real(kind=8),dimension(2,2) :: A1
10162 real(kind=8) :: vaux1,vaux2
10166 ! 3 VI=VI+A1(I,K)*V1(K)
10170 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10171 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10175 end subroutine MATVEC2
10176 !-----------------------------------------------------------------------------
10177 subroutine MATMAT2(A1,A2,A3)
10179 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10181 ! implicit real*8 (a-h,o-z)
10182 ! include 'DIMENSIONS'
10183 real(kind=8),dimension(2,2) :: A1,A2,A3
10184 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
10185 ! DIMENSION AI3(2,2)
10189 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
10195 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10196 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10197 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10198 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10204 end subroutine MATMAT2
10205 !-----------------------------------------------------------------------------
10206 real(kind=8) function scalar2(u,v)
10207 !DIR$ INLINEALWAYS scalar2
10209 real(kind=8),dimension(2) :: u,v
10212 scalar2=u(1)*v(1)+u(2)*v(2)
10214 end function scalar2
10215 !-----------------------------------------------------------------------------
10216 subroutine transpose2(a,at)
10217 !DIR$ INLINEALWAYS transpose2
10219 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
10222 real(kind=8),dimension(2,2) :: a,at
10228 end subroutine transpose2
10229 !-----------------------------------------------------------------------------
10230 subroutine transpose(n,a,at)
10233 real(kind=8),dimension(n,n) :: a,at
10240 end subroutine transpose
10241 !-----------------------------------------------------------------------------
10242 subroutine prodmat3(a1,a2,kk,transp,prod)
10243 !DIR$ INLINEALWAYS prodmat3
10245 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
10249 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
10251 !rc double precision auxmat(2,2),prod_(2,2)
10254 !rc call transpose2(kk(1,1),auxmat(1,1))
10255 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10256 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10258 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
10259 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10260 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
10261 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10262 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
10263 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10264 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
10265 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10268 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10269 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10271 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
10272 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10273 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
10274 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10275 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
10276 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10277 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
10278 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10281 ! call transpose2(a2(1,1),a2t(1,1))
10284 !rc print *,((prod_(i,j),i=1,2),j=1,2)
10285 !rc print *,((prod(i,j),i=1,2),j=1,2)
10288 end subroutine prodmat3
10289 !-----------------------------------------------------------------------------
10290 ! energy_p_new_barrier.F
10291 !-----------------------------------------------------------------------------
10292 subroutine sum_gradient
10293 ! implicit real*8 (a-h,o-z)
10294 use io_base, only: pdbout
10295 ! include 'DIMENSIONS'
10299 !MS$ATTRIBUTES C :: proc_proc
10305 real(kind=8),dimension(3,-1:nres) :: gradbufc,gradbufx,gradbufc_sum,&
10306 gloc_scbuf !(3,maxres)
10308 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
10310 !el local variables
10311 integer :: i,j,k,ierror,ierr
10312 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
10313 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
10314 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
10315 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
10316 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
10317 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
10318 gsccorr_max,gsccorrx_max,time00
10320 ! include 'COMMON.SETUP'
10321 ! include 'COMMON.IOUNITS'
10322 ! include 'COMMON.FFIELD'
10323 ! include 'COMMON.DERIV'
10324 ! include 'COMMON.INTERACT'
10325 ! include 'COMMON.SBRIDGE'
10326 ! include 'COMMON.CHAIN'
10327 ! include 'COMMON.VAR'
10328 ! include 'COMMON.CONTROL'
10329 ! include 'COMMON.TIME1'
10330 ! include 'COMMON.MAXGRAD'
10331 ! include 'COMMON.SCCOR'
10336 write (iout,*) "sum_gradient gvdwc, gvdwx"
10338 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10339 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
10349 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
10350 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
10351 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
10354 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
10355 ! in virtual-bond-vector coordinates
10358 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
10360 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
10361 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
10363 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
10365 ! write (iout,'(i5,3f10.5,2x,f10.5)')
10366 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
10368 write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
10370 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10371 i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
10372 (gvdwc_scpp(j,i),j=1,3)
10374 write (iout,*) "gelc_long gvdwpp gel_loc_long"
10376 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
10377 i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
10378 (gelc_loc_long(j,i),j=1,3)
10385 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10386 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10387 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10388 wel_loc*gel_loc_long(j,i)+ &
10389 wcorr*gradcorr_long(j,i)+ &
10390 wcorr5*gradcorr5_long(j,i)+ &
10391 wcorr6*gradcorr6_long(j,i)+ &
10392 wturn6*gcorr6_turn_long(j,i)+ &
10393 wstrain*ghpbc(j,i) &
10394 +wliptran*gliptranc(j,i) &
10396 +welec*gshieldc(j,i) &
10397 +wcorr*gshieldc_ec(j,i) &
10398 +wturn3*gshieldc_t3(j,i)&
10399 +wturn4*gshieldc_t4(j,i)&
10400 +wel_loc*gshieldc_ll(j,i)&
10401 +wtube*gg_tube(j,i) &
10402 +wbond_nucl*gradb_nucl(j,i)
10408 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
10409 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
10410 welec*gelc_long(j,i)+ &
10411 wbond*gradb(j,i)+ &
10412 wel_loc*gel_loc_long(j,i)+ &
10413 wcorr*gradcorr_long(j,i)+ &
10414 wcorr5*gradcorr5_long(j,i)+ &
10415 wcorr6*gradcorr6_long(j,i)+ &
10416 wturn6*gcorr6_turn_long(j,i)+ &
10417 wstrain*ghpbc(j,i) &
10418 +wliptran*gliptranc(j,i) &
10420 +welec*gshieldc(j,i)&
10421 +wcorr*gshieldc_ec(j,i) &
10422 +wturn4*gshieldc_t4(j,i) &
10423 +wel_loc*gshieldc_ll(j,i)&
10424 +wtube*gg_tube(j,i) &
10425 +wbond_nucl*gradb_nucl(j,i)
10431 if (nfgtasks.gt.1) then
10434 write (iout,*) "gradbufc before allreduce"
10436 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10442 gradbufc_sum(j,i)=gradbufc(j,i)
10445 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
10446 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
10447 ! time_reduce=time_reduce+MPI_Wtime()-time00
10449 ! write (iout,*) "gradbufc_sum after allreduce"
10451 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
10456 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
10460 gradbufc(k,i)=0.0d0
10464 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
10465 write (iout,*) (i," jgrad_start",jgrad_start(i),&
10466 " jgrad_end ",jgrad_end(i),&
10467 i=igrad_start,igrad_end)
10470 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
10471 ! do not parallelize this part.
10473 ! do i=igrad_start,igrad_end
10474 ! do j=jgrad_start(i),jgrad_end(i)
10476 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
10481 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10485 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10489 write (iout,*) "gradbufc after summing"
10491 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10499 write (iout,*) "gradbufc"
10501 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10508 gradbufc_sum(j,i)=gradbufc(j,i)
10509 gradbufc(j,i)=0.0d0
10513 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
10517 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
10522 ! gradbufc(k,i)=0.0d0
10526 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
10532 write (iout,*) "gradbufc after summing"
10534 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
10543 gradbufc(k,nres)=0.0d0
10545 !el----------------
10546 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
10547 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
10548 !el-----------------
10552 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10553 wel_loc*gel_loc(j,i)+ &
10554 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10555 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
10556 wel_loc*gel_loc_long(j,i)+ &
10557 wcorr*gradcorr_long(j,i)+ &
10558 wcorr5*gradcorr5_long(j,i)+ &
10559 wcorr6*gradcorr6_long(j,i)+ &
10560 wturn6*gcorr6_turn_long(j,i))+ &
10561 wbond*gradb(j,i)+ &
10562 wcorr*gradcorr(j,i)+ &
10563 wturn3*gcorr3_turn(j,i)+ &
10564 wturn4*gcorr4_turn(j,i)+ &
10565 wcorr5*gradcorr5(j,i)+ &
10566 wcorr6*gradcorr6(j,i)+ &
10567 wturn6*gcorr6_turn(j,i)+ &
10568 wsccor*gsccorc(j,i) &
10569 +wscloc*gscloc(j,i) &
10570 +wliptran*gliptranc(j,i) &
10572 +welec*gshieldc(j,i) &
10573 +welec*gshieldc_loc(j,i) &
10574 +wcorr*gshieldc_ec(j,i) &
10575 +wcorr*gshieldc_loc_ec(j,i) &
10576 +wturn3*gshieldc_t3(j,i) &
10577 +wturn3*gshieldc_loc_t3(j,i) &
10578 +wturn4*gshieldc_t4(j,i) &
10579 +wturn4*gshieldc_loc_t4(j,i) &
10580 +wel_loc*gshieldc_ll(j,i) &
10581 +wel_loc*gshieldc_loc_ll(j,i) &
10582 +wtube*gg_tube(j,i) &
10583 +wbond_nucl*gradb_nucl(j,i)
10588 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
10589 wel_loc*gel_loc(j,i)+ &
10590 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
10591 welec*gelc_long(j,i)+ &
10592 wel_loc*gel_loc_long(j,i)+ &
10593 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
10594 wcorr5*gradcorr5_long(j,i)+ &
10595 wcorr6*gradcorr6_long(j,i)+ &
10596 wturn6*gcorr6_turn_long(j,i))+ &
10597 wbond*gradb(j,i)+ &
10598 wcorr*gradcorr(j,i)+ &
10599 wturn3*gcorr3_turn(j,i)+ &
10600 wturn4*gcorr4_turn(j,i)+ &
10601 wcorr5*gradcorr5(j,i)+ &
10602 wcorr6*gradcorr6(j,i)+ &
10603 wturn6*gcorr6_turn(j,i)+ &
10604 wsccor*gsccorc(j,i) &
10605 +wscloc*gscloc(j,i) &
10607 +wliptran*gliptranc(j,i) &
10608 +welec*gshieldc(j,i) &
10609 +welec*gshieldc_loc(j,) &
10610 +wcorr*gshieldc_ec(j,i) &
10611 +wcorr*gshieldc_loc_ec(j,i) &
10612 +wturn3*gshieldc_t3(j,i) &
10613 +wturn3*gshieldc_loc_t3(j,i) &
10614 +wturn4*gshieldc_t4(j,i) &
10615 +wturn4*gshieldc_loc_t4(j,i) &
10616 +wel_loc*gshieldc_ll(j,i) &
10617 +wel_loc*gshieldc_loc_ll(j,i) &
10618 +wtube*gg_tube(j,i) &
10619 +wbond_nucl*gradb_nucl(j,i)
10625 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
10626 wbond*gradbx(j,i)+ &
10627 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
10628 wsccor*gsccorx(j,i) &
10629 +wscloc*gsclocx(j,i) &
10630 +wliptran*gliptranx(j,i) &
10631 +welec*gshieldx(j,i) &
10632 +wcorr*gshieldx_ec(j,i) &
10633 +wturn3*gshieldx_t3(j,i) &
10634 +wturn4*gshieldx_t4(j,i) &
10635 +wel_loc*gshieldx_ll(j,i)&
10636 +wtube*gg_tube_sc(j,i) &
10637 +wbond_nucl*gradbx_nucl(j,i)
10644 write (iout,*) "gloc before adding corr"
10646 write (iout,*) i,gloc(i,icg)
10650 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
10651 +wcorr5*g_corr5_loc(i) &
10652 +wcorr6*g_corr6_loc(i) &
10653 +wturn4*gel_loc_turn4(i) &
10654 +wturn3*gel_loc_turn3(i) &
10655 +wturn6*gel_loc_turn6(i) &
10656 +wel_loc*gel_loc_loc(i)
10659 write (iout,*) "gloc after adding corr"
10661 write (iout,*) i,gloc(i,icg)
10665 if (nfgtasks.gt.1) then
10668 gradbufc(j,i)=gradc(j,i,icg)
10669 gradbufx(j,i)=gradx(j,i,icg)
10673 glocbuf(i)=gloc(i,icg)
10677 write (iout,*) "gloc_sc before reduce"
10680 write (iout,*) i,j,gloc_sc(j,i,icg)
10687 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
10691 call MPI_Barrier(FG_COMM,IERR)
10692 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
10694 call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,&
10695 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10696 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,&
10697 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10698 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
10699 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10700 time_reduce=time_reduce+MPI_Wtime()-time00
10701 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
10702 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
10703 time_reduce=time_reduce+MPI_Wtime()-time00
10706 write (iout,*) "gloc_sc after reduce"
10709 write (iout,*) i,j,gloc_sc(j,i,icg)
10715 write (iout,*) "gloc after reduce"
10717 write (iout,*) i,gloc(i,icg)
10722 if (gnorm_check) then
10724 ! Compute the maximum elements of the gradient
10727 gvdwc_scp_max=0.0d0
10734 gcorr3_turn_max=0.0d0
10735 gcorr4_turn_max=0.0d0
10736 gradcorr5_max=0.0d0
10737 gradcorr6_max=0.0d0
10738 gcorr6_turn_max=0.0d0
10742 gradx_scp_max=0.0d0
10748 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
10749 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
10750 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
10751 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
10752 gvdwc_scp_max=gvdwc_scp_norm
10753 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
10754 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
10755 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
10756 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
10757 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
10758 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
10759 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
10760 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
10761 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
10762 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
10763 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
10764 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
10765 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
10767 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
10768 gcorr3_turn_max=gcorr3_turn_norm
10769 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
10771 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
10772 gcorr4_turn_max=gcorr4_turn_norm
10773 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
10774 if (gradcorr5_norm.gt.gradcorr5_max) &
10775 gradcorr5_max=gradcorr5_norm
10776 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
10777 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
10778 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
10780 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
10781 gcorr6_turn_max=gcorr6_turn_norm
10782 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
10783 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
10784 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
10785 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
10786 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
10787 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
10788 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
10789 if (gradx_scp_norm.gt.gradx_scp_max) &
10790 gradx_scp_max=gradx_scp_norm
10791 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
10792 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
10793 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
10794 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
10795 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
10796 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
10797 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
10798 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
10802 open(istat,file=statname,position="append")
10804 open(istat,file=statname,access="append")
10806 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
10807 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
10808 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
10809 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
10810 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
10811 gsccorx_max,gsclocx_max
10813 if (gvdwc_max.gt.1.0d4) then
10814 write (iout,*) "gvdwc gvdwx gradb gradbx"
10816 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
10817 gradb(j,i),gradbx(j,i),j=1,3)
10819 call pdbout(0.0d0,'cipiszcze',iout)
10826 write (iout,*) "gradc gradx gloc"
10828 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
10829 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
10834 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
10837 end subroutine sum_gradient
10838 !-----------------------------------------------------------------------------
10840 ! implicit real*8 (a-h,o-z)
10842 ! include 'DIMENSIONS'
10843 ! include 'COMMON.CHAIN'
10844 ! include 'COMMON.DERIV'
10845 ! include 'COMMON.CALC'
10846 ! include 'COMMON.IOUNITS'
10847 real(kind=8), dimension(3) :: dcosom1,dcosom2
10848 ! print *,"wchodze"
10849 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
10850 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
10851 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
10852 -2.0D0*alf12*eps3der+sigder*sigsq_om12
10856 ! eom12=evdwij*eps1_om12
10858 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
10860 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
10861 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
10862 !C print *,sss_ele_cut,'in sc_grad'
10864 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
10865 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
10868 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
10869 !C print *,'gg',k,gg(k)
10871 ! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
10872 ! write (iout,*) "gg",(gg(k),k=1,3)
10874 gvdwx(k,i)=gvdwx(k,i)-gg(k) +gg_lipi(k)&
10875 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
10876 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
10879 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)&
10880 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
10881 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv &
10884 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
10885 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
10886 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
10887 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
10890 ! Calculate the components of the gradient in DC and X
10894 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
10898 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
10899 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
10902 end subroutine sc_grad
10904 !-----------------------------------------------------------------------------
10905 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
10908 ! implicit real*8 (a-h,o-z)
10909 ! include 'DIMENSIONS'
10910 ! include 'COMMON.LOCAL'
10911 ! include 'COMMON.IOUNITS'
10912 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
10913 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
10914 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
10915 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
10916 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
10918 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
10919 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
10920 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
10921 !el local variables
10923 delthec=thetai-thet_pred_mean
10924 delthe0=thetai-theta0i
10925 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
10926 t3 = thetai-thet_pred_mean
10930 t14 = t12+t6*sigsqtc
10932 t21 = thetai-theta0i
10938 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
10939 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
10940 *(-t12*t9-ak*sig0inv*t27)
10942 end subroutine mixder
10944 !-----------------------------------------------------------------------------
10946 !-----------------------------------------------------------------------------
10948 !-----------------------------------------------------------------------------
10949 ! This subroutine calculates the derivatives of the consecutive virtual
10950 ! bond vectors and the SC vectors in the virtual-bond angles theta and
10951 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
10952 ! in the angles alpha and omega, describing the location of a side chain
10953 ! in its local coordinate system.
10955 ! The derivatives are stored in the following arrays:
10957 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
10958 ! The structure is as follows:
10960 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
10961 ! 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)
10962 ! . . . . . . . . . . . . . . . . . .
10963 ! 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)
10967 ! 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)
10969 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
10970 ! The structure is same as above.
10972 ! DCDS - the derivatives of the side chain vectors in the local spherical
10973 ! andgles alph and omega:
10975 ! 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)
10976 ! 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)
10980 ! 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)
10982 ! Version of March '95, based on an early version of November '91.
10984 !**********************************************************************
10985 ! implicit real*8 (a-h,o-z)
10986 ! include 'DIMENSIONS'
10987 ! include 'COMMON.VAR'
10988 ! include 'COMMON.CHAIN'
10989 ! include 'COMMON.DERIV'
10990 ! include 'COMMON.GEO'
10991 ! include 'COMMON.LOCAL'
10992 ! include 'COMMON.INTERACT'
10993 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
10994 real(kind=8),dimension(3,3) :: dp,temp
10995 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
10996 real(kind=8),dimension(3) :: xx,xx1
10997 !el local variables
10998 integer :: i,k,l,j,m,ind,ind1,jjj
10999 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
11000 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
11001 sint2,xp,yp,xxp,yyp,zzp,dj
11003 ! common /przechowalnia/ fromto
11004 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
11005 ! get the position of the jth ijth fragment of the chain coordinate system
11006 ! in the fromto array.
11007 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
11009 ! maxdim=(nres-1)*(nres-2)/2
11010 ! allocate(dcdv(6,maxdim),dxds(6,nres))
11011 ! calculate the derivatives of transformation matrix elements in theta
11014 !el call flush(iout) !el
11016 rdt(1,1,i)=-rt(1,2,i)
11017 rdt(1,2,i)= rt(1,1,i)
11019 rdt(2,1,i)=-rt(2,2,i)
11020 rdt(2,2,i)= rt(2,1,i)
11022 rdt(3,1,i)=-rt(3,2,i)
11023 rdt(3,2,i)= rt(3,1,i)
11027 ! derivatives in phi
11033 drt(2,1,i)= rt(3,1,i)
11034 drt(2,2,i)= rt(3,2,i)
11035 drt(2,3,i)= rt(3,3,i)
11036 drt(3,1,i)=-rt(2,1,i)
11037 drt(3,2,i)=-rt(2,2,i)
11038 drt(3,3,i)=-rt(2,3,i)
11041 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
11047 temp(k,l)=rt(k,l,i)
11052 fromto(k,l,ind)=temp(k,l)
11061 dpkl=dpkl+temp(k,m)*rt(m,l,j)
11064 fromto(k,l,ind)=dpkl
11075 ! Calculate derivatives.
11081 ! Derivatives of DC(i+1) in theta(i+2)
11087 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
11090 prordt(j,k,i)=dp(j,k)
11093 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
11096 ! Derivatives of SC(i+1) in theta(i+2)
11098 xx1(1)=-0.5D0*xloc(2,i+1)
11099 xx1(2)= 0.5D0*xloc(1,i+1)
11103 xj=xj+r(j,k,i)*xx1(k)
11110 rj=rj+prod(j,k,i)*xx(k)
11115 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
11116 ! than the other off-diagonal derivatives.
11121 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
11123 dxdv(j,ind1+1)=dxoiij
11125 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
11127 ! Derivatives of DC(i+1) in phi(i+2)
11133 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
11136 prodrt(j,k,i)=dp(j,k)
11138 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
11141 ! Derivatives of SC(i+1) in phi(i+2)
11144 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
11145 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
11149 rj=rj+prod(j,k,i)*xx(k)
11154 ! Derivatives of SC(i+1) in phi(i+3).
11159 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
11161 dxdv(j+3,ind1+1)=dxoiij
11164 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
11165 ! theta(nres) and phi(i+3) thru phi(nres).
11169 ind=indmat(i+1,j+1)
11170 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
11175 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
11180 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
11181 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
11182 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
11183 ! Derivatives of virtual-bond vectors in theta
11185 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
11187 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
11188 ! Derivatives of SC vectors in theta
11192 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
11194 dxdv(k,ind1+1)=dxoijk
11197 !--- Calculate the derivatives in phi
11203 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
11209 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
11214 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
11216 dxdv(k+3,ind1+1)=dxoijk
11221 ! Derivatives in alpha and omega:
11224 ! dsci=dsc(itype(i,1))
11229 if(alphi.ne.alphi) alphi=100.0
11230 if(omegi.ne.omegi) omegi=-100.0
11235 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
11236 cosalphi=dcos(alphi)
11237 sinalphi=dsin(alphi)
11238 cosomegi=dcos(omegi)
11239 sinomegi=dsin(omegi)
11240 temp(1,1)=-dsci*sinalphi
11241 temp(2,1)= dsci*cosalphi*cosomegi
11242 temp(3,1)=-dsci*cosalphi*sinomegi
11244 temp(2,2)=-dsci*sinalphi*sinomegi
11245 temp(3,2)=-dsci*sinalphi*cosomegi
11246 theta2=pi-0.5D0*theta(i+1)
11250 !d print *,((temp(l,k),l=1,3),k=1,2)
11254 xxp= xp*cost2+yp*sint2
11255 yyp=-xp*sint2+yp*cost2
11258 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
11259 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
11263 dj=dj+prod(k,l,i-1)*xx(l)
11271 end subroutine cartder
11272 !-----------------------------------------------------------------------------
11274 !-----------------------------------------------------------------------------
11275 subroutine check_cartgrad
11276 ! Check the gradient of Cartesian coordinates in internal coordinates.
11277 ! implicit real*8 (a-h,o-z)
11278 ! include 'DIMENSIONS'
11279 ! include 'COMMON.IOUNITS'
11280 ! include 'COMMON.VAR'
11281 ! include 'COMMON.CHAIN'
11282 ! include 'COMMON.GEO'
11283 ! include 'COMMON.LOCAL'
11284 ! include 'COMMON.DERIV'
11285 real(kind=8),dimension(6,nres) :: temp
11286 real(kind=8),dimension(3) :: xx,gg
11287 integer :: i,k,j,ii
11288 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
11289 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
11291 ! Check the gradient of the virtual-bond and SC vectors in the internal
11297 write (iout,'(a)') '**************** dx/dalpha'
11301 alph(i)=alph(i)+aincr
11303 temp(k,i)=dc(k,nres+i)
11307 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11308 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
11310 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11311 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
11317 write (iout,'(a)') '**************** dx/domega'
11321 omeg(i)=omeg(i)+aincr
11323 temp(k,i)=dc(k,nres+i)
11327 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
11328 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
11329 (aincr*dabs(dxds(k+3,i))+aincr))
11331 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
11332 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
11338 write (iout,'(a)') '**************** dx/dtheta'
11342 theta(i)=theta(i)+aincr
11345 temp(k,j)=dc(k,nres+j)
11351 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
11353 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11354 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
11355 (aincr*dabs(dxdv(k,ii))+aincr))
11357 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11358 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
11365 write (iout,'(a)') '***************** dx/dphi'
11368 phi(i)=phi(i)+aincr
11371 temp(k,j)=dc(k,nres+j)
11379 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
11380 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
11381 (aincr*dabs(dxdv(k+3,ii))+aincr))
11383 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11384 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11387 phi(i)=phi(i)-aincr
11390 write (iout,'(a)') '****************** ddc/dtheta'
11393 theta(i+2)=thet+aincr
11404 gg(k)=(dc(k,j)-temp(k,j))/aincr
11405 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
11406 (aincr*dabs(dcdv(k,ii))+aincr))
11408 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11409 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
11419 write (iout,'(a)') '******************* ddc/dphi'
11422 phi(i+3)=phii+aincr
11433 gg(k)=(dc(k,j)-temp(k,j))/aincr
11434 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
11435 (aincr*dabs(dcdv(k+3,ii))+aincr))
11437 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
11438 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
11449 end subroutine check_cartgrad
11450 !-----------------------------------------------------------------------------
11451 subroutine check_ecart
11452 ! Check the gradient of the energy in Cartesian coordinates.
11453 ! implicit real*8 (a-h,o-z)
11454 ! include 'DIMENSIONS'
11455 ! include 'COMMON.CHAIN'
11456 ! include 'COMMON.DERIV'
11457 ! include 'COMMON.IOUNITS'
11458 ! include 'COMMON.VAR'
11459 ! include 'COMMON.CONTACTS'
11461 !el integer :: icall
11462 !el common /srutu/ icall
11463 real(kind=8),dimension(6) :: ggg
11464 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
11465 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11466 real(kind=8),dimension(6,nres) :: grad_s
11467 real(kind=8),dimension(0:n_ene) :: energia,energia1
11468 integer :: uiparm(1)
11469 real(kind=8) :: urparm(1)
11471 integer :: nf,i,j,k
11472 real(kind=8) :: aincr,etot,etot1
11478 print '(a)','CG processor',me,' calling CHECK_CART.',aincr
11481 call geom_to_var(nvar,x)
11482 call etotal(energia)
11484 !el call enerprint(energia)
11485 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
11488 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11492 grad_s(j,i)=gradc(j,i,icg)
11493 grad_s(j+3,i)=gradx(j,i,icg)
11497 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11502 ddx(j)=dc(j,i+nres)
11505 dc(j,i)=dc(j,i)+aincr
11507 c(j,k)=c(j,k)+aincr
11508 c(j,k+nres)=c(j,k+nres)+aincr
11510 call etotal(energia1)
11512 ggg(j)=(etot1-etot)/aincr
11515 c(j,k)=c(j,k)-aincr
11516 c(j,k+nres)=c(j,k+nres)-aincr
11520 c(j,i+nres)=c(j,i+nres)+aincr
11521 dc(j,i+nres)=dc(j,i+nres)+aincr
11522 call etotal(energia1)
11524 ggg(j+3)=(etot1-etot)/aincr
11526 dc(j,i+nres)=ddx(j)
11528 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
11529 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
11532 end subroutine check_ecart
11534 !-----------------------------------------------------------------------------
11535 subroutine check_ecartint
11536 ! Check the gradient of the energy in Cartesian coordinates.
11537 use io_base, only: intout
11538 ! implicit real*8 (a-h,o-z)
11539 ! include 'DIMENSIONS'
11540 ! include 'COMMON.CONTROL'
11541 ! include 'COMMON.CHAIN'
11542 ! include 'COMMON.DERIV'
11543 ! include 'COMMON.IOUNITS'
11544 ! include 'COMMON.VAR'
11545 ! include 'COMMON.CONTACTS'
11546 ! include 'COMMON.MD'
11547 ! include 'COMMON.LOCAL'
11548 ! include 'COMMON.SPLITELE'
11550 !el integer :: icall
11551 !el common /srutu/ icall
11552 real(kind=8),dimension(6) :: ggg,ggg1
11553 real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
11554 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11555 real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
11556 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
11557 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
11558 real(kind=8),dimension(0:n_ene) :: energia,energia1
11559 integer :: uiparm(1)
11560 real(kind=8) :: urparm(1)
11562 integer :: i,j,k,nf
11563 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
11571 ! call intcartderiv
11572 ! call checkintcartgrad
11575 write(iout,*) 'Calling CHECK_ECARTINT.'
11578 write (iout,*) "Before geom_to_var"
11579 call geom_to_var(nvar,x)
11580 write (iout,*) "after geom_to_var"
11581 write (iout,*) "split_ene ",split_ene
11583 if (.not.split_ene) then
11584 write(iout,*) 'Calling CHECK_ECARTINT if'
11585 call etotal(energia)
11586 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11588 write (iout,*) "etot",etot
11590 !el call enerprint(energia)
11591 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11593 write (iout,*) "enter cartgrad"
11596 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11597 write (iout,*) "exit cartgrad"
11601 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11604 grad_s(j,0)=gcart(j,0)
11606 !elwrite(iout,*) 'Calling CHECK_ECARTINT if'
11609 grad_s(j,i)=gcart(j,i)
11610 grad_s(j+3,i)=gxcart(j,i)
11614 write(iout,*) 'Calling CHECK_ECARTIN else.'
11615 !- split gradient check
11617 call etotal_long(energia)
11618 !el call enerprint(energia)
11620 write (iout,*) "enter cartgrad"
11623 write (iout,*) "exit cartgrad"
11626 write (iout,*) "longrange grad"
11628 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11629 (gxcart(j,i),j=1,3)
11632 grad_s(j,0)=gcart(j,0)
11636 grad_s(j,i)=gcart(j,i)
11637 grad_s(j+3,i)=gxcart(j,i)
11641 call etotal_short(energia)
11642 !el call enerprint(energia)
11644 write (iout,*) "enter cartgrad"
11647 write (iout,*) "exit cartgrad"
11650 write (iout,*) "shortrange grad"
11652 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11653 (gxcart(j,i),j=1,3)
11656 grad_s1(j,0)=gcart(j,0)
11660 grad_s1(j,i)=gcart(j,i)
11661 grad_s1(j+3,i)=gxcart(j,i)
11665 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11669 if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
11670 if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
11673 dcnorm_safe1(j)=dc_norm(j,i-1)
11674 dcnorm_safe2(j)=dc_norm(j,i)
11675 dxnorm_safe(j)=dc_norm(j,i+nres)
11678 c(j,i)=ddc(j)+aincr
11679 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
11680 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
11681 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11682 dc(j,i)=c(j,i+1)-c(j,i)
11683 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11684 call int_from_cart1(.false.)
11685 if (.not.split_ene) then
11686 call etotal(energia1)
11688 write (iout,*) "ij",i,j," etot1",etot1
11691 call etotal_long(energia1)
11693 call etotal_short(energia1)
11696 !- end split gradient
11697 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11698 c(j,i)=ddc(j)-aincr
11699 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
11700 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
11701 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11702 dc(j,i)=c(j,i+1)-c(j,i)
11703 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11704 call int_from_cart1(.false.)
11705 if (.not.split_ene) then
11706 call etotal(energia1)
11708 write (iout,*) "ij",i,j," etot2",etot2
11709 ggg(j)=(etot1-etot2)/(2*aincr)
11712 call etotal_long(energia1)
11714 ggg(j)=(etot11-etot21)/(2*aincr)
11715 call etotal_short(energia1)
11717 ggg1(j)=(etot12-etot22)/(2*aincr)
11718 !- end split gradient
11719 ! write (iout,*) "etot21",etot21," etot22",etot22
11721 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11723 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
11724 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
11725 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
11726 dc(j,i)=c(j,i+1)-c(j,i)
11727 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11728 dc_norm(j,i-1)=dcnorm_safe1(j)
11729 dc_norm(j,i)=dcnorm_safe2(j)
11730 dc_norm(j,i+nres)=dxnorm_safe(j)
11733 c(j,i+nres)=ddx(j)+aincr
11734 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11735 call int_from_cart1(.false.)
11736 if (.not.split_ene) then
11737 call etotal(energia1)
11741 call etotal_long(energia1)
11743 call etotal_short(energia1)
11746 !- end split gradient
11747 c(j,i+nres)=ddx(j)-aincr
11748 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11749 call int_from_cart1(.false.)
11750 if (.not.split_ene) then
11751 call etotal(energia1)
11753 ggg(j+3)=(etot1-etot2)/(2*aincr)
11756 call etotal_long(energia1)
11758 ggg(j+3)=(etot11-etot21)/(2*aincr)
11759 call etotal_short(energia1)
11761 ggg1(j+3)=(etot12-etot22)/(2*aincr)
11762 !- end split gradient
11764 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11766 dc(j,i+nres)=c(j,i+nres)-c(j,i)
11767 dc_norm(j,i+nres)=dxnorm_safe(j)
11768 call int_from_cart1(.false.)
11770 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11771 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
11772 if (split_ene) then
11773 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11774 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
11776 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
11777 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
11778 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
11782 end subroutine check_ecartint
11784 !-----------------------------------------------------------------------------
11785 subroutine check_ecartint
11786 ! Check the gradient of the energy in Cartesian coordinates.
11787 use io_base, only: intout
11788 ! implicit real*8 (a-h,o-z)
11789 ! include 'DIMENSIONS'
11790 ! include 'COMMON.CONTROL'
11791 ! include 'COMMON.CHAIN'
11792 ! include 'COMMON.DERIV'
11793 ! include 'COMMON.IOUNITS'
11794 ! include 'COMMON.VAR'
11795 ! include 'COMMON.CONTACTS'
11796 ! include 'COMMON.MD'
11797 ! include 'COMMON.LOCAL'
11798 ! include 'COMMON.SPLITELE'
11800 !el integer :: icall
11801 !el common /srutu/ icall
11802 real(kind=8),dimension(6) :: ggg,ggg1
11803 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
11804 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
11805 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
11806 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
11807 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
11808 real(kind=8),dimension(0:n_ene) :: energia,energia1
11809 integer :: uiparm(1)
11810 real(kind=8) :: urparm(1)
11812 integer :: i,j,k,nf
11813 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
11821 ! call intcartderiv
11822 ! call checkintcartgrad
11825 write(iout,*) 'Calling CHECK_ECARTINT.',aincr
11828 call geom_to_var(nvar,x)
11829 if (.not.split_ene) then
11830 call etotal(energia)
11832 !el call enerprint(energia)
11834 write (iout,*) "enter cartgrad"
11837 write (iout,*) "exit cartgrad"
11841 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
11844 grad_s(j,0)=gcart(j,0)
11848 grad_s(j,i)=gcart(j,i)
11849 grad_s(j+3,i)=gxcart(j,i)
11853 !- split gradient check
11855 call etotal_long(energia)
11856 !el call enerprint(energia)
11858 write (iout,*) "enter cartgrad"
11861 write (iout,*) "exit cartgrad"
11864 write (iout,*) "longrange grad"
11866 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11867 (gxcart(j,i),j=1,3)
11870 grad_s(j,0)=gcart(j,0)
11874 grad_s(j,i)=gcart(j,i)
11875 grad_s(j+3,i)=gxcart(j,i)
11879 call etotal_short(energia)
11880 !el call enerprint(energia)
11882 write (iout,*) "enter cartgrad"
11885 write (iout,*) "exit cartgrad"
11888 write (iout,*) "shortrange grad"
11890 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
11891 (gxcart(j,i),j=1,3)
11894 grad_s1(j,0)=gcart(j,0)
11898 grad_s1(j,i)=gcart(j,i)
11899 grad_s1(j+3,i)=gxcart(j,i)
11903 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
11908 ddx(j)=dc(j,i+nres)
11910 dcnorm_safe(k)=dc_norm(k,i)
11911 dxnorm_safe(k)=dc_norm(k,i+nres)
11915 dc(j,i)=ddc(j)+aincr
11916 call chainbuild_cart
11918 ! Broadcast the order to compute internal coordinates to the slaves.
11919 ! if (nfgtasks.gt.1)
11920 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
11922 ! call int_from_cart1(.false.)
11923 if (.not.split_ene) then
11924 call etotal(energia1)
11928 call etotal_long(energia1)
11930 call etotal_short(energia1)
11932 ! write (iout,*) "etot11",etot11," etot12",etot12
11934 !- end split gradient
11935 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11936 dc(j,i)=ddc(j)-aincr
11937 call chainbuild_cart
11938 ! call int_from_cart1(.false.)
11939 if (.not.split_ene) then
11940 call etotal(energia1)
11942 ggg(j)=(etot1-etot2)/(2*aincr)
11945 call etotal_long(energia1)
11947 ggg(j)=(etot11-etot21)/(2*aincr)
11948 call etotal_short(energia1)
11950 ggg1(j)=(etot12-etot22)/(2*aincr)
11951 !- end split gradient
11952 ! write (iout,*) "etot21",etot21," etot22",etot22
11954 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
11956 call chainbuild_cart
11959 dc(j,i+nres)=ddx(j)+aincr
11960 call chainbuild_cart
11961 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
11962 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
11963 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
11964 ! write (iout,*) "dxnormnorm",dsqrt(
11965 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
11966 ! write (iout,*) "dxnormnormsafe",dsqrt(
11967 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
11969 if (.not.split_ene) then
11970 call etotal(energia1)
11974 call etotal_long(energia1)
11976 call etotal_short(energia1)
11979 !- end split gradient
11980 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
11981 dc(j,i+nres)=ddx(j)-aincr
11982 call chainbuild_cart
11983 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
11984 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
11985 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
11987 ! write (iout,*) "dxnormnorm",dsqrt(
11988 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
11989 ! write (iout,*) "dxnormnormsafe",dsqrt(
11990 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
11991 if (.not.split_ene) then
11992 call etotal(energia1)
11994 ggg(j+3)=(etot1-etot2)/(2*aincr)
11997 call etotal_long(energia1)
11999 ggg(j+3)=(etot11-etot21)/(2*aincr)
12000 call etotal_short(energia1)
12002 ggg1(j+3)=(etot12-etot22)/(2*aincr)
12003 !- end split gradient
12005 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12006 dc(j,i+nres)=ddx(j)
12007 call chainbuild_cart
12009 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12010 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
12011 if (split_ene) then
12012 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12013 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
12015 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12016 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
12017 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
12021 end subroutine check_ecartint
12023 !-----------------------------------------------------------------------------
12024 subroutine check_eint
12025 ! Check the gradient of energy in internal coordinates.
12026 ! implicit real*8 (a-h,o-z)
12027 ! include 'DIMENSIONS'
12028 ! include 'COMMON.CHAIN'
12029 ! include 'COMMON.DERIV'
12030 ! include 'COMMON.IOUNITS'
12031 ! include 'COMMON.VAR'
12032 ! include 'COMMON.GEO'
12034 !el integer :: icall
12035 !el common /srutu/ icall
12036 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
12037 integer :: uiparm(1)
12038 real(kind=8) :: urparm(1)
12039 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
12040 character(len=6) :: key
12043 real(kind=8) :: xi,aincr,etot,etot1,etot2
12046 print '(a)','Calling CHECK_INT.'
12050 call geom_to_var(nvar,x)
12051 call var_to_geom(nvar,x)
12055 call etotal(energia)
12057 !el call enerprint(energia)
12060 if (MyID.ne.BossID) then
12061 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
12069 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
12070 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
12071 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
12075 x(i)=xi-0.5D0*aincr
12076 call var_to_geom(nvar,x)
12078 call etotal(energia1)
12080 x(i)=xi+0.5D0*aincr
12081 call var_to_geom(nvar,x)
12083 call etotal(energia2)
12085 gg(i)=(etot2-etot1)/aincr
12086 write (iout,*) i,etot1,etot2
12089 write (iout,'(/2a)')' Variable Numerical Analytical',&
12092 if (i.le.nphi) then
12095 else if (i.le.nphi+ntheta) then
12098 else if (i.le.nphi+ntheta+nside) then
12102 ii=i-(nphi+ntheta+nside)
12105 write (iout,'(i3,a,i3,3(1pd16.6))') &
12106 i,key,ii,gg(i),gana(i),&
12107 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
12110 end subroutine check_eint
12111 !-----------------------------------------------------------------------------
12113 !-----------------------------------------------------------------------------
12114 subroutine Econstr_back
12115 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
12116 ! implicit real*8 (a-h,o-z)
12117 ! include 'DIMENSIONS'
12118 ! include 'COMMON.CONTROL'
12119 ! include 'COMMON.VAR'
12120 ! include 'COMMON.MD'
12123 ! include 'COMMON.LANGEVIN'
12125 ! include 'COMMON.LANGEVIN.lang0'
12127 ! include 'COMMON.CHAIN'
12128 ! include 'COMMON.DERIV'
12129 ! include 'COMMON.GEO'
12130 ! include 'COMMON.LOCAL'
12131 ! include 'COMMON.INTERACT'
12132 ! include 'COMMON.IOUNITS'
12133 ! include 'COMMON.NAMES'
12134 ! include 'COMMON.TIME1'
12135 integer :: i,j,ii,k
12136 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
12138 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
12139 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
12140 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
12147 duscdiff(j,i)=0.0d0
12148 duscdiffx(j,i)=0.0d0
12152 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
12154 ! Deviations from theta angles
12157 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
12158 dtheta_i=theta(j)-thetaref(j)
12159 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
12160 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
12162 utheta(i)=utheta_i/(ii-1)
12164 ! Deviations from gamma angles
12167 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
12168 dgamma_i=pinorm(phi(j)-phiref(j))
12169 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
12170 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
12171 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
12172 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
12174 ugamma(i)=ugamma_i/(ii-2)
12176 ! Deviations from local SC geometry
12179 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
12180 dxx=xxtab(j)-xxref(j)
12181 dyy=yytab(j)-yyref(j)
12182 dzz=zztab(j)-zzref(j)
12183 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
12185 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
12186 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
12188 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
12189 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
12191 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
12192 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
12195 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
12196 ! & xxref(j),yyref(j),zzref(j)
12198 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
12199 ! write (iout,*) i," uscdiff",uscdiff(i)
12201 ! Put together deviations from local geometry
12203 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
12204 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
12205 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
12206 ! & " uconst_back",uconst_back
12207 utheta(i)=dsqrt(utheta(i))
12208 ugamma(i)=dsqrt(ugamma(i))
12209 uscdiff(i)=dsqrt(uscdiff(i))
12212 end subroutine Econstr_back
12213 !-----------------------------------------------------------------------------
12214 ! energy_p_new-sep_barrier.F
12215 !-----------------------------------------------------------------------------
12216 real(kind=8) function sscale(r)
12217 ! include "COMMON.SPLITELE"
12218 real(kind=8) :: r,gamm
12219 if(r.lt.r_cut-rlamb) then
12221 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
12222 gamm=(r-(r_cut-rlamb))/rlamb
12223 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12228 end function sscale
12229 real(kind=8) function sscale_grad(r)
12230 ! include "COMMON.SPLITELE"
12231 real(kind=8) :: r,gamm
12232 if(r.lt.r_cut-rlamb) then
12234 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
12235 gamm=(r-(r_cut-rlamb))/rlamb
12236 sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
12241 end function sscale_grad
12243 !!!!!!!!!! PBCSCALE
12244 real(kind=8) function sscale_ele(r)
12245 ! include "COMMON.SPLITELE"
12246 real(kind=8) :: r,gamm
12247 if(r.lt.r_cut_ele-rlamb_ele) then
12249 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12250 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12251 sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
12256 end function sscale_ele
12258 real(kind=8) function sscagrad_ele(r)
12259 real(kind=8) :: r,gamm
12260 ! include "COMMON.SPLITELE"
12261 if(r.lt.r_cut_ele-rlamb_ele) then
12263 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
12264 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
12265 sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
12270 end function sscagrad_ele
12271 real(kind=8) function sscalelip(r)
12272 real(kind=8) r,gamm
12273 sscalelip=1.0d0+r*r*(2.0d0*r-3.0d0)
12275 end function sscalelip
12276 !C-----------------------------------------------------------------------
12277 real(kind=8) function sscagradlip(r)
12278 real(kind=8) r,gamm
12279 sscagradlip=r*(6.0d0*r-6.0d0)
12281 end function sscagradlip
12284 !-----------------------------------------------------------------------------
12285 subroutine elj_long(evdw)
12287 ! This subroutine calculates the interaction energy of nonbonded side chains
12288 ! assuming the LJ potential of interaction.
12290 ! implicit real*8 (a-h,o-z)
12291 ! include 'DIMENSIONS'
12292 ! include 'COMMON.GEO'
12293 ! include 'COMMON.VAR'
12294 ! include 'COMMON.LOCAL'
12295 ! include 'COMMON.CHAIN'
12296 ! include 'COMMON.DERIV'
12297 ! include 'COMMON.INTERACT'
12298 ! include 'COMMON.TORSION'
12299 ! include 'COMMON.SBRIDGE'
12300 ! include 'COMMON.NAMES'
12301 ! include 'COMMON.IOUNITS'
12302 ! include 'COMMON.CONTACTS'
12303 real(kind=8),parameter :: accur=1.0d-10
12304 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12305 !el local variables
12306 integer :: i,iint,j,k,itypi,itypi1,itypj
12307 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12308 real(kind=8) :: e1,e2,evdwij,evdw
12309 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12311 do i=iatsc_s,iatsc_e
12313 if (itypi.eq.ntyp1) cycle
12314 itypi1=itype(i+1,1)
12319 ! Calculate SC interaction energy.
12321 do iint=1,nint_gr(i)
12322 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12323 !d & 'iend=',iend(i,iint)
12324 do j=istart(i,iint),iend(i,iint)
12326 if (itypj.eq.ntyp1) cycle
12330 rij=xj*xj+yj*yj+zj*zj
12331 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12332 if (sss.lt.1.0d0) then
12334 eps0ij=eps(itypi,itypj)
12336 e1=fac*fac*aa_aq(itypi,itypj)
12337 e2=fac*bb_aq(itypi,itypj)
12339 evdw=evdw+(1.0d0-sss)*evdwij
12341 ! Calculate the components of the gradient in DC and X
12343 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
12348 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12349 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12350 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12351 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12359 gvdwc(j,i)=expon*gvdwc(j,i)
12360 gvdwx(j,i)=expon*gvdwx(j,i)
12363 !******************************************************************************
12367 ! To save time, the factor of EXPON has been extracted from ALL components
12368 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12371 !******************************************************************************
12373 end subroutine elj_long
12374 !-----------------------------------------------------------------------------
12375 subroutine elj_short(evdw)
12377 ! This subroutine calculates the interaction energy of nonbonded side chains
12378 ! assuming the LJ potential of interaction.
12380 ! implicit real*8 (a-h,o-z)
12381 ! include 'DIMENSIONS'
12382 ! include 'COMMON.GEO'
12383 ! include 'COMMON.VAR'
12384 ! include 'COMMON.LOCAL'
12385 ! include 'COMMON.CHAIN'
12386 ! include 'COMMON.DERIV'
12387 ! include 'COMMON.INTERACT'
12388 ! include 'COMMON.TORSION'
12389 ! include 'COMMON.SBRIDGE'
12390 ! include 'COMMON.NAMES'
12391 ! include 'COMMON.IOUNITS'
12392 ! include 'COMMON.CONTACTS'
12393 real(kind=8),parameter :: accur=1.0d-10
12394 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12395 !el local variables
12396 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
12397 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
12398 real(kind=8) :: e1,e2,evdwij,evdw
12399 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
12401 do i=iatsc_s,iatsc_e
12403 if (itypi.eq.ntyp1) cycle
12404 itypi1=itype(i+1,1)
12411 ! Calculate SC interaction energy.
12413 do iint=1,nint_gr(i)
12414 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
12415 !d & 'iend=',iend(i,iint)
12416 do j=istart(i,iint),iend(i,iint)
12418 if (itypj.eq.ntyp1) cycle
12422 ! Change 12/1/95 to calculate four-body interactions
12423 rij=xj*xj+yj*yj+zj*zj
12424 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
12425 if (sss.gt.0.0d0) then
12427 eps0ij=eps(itypi,itypj)
12429 e1=fac*fac*aa_aq(itypi,itypj)
12430 e2=fac*bb_aq(itypi,itypj)
12432 evdw=evdw+sss*evdwij
12434 ! Calculate the components of the gradient in DC and X
12436 fac=-rrij*(e1+evdwij)*sss
12441 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12442 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12443 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12444 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12452 gvdwc(j,i)=expon*gvdwc(j,i)
12453 gvdwx(j,i)=expon*gvdwx(j,i)
12456 !******************************************************************************
12460 ! To save time, the factor of EXPON has been extracted from ALL components
12461 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
12464 !******************************************************************************
12466 end subroutine elj_short
12467 !-----------------------------------------------------------------------------
12468 subroutine eljk_long(evdw)
12470 ! This subroutine calculates the interaction energy of nonbonded side chains
12471 ! assuming the LJK potential of interaction.
12473 ! implicit real*8 (a-h,o-z)
12474 ! include 'DIMENSIONS'
12475 ! include 'COMMON.GEO'
12476 ! include 'COMMON.VAR'
12477 ! include 'COMMON.LOCAL'
12478 ! include 'COMMON.CHAIN'
12479 ! include 'COMMON.DERIV'
12480 ! include 'COMMON.INTERACT'
12481 ! include 'COMMON.IOUNITS'
12482 ! include 'COMMON.NAMES'
12483 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12485 !el local variables
12486 integer :: i,iint,j,k,itypi,itypi1,itypj
12487 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12488 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12489 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12491 do i=iatsc_s,iatsc_e
12493 if (itypi.eq.ntyp1) cycle
12494 itypi1=itype(i+1,1)
12499 ! Calculate SC interaction energy.
12501 do iint=1,nint_gr(i)
12502 do j=istart(i,iint),iend(i,iint)
12504 if (itypj.eq.ntyp1) cycle
12508 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12509 fac_augm=rrij**expon
12510 e_augm=augm(itypi,itypj)*fac_augm
12511 r_inv_ij=dsqrt(rrij)
12513 sss=sscale(rij/sigma(itypi,itypj))
12514 if (sss.lt.1.0d0) then
12515 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12516 fac=r_shift_inv**expon
12517 e1=fac*fac*aa_aq(itypi,itypj)
12518 e2=fac*bb_aq(itypi,itypj)
12519 evdwij=e_augm+e1+e2
12520 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12521 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12522 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12523 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
12524 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12525 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12526 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12527 evdw=evdw+(1.0d0-sss)*evdwij
12529 ! Calculate the components of the gradient in DC and X
12531 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12532 fac=fac*(1.0d0-sss)
12537 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12538 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12539 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12540 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12548 gvdwc(j,i)=expon*gvdwc(j,i)
12549 gvdwx(j,i)=expon*gvdwx(j,i)
12553 end subroutine eljk_long
12554 !-----------------------------------------------------------------------------
12555 subroutine eljk_short(evdw)
12557 ! This subroutine calculates the interaction energy of nonbonded side chains
12558 ! assuming the LJK potential of interaction.
12560 ! implicit real*8 (a-h,o-z)
12561 ! include 'DIMENSIONS'
12562 ! include 'COMMON.GEO'
12563 ! include 'COMMON.VAR'
12564 ! include 'COMMON.LOCAL'
12565 ! include 'COMMON.CHAIN'
12566 ! include 'COMMON.DERIV'
12567 ! include 'COMMON.INTERACT'
12568 ! include 'COMMON.IOUNITS'
12569 ! include 'COMMON.NAMES'
12570 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
12572 !el local variables
12573 integer :: i,iint,j,k,itypi,itypi1,itypj
12574 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
12575 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
12576 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
12578 do i=iatsc_s,iatsc_e
12580 if (itypi.eq.ntyp1) cycle
12581 itypi1=itype(i+1,1)
12586 ! Calculate SC interaction energy.
12588 do iint=1,nint_gr(i)
12589 do j=istart(i,iint),iend(i,iint)
12591 if (itypj.eq.ntyp1) cycle
12595 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12596 fac_augm=rrij**expon
12597 e_augm=augm(itypi,itypj)*fac_augm
12598 r_inv_ij=dsqrt(rrij)
12600 sss=sscale(rij/sigma(itypi,itypj))
12601 if (sss.gt.0.0d0) then
12602 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
12603 fac=r_shift_inv**expon
12604 e1=fac*fac*aa_aq(itypi,itypj)
12605 e2=fac*bb_aq(itypi,itypj)
12606 evdwij=e_augm+e1+e2
12607 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
12608 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
12609 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
12610 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
12611 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
12612 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
12613 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
12614 evdw=evdw+sss*evdwij
12616 ! Calculate the components of the gradient in DC and X
12618 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
12624 gvdwx(k,i)=gvdwx(k,i)-gg(k)
12625 gvdwx(k,j)=gvdwx(k,j)+gg(k)
12626 gvdwc(k,i)=gvdwc(k,i)-gg(k)
12627 gvdwc(k,j)=gvdwc(k,j)+gg(k)
12635 gvdwc(j,i)=expon*gvdwc(j,i)
12636 gvdwx(j,i)=expon*gvdwx(j,i)
12640 end subroutine eljk_short
12641 !-----------------------------------------------------------------------------
12642 subroutine ebp_long(evdw)
12644 ! This subroutine calculates the interaction energy of nonbonded side chains
12645 ! assuming the Berne-Pechukas potential of interaction.
12648 ! implicit real*8 (a-h,o-z)
12649 ! include 'DIMENSIONS'
12650 ! include 'COMMON.GEO'
12651 ! include 'COMMON.VAR'
12652 ! include 'COMMON.LOCAL'
12653 ! include 'COMMON.CHAIN'
12654 ! include 'COMMON.DERIV'
12655 ! include 'COMMON.NAMES'
12656 ! include 'COMMON.INTERACT'
12657 ! include 'COMMON.IOUNITS'
12658 ! include 'COMMON.CALC'
12660 !el integer :: icall
12661 !el common /srutu/ icall
12662 ! double precision rrsave(maxdim)
12664 !el local variables
12665 integer :: iint,itypi,itypi1,itypj
12666 real(kind=8) :: rrij,xi,yi,zi,fac
12667 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
12669 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
12671 ! if (icall.eq.0) then
12677 do i=iatsc_s,iatsc_e
12679 if (itypi.eq.ntyp1) cycle
12680 itypi1=itype(i+1,1)
12684 dxi=dc_norm(1,nres+i)
12685 dyi=dc_norm(2,nres+i)
12686 dzi=dc_norm(3,nres+i)
12687 ! dsci_inv=dsc_inv(itypi)
12688 dsci_inv=vbld_inv(i+nres)
12690 ! Calculate SC interaction energy.
12692 do iint=1,nint_gr(i)
12693 do j=istart(i,iint),iend(i,iint)
12696 if (itypj.eq.ntyp1) cycle
12697 ! dscj_inv=dsc_inv(itypj)
12698 dscj_inv=vbld_inv(j+nres)
12699 chi1=chi(itypi,itypj)
12700 chi2=chi(itypj,itypi)
12707 alf12=0.5D0*(alf1+alf2)
12711 dxj=dc_norm(1,nres+j)
12712 dyj=dc_norm(2,nres+j)
12713 dzj=dc_norm(3,nres+j)
12714 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12716 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12718 if (sss.lt.1.0d0) then
12720 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
12722 ! Calculate whole angle-dependent part of epsilon and contributions
12723 ! to its derivatives
12724 fac=(rrij*sigsq)**expon2
12725 e1=fac*fac*aa_aq(itypi,itypj)
12726 e2=fac*bb_aq(itypi,itypj)
12727 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12728 eps2der=evdwij*eps3rt
12729 eps3der=evdwij*eps2rt
12730 evdwij=evdwij*eps2rt*eps3rt
12731 evdw=evdw+evdwij*(1.0d0-sss)
12733 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
12734 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
12735 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
12736 !d & restyp(itypi,1),i,restyp(itypj,1),j,
12737 !d & epsi,sigm,chi1,chi2,chip1,chip2,
12738 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
12739 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
12742 ! Calculate gradient components.
12743 e1=e1*eps1*eps2rt**2*eps3rt**2
12744 fac=-expon*(e1+evdwij)
12747 ! Calculate radial part of the gradient
12751 ! Calculate the angular part of the gradient and sum add the contributions
12752 ! to the appropriate components of the Cartesian gradient.
12753 call sc_grad_scale(1.0d0-sss)
12760 end subroutine ebp_long
12761 !-----------------------------------------------------------------------------
12762 subroutine ebp_short(evdw)
12764 ! This subroutine calculates the interaction energy of nonbonded side chains
12765 ! assuming the Berne-Pechukas potential of interaction.
12768 ! implicit real*8 (a-h,o-z)
12769 ! include 'DIMENSIONS'
12770 ! include 'COMMON.GEO'
12771 ! include 'COMMON.VAR'
12772 ! include 'COMMON.LOCAL'
12773 ! include 'COMMON.CHAIN'
12774 ! include 'COMMON.DERIV'
12775 ! include 'COMMON.NAMES'
12776 ! include 'COMMON.INTERACT'
12777 ! include 'COMMON.IOUNITS'
12778 ! include 'COMMON.CALC'
12780 !el integer :: icall
12781 !el common /srutu/ icall
12782 ! double precision rrsave(maxdim)
12784 !el local variables
12785 integer :: iint,itypi,itypi1,itypj
12786 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
12787 real(kind=8) :: sss,e1,e2,evdw
12789 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
12791 ! if (icall.eq.0) then
12797 do i=iatsc_s,iatsc_e
12799 if (itypi.eq.ntyp1) cycle
12800 itypi1=itype(i+1,1)
12804 dxi=dc_norm(1,nres+i)
12805 dyi=dc_norm(2,nres+i)
12806 dzi=dc_norm(3,nres+i)
12807 ! dsci_inv=dsc_inv(itypi)
12808 dsci_inv=vbld_inv(i+nres)
12810 ! Calculate SC interaction energy.
12812 do iint=1,nint_gr(i)
12813 do j=istart(i,iint),iend(i,iint)
12816 if (itypj.eq.ntyp1) cycle
12817 ! dscj_inv=dsc_inv(itypj)
12818 dscj_inv=vbld_inv(j+nres)
12819 chi1=chi(itypi,itypj)
12820 chi2=chi(itypj,itypi)
12827 alf12=0.5D0*(alf1+alf2)
12831 dxj=dc_norm(1,nres+j)
12832 dyj=dc_norm(2,nres+j)
12833 dzj=dc_norm(3,nres+j)
12834 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
12836 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
12838 if (sss.gt.0.0d0) then
12840 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
12842 ! Calculate whole angle-dependent part of epsilon and contributions
12843 ! to its derivatives
12844 fac=(rrij*sigsq)**expon2
12845 e1=fac*fac*aa_aq(itypi,itypj)
12846 e2=fac*bb_aq(itypi,itypj)
12847 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
12848 eps2der=evdwij*eps3rt
12849 eps3der=evdwij*eps2rt
12850 evdwij=evdwij*eps2rt*eps3rt
12851 evdw=evdw+evdwij*sss
12853 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
12854 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
12855 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
12856 !d & restyp(itypi,1),i,restyp(itypj,1),j,
12857 !d & epsi,sigm,chi1,chi2,chip1,chip2,
12858 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
12859 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
12862 ! Calculate gradient components.
12863 e1=e1*eps1*eps2rt**2*eps3rt**2
12864 fac=-expon*(e1+evdwij)
12867 ! Calculate radial part of the gradient
12871 ! Calculate the angular part of the gradient and sum add the contributions
12872 ! to the appropriate components of the Cartesian gradient.
12873 call sc_grad_scale(sss)
12880 end subroutine ebp_short
12881 !-----------------------------------------------------------------------------
12882 subroutine egb_long(evdw)
12884 ! This subroutine calculates the interaction energy of nonbonded side chains
12885 ! assuming the Gay-Berne potential of interaction.
12888 ! implicit real*8 (a-h,o-z)
12889 ! include 'DIMENSIONS'
12890 ! include 'COMMON.GEO'
12891 ! include 'COMMON.VAR'
12892 ! include 'COMMON.LOCAL'
12893 ! include 'COMMON.CHAIN'
12894 ! include 'COMMON.DERIV'
12895 ! include 'COMMON.NAMES'
12896 ! include 'COMMON.INTERACT'
12897 ! include 'COMMON.IOUNITS'
12898 ! include 'COMMON.CALC'
12899 ! include 'COMMON.CONTROL'
12901 !el local variables
12902 integer :: iint,itypi,itypi1,itypj,subchap
12903 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
12904 real(kind=8) :: sss,e1,e2,evdw,sss_grad
12905 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
12906 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
12907 ssgradlipi,ssgradlipj
12911 !cccc energy_dec=.false.
12912 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
12915 ! if (icall.eq.0) lprn=.false.
12917 do i=iatsc_s,iatsc_e
12919 if (itypi.eq.ntyp1) cycle
12920 itypi1=itype(i+1,1)
12924 xi=mod(xi,boxxsize)
12925 if (xi.lt.0) xi=xi+boxxsize
12926 yi=mod(yi,boxysize)
12927 if (yi.lt.0) yi=yi+boxysize
12928 zi=mod(zi,boxzsize)
12929 if (zi.lt.0) zi=zi+boxzsize
12930 if ((zi.gt.bordlipbot) &
12931 .and.(zi.lt.bordliptop)) then
12932 !C the energy transfer exist
12933 if (zi.lt.buflipbot) then
12934 !C what fraction I am in
12936 ((zi-bordlipbot)/lipbufthick)
12937 !C lipbufthick is thickenes of lipid buffore
12938 sslipi=sscalelip(fracinbuf)
12939 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
12940 elseif (zi.gt.bufliptop) then
12941 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
12942 sslipi=sscalelip(fracinbuf)
12943 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
12953 dxi=dc_norm(1,nres+i)
12954 dyi=dc_norm(2,nres+i)
12955 dzi=dc_norm(3,nres+i)
12956 ! dsci_inv=dsc_inv(itypi)
12957 dsci_inv=vbld_inv(i+nres)
12958 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
12959 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
12961 ! Calculate SC interaction energy.
12963 do iint=1,nint_gr(i)
12964 do j=istart(i,iint),iend(i,iint)
12965 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
12966 ! call dyn_ssbond_ene(i,j,evdwij)
12968 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
12969 ! 'evdw',i,j,evdwij,' ss'
12970 ! if (energy_dec) write (iout,*) &
12971 ! 'evdw',i,j,evdwij,' ss'
12972 ! do k=j+1,iend(i,iint)
12973 !C search over all next residues
12974 ! if (dyn_ss_mask(k)) then
12975 !C check if they are cysteins
12976 !C write(iout,*) 'k=',k
12978 !c write(iout,*) "PRZED TRI", evdwij
12979 ! evdwij_przed_tri=evdwij
12980 ! call triple_ssbond_ene(i,j,k,evdwij)
12981 !c if(evdwij_przed_tri.ne.evdwij) then
12982 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
12985 !c write(iout,*) "PO TRI", evdwij
12986 !C call the energy function that removes the artifical triple disulfide
12987 !C bond the soubroutine is located in ssMD.F
12989 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
12990 'evdw',i,j,evdwij,'tss'
12991 ! endif!dyn_ss_mask(k)
12997 if (itypj.eq.ntyp1) cycle
12998 ! dscj_inv=dsc_inv(itypj)
12999 dscj_inv=vbld_inv(j+nres)
13000 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
13001 ! & 1.0d0/vbld(j+nres)
13002 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
13003 sig0ij=sigma(itypi,itypj)
13004 chi1=chi(itypi,itypj)
13005 chi2=chi(itypj,itypi)
13012 alf12=0.5D0*(alf1+alf2)
13016 ! Searching for nearest neighbour
13017 xj=mod(xj,boxxsize)
13018 if (xj.lt.0) xj=xj+boxxsize
13019 yj=mod(yj,boxysize)
13020 if (yj.lt.0) yj=yj+boxysize
13021 zj=mod(zj,boxzsize)
13022 if (zj.lt.0) zj=zj+boxzsize
13023 if ((zj.gt.bordlipbot) &
13024 .and.(zj.lt.bordliptop)) then
13025 !C the energy transfer exist
13026 if (zj.lt.buflipbot) then
13027 !C what fraction I am in
13029 ((zj-bordlipbot)/lipbufthick)
13030 !C lipbufthick is thickenes of lipid buffore
13031 sslipj=sscalelip(fracinbuf)
13032 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
13033 elseif (zj.gt.bufliptop) then
13034 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
13035 sslipj=sscalelip(fracinbuf)
13036 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13045 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13046 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13047 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13048 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13050 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13058 xj=xj_safe+xshift*boxxsize
13059 yj=yj_safe+yshift*boxysize
13060 zj=zj_safe+zshift*boxzsize
13061 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13062 if(dist_temp.lt.dist_init) then
13063 dist_init=dist_temp
13072 if (subchap.eq.1) then
13082 dxj=dc_norm(1,nres+j)
13083 dyj=dc_norm(2,nres+j)
13084 dzj=dc_norm(3,nres+j)
13085 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13087 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13088 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
13089 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
13090 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13091 if (sss_ele_cut.le.0.0) cycle
13092 if (sss.lt.1.0d0) then
13094 ! Calculate angle-dependent terms of energy and contributions to their
13098 sig=sig0ij*dsqrt(sigsq)
13099 rij_shift=1.0D0/rij-sig+sig0ij
13100 ! for diagnostics; uncomment
13101 ! rij_shift=1.2*sig0ij
13102 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13103 if (rij_shift.le.0.0D0) then
13105 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13106 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13107 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13111 !---------------------------------------------------------------
13112 rij_shift=1.0D0/rij_shift
13113 fac=rij_shift**expon
13116 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13117 eps2der=evdwij*eps3rt
13118 eps3der=evdwij*eps2rt
13119 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13120 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13121 evdwij=evdwij*eps2rt*eps3rt
13122 evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
13124 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13125 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13126 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13127 restyp(itypi,1),i,restyp(itypj,1),j,&
13128 epsi,sigm,chi1,chi2,chip1,chip2,&
13129 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13130 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13134 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13136 ! if (energy_dec) write (iout,*) &
13137 ! 'evdw',i,j,evdwij,"egb_long"
13139 ! Calculate gradient components.
13140 e1=e1*eps1*eps2rt**2*eps3rt**2
13141 fac=-expon*(e1+evdwij)*rij_shift
13144 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13145 /sigma(itypi,itypj)*rij-sss_grad/(1.0-sss)*rij &
13146 /sigmaii(itypi,itypj))
13148 ! Calculate the radial part of the gradient
13152 ! Calculate angular part of the gradient.
13153 call sc_grad_scale(1.0d0-sss)
13159 ! write (iout,*) "Number of loop steps in EGB:",ind
13160 !ccc energy_dec=.false.
13162 end subroutine egb_long
13163 !-----------------------------------------------------------------------------
13164 subroutine egb_short(evdw)
13166 ! This subroutine calculates the interaction energy of nonbonded side chains
13167 ! assuming the Gay-Berne potential of interaction.
13170 ! implicit real*8 (a-h,o-z)
13171 ! include 'DIMENSIONS'
13172 ! include 'COMMON.GEO'
13173 ! include 'COMMON.VAR'
13174 ! include 'COMMON.LOCAL'
13175 ! include 'COMMON.CHAIN'
13176 ! include 'COMMON.DERIV'
13177 ! include 'COMMON.NAMES'
13178 ! include 'COMMON.INTERACT'
13179 ! include 'COMMON.IOUNITS'
13180 ! include 'COMMON.CALC'
13181 ! include 'COMMON.CONTROL'
13183 !el local variables
13184 integer :: iint,itypi,itypi1,itypj,subchap
13185 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
13186 real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad
13187 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13188 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13189 ssgradlipi,ssgradlipj
13191 !cccc energy_dec=.false.
13192 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13195 ! if (icall.eq.0) lprn=.false.
13197 do i=iatsc_s,iatsc_e
13199 if (itypi.eq.ntyp1) cycle
13200 itypi1=itype(i+1,1)
13204 xi=mod(xi,boxxsize)
13205 if (xi.lt.0) xi=xi+boxxsize
13206 yi=mod(yi,boxysize)
13207 if (yi.lt.0) yi=yi+boxysize
13208 zi=mod(zi,boxzsize)
13209 if (zi.lt.0) zi=zi+boxzsize
13210 if ((zi.gt.bordlipbot) &
13211 .and.(zi.lt.bordliptop)) then
13212 !C the energy transfer exist
13213 if (zi.lt.buflipbot) then
13214 !C what fraction I am in
13216 ((zi-bordlipbot)/lipbufthick)
13217 !C lipbufthick is thickenes of lipid buffore
13218 sslipi=sscalelip(fracinbuf)
13219 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
13220 elseif (zi.gt.bufliptop) then
13221 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
13222 sslipi=sscalelip(fracinbuf)
13223 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
13233 dxi=dc_norm(1,nres+i)
13234 dyi=dc_norm(2,nres+i)
13235 dzi=dc_norm(3,nres+i)
13236 ! dsci_inv=dsc_inv(itypi)
13237 dsci_inv=vbld_inv(i+nres)
13239 dxi=dc_norm(1,nres+i)
13240 dyi=dc_norm(2,nres+i)
13241 dzi=dc_norm(3,nres+i)
13242 ! dsci_inv=dsc_inv(itypi)
13243 dsci_inv=vbld_inv(i+nres)
13244 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
13245 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
13247 ! Calculate SC interaction energy.
13249 do iint=1,nint_gr(i)
13250 do j=istart(i,iint),iend(i,iint)
13251 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
13252 call dyn_ssbond_ene(i,j,evdwij)
13254 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13255 'evdw',i,j,evdwij,' ss'
13256 do k=j+1,iend(i,iint)
13257 !C search over all next residues
13258 if (dyn_ss_mask(k)) then
13259 !C check if they are cysteins
13260 !C write(iout,*) 'k=',k
13262 !c write(iout,*) "PRZED TRI", evdwij
13263 ! evdwij_przed_tri=evdwij
13264 call triple_ssbond_ene(i,j,k,evdwij)
13265 !c if(evdwij_przed_tri.ne.evdwij) then
13266 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
13269 !c write(iout,*) "PO TRI", evdwij
13270 !C call the energy function that removes the artifical triple disulfide
13271 !C bond the soubroutine is located in ssMD.F
13273 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13274 'evdw',i,j,evdwij,'tss'
13275 endif!dyn_ss_mask(k)
13278 ! if (energy_dec) write (iout,*) &
13279 ! 'evdw',i,j,evdwij,' ss'
13283 if (itypj.eq.ntyp1) cycle
13284 ! dscj_inv=dsc_inv(itypj)
13285 dscj_inv=vbld_inv(j+nres)
13286 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
13287 ! & 1.0d0/vbld(j+nres)
13288 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
13289 sig0ij=sigma(itypi,itypj)
13290 chi1=chi(itypi,itypj)
13291 chi2=chi(itypj,itypi)
13298 alf12=0.5D0*(alf1+alf2)
13299 ! xj=c(1,nres+j)-xi
13300 ! yj=c(2,nres+j)-yi
13301 ! zj=c(3,nres+j)-zi
13305 ! Searching for nearest neighbour
13306 xj=mod(xj,boxxsize)
13307 if (xj.lt.0) xj=xj+boxxsize
13308 yj=mod(yj,boxysize)
13309 if (yj.lt.0) yj=yj+boxysize
13310 zj=mod(zj,boxzsize)
13311 if (zj.lt.0) zj=zj+boxzsize
13312 if ((zj.gt.bordlipbot) &
13313 .and.(zj.lt.bordliptop)) then
13314 !C the energy transfer exist
13315 if (zj.lt.buflipbot) then
13316 !C what fraction I am in
13318 ((zj-bordlipbot)/lipbufthick)
13319 !C lipbufthick is thickenes of lipid buffore
13320 sslipj=sscalelip(fracinbuf)
13321 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
13322 elseif (zj.gt.bufliptop) then
13323 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
13324 sslipj=sscalelip(fracinbuf)
13325 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13334 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13335 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13336 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13337 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13339 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13348 xj=xj_safe+xshift*boxxsize
13349 yj=yj_safe+yshift*boxysize
13350 zj=zj_safe+zshift*boxzsize
13351 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13352 if(dist_temp.lt.dist_init) then
13353 dist_init=dist_temp
13362 if (subchap.eq.1) then
13372 dxj=dc_norm(1,nres+j)
13373 dyj=dc_norm(2,nres+j)
13374 dzj=dc_norm(3,nres+j)
13375 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13377 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13378 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
13379 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
13380 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
13381 if (sss_ele_cut.le.0.0) cycle
13383 if (sss.gt.0.0d0) then
13385 ! Calculate angle-dependent terms of energy and contributions to their
13389 sig=sig0ij*dsqrt(sigsq)
13390 rij_shift=1.0D0/rij-sig+sig0ij
13391 ! for diagnostics; uncomment
13392 ! rij_shift=1.2*sig0ij
13393 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13394 if (rij_shift.le.0.0D0) then
13396 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
13397 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13398 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
13402 !---------------------------------------------------------------
13403 rij_shift=1.0D0/rij_shift
13404 fac=rij_shift**expon
13407 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13408 eps2der=evdwij*eps3rt
13409 eps3der=evdwij*eps2rt
13410 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
13411 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
13412 evdwij=evdwij*eps2rt*eps3rt
13413 evdw=evdw+evdwij*sss*sss_ele_cut
13415 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13416 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13417 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13418 restyp(itypi,1),i,restyp(itypj,1),j,&
13419 epsi,sigm,chi1,chi2,chip1,chip2,&
13420 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
13421 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13425 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
13427 ! if (energy_dec) write (iout,*) &
13428 ! 'evdw',i,j,evdwij,"egb_short"
13430 ! Calculate gradient components.
13431 e1=e1*eps1*eps2rt**2*eps3rt**2
13432 fac=-expon*(e1+evdwij)*rij_shift
13435 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
13436 /sigma(itypi,itypj)*rij+sss_grad/sss*rij &
13437 /sigmaii(itypi,itypj))
13440 ! Calculate the radial part of the gradient
13444 ! Calculate angular part of the gradient.
13445 call sc_grad_scale(sss)
13451 ! write (iout,*) "Number of loop steps in EGB:",ind
13452 !ccc energy_dec=.false.
13454 end subroutine egb_short
13455 !-----------------------------------------------------------------------------
13456 subroutine egbv_long(evdw)
13458 ! This subroutine calculates the interaction energy of nonbonded side chains
13459 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13462 ! implicit real*8 (a-h,o-z)
13463 ! include 'DIMENSIONS'
13464 ! include 'COMMON.GEO'
13465 ! include 'COMMON.VAR'
13466 ! include 'COMMON.LOCAL'
13467 ! include 'COMMON.CHAIN'
13468 ! include 'COMMON.DERIV'
13469 ! include 'COMMON.NAMES'
13470 ! include 'COMMON.INTERACT'
13471 ! include 'COMMON.IOUNITS'
13472 ! include 'COMMON.CALC'
13474 !el integer :: icall
13475 !el common /srutu/ icall
13477 !el local variables
13478 integer :: iint,itypi,itypi1,itypj
13479 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
13480 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
13482 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13485 ! if (icall.eq.0) lprn=.true.
13487 do i=iatsc_s,iatsc_e
13489 if (itypi.eq.ntyp1) cycle
13490 itypi1=itype(i+1,1)
13494 dxi=dc_norm(1,nres+i)
13495 dyi=dc_norm(2,nres+i)
13496 dzi=dc_norm(3,nres+i)
13497 ! dsci_inv=dsc_inv(itypi)
13498 dsci_inv=vbld_inv(i+nres)
13500 ! Calculate SC interaction energy.
13502 do iint=1,nint_gr(i)
13503 do j=istart(i,iint),iend(i,iint)
13506 if (itypj.eq.ntyp1) cycle
13507 ! dscj_inv=dsc_inv(itypj)
13508 dscj_inv=vbld_inv(j+nres)
13509 sig0ij=sigma(itypi,itypj)
13510 r0ij=r0(itypi,itypj)
13511 chi1=chi(itypi,itypj)
13512 chi2=chi(itypj,itypi)
13519 alf12=0.5D0*(alf1+alf2)
13523 dxj=dc_norm(1,nres+j)
13524 dyj=dc_norm(2,nres+j)
13525 dzj=dc_norm(3,nres+j)
13526 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13529 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13531 if (sss.lt.1.0d0) then
13533 ! Calculate angle-dependent terms of energy and contributions to their
13537 sig=sig0ij*dsqrt(sigsq)
13538 rij_shift=1.0D0/rij-sig+r0ij
13539 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13540 if (rij_shift.le.0.0D0) then
13545 !---------------------------------------------------------------
13546 rij_shift=1.0D0/rij_shift
13547 fac=rij_shift**expon
13548 e1=fac*fac*aa_aq(itypi,itypj)
13549 e2=fac*bb_aq(itypi,itypj)
13550 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13551 eps2der=evdwij*eps3rt
13552 eps3der=evdwij*eps2rt
13553 fac_augm=rrij**expon
13554 e_augm=augm(itypi,itypj)*fac_augm
13555 evdwij=evdwij*eps2rt*eps3rt
13556 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
13558 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13559 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13560 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13561 restyp(itypi,1),i,restyp(itypj,1),j,&
13562 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13563 chi1,chi2,chip1,chip2,&
13564 eps1,eps2rt**2,eps3rt**2,&
13565 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13568 ! Calculate gradient components.
13569 e1=e1*eps1*eps2rt**2*eps3rt**2
13570 fac=-expon*(e1+evdwij)*rij_shift
13572 fac=rij*fac-2*expon*rrij*e_augm
13573 ! Calculate the radial part of the gradient
13577 ! Calculate angular part of the gradient.
13578 call sc_grad_scale(1.0d0-sss)
13583 end subroutine egbv_long
13584 !-----------------------------------------------------------------------------
13585 subroutine egbv_short(evdw)
13587 ! This subroutine calculates the interaction energy of nonbonded side chains
13588 ! assuming the Gay-Berne-Vorobjev potential of interaction.
13591 ! implicit real*8 (a-h,o-z)
13592 ! include 'DIMENSIONS'
13593 ! include 'COMMON.GEO'
13594 ! include 'COMMON.VAR'
13595 ! include 'COMMON.LOCAL'
13596 ! include 'COMMON.CHAIN'
13597 ! include 'COMMON.DERIV'
13598 ! include 'COMMON.NAMES'
13599 ! include 'COMMON.INTERACT'
13600 ! include 'COMMON.IOUNITS'
13601 ! include 'COMMON.CALC'
13603 !el integer :: icall
13604 !el common /srutu/ icall
13606 !el local variables
13607 integer :: iint,itypi,itypi1,itypj
13608 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
13609 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
13611 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13614 ! if (icall.eq.0) lprn=.true.
13616 do i=iatsc_s,iatsc_e
13618 if (itypi.eq.ntyp1) cycle
13619 itypi1=itype(i+1,1)
13623 dxi=dc_norm(1,nres+i)
13624 dyi=dc_norm(2,nres+i)
13625 dzi=dc_norm(3,nres+i)
13626 ! dsci_inv=dsc_inv(itypi)
13627 dsci_inv=vbld_inv(i+nres)
13629 ! Calculate SC interaction energy.
13631 do iint=1,nint_gr(i)
13632 do j=istart(i,iint),iend(i,iint)
13635 if (itypj.eq.ntyp1) cycle
13636 ! dscj_inv=dsc_inv(itypj)
13637 dscj_inv=vbld_inv(j+nres)
13638 sig0ij=sigma(itypi,itypj)
13639 r0ij=r0(itypi,itypj)
13640 chi1=chi(itypi,itypj)
13641 chi2=chi(itypj,itypi)
13648 alf12=0.5D0*(alf1+alf2)
13652 dxj=dc_norm(1,nres+j)
13653 dyj=dc_norm(2,nres+j)
13654 dzj=dc_norm(3,nres+j)
13655 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13658 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13660 if (sss.gt.0.0d0) then
13662 ! Calculate angle-dependent terms of energy and contributions to their
13666 sig=sig0ij*dsqrt(sigsq)
13667 rij_shift=1.0D0/rij-sig+r0ij
13668 ! I hate to put IF's in the loops, but here don't have another choice!!!!
13669 if (rij_shift.le.0.0D0) then
13674 !---------------------------------------------------------------
13675 rij_shift=1.0D0/rij_shift
13676 fac=rij_shift**expon
13677 e1=fac*fac*aa_aq(itypi,itypj)
13678 e2=fac*bb_aq(itypi,itypj)
13679 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13680 eps2der=evdwij*eps3rt
13681 eps3der=evdwij*eps2rt
13682 fac_augm=rrij**expon
13683 e_augm=augm(itypi,itypj)*fac_augm
13684 evdwij=evdwij*eps2rt*eps3rt
13685 evdw=evdw+(evdwij+e_augm)*sss
13687 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13688 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13689 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
13690 restyp(itypi,1),i,restyp(itypj,1),j,&
13691 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
13692 chi1,chi2,chip1,chip2,&
13693 eps1,eps2rt**2,eps3rt**2,&
13694 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
13697 ! Calculate gradient components.
13698 e1=e1*eps1*eps2rt**2*eps3rt**2
13699 fac=-expon*(e1+evdwij)*rij_shift
13701 fac=rij*fac-2*expon*rrij*e_augm
13702 ! Calculate the radial part of the gradient
13706 ! Calculate angular part of the gradient.
13707 call sc_grad_scale(sss)
13712 end subroutine egbv_short
13713 !-----------------------------------------------------------------------------
13714 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
13716 ! This subroutine calculates the average interaction energy and its gradient
13717 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
13718 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
13719 ! The potential depends both on the distance of peptide-group centers and on
13720 ! the orientation of the CA-CA virtual bonds.
13722 ! implicit real*8 (a-h,o-z)
13728 ! include 'DIMENSIONS'
13729 ! include 'COMMON.CONTROL'
13730 ! include 'COMMON.SETUP'
13731 ! include 'COMMON.IOUNITS'
13732 ! include 'COMMON.GEO'
13733 ! include 'COMMON.VAR'
13734 ! include 'COMMON.LOCAL'
13735 ! include 'COMMON.CHAIN'
13736 ! include 'COMMON.DERIV'
13737 ! include 'COMMON.INTERACT'
13738 ! include 'COMMON.CONTACTS'
13739 ! include 'COMMON.TORSION'
13740 ! include 'COMMON.VECTORS'
13741 ! include 'COMMON.FFIELD'
13742 ! include 'COMMON.TIME1'
13743 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
13744 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
13745 real(kind=8),dimension(2,2) :: acipa !el,a_temp
13746 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
13747 real(kind=8),dimension(4) :: muij
13748 !el integer :: num_conti,j1,j2
13749 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
13750 !el dz_normi,xmedi,ymedi,zmedi
13751 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
13752 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
13753 !el num_conti,j1,j2
13754 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
13756 real(kind=8) :: scal_el=1.0d0
13758 real(kind=8) :: scal_el=0.5d0
13761 ! 13-go grudnia roku pamietnego...
13762 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
13763 0.0d0,1.0d0,0.0d0,&
13764 0.0d0,0.0d0,1.0d0/),shape(unmat))
13765 !el local variables
13767 real(kind=8) :: fac
13768 real(kind=8) :: dxj,dyj,dzj
13769 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
13771 ! allocate(num_cont_hb(nres)) !(maxres)
13772 !d write(iout,*) 'In EELEC'
13774 !d write(iout,*) 'Type',i
13775 !d write(iout,*) 'B1',B1(:,i)
13776 !d write(iout,*) 'B2',B2(:,i)
13777 !d write(iout,*) 'CC',CC(:,:,i)
13778 !d write(iout,*) 'DD',DD(:,:,i)
13779 !d write(iout,*) 'EE',EE(:,:,i)
13781 !d call check_vecgrad
13783 if (icheckgrad.eq.1) then
13785 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
13787 dc_norm(k,i)=dc(k,i)*fac
13789 ! write (iout,*) 'i',i,' fac',fac
13792 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
13793 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
13794 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
13795 ! call vec_and_deriv
13799 ! print *, "before set matrices"
13801 ! print *,"after set martices"
13803 time_mat=time_mat+MPI_Wtime()-time01
13807 !d write (iout,*) 'i=',i
13809 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
13812 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
13813 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
13826 !d print '(a)','Enter EELEC'
13827 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
13828 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
13829 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
13831 gel_loc_loc(i)=0.0d0
13836 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
13838 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
13840 do i=iturn3_start,iturn3_end
13841 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1 &
13842 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
13846 dx_normi=dc_norm(1,i)
13847 dy_normi=dc_norm(2,i)
13848 dz_normi=dc_norm(3,i)
13849 xmedi=c(1,i)+0.5d0*dxi
13850 ymedi=c(2,i)+0.5d0*dyi
13851 zmedi=c(3,i)+0.5d0*dzi
13852 xmedi=dmod(xmedi,boxxsize)
13853 if (xmedi.lt.0) xmedi=xmedi+boxxsize
13854 ymedi=dmod(ymedi,boxysize)
13855 if (ymedi.lt.0) ymedi=ymedi+boxysize
13856 zmedi=dmod(zmedi,boxzsize)
13857 if (zmedi.lt.0) zmedi=zmedi+boxzsize
13859 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
13860 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
13861 num_cont_hb(i)=num_conti
13863 do i=iturn4_start,iturn4_end
13864 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
13865 .or. itype(i+3,1).eq.ntyp1 &
13866 .or. itype(i+4,1).eq.ntyp1) cycle
13870 dx_normi=dc_norm(1,i)
13871 dy_normi=dc_norm(2,i)
13872 dz_normi=dc_norm(3,i)
13873 xmedi=c(1,i)+0.5d0*dxi
13874 ymedi=c(2,i)+0.5d0*dyi
13875 zmedi=c(3,i)+0.5d0*dzi
13876 xmedi=dmod(xmedi,boxxsize)
13877 if (xmedi.lt.0) xmedi=xmedi+boxxsize
13878 ymedi=dmod(ymedi,boxysize)
13879 if (ymedi.lt.0) ymedi=ymedi+boxysize
13880 zmedi=dmod(zmedi,boxzsize)
13881 if (zmedi.lt.0) zmedi=zmedi+boxzsize
13882 num_conti=num_cont_hb(i)
13883 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
13884 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
13885 call eturn4(i,eello_turn4)
13886 num_cont_hb(i)=num_conti
13889 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
13891 do i=iatel_s,iatel_e
13892 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
13896 dx_normi=dc_norm(1,i)
13897 dy_normi=dc_norm(2,i)
13898 dz_normi=dc_norm(3,i)
13899 xmedi=c(1,i)+0.5d0*dxi
13900 ymedi=c(2,i)+0.5d0*dyi
13901 zmedi=c(3,i)+0.5d0*dzi
13902 xmedi=dmod(xmedi,boxxsize)
13903 if (xmedi.lt.0) xmedi=xmedi+boxxsize
13904 ymedi=dmod(ymedi,boxysize)
13905 if (ymedi.lt.0) ymedi=ymedi+boxysize
13906 zmedi=dmod(zmedi,boxzsize)
13907 if (zmedi.lt.0) zmedi=zmedi+boxzsize
13908 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
13909 num_conti=num_cont_hb(i)
13910 do j=ielstart(i),ielend(i)
13911 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
13912 call eelecij_scale(i,j,ees,evdw1,eel_loc)
13914 num_cont_hb(i)=num_conti
13916 ! write (iout,*) "Number of loop steps in EELEC:",ind
13918 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
13919 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
13921 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
13922 !cc eel_loc=eel_loc+eello_turn3
13923 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
13925 end subroutine eelec_scale
13926 !-----------------------------------------------------------------------------
13927 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
13928 ! implicit real*8 (a-h,o-z)
13931 ! include 'DIMENSIONS'
13935 ! include 'COMMON.CONTROL'
13936 ! include 'COMMON.IOUNITS'
13937 ! include 'COMMON.GEO'
13938 ! include 'COMMON.VAR'
13939 ! include 'COMMON.LOCAL'
13940 ! include 'COMMON.CHAIN'
13941 ! include 'COMMON.DERIV'
13942 ! include 'COMMON.INTERACT'
13943 ! include 'COMMON.CONTACTS'
13944 ! include 'COMMON.TORSION'
13945 ! include 'COMMON.VECTORS'
13946 ! include 'COMMON.FFIELD'
13947 ! include 'COMMON.TIME1'
13948 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
13949 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
13950 real(kind=8),dimension(2,2) :: acipa !el,a_temp
13951 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
13952 real(kind=8),dimension(4) :: muij
13953 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13954 dist_temp, dist_init,sss_grad
13955 integer xshift,yshift,zshift
13957 !el integer :: num_conti,j1,j2
13958 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
13959 !el dz_normi,xmedi,ymedi,zmedi
13960 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
13961 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
13962 !el num_conti,j1,j2
13963 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
13965 real(kind=8) :: scal_el=1.0d0
13967 real(kind=8) :: scal_el=0.5d0
13970 ! 13-go grudnia roku pamietnego...
13971 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
13972 0.0d0,1.0d0,0.0d0,&
13973 0.0d0,0.0d0,1.0d0/),shape(unmat))
13974 !el local variables
13975 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m,isubchap
13976 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
13977 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
13978 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
13979 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
13980 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
13981 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
13982 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
13983 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
13984 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
13985 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
13986 ecosam,ecosbm,ecosgm,ghalf,time00
13987 ! integer :: maxconts
13988 ! maxconts = nres/4
13989 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13990 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13991 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13992 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13993 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13994 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13995 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13996 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
13997 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
13998 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
13999 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
14000 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
14001 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
14003 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
14004 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
14009 !d write (iout,*) "eelecij",i,j
14013 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
14014 aaa=app(iteli,itelj)
14015 bbb=bpp(iteli,itelj)
14016 ael6i=ael6(iteli,itelj)
14017 ael3i=ael3(iteli,itelj)
14021 dx_normj=dc_norm(1,j)
14022 dy_normj=dc_norm(2,j)
14023 dz_normj=dc_norm(3,j)
14024 ! xj=c(1,j)+0.5D0*dxj-xmedi
14025 ! yj=c(2,j)+0.5D0*dyj-ymedi
14026 ! zj=c(3,j)+0.5D0*dzj-zmedi
14027 xj=c(1,j)+0.5D0*dxj
14028 yj=c(2,j)+0.5D0*dyj
14029 zj=c(3,j)+0.5D0*dzj
14030 xj=mod(xj,boxxsize)
14031 if (xj.lt.0) xj=xj+boxxsize
14032 yj=mod(yj,boxysize)
14033 if (yj.lt.0) yj=yj+boxysize
14034 zj=mod(zj,boxzsize)
14035 if (zj.lt.0) zj=zj+boxzsize
14037 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14044 xj=xj_safe+xshift*boxxsize
14045 yj=yj_safe+yshift*boxysize
14046 zj=zj_safe+zshift*boxzsize
14047 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14048 if(dist_temp.lt.dist_init) then
14049 dist_init=dist_temp
14058 if (isubchap.eq.1) then
14069 rij=xj*xj+yj*yj+zj*zj
14073 ! For extracting the short-range part of Evdwpp
14074 sss=sscale(rij/rpp(iteli,itelj))
14075 sss_ele_cut=sscale_ele(rij)
14076 sss_ele_grad=sscagrad_ele(rij)
14077 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
14078 ! sss_ele_cut=1.0d0
14079 ! sss_ele_grad=0.0d0
14080 if (sss_ele_cut.le.0.0) go to 128
14084 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
14085 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
14086 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
14087 fac=cosa-3.0D0*cosb*cosg
14089 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
14090 if (j.eq.i+2) ev1=scal_el*ev1
14095 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
14098 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
14099 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
14100 ees=ees+eesij*sss_ele_cut
14101 evdw1=evdw1+evdwij*(1.0d0-sss)*sss_ele_cut
14102 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
14103 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
14104 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
14105 !d & xmedi,ymedi,zmedi,xj,yj,zj
14107 if (energy_dec) then
14108 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
14109 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
14113 ! Calculate contributions to the Cartesian gradient.
14116 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
14117 facel=-3*rrmij*(el1+eesij)*sss_ele_cut
14123 ! Radial derivatives. First process both termini of the fragment (i,j)
14125 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj
14126 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj
14127 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj
14129 ! ghalf=0.5D0*ggg(k)
14130 ! gelc(k,i)=gelc(k,i)+ghalf
14131 ! gelc(k,j)=gelc(k,j)+ghalf
14133 ! 9/28/08 AL Gradient compotents will be summed only at the end
14135 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14136 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14139 ! Loop over residues i+1 thru j-1.
14143 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14146 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*(1.0d0-sss) &
14147 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
14148 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*(1.0d0-sss) &
14149 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
14150 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*(1.0d0-sss) &
14151 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
14153 ! ghalf=0.5D0*ggg(k)
14154 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
14155 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
14157 ! 9/28/08 AL Gradient compotents will be summed only at the end
14159 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14160 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14163 ! Loop over residues i+1 thru j-1.
14167 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
14171 facvdw=(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
14172 facel=(el1+eesij)*sss_ele_cut
14174 fac=-3*rrmij*(facvdw+facvdw+facel)
14179 ! Radial derivatives. First process both termini of the fragment (i,j)
14185 ! ghalf=0.5D0*ggg(k)
14186 ! gelc(k,i)=gelc(k,i)+ghalf
14187 ! gelc(k,j)=gelc(k,j)+ghalf
14189 ! 9/28/08 AL Gradient compotents will be summed only at the end
14191 gelc_long(k,j)=gelc(k,j)+ggg(k)
14192 gelc_long(k,i)=gelc(k,i)-ggg(k)
14195 ! Loop over residues i+1 thru j-1.
14199 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14202 ! 9/28/08 AL Gradient compotents will be summed only at the end
14207 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14208 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14214 ecosa=2.0D0*fac3*fac1+fac4
14217 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
14218 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
14220 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14221 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14223 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
14224 !d & (dcosg(k),k=1,3)
14226 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k) )*sss_ele_cut
14229 ! ghalf=0.5D0*ggg(k)
14230 ! gelc(k,i)=gelc(k,i)+ghalf
14231 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
14232 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14233 ! gelc(k,j)=gelc(k,j)+ghalf
14234 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
14235 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14239 !grad gelc(l,k)=gelc(l,k)+ggg(l)
14243 gelc(k,i)=gelc(k,i) &
14244 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14245 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
14247 gelc(k,j)=gelc(k,j) &
14248 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14249 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14251 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
14252 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
14254 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
14255 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
14256 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14258 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
14259 ! energy of a peptide unit is assumed in the form of a second-order
14260 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
14261 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
14262 ! are computed for EVERY pair of non-contiguous peptide groups.
14264 if (j.lt.nres-1) then
14275 muij(kkk)=mu(k,i)*mu(l,j)
14278 !d write (iout,*) 'EELEC: i',i,' j',j
14279 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
14280 !d write(iout,*) 'muij',muij
14281 ury=scalar(uy(1,i),erij)
14282 urz=scalar(uz(1,i),erij)
14283 vry=scalar(uy(1,j),erij)
14284 vrz=scalar(uz(1,j),erij)
14285 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
14286 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
14287 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
14288 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
14289 fac=dsqrt(-ael6i)*r3ij
14294 !d write (iout,'(4i5,4f10.5)')
14295 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
14296 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
14297 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
14298 !d & uy(:,j),uz(:,j)
14299 !d write (iout,'(4f10.5)')
14300 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
14301 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
14302 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
14303 !d write (iout,'(9f10.5/)')
14304 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
14305 ! Derivatives of the elements of A in virtual-bond vectors
14306 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
14308 uryg(k,1)=scalar(erder(1,k),uy(1,i))
14309 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
14310 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
14311 urzg(k,1)=scalar(erder(1,k),uz(1,i))
14312 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
14313 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
14314 vryg(k,1)=scalar(erder(1,k),uy(1,j))
14315 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
14316 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
14317 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
14318 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
14319 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
14321 ! Compute radial contributions to the gradient
14339 ! Add the contributions coming from er
14342 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
14343 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
14344 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
14345 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
14348 ! Derivatives in DC(i)
14349 !grad ghalf1=0.5d0*agg(k,1)
14350 !grad ghalf2=0.5d0*agg(k,2)
14351 !grad ghalf3=0.5d0*agg(k,3)
14352 !grad ghalf4=0.5d0*agg(k,4)
14353 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
14354 -3.0d0*uryg(k,2)*vry)!+ghalf1
14355 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
14356 -3.0d0*uryg(k,2)*vrz)!+ghalf2
14357 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
14358 -3.0d0*urzg(k,2)*vry)!+ghalf3
14359 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
14360 -3.0d0*urzg(k,2)*vrz)!+ghalf4
14361 ! Derivatives in DC(i+1)
14362 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
14363 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
14364 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
14365 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
14366 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
14367 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
14368 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
14369 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
14370 ! Derivatives in DC(j)
14371 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
14372 -3.0d0*vryg(k,2)*ury)!+ghalf1
14373 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
14374 -3.0d0*vrzg(k,2)*ury)!+ghalf2
14375 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
14376 -3.0d0*vryg(k,2)*urz)!+ghalf3
14377 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
14378 -3.0d0*vrzg(k,2)*urz)!+ghalf4
14379 ! Derivatives in DC(j+1) or DC(nres-1)
14380 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
14381 -3.0d0*vryg(k,3)*ury)
14382 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
14383 -3.0d0*vrzg(k,3)*ury)
14384 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
14385 -3.0d0*vryg(k,3)*urz)
14386 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
14387 -3.0d0*vrzg(k,3)*urz)
14388 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
14390 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
14403 aggi(k,l)=-aggi(k,l)
14404 aggi1(k,l)=-aggi1(k,l)
14405 aggj(k,l)=-aggj(k,l)
14406 aggj1(k,l)=-aggj1(k,l)
14409 if (j.lt.nres-1) then
14415 aggi(k,l)=-aggi(k,l)
14416 aggi1(k,l)=-aggi1(k,l)
14417 aggj(k,l)=-aggj(k,l)
14418 aggj1(k,l)=-aggj1(k,l)
14429 aggi(k,l)=-aggi(k,l)
14430 aggi1(k,l)=-aggi1(k,l)
14431 aggj(k,l)=-aggj(k,l)
14432 aggj1(k,l)=-aggj1(k,l)
14437 IF (wel_loc.gt.0.0d0) THEN
14438 ! Contribution to the local-electrostatic energy coming from the i-j pair
14439 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
14441 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
14443 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
14444 'eelloc',i,j,eel_loc_ij
14445 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
14447 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
14448 ! Partial derivatives in virtual-bond dihedral angles gamma
14450 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
14451 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
14452 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
14454 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
14455 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
14456 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
14462 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
14464 ggg(l)=(agg(l,1)*muij(1)+ &
14465 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
14467 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
14469 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
14470 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
14471 !grad ghalf=0.5d0*ggg(l)
14472 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
14473 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
14477 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
14480 ! Remaining derivatives of eello
14482 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
14483 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
14486 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
14487 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))&
14490 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
14491 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
14494 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
14495 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))&
14500 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
14501 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
14502 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
14503 .and. num_conti.le.maxconts) then
14504 ! write (iout,*) i,j," entered corr"
14506 ! Calculate the contact function. The ith column of the array JCONT will
14507 ! contain the numbers of atoms that make contacts with the atom I (of numbers
14508 ! greater than I). The arrays FACONT and GACONT will contain the values of
14509 ! the contact function and its derivative.
14510 ! r0ij=1.02D0*rpp(iteli,itelj)
14511 ! r0ij=1.11D0*rpp(iteli,itelj)
14512 r0ij=2.20D0*rpp(iteli,itelj)
14513 ! r0ij=1.55D0*rpp(iteli,itelj)
14514 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
14515 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14516 if (fcont.gt.0.0D0) then
14517 num_conti=num_conti+1
14518 if (num_conti.gt.maxconts) then
14519 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
14520 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
14521 ' will skip next contacts for this conf.',num_conti
14523 jcont_hb(num_conti,i)=j
14524 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
14525 !d & " jcont_hb",jcont_hb(num_conti,i)
14526 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
14527 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
14528 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
14530 d_cont(num_conti,i)=rij
14531 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
14532 ! --- Electrostatic-interaction matrix ---
14533 a_chuj(1,1,num_conti,i)=a22
14534 a_chuj(1,2,num_conti,i)=a23
14535 a_chuj(2,1,num_conti,i)=a32
14536 a_chuj(2,2,num_conti,i)=a33
14537 ! --- Gradient of rij
14539 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
14546 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
14547 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
14548 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
14549 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
14550 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
14555 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
14556 ! Calculate contact energies
14558 wij=cosa-3.0D0*cosb*cosg
14561 ! fac3=dsqrt(-ael6i)/r0ij**3
14562 fac3=dsqrt(-ael6i)*r3ij
14563 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
14564 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
14565 if (ees0tmp.gt.0) then
14566 ees0pij=dsqrt(ees0tmp)
14570 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
14571 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
14572 if (ees0tmp.gt.0) then
14573 ees0mij=dsqrt(ees0tmp)
14578 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
14581 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
14584 ! Diagnostics. Comment out or remove after debugging!
14585 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
14586 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
14587 ! ees0m(num_conti,i)=0.0D0
14589 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
14590 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
14591 ! Angular derivatives of the contact function
14592 ees0pij1=fac3/ees0pij
14593 ees0mij1=fac3/ees0mij
14594 fac3p=-3.0D0*fac3*rrmij
14595 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
14596 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
14598 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
14599 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
14600 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
14601 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
14602 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
14603 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
14604 ecosap=ecosa1+ecosa2
14605 ecosbp=ecosb1+ecosb2
14606 ecosgp=ecosg1+ecosg2
14607 ecosam=ecosa1-ecosa2
14608 ecosbm=ecosb1-ecosb2
14609 ecosgm=ecosg1-ecosg2
14618 facont_hb(num_conti,i)=fcont
14619 fprimcont=fprimcont/rij
14620 !d facont_hb(num_conti,i)=1.0D0
14621 ! Following line is for diagnostics.
14624 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
14625 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
14628 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
14629 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
14631 ! gggp(1)=gggp(1)+ees0pijp*xj
14632 ! gggp(2)=gggp(2)+ees0pijp*yj
14633 ! gggp(3)=gggp(3)+ees0pijp*zj
14634 ! gggm(1)=gggm(1)+ees0mijp*xj
14635 ! gggm(2)=gggm(2)+ees0mijp*yj
14636 ! gggm(3)=gggm(3)+ees0mijp*zj
14637 gggp(1)=gggp(1)+ees0pijp*xj &
14638 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14639 gggp(2)=gggp(2)+ees0pijp*yj &
14640 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14641 gggp(3)=gggp(3)+ees0pijp*zj &
14642 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14644 gggm(1)=gggm(1)+ees0mijp*xj &
14645 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
14647 gggm(2)=gggm(2)+ees0mijp*yj &
14648 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
14650 gggm(3)=gggm(3)+ees0mijp*zj &
14651 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
14653 ! Derivatives due to the contact function
14654 gacont_hbr(1,num_conti,i)=fprimcont*xj
14655 gacont_hbr(2,num_conti,i)=fprimcont*yj
14656 gacont_hbr(3,num_conti,i)=fprimcont*zj
14659 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
14660 ! following the change of gradient-summation algorithm.
14662 !grad ghalfp=0.5D0*gggp(k)
14663 !grad ghalfm=0.5D0*gggm(k)
14664 ! gacontp_hb1(k,num_conti,i)= & !ghalfp
14665 ! +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14666 ! + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14667 ! gacontp_hb2(k,num_conti,i)= & !ghalfp
14668 ! +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14669 ! + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14670 ! gacontp_hb3(k,num_conti,i)=gggp(k)
14671 ! gacontm_hb1(k,num_conti,i)= &!ghalfm
14672 ! +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14673 ! + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
14674 ! gacontm_hb2(k,num_conti,i)= & !ghalfm
14675 ! +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14676 ! + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
14677 ! gacontm_hb3(k,num_conti,i)=gggm(k)
14678 gacontp_hb1(k,num_conti,i)= & !ghalfp+
14679 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14680 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14683 gacontp_hb2(k,num_conti,i)= & !ghalfp+
14684 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14685 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
14688 gacontp_hb3(k,num_conti,i)=gggp(k) &
14691 gacontm_hb1(k,num_conti,i)= & !ghalfm+
14692 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
14693 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
14696 gacontm_hb2(k,num_conti,i)= & !ghalfm+
14697 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
14698 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
14701 gacontm_hb3(k,num_conti,i)=gggm(k) &
14706 endif ! num_conti.le.maxconts
14709 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
14712 ghalf=0.5d0*agg(l,k)
14713 aggi(l,k)=aggi(l,k)+ghalf
14714 aggi1(l,k)=aggi1(l,k)+agg(l,k)
14715 aggj(l,k)=aggj(l,k)+ghalf
14718 if (j.eq.nres-1 .and. i.lt.j-2) then
14721 aggj1(l,k)=aggj1(l,k)+agg(l,k)
14727 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
14729 end subroutine eelecij_scale
14730 !-----------------------------------------------------------------------------
14731 subroutine evdwpp_short(evdw1)
14735 ! implicit real*8 (a-h,o-z)
14736 ! include 'DIMENSIONS'
14737 ! include 'COMMON.CONTROL'
14738 ! include 'COMMON.IOUNITS'
14739 ! include 'COMMON.GEO'
14740 ! include 'COMMON.VAR'
14741 ! include 'COMMON.LOCAL'
14742 ! include 'COMMON.CHAIN'
14743 ! include 'COMMON.DERIV'
14744 ! include 'COMMON.INTERACT'
14745 ! include 'COMMON.CONTACTS'
14746 ! include 'COMMON.TORSION'
14747 ! include 'COMMON.VECTORS'
14748 ! include 'COMMON.FFIELD'
14749 real(kind=8),dimension(3) :: ggg
14750 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14752 real(kind=8) :: scal_el=1.0d0
14754 real(kind=8) :: scal_el=0.5d0
14756 !el local variables
14757 integer :: i,j,k,iteli,itelj,num_conti,isubchap
14758 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
14759 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
14760 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14761 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
14762 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14763 dist_temp, dist_init,sss_grad
14764 integer xshift,yshift,zshift
14768 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
14769 ! & " iatel_e_vdw",iatel_e_vdw
14771 do i=iatel_s_vdw,iatel_e_vdw
14772 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1) cycle
14776 dx_normi=dc_norm(1,i)
14777 dy_normi=dc_norm(2,i)
14778 dz_normi=dc_norm(3,i)
14779 xmedi=c(1,i)+0.5d0*dxi
14780 ymedi=c(2,i)+0.5d0*dyi
14781 zmedi=c(3,i)+0.5d0*dzi
14782 xmedi=dmod(xmedi,boxxsize)
14783 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14784 ymedi=dmod(ymedi,boxysize)
14785 if (ymedi.lt.0) ymedi=ymedi+boxysize
14786 zmedi=dmod(zmedi,boxzsize)
14787 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14789 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
14790 ! & ' ielend',ielend_vdw(i)
14792 do j=ielstart_vdw(i),ielend_vdw(i)
14793 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
14797 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
14798 aaa=app(iteli,itelj)
14799 bbb=bpp(iteli,itelj)
14803 dx_normj=dc_norm(1,j)
14804 dy_normj=dc_norm(2,j)
14805 dz_normj=dc_norm(3,j)
14806 ! xj=c(1,j)+0.5D0*dxj-xmedi
14807 ! yj=c(2,j)+0.5D0*dyj-ymedi
14808 ! zj=c(3,j)+0.5D0*dzj-zmedi
14809 xj=c(1,j)+0.5D0*dxj
14810 yj=c(2,j)+0.5D0*dyj
14811 zj=c(3,j)+0.5D0*dzj
14812 xj=mod(xj,boxxsize)
14813 if (xj.lt.0) xj=xj+boxxsize
14814 yj=mod(yj,boxysize)
14815 if (yj.lt.0) yj=yj+boxysize
14816 zj=mod(zj,boxzsize)
14817 if (zj.lt.0) zj=zj+boxzsize
14819 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14826 xj=xj_safe+xshift*boxxsize
14827 yj=yj_safe+yshift*boxysize
14828 zj=zj_safe+zshift*boxzsize
14829 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14830 if(dist_temp.lt.dist_init) then
14831 dist_init=dist_temp
14840 if (isubchap.eq.1) then
14851 rij=xj*xj+yj*yj+zj*zj
14854 sss=sscale(rij/rpp(iteli,itelj))
14855 sss_ele_cut=sscale_ele(rij)
14856 sss_ele_grad=sscagrad_ele(rij)
14857 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
14858 if (sss_ele_cut.le.0.0) cycle
14859 if (sss.gt.0.0d0) then
14864 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
14865 if (j.eq.i+2) ev1=scal_el*ev1
14868 if (energy_dec) then
14869 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
14871 evdw1=evdw1+evdwij*sss*sss_ele_cut
14873 ! Calculate contributions to the Cartesian gradient.
14875 facvdw=-6*rrmij*(ev1+evdwij)*sss*sss_ele_cut
14879 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*sss &
14880 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
14881 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*sss &
14882 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
14883 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*sss &
14884 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
14887 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
14888 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
14894 end subroutine evdwpp_short
14895 !-----------------------------------------------------------------------------
14896 subroutine escp_long(evdw2,evdw2_14)
14898 ! This subroutine calculates the excluded-volume interaction energy between
14899 ! peptide-group centers and side chains and its gradient in virtual-bond and
14900 ! side-chain vectors.
14902 ! implicit real*8 (a-h,o-z)
14903 ! include 'DIMENSIONS'
14904 ! include 'COMMON.GEO'
14905 ! include 'COMMON.VAR'
14906 ! include 'COMMON.LOCAL'
14907 ! include 'COMMON.CHAIN'
14908 ! include 'COMMON.DERIV'
14909 ! include 'COMMON.INTERACT'
14910 ! include 'COMMON.FFIELD'
14911 ! include 'COMMON.IOUNITS'
14912 ! include 'COMMON.CONTROL'
14913 real(kind=8),dimension(3) :: ggg
14914 !el local variables
14915 integer :: i,iint,j,k,iteli,itypj,subchap
14916 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
14917 real(kind=8) :: evdw2,evdw2_14,evdwij
14918 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14919 dist_temp, dist_init
14923 !d print '(a)','Enter ESCP'
14924 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
14925 do i=iatscp_s,iatscp_e
14926 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
14928 xi=0.5D0*(c(1,i)+c(1,i+1))
14929 yi=0.5D0*(c(2,i)+c(2,i+1))
14930 zi=0.5D0*(c(3,i)+c(3,i+1))
14931 xi=mod(xi,boxxsize)
14932 if (xi.lt.0) xi=xi+boxxsize
14933 yi=mod(yi,boxysize)
14934 if (yi.lt.0) yi=yi+boxysize
14935 zi=mod(zi,boxzsize)
14936 if (zi.lt.0) zi=zi+boxzsize
14938 do iint=1,nscp_gr(i)
14940 do j=iscpstart(i,iint),iscpend(i,iint)
14942 if (itypj.eq.ntyp1) cycle
14943 ! Uncomment following three lines for SC-p interactions
14944 ! xj=c(1,nres+j)-xi
14945 ! yj=c(2,nres+j)-yi
14946 ! zj=c(3,nres+j)-zi
14947 ! Uncomment following three lines for Ca-p interactions
14951 xj=mod(xj,boxxsize)
14952 if (xj.lt.0) xj=xj+boxxsize
14953 yj=mod(yj,boxysize)
14954 if (yj.lt.0) yj=yj+boxysize
14955 zj=mod(zj,boxzsize)
14956 if (zj.lt.0) zj=zj+boxzsize
14957 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14965 xj=xj_safe+xshift*boxxsize
14966 yj=yj_safe+yshift*boxysize
14967 zj=zj_safe+zshift*boxzsize
14968 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14969 if(dist_temp.lt.dist_init) then
14970 dist_init=dist_temp
14979 if (subchap.eq.1) then
14988 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14990 rij=dsqrt(1.0d0/rrij)
14991 sss_ele_cut=sscale_ele(rij)
14992 sss_ele_grad=sscagrad_ele(rij)
14993 ! print *,sss_ele_cut,sss_ele_grad,&
14994 ! (rij),r_cut_ele,rlamb_ele
14995 if (sss_ele_cut.le.0.0) cycle
14996 sss=sscale((rij/rscp(itypj,iteli)))
14997 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
14998 if (sss.lt.1.0d0) then
15001 e1=fac*fac*aad(itypj,iteli)
15002 e2=fac*bad(itypj,iteli)
15003 if (iabs(j-i) .le. 2) then
15006 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)*sss_ele_cut
15009 evdw2=evdw2+evdwij*(1.0d0-sss)*sss_ele_cut
15010 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15011 'evdw2',i,j,sss,evdwij
15013 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15015 fac=-(evdwij+e1)*rrij*(1.0d0-sss)*sss_ele_cut
15016 fac=fac+evdwij*sss_ele_grad/rij/expon*(1.0d0-sss)&
15017 -evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15021 ! Uncomment following three lines for SC-p interactions
15023 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15025 ! Uncomment following line for SC-p interactions
15026 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15028 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15029 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15038 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15039 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15040 gradx_scp(j,i)=expon*gradx_scp(j,i)
15043 !******************************************************************************
15047 ! To save time the factor EXPON has been extracted from ALL components
15048 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15051 !******************************************************************************
15053 end subroutine escp_long
15054 !-----------------------------------------------------------------------------
15055 subroutine escp_short(evdw2,evdw2_14)
15057 ! This subroutine calculates the excluded-volume interaction energy between
15058 ! peptide-group centers and side chains and its gradient in virtual-bond and
15059 ! side-chain vectors.
15061 ! implicit real*8 (a-h,o-z)
15062 ! include 'DIMENSIONS'
15063 ! include 'COMMON.GEO'
15064 ! include 'COMMON.VAR'
15065 ! include 'COMMON.LOCAL'
15066 ! include 'COMMON.CHAIN'
15067 ! include 'COMMON.DERIV'
15068 ! include 'COMMON.INTERACT'
15069 ! include 'COMMON.FFIELD'
15070 ! include 'COMMON.IOUNITS'
15071 ! include 'COMMON.CONTROL'
15072 real(kind=8),dimension(3) :: ggg
15073 !el local variables
15074 integer :: i,iint,j,k,iteli,itypj,subchap
15075 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
15076 real(kind=8) :: evdw2,evdw2_14,evdwij
15077 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15078 dist_temp, dist_init
15082 !d print '(a)','Enter ESCP'
15083 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
15084 do i=iatscp_s,iatscp_e
15085 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
15087 xi=0.5D0*(c(1,i)+c(1,i+1))
15088 yi=0.5D0*(c(2,i)+c(2,i+1))
15089 zi=0.5D0*(c(3,i)+c(3,i+1))
15090 xi=mod(xi,boxxsize)
15091 if (xi.lt.0) xi=xi+boxxsize
15092 yi=mod(yi,boxysize)
15093 if (yi.lt.0) yi=yi+boxysize
15094 zi=mod(zi,boxzsize)
15095 if (zi.lt.0) zi=zi+boxzsize
15097 do iint=1,nscp_gr(i)
15099 do j=iscpstart(i,iint),iscpend(i,iint)
15101 if (itypj.eq.ntyp1) cycle
15102 ! Uncomment following three lines for SC-p interactions
15103 ! xj=c(1,nres+j)-xi
15104 ! yj=c(2,nres+j)-yi
15105 ! zj=c(3,nres+j)-zi
15106 ! Uncomment following three lines for Ca-p interactions
15113 xj=mod(xj,boxxsize)
15114 if (xj.lt.0) xj=xj+boxxsize
15115 yj=mod(yj,boxysize)
15116 if (yj.lt.0) yj=yj+boxysize
15117 zj=mod(zj,boxzsize)
15118 if (zj.lt.0) zj=zj+boxzsize
15119 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15127 xj=xj_safe+xshift*boxxsize
15128 yj=yj_safe+yshift*boxysize
15129 zj=zj_safe+zshift*boxzsize
15130 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15131 if(dist_temp.lt.dist_init) then
15132 dist_init=dist_temp
15141 if (subchap.eq.1) then
15151 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15152 rij=dsqrt(1.0d0/rrij)
15153 sss_ele_cut=sscale_ele(rij)
15154 sss_ele_grad=sscagrad_ele(rij)
15155 ! print *,sss_ele_cut,sss_ele_grad,&
15156 ! (rij),r_cut_ele,rlamb_ele
15157 if (sss_ele_cut.le.0.0) cycle
15158 sss=sscale(rij/rscp(itypj,iteli))
15159 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
15160 if (sss.gt.0.0d0) then
15163 e1=fac*fac*aad(itypj,iteli)
15164 e2=fac*bad(itypj,iteli)
15165 if (iabs(j-i) .le. 2) then
15168 evdw2_14=evdw2_14+(e1+e2)*sss*sss_ele_cut
15171 evdw2=evdw2+evdwij*sss*sss_ele_cut
15172 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15173 'evdw2',i,j,sss,evdwij
15175 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15177 fac=-(evdwij+e1)*rrij*sss*sss_ele_cut
15178 fac=fac+evdwij*sss_ele_grad/rij/expon*sss &
15179 +evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15184 ! Uncomment following three lines for SC-p interactions
15186 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15188 ! Uncomment following line for SC-p interactions
15189 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15191 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15192 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15201 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15202 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15203 gradx_scp(j,i)=expon*gradx_scp(j,i)
15206 !******************************************************************************
15210 ! To save time the factor EXPON has been extracted from ALL components
15211 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15214 !******************************************************************************
15216 end subroutine escp_short
15217 !-----------------------------------------------------------------------------
15218 ! energy_p_new-sep_barrier.F
15219 !-----------------------------------------------------------------------------
15220 subroutine sc_grad_scale(scalfac)
15221 ! implicit real*8 (a-h,o-z)
15223 ! include 'DIMENSIONS'
15224 ! include 'COMMON.CHAIN'
15225 ! include 'COMMON.DERIV'
15226 ! include 'COMMON.CALC'
15227 ! include 'COMMON.IOUNITS'
15228 real(kind=8),dimension(3) :: dcosom1,dcosom2
15229 real(kind=8) :: scalfac
15230 !el local variables
15231 ! integer :: i,j,k,l
15233 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
15234 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
15235 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
15236 -2.0D0*alf12*eps3der+sigder*sigsq_om12
15240 ! eom12=evdwij*eps1_om12
15242 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
15243 ! & " sigder",sigder
15244 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
15245 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
15247 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
15248 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
15251 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac&
15254 ! write (iout,*) "gg",(gg(k),k=1,3)
15256 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
15257 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
15258 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
15260 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
15261 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
15262 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac&
15264 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
15265 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
15266 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
15267 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
15270 ! Calculate the components of the gradient in DC and X
15273 gvdwc(l,i)=gvdwc(l,i)-gg(l)
15274 gvdwc(l,j)=gvdwc(l,j)+gg(l)
15277 end subroutine sc_grad_scale
15278 !-----------------------------------------------------------------------------
15279 ! energy_split-sep.F
15280 !-----------------------------------------------------------------------------
15281 subroutine etotal_long(energia)
15283 ! Compute the long-range slow-varying contributions to the energy
15285 ! implicit real*8 (a-h,o-z)
15286 ! include 'DIMENSIONS'
15287 use MD_data, only: totT,usampl,eq_time
15291 !MS$ATTRIBUTES C :: proc_proc
15296 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
15298 ! include 'COMMON.SETUP'
15299 ! include 'COMMON.IOUNITS'
15300 ! include 'COMMON.FFIELD'
15301 ! include 'COMMON.DERIV'
15302 ! include 'COMMON.INTERACT'
15303 ! include 'COMMON.SBRIDGE'
15304 ! include 'COMMON.CHAIN'
15305 ! include 'COMMON.VAR'
15306 ! include 'COMMON.LOCAL'
15307 ! include 'COMMON.MD'
15308 real(kind=8),dimension(0:n_ene) :: energia
15309 !el local variables
15310 integer :: i,n_corr,n_corr1,ierror,ierr
15311 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
15312 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
15313 ecorr,ecorr5,ecorr6,eturn6,time00
15314 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
15315 !elwrite(iout,*)"in etotal long"
15317 if (modecalc.eq.12.or.modecalc.eq.14) then
15319 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
15321 call int_from_cart1(.false.)
15324 !elwrite(iout,*)"in etotal long"
15327 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
15328 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15330 if (nfgtasks.gt.1) then
15332 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15333 if (fg_rank.eq.0) then
15334 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
15335 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15337 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15338 ! FG slaves as WEIGHTS array.
15345 weights_(7)=wel_loc
15348 weights_(10)=wturn6
15350 weights_(12)=wscloc
15352 weights_(14)=wtor_d
15353 weights_(15)=wstrain
15354 weights_(16)=wvdwpp
15356 weights_(18)=scal14
15357 weights_(21)=wsccor
15358 ! FG Master broadcasts the WEIGHTS_ array
15359 call MPI_Bcast(weights_(1),n_ene,&
15360 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15362 ! FG slaves receive the WEIGHTS array
15363 call MPI_Bcast(weights(1),n_ene,&
15364 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15379 wstrain=weights(15)
15385 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
15387 time_Bcast=time_Bcast+MPI_Wtime()-time00
15388 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
15389 ! call chainbuild_cart
15390 ! call int_from_cart1(.false.)
15392 ! write (iout,*) 'Processor',myrank,
15393 ! & ' calling etotal_short ipot=',ipot
15395 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15397 !d print *,'nnt=',nnt,' nct=',nct
15399 !elwrite(iout,*)"in etotal long"
15400 ! Compute the side-chain and electrostatic interaction energy
15402 goto (101,102,103,104,105,106) ipot
15403 ! Lennard-Jones potential.
15404 101 call elj_long(evdw)
15405 !d print '(a)','Exit ELJ'
15407 ! Lennard-Jones-Kihara potential (shifted).
15408 102 call eljk_long(evdw)
15410 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15411 103 call ebp_long(evdw)
15413 ! Gay-Berne potential (shifted LJ, angular dependence).
15414 104 call egb_long(evdw)
15416 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15417 105 call egbv_long(evdw)
15419 ! Soft-sphere potential
15420 106 call e_softsphere(evdw)
15422 ! Calculate electrostatic (H-bonding) energy of the main chain.
15426 if (ipot.lt.6) then
15428 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
15429 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15430 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15431 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15433 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
15434 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
15435 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
15436 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
15438 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
15447 ! write (iout,*) "Soft-spheer ELEC potential"
15448 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
15452 ! Calculate excluded-volume interaction energy between peptide groups
15455 if (ipot.lt.6) then
15456 if(wscp.gt.0d0) then
15457 call escp_long(evdw2,evdw2_14)
15463 call escp_soft_sphere(evdw2,evdw2_14)
15466 ! 12/1/95 Multi-body terms
15470 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
15471 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
15472 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
15473 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
15474 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
15481 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
15482 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
15485 ! If performing constraint dynamics, call the constraint energy
15486 ! after the equilibration time
15487 if(usampl.and.totT.gt.eq_time) then
15502 energia(2)=evdw2-evdw2_14
15503 energia(18)=evdw2_14
15512 energia(3)=ees+evdw1
15519 energia(8)=eello_turn3
15520 energia(9)=eello_turn4
15522 energia(20)=Uconst+Uconst_back
15523 call sum_energy(energia,.true.)
15524 ! write (iout,*) "Exit ETOTAL_LONG"
15527 end subroutine etotal_long
15528 !-----------------------------------------------------------------------------
15529 subroutine etotal_short(energia)
15531 ! Compute the short-range fast-varying contributions to the energy
15533 ! implicit real*8 (a-h,o-z)
15534 ! include 'DIMENSIONS'
15538 !MS$ATTRIBUTES C :: proc_proc
15543 integer :: ierror,ierr
15544 real(kind=8),dimension(n_ene) :: weights_
15545 real(kind=8) :: time00
15547 ! include 'COMMON.SETUP'
15548 ! include 'COMMON.IOUNITS'
15549 ! include 'COMMON.FFIELD'
15550 ! include 'COMMON.DERIV'
15551 ! include 'COMMON.INTERACT'
15552 ! include 'COMMON.SBRIDGE'
15553 ! include 'COMMON.CHAIN'
15554 ! include 'COMMON.VAR'
15555 ! include 'COMMON.LOCAL'
15556 real(kind=8),dimension(0:n_ene) :: energia
15557 !el local variables
15559 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
15560 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr
15563 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
15565 if (modecalc.eq.12.or.modecalc.eq.14) then
15567 if (fg_rank.eq.0) call int_from_cart1(.false.)
15569 call int_from_cart1(.false.)
15573 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
15574 ! & " absolute rank",myrank," nfgtasks",nfgtasks
15576 if (nfgtasks.gt.1) then
15578 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
15579 if (fg_rank.eq.0) then
15580 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
15581 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
15583 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
15584 ! FG slaves as WEIGHTS array.
15591 weights_(7)=wel_loc
15594 weights_(10)=wturn6
15596 weights_(12)=wscloc
15598 weights_(14)=wtor_d
15599 weights_(15)=wstrain
15600 weights_(16)=wvdwpp
15602 weights_(18)=scal14
15603 weights_(21)=wsccor
15604 ! FG Master broadcasts the WEIGHTS_ array
15605 call MPI_Bcast(weights_(1),n_ene,&
15606 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15608 ! FG slaves receive the WEIGHTS array
15609 call MPI_Bcast(weights(1),n_ene,&
15610 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
15625 wstrain=weights(15)
15631 ! write (iout,*),"Processor",myrank," BROADCAST weights"
15632 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
15634 ! write (iout,*) "Processor",myrank," BROADCAST c"
15635 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
15637 ! write (iout,*) "Processor",myrank," BROADCAST dc"
15638 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
15640 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
15641 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
15643 ! write (iout,*) "Processor",myrank," BROADCAST theta"
15644 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
15646 ! write (iout,*) "Processor",myrank," BROADCAST phi"
15647 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
15649 ! write (iout,*) "Processor",myrank," BROADCAST alph"
15650 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
15652 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
15653 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
15655 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
15656 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
15658 time_Bcast=time_Bcast+MPI_Wtime()-time00
15659 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
15661 ! write (iout,*) 'Processor',myrank,
15662 ! & ' calling etotal_short ipot=',ipot
15664 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
15666 ! call int_from_cart1(.false.)
15668 ! Compute the side-chain and electrostatic interaction energy
15670 goto (101,102,103,104,105,106) ipot
15671 ! Lennard-Jones potential.
15672 101 call elj_short(evdw)
15673 !d print '(a)','Exit ELJ'
15675 ! Lennard-Jones-Kihara potential (shifted).
15676 102 call eljk_short(evdw)
15678 ! Berne-Pechukas potential (dilated LJ, angular dependence).
15679 103 call ebp_short(evdw)
15681 ! Gay-Berne potential (shifted LJ, angular dependence).
15682 104 call egb_short(evdw)
15684 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
15685 105 call egbv_short(evdw)
15687 ! Soft-sphere potential - already dealt with in the long-range part
15689 ! 106 call e_softsphere_short(evdw)
15691 ! Calculate electrostatic (H-bonding) energy of the main chain.
15695 ! Calculate the short-range part of Evdwpp
15697 call evdwpp_short(evdw1)
15699 ! Calculate the short-range part of ESCp
15701 if (ipot.lt.6) then
15702 call escp_short(evdw2,evdw2_14)
15705 ! Calculate the bond-stretching energy
15709 ! Calculate the disulfide-bridge and other energy and the contributions
15710 ! from other distance constraints.
15713 ! Calculate the virtual-bond-angle energy.
15715 call ebend(ebe,ethetacnstr)
15717 ! Calculate the SC local energy.
15722 ! Calculate the virtual-bond torsional energy.
15724 call etor(etors,edihcnstr)
15726 ! 6/23/01 Calculate double-torsional energy
15728 call etor_d(etors_d)
15730 ! 21/5/07 Calculate local sicdechain correlation energy
15732 if (wsccor.gt.0.0d0) then
15733 call eback_sc_corr(esccor)
15738 ! Put energy components into an array
15745 energia(2)=evdw2-evdw2_14
15746 energia(18)=evdw2_14
15759 energia(14)=etors_d
15762 energia(19)=edihcnstr
15764 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
15766 call sum_energy(energia,.true.)
15767 ! write (iout,*) "Exit ETOTAL_SHORT"
15770 end subroutine etotal_short
15771 !-----------------------------------------------------------------------------
15773 !-----------------------------------------------------------------------------
15774 real(kind=8) function gnmr1(y,ymin,ymax)
15776 real(kind=8) :: y,ymin,ymax
15777 real(kind=8) :: wykl=4.0d0
15778 if (y.lt.ymin) then
15779 gnmr1=(ymin-y)**wykl/wykl
15780 else if (y.gt.ymax) then
15781 gnmr1=(y-ymax)**wykl/wykl
15787 !-----------------------------------------------------------------------------
15788 real(kind=8) function gnmr1prim(y,ymin,ymax)
15790 real(kind=8) :: y,ymin,ymax
15791 real(kind=8) :: wykl=4.0d0
15792 if (y.lt.ymin) then
15793 gnmr1prim=-(ymin-y)**(wykl-1)
15794 else if (y.gt.ymax) then
15795 gnmr1prim=(y-ymax)**(wykl-1)
15800 end function gnmr1prim
15801 !----------------------------------------------------------------------------
15802 real(kind=8) function rlornmr1(y,ymin,ymax,sigma)
15803 real(kind=8) y,ymin,ymax,sigma
15804 real(kind=8) wykl /4.0d0/
15805 if (y.lt.ymin) then
15806 rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl)
15807 else if (y.gt.ymax) then
15808 rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
15813 end function rlornmr1
15814 !------------------------------------------------------------------------------
15815 real(kind=8) function rlornmr1prim(y,ymin,ymax,sigma)
15816 real(kind=8) y,ymin,ymax,sigma
15817 real(kind=8) wykl /4.0d0/
15818 if (y.lt.ymin) then
15819 rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ &
15820 ((ymin-y)**wykl+sigma**wykl)**2
15821 else if (y.gt.ymax) then
15822 rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ &
15823 ((y-ymax)**wykl+sigma**wykl)**2
15828 end function rlornmr1prim
15830 real(kind=8) function harmonic(y,ymax)
15832 real(kind=8) :: y,ymax
15833 real(kind=8) :: wykl=2.0d0
15834 harmonic=(y-ymax)**wykl
15836 end function harmonic
15837 !-----------------------------------------------------------------------------
15838 real(kind=8) function harmonicprim(y,ymax)
15839 real(kind=8) :: y,ymin,ymax
15840 real(kind=8) :: wykl=2.0d0
15841 harmonicprim=(y-ymax)*wykl
15843 end function harmonicprim
15844 !-----------------------------------------------------------------------------
15846 !-----------------------------------------------------------------------------
15847 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
15849 use io_base, only:intout,briefout
15850 ! implicit real*8 (a-h,o-z)
15851 ! include 'DIMENSIONS'
15852 ! include 'COMMON.CHAIN'
15853 ! include 'COMMON.DERIV'
15854 ! include 'COMMON.VAR'
15855 ! include 'COMMON.INTERACT'
15856 ! include 'COMMON.FFIELD'
15857 ! include 'COMMON.MD'
15858 ! include 'COMMON.IOUNITS'
15859 real(kind=8),external :: ufparm
15860 integer :: uiparm(1)
15861 real(kind=8) :: urparm(1)
15862 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
15863 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
15864 integer :: n,nf,ind,ind1,i,k,j
15866 ! This subroutine calculates total internal coordinate gradient.
15867 ! Depending on the number of function evaluations, either whole energy
15868 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
15869 ! internal coordinates are reevaluated or only the cartesian-in-internal
15870 ! coordinate derivatives are evaluated. The subroutine was designed to work
15876 !d print *,'grad',nf,icg
15877 if (nf-nfl+1) 20,30,40
15878 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
15879 ! write (iout,*) 'grad 20'
15880 if (nf.eq.0) return
15882 30 call var_to_geom(n,x)
15884 ! write (iout,*) 'grad 30'
15886 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
15889 ! write (iout,*) 'grad 40'
15890 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
15892 ! Convert the Cartesian gradient into internal-coordinate gradient.
15902 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
15904 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
15907 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
15913 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
15915 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
15916 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
15919 if (i.gt.1) g(i-1)=gphii
15920 if (n.gt.nphi) g(nphi+i)=gthetai
15922 if (n.le.nphi+ntheta) goto 10
15924 if (itype(i,1).ne.10) then
15928 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
15931 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
15933 g(ialph(i,1))=galphai
15934 g(ialph(i,1)+nside)=gomegai
15938 ! Add the components corresponding to local energy terms.
15942 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
15943 g(i)=g(i)+gloc(i,icg)
15945 ! Uncomment following three lines for diagnostics.
15947 !elwrite(iout,*) "in gradient after calling intout"
15948 !d call briefout(0,0.0d0)
15949 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
15951 end subroutine gradient
15952 !-----------------------------------------------------------------------------
15953 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
15956 ! implicit real*8 (a-h,o-z)
15957 ! include 'DIMENSIONS'
15958 ! include 'COMMON.DERIV'
15959 ! include 'COMMON.IOUNITS'
15960 ! include 'COMMON.GEO'
15963 !el common /chuju/ jjj
15964 real(kind=8) :: energia(0:n_ene)
15965 integer :: uiparm(1)
15966 real(kind=8) :: urparm(1)
15968 real(kind=8),external :: ufparm
15969 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
15970 ! if (jjj.gt.0) then
15971 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
15975 !d print *,'func',nf,nfl,icg
15976 call var_to_geom(n,x)
15979 !d write (iout,*) 'ETOTAL called from FUNC'
15980 call etotal(energia)
15983 ! if (jjj.gt.0) then
15984 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
15985 ! write (iout,*) 'f=',etot
15989 end subroutine func
15990 !-----------------------------------------------------------------------------
15991 subroutine cartgrad
15992 ! implicit real*8 (a-h,o-z)
15993 ! include 'DIMENSIONS'
15995 use MD_data, only: totT,usampl,eq_time
15999 ! include 'COMMON.CHAIN'
16000 ! include 'COMMON.DERIV'
16001 ! include 'COMMON.VAR'
16002 ! include 'COMMON.INTERACT'
16003 ! include 'COMMON.FFIELD'
16004 ! include 'COMMON.MD'
16005 ! include 'COMMON.IOUNITS'
16006 ! include 'COMMON.TIME1'
16010 ! This subrouting calculates total Cartesian coordinate gradient.
16011 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
16021 !el write (iout,*) "After sum_gradient"
16023 !el write (iout,*) "After sum_gradient"
16025 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
16026 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
16029 ! If performing constraint dynamics, add the gradients of the constraint energy
16030 if(usampl.and.totT.gt.eq_time) then
16033 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
16034 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
16038 gloc(i,icg)=gloc(i,icg)+dugamma(i)
16041 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
16044 !elwrite (iout,*) "After sum_gradient"
16049 !elwrite (iout,*) "After sum_gradient"
16051 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
16053 ! call checkintcartgrad
16054 ! write(iout,*) 'calling int_to_cart'
16056 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
16060 gcart(j,i)=gradc(j,i,icg)
16061 gxcart(j,i)=gradx(j,i,icg)
16064 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
16065 (gxcart(j,i),j=1,3),gloc(i,icg)
16073 time_inttocart=time_inttocart+MPI_Wtime()-time01
16076 write (iout,*) "gcart and gxcart after int_to_cart"
16078 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
16079 (gxcart(j,i),j=1,3)
16084 write (iout,*) "CARGRAD"
16088 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
16089 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
16091 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
16092 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
16094 ! Correction: dummy residues
16097 ! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
16098 gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
16101 if (nct.lt.nres) then
16103 ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
16104 gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
16109 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
16113 end subroutine cartgrad
16114 !-----------------------------------------------------------------------------
16115 subroutine zerograd
16116 ! implicit real*8 (a-h,o-z)
16117 ! include 'DIMENSIONS'
16118 ! include 'COMMON.DERIV'
16119 ! include 'COMMON.CHAIN'
16120 ! include 'COMMON.VAR'
16121 ! include 'COMMON.MD'
16122 ! include 'COMMON.SCCOR'
16124 !el local variables
16125 integer :: i,j,intertyp,k
16126 ! Initialize Cartesian-coordinate gradient
16128 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
16129 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
16131 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
16132 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
16133 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
16134 ! allocate(gradcorr_long(3,nres))
16135 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
16136 ! allocate(gcorr6_turn_long(3,nres))
16137 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
16139 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
16141 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
16142 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
16144 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
16145 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
16147 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
16148 ! allocate(gscloc(3,nres)) !(3,maxres)
16149 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
16153 ! common /deriv_scloc/
16154 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
16155 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
16156 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
16158 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
16162 ! gradc(j,i,icg)=0.0d0
16163 ! gradx(j,i,icg)=0.0d0
16165 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
16166 !elwrite(iout,*) "icg",icg
16170 gradx_scp(j,i)=0.0D0
16172 gvdwc_scp(j,i)=0.0D0
16173 gvdwc_scpp(j,i)=0.0d0
16175 gelc_long(j,i)=0.0D0
16180 gel_loc_long(j,i)=0.0d0
16183 gcorr3_turn(j,i)=0.0d0
16184 gcorr4_turn(j,i)=0.0d0
16185 gradcorr(j,i)=0.0d0
16186 gradcorr_long(j,i)=0.0d0
16187 gradcorr5_long(j,i)=0.0d0
16188 gradcorr6_long(j,i)=0.0d0
16189 gcorr6_turn_long(j,i)=0.0d0
16190 gradcorr5(j,i)=0.0d0
16191 gradcorr6(j,i)=0.0d0
16192 gcorr6_turn(j,i)=0.0d0
16195 gradc(j,i,icg)=0.0d0
16196 gradx(j,i,icg)=0.0d0
16199 gliptran(j,i)=0.0d0
16200 gliptranx(j,i)=0.0d0
16201 gliptranc(j,i)=0.0d0
16202 gshieldx(j,i)=0.0d0
16203 gshieldc(j,i)=0.0d0
16204 gshieldc_loc(j,i)=0.0d0
16205 gshieldx_ec(j,i)=0.0d0
16206 gshieldc_ec(j,i)=0.0d0
16207 gshieldc_loc_ec(j,i)=0.0d0
16208 gshieldx_t3(j,i)=0.0d0
16209 gshieldc_t3(j,i)=0.0d0
16210 gshieldc_loc_t3(j,i)=0.0d0
16211 gshieldx_t4(j,i)=0.0d0
16212 gshieldc_t4(j,i)=0.0d0
16213 gshieldc_loc_t4(j,i)=0.0d0
16214 gshieldx_ll(j,i)=0.0d0
16215 gshieldc_ll(j,i)=0.0d0
16216 gshieldc_loc_ll(j,i)=0.0d0
16218 gg_tube_sc(j,i)=0.0d0
16220 gradb_nucl(j,i)=0.0d0
16221 gradbx_nucl(j,i)=0.0d0
16223 gloc_sc(intertyp,i,icg)=0.0d0
16232 grad_shield_side(k,j,i)=0.0d0
16233 grad_shield_loc(k,j,i)=0.0d0
16240 ! Initialize the gradient of local energy terms.
16242 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
16243 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
16244 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
16245 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
16246 ! allocate(gel_loc_turn3(nres))
16247 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
16248 ! allocate(gsccor_loc(nres)) !(maxres)
16254 gel_loc_loc(i)=0.0d0
16256 g_corr5_loc(i)=0.0d0
16257 g_corr6_loc(i)=0.0d0
16258 gel_loc_turn3(i)=0.0d0
16259 gel_loc_turn4(i)=0.0d0
16260 gel_loc_turn6(i)=0.0d0
16261 gsccor_loc(i)=0.0d0
16263 ! initialize gcart and gxcart
16264 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
16272 end subroutine zerograd
16273 !-----------------------------------------------------------------------------
16274 real(kind=8) function fdum()
16278 !-----------------------------------------------------------------------------
16280 !-----------------------------------------------------------------------------
16281 subroutine intcartderiv
16282 ! implicit real*8 (a-h,o-z)
16283 ! include 'DIMENSIONS'
16287 ! include 'COMMON.SETUP'
16288 ! include 'COMMON.CHAIN'
16289 ! include 'COMMON.VAR'
16290 ! include 'COMMON.GEO'
16291 ! include 'COMMON.INTERACT'
16292 ! include 'COMMON.DERIV'
16293 ! include 'COMMON.IOUNITS'
16294 ! include 'COMMON.LOCAL'
16295 ! include 'COMMON.SCCOR'
16296 real(kind=8) :: pi4,pi34
16297 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
16298 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
16299 dcosomega,dsinomega !(3,3,maxres)
16300 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
16303 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
16304 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
16305 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
16306 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
16310 !el from module energy-------------
16311 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
16312 !el allocate(dsintau(3,3,3,itau_start:itau_end))
16313 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
16315 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
16316 !el allocate(dsintau(3,3,3,0:nres2))
16317 !el allocate(dtauangle(3,3,3,0:nres2))
16318 !el allocate(domicron(3,2,2,0:nres2))
16319 !el allocate(dcosomicron(3,2,2,0:nres2))
16323 #if defined(MPI) && defined(PARINTDER)
16324 if (nfgtasks.gt.1 .and. me.eq.king) &
16325 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
16330 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
16331 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
16333 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
16336 dtheta(j,1,i)=0.0d0
16337 dtheta(j,2,i)=0.0d0
16343 ! Derivatives of theta's
16344 #if defined(MPI) && defined(PARINTDER)
16345 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16346 do i=max0(ithet_start-1,3),ithet_end
16350 cost=dcos(theta(i))
16351 sint=sqrt(1-cost*cost)
16353 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
16355 if (itype(i-1,1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
16356 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
16358 if (itype(i-1,1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
16361 #if defined(MPI) && defined(PARINTDER)
16362 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
16363 do i=max0(ithet_start-1,3),ithet_end
16367 if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1)) then
16368 cost1=dcos(omicron(1,i))
16369 sint1=sqrt(1-cost1*cost1)
16370 cost2=dcos(omicron(2,i))
16371 sint2=sqrt(1-cost2*cost2)
16373 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
16374 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
16375 cost1*dc_norm(j,i-2))/ &
16377 domicron(j,1,1,i)=-1/sint1*dcosomicron(j,1,1,i)
16378 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
16379 +cost1*(dc_norm(j,i-1+nres)))/ &
16381 domicron(j,1,2,i)=-1/sint1*dcosomicron(j,1,2,i)
16382 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
16383 !C Looks messy but better than if in loop
16384 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
16385 +cost2*dc_norm(j,i-1))/ &
16387 domicron(j,2,1,i)=-1/sint2*dcosomicron(j,2,1,i)
16388 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
16389 +cost2*(-dc_norm(j,i-1+nres)))/ &
16391 ! write(iout,*) "vbld", i,itype(i,1),vbld(i-1+nres)
16392 domicron(j,2,2,i)=-1/sint2*dcosomicron(j,2,2,i)
16396 !elwrite(iout,*) "after vbld write"
16397 ! Derivatives of phi:
16398 ! If phi is 0 or 180 degrees, then the formulas
16399 ! have to be derived by power series expansion of the
16400 ! conventional formulas around 0 and 180.
16402 do i=iphi1_start,iphi1_end
16406 ! if (itype(i-1,1).eq.21 .or. itype(i-2,1).eq.21 ) cycle
16407 ! the conventional case
16408 sint=dsin(theta(i))
16409 sint1=dsin(theta(i-1))
16411 cost=dcos(theta(i))
16412 cost1=dcos(theta(i-1))
16414 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
16415 fac0=1.0d0/(sint1*sint)
16418 fac3=cosg*cost1/(sint1*sint1)
16419 fac4=cosg*cost/(sint*sint)
16420 ! Obtaining the gamma derivatives from sine derivative
16421 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
16422 phi(i).gt.pi34.and.phi(i).le.pi.or. &
16423 phi(i).ge.-pi.and.phi(i).le.-pi34) then
16424 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16425 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
16426 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16430 cosg_inv=1.0d0/cosg
16431 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
16432 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16433 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
16434 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
16436 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
16437 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16438 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
16439 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
16440 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16441 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16442 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
16444 ! Bug fixed 3/24/05 (AL)
16446 ! Obtaining the gamma derivatives from cosine derivative
16449 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
16450 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16451 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16452 dc_norm(j,i-3))/vbld(i-2)
16453 dphi(j,1,i)=-1/sing*dcosphi(j,1,i)
16454 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16455 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16457 dphi(j,2,i)=-1/sing*dcosphi(j,2,i)
16458 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16459 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16460 dc_norm(j,i-1))/vbld(i)
16461 dphi(j,3,i)=-1/sing*dcosphi(j,3,i)
16466 !alculate derivative of Tauangle
16468 do i=itau_start,itau_end
16471 !elwrite(iout,*) " vecpr",i,nres
16473 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
16474 ! if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10).or.
16475 ! & (itype(i-1,1).eq.ntyp1).or.(itype(i,1).eq.ntyp1)) cycle
16476 !c dtauangle(j,intertyp,dervityp,residue number)
16477 !c INTERTYP=1 SC...Ca...Ca..Ca
16478 ! the conventional case
16479 sint=dsin(theta(i))
16480 sint1=dsin(omicron(2,i-1))
16481 sing=dsin(tauangle(1,i))
16482 cost=dcos(theta(i))
16483 cost1=dcos(omicron(2,i-1))
16484 cosg=dcos(tauangle(1,i))
16485 !elwrite(iout,*) " vecpr5",i,nres
16487 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
16488 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
16489 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16490 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
16492 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
16493 fac0=1.0d0/(sint1*sint)
16496 fac3=cosg*cost1/(sint1*sint1)
16497 fac4=cosg*cost/(sint*sint)
16498 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
16499 ! Obtaining the gamma derivatives from sine derivative
16500 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
16501 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
16502 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
16503 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
16504 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
16505 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16509 cosg_inv=1.0d0/cosg
16510 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16511 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
16512 *vbld_inv(i-2+nres)
16513 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
16514 dsintau(j,1,2,i)= &
16515 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
16516 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16517 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
16518 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
16519 ! Bug fixed 3/24/05 (AL)
16520 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
16521 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
16522 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16523 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
16525 ! Obtaining the gamma derivatives from cosine derivative
16528 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16529 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
16530 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
16531 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
16532 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16533 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16535 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
16536 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
16537 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
16538 dc_norm(j,i-1))/vbld(i)
16539 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
16540 ! write (iout,*) "else",i
16544 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
16547 !C Second case Ca...Ca...Ca...SC
16549 do i=itau_start,itau_end
16553 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
16554 (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle
16555 ! the conventional case
16556 sint=dsin(omicron(1,i))
16557 sint1=dsin(theta(i-1))
16558 sing=dsin(tauangle(2,i))
16559 cost=dcos(omicron(1,i))
16560 cost1=dcos(theta(i-1))
16561 cosg=dcos(tauangle(2,i))
16563 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16565 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
16566 fac0=1.0d0/(sint1*sint)
16569 fac3=cosg*cost1/(sint1*sint1)
16570 fac4=cosg*cost/(sint*sint)
16571 ! Obtaining the gamma derivatives from sine derivative
16572 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
16573 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
16574 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
16575 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
16576 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
16577 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
16581 cosg_inv=1.0d0/cosg
16582 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
16583 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
16584 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
16585 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
16586 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
16587 dsintau(j,2,2,i)= &
16588 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
16589 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16590 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
16591 ! & sing*ctgt*domicron(j,1,2,i),
16592 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16593 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
16594 ! Bug fixed 3/24/05 (AL)
16595 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16596 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
16597 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16598 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
16600 ! Obtaining the gamma derivatives from cosine derivative
16603 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
16604 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16605 dc_norm(j,i-3))/vbld(i-2)
16606 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
16607 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
16608 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
16609 dcosomicron(j,1,1,i)
16610 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
16611 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16612 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
16613 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16614 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
16615 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
16620 !CC third case SC...Ca...Ca...SC
16623 do i=itau_start,itau_end
16627 ! the conventional case
16628 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
16629 (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
16630 sint=dsin(omicron(1,i))
16631 sint1=dsin(omicron(2,i-1))
16632 sing=dsin(tauangle(3,i))
16633 cost=dcos(omicron(1,i))
16634 cost1=dcos(omicron(2,i-1))
16635 cosg=dcos(tauangle(3,i))
16637 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
16638 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
16640 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
16641 fac0=1.0d0/(sint1*sint)
16644 fac3=cosg*cost1/(sint1*sint1)
16645 fac4=cosg*cost/(sint*sint)
16646 ! Obtaining the gamma derivatives from sine derivative
16647 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
16648 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
16649 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
16650 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
16651 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
16652 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
16656 cosg_inv=1.0d0/cosg
16657 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
16658 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
16659 *vbld_inv(i-2+nres)
16660 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
16661 dsintau(j,3,2,i)= &
16662 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
16663 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
16664 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
16665 ! Bug fixed 3/24/05 (AL)
16666 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
16667 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
16668 *vbld_inv(i-1+nres)
16669 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
16670 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
16672 ! Obtaining the gamma derivatives from cosine derivative
16675 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
16676 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
16677 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
16678 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
16679 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
16680 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
16681 dcosomicron(j,1,1,i)
16682 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
16683 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
16684 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
16685 dc_norm(j,i-1+nres))/vbld(i-1+nres)
16686 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
16687 ! write(iout,*) "else",i
16693 ! Derivatives of side-chain angles alpha and omega
16694 #if defined(MPI) && defined(PARINTDER)
16695 do i=ibond_start,ibond_end
16699 if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
16700 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
16703 fac8=fac5/vbld(i+1)
16704 fac9=fac5/vbld(i+nres)
16705 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
16706 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
16707 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
16708 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
16709 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
16710 sina=sqrt(1-cosa*cosa)
16712 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
16714 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
16715 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
16716 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
16717 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
16718 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
16719 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
16720 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
16721 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
16723 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
16725 ! obtaining the derivatives of omega from sines
16726 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
16727 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
16728 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
16729 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
16731 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
16732 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
16733 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
16734 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
16735 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
16736 coso_inv=1.0d0/dcos(omeg(i))
16738 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
16739 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
16740 (sino*dc_norm(j,i-1))/vbld(i)
16741 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
16742 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
16743 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
16744 -sino*dc_norm(j,i)/vbld(i+1)
16745 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
16746 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
16747 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
16749 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
16752 ! obtaining the derivatives of omega from cosines
16753 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
16754 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
16759 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
16760 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
16761 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
16762 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
16763 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
16764 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
16765 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
16766 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
16767 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
16768 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
16769 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
16770 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
16771 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
16772 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
16773 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
16779 dalpha(k,j,i)=0.0d0
16780 domega(k,j,i)=0.0d0
16786 #if defined(MPI) && defined(PARINTDER)
16787 if (nfgtasks.gt.1) then
16789 !d write (iout,*) "Gather dtheta"
16790 !d call flush(iout)
16791 write (iout,*) "dtheta before gather"
16793 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
16796 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
16797 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
16798 king,FG_COMM,IERROR)
16800 !d write (iout,*) "Gather dphi"
16801 !d call flush(iout)
16802 write (iout,*) "dphi before gather"
16804 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
16807 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
16808 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
16809 king,FG_COMM,IERROR)
16810 !d write (iout,*) "Gather dalpha"
16811 !d call flush(iout)
16813 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
16814 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
16815 king,FG_COMM,IERROR)
16816 !d write (iout,*) "Gather domega"
16817 !d call flush(iout)
16818 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
16819 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
16820 king,FG_COMM,IERROR)
16825 write (iout,*) "dtheta after gather"
16827 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
16829 write (iout,*) "dphi after gather"
16831 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
16833 write (iout,*) "dalpha after gather"
16835 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
16837 write (iout,*) "domega after gather"
16839 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
16843 end subroutine intcartderiv
16844 !-----------------------------------------------------------------------------
16845 subroutine checkintcartgrad
16846 ! implicit real*8 (a-h,o-z)
16847 ! include 'DIMENSIONS'
16851 ! include 'COMMON.CHAIN'
16852 ! include 'COMMON.VAR'
16853 ! include 'COMMON.GEO'
16854 ! include 'COMMON.INTERACT'
16855 ! include 'COMMON.DERIV'
16856 ! include 'COMMON.IOUNITS'
16857 ! include 'COMMON.SETUP'
16858 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
16859 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
16860 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
16861 real(kind=8),dimension(3) :: dc_norm_s
16862 real(kind=8) :: aincr=1.0d-5
16864 real(kind=8) :: dcji
16867 theta_s(i)=theta(i)
16871 ! Check theta gradient
16873 "Analytical (upper) and numerical (lower) gradient of theta"
16878 dc(j,i-2)=dcji+aincr
16879 call chainbuild_cart
16880 call int_from_cart1(.false.)
16881 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
16884 dc(j,i-1)=dc(j,i-1)+aincr
16885 call chainbuild_cart
16886 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
16889 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
16890 !el (dtheta(j,2,i),j=1,3)
16891 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
16892 !el (dthetanum(j,2,i),j=1,3)
16893 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
16894 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
16895 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
16898 ! Check gamma gradient
16900 "Analytical (upper) and numerical (lower) gradient of gamma"
16904 dc(j,i-3)=dcji+aincr
16905 call chainbuild_cart
16906 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
16909 dc(j,i-2)=dcji+aincr
16910 call chainbuild_cart
16911 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
16914 dc(j,i-1)=dc(j,i-1)+aincr
16915 call chainbuild_cart
16916 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
16919 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
16920 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
16921 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
16922 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
16923 !el write (iout,'(5x,3(3f10.5,5x))') &
16924 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
16925 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
16926 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
16929 ! Check alpha gradient
16931 "Analytical (upper) and numerical (lower) gradient of alpha"
16933 if(itype(i,1).ne.10) then
16936 dc(j,i-1)=dcji+aincr
16937 call chainbuild_cart
16938 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
16943 call chainbuild_cart
16944 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
16948 dc(j,i+nres)=dc(j,i+nres)+aincr
16949 call chainbuild_cart
16950 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
16955 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
16956 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
16957 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
16958 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
16959 !el write (iout,'(5x,3(3f10.5,5x))') &
16960 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
16961 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
16962 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
16965 ! Check omega gradient
16967 "Analytical (upper) and numerical (lower) gradient of omega"
16969 if(itype(i,1).ne.10) then
16972 dc(j,i-1)=dcji+aincr
16973 call chainbuild_cart
16974 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
16979 call chainbuild_cart
16980 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
16984 dc(j,i+nres)=dc(j,i+nres)+aincr
16985 call chainbuild_cart
16986 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
16991 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
16992 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
16993 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
16994 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
16995 !el write (iout,'(5x,3(3f10.5,5x))') &
16996 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
16997 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
16998 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
17002 end subroutine checkintcartgrad
17003 !-----------------------------------------------------------------------------
17005 !-----------------------------------------------------------------------------
17006 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
17007 ! implicit real*8 (a-h,o-z)
17008 ! include 'DIMENSIONS'
17009 ! include 'COMMON.IOUNITS'
17010 ! include 'COMMON.CHAIN'
17011 ! include 'COMMON.INTERACT'
17012 ! include 'COMMON.VAR'
17013 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
17014 integer :: kkk,nsep=3
17015 real(kind=8) :: qm !dist,
17016 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
17017 logical :: lprn=.false.
17019 ! real(kind=8) :: sigm,x
17021 !el sigm(x)=0.25d0*x ! local function
17027 do il=seg1+nsep,seg2
17030 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
17031 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
17032 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17034 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
17035 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17038 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17039 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17040 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17041 dijCM=dist(il+nres,jl+nres)
17042 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
17044 qq = qq+qqij+qqijCM
17050 if((seg3-il).lt.3) then
17057 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17058 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17059 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17061 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
17062 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17065 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17066 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17067 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17068 dijCM=dist(il+nres,jl+nres)
17069 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
17071 qq = qq+qqij+qqijCM
17076 if (qqmax.le.qq) qqmax=qq
17078 qwolynes=1.0d0-qqmax
17080 end function qwolynes
17081 !-----------------------------------------------------------------------------
17082 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
17083 ! implicit real*8 (a-h,o-z)
17084 ! include 'DIMENSIONS'
17085 ! include 'COMMON.IOUNITS'
17086 ! include 'COMMON.CHAIN'
17087 ! include 'COMMON.INTERACT'
17088 ! include 'COMMON.VAR'
17089 ! include 'COMMON.MD'
17090 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
17091 integer :: nsep=3, kkk
17092 !el real(kind=8) :: dist
17093 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
17094 logical :: lprn=.false.
17096 real(kind=8) :: sim,dd0,fac,ddqij
17097 !el sigm(x)=0.25d0*x ! local function
17107 do il=seg1+nsep,seg2
17110 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17111 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17112 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17114 sim = 1.0d0/sigm(d0ij)
17117 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
17119 ddqij = (c(k,il)-c(k,jl))*fac
17120 dqwol(k,il)=dqwol(k,il)+ddqij
17121 dqwol(k,jl)=dqwol(k,jl)-ddqij
17124 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17127 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17128 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17129 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17130 dijCM=dist(il+nres,jl+nres)
17131 sim = 1.0d0/sigm(d0ijCM)
17134 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17136 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17137 dxqwol(k,il)=dxqwol(k,il)+ddqij
17138 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17145 if((seg3-il).lt.3) then
17152 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
17153 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
17154 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
17156 sim = 1.0d0/sigm(d0ij)
17159 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
17161 ddqij = (c(k,il)-c(k,jl))*fac
17162 dqwol(k,il)=dqwol(k,il)+ddqij
17163 dqwol(k,jl)=dqwol(k,jl)-ddqij
17165 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
17168 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
17169 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
17170 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
17171 dijCM=dist(il+nres,jl+nres)
17172 sim = 1.0d0/sigm(d0ijCM)
17175 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
17177 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
17178 dxqwol(k,il)=dxqwol(k,il)+ddqij
17179 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
17188 dqwol(j,i)=dqwol(j,i)/nl
17189 dxqwol(j,i)=dxqwol(j,i)/nl
17193 end subroutine qwolynes_prim
17194 !-----------------------------------------------------------------------------
17195 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
17196 ! implicit real*8 (a-h,o-z)
17197 ! include 'DIMENSIONS'
17198 ! include 'COMMON.IOUNITS'
17199 ! include 'COMMON.CHAIN'
17200 ! include 'COMMON.INTERACT'
17201 ! include 'COMMON.VAR'
17202 integer :: seg1,seg2,seg3,seg4
17204 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
17205 real(kind=8),dimension(3,0:2*nres) :: cdummy
17206 real(kind=8) :: q1,q2
17207 real(kind=8) :: delta=1.0d-10
17212 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
17214 c(j,i)=c(j,i)+delta
17215 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
17216 qwolan(j,i)=(q2-q1)/delta
17222 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
17223 cdummy(j,i+nres)=c(j,i+nres)
17224 c(j,i+nres)=c(j,i+nres)+delta
17225 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
17226 qwolxan(j,i)=(q2-q1)/delta
17227 c(j,i+nres)=cdummy(j,i+nres)
17230 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
17232 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
17234 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
17236 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
17239 end subroutine qwol_num
17240 !-----------------------------------------------------------------------------
17241 subroutine EconstrQ
17242 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
17243 ! implicit real*8 (a-h,o-z)
17244 ! include 'DIMENSIONS'
17245 ! include 'COMMON.CONTROL'
17246 ! include 'COMMON.VAR'
17247 ! include 'COMMON.MD'
17250 ! include 'COMMON.LANGEVIN'
17252 ! include 'COMMON.LANGEVIN.lang0'
17254 ! include 'COMMON.CHAIN'
17255 ! include 'COMMON.DERIV'
17256 ! include 'COMMON.GEO'
17257 ! include 'COMMON.LOCAL'
17258 ! include 'COMMON.INTERACT'
17259 ! include 'COMMON.IOUNITS'
17260 ! include 'COMMON.NAMES'
17261 ! include 'COMMON.TIME1'
17262 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
17263 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
17265 integer :: kstart,kend,lstart,lend,idummy
17266 real(kind=8) :: delta=1.0d-7
17267 integer :: i,j,k,ii
17271 dudconst(j,i)=0.0d0
17272 duxconst(j,i)=0.0d0
17273 dudxconst(j,i)=0.0d0
17278 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
17280 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
17281 ! Calculating the derivatives of Constraint energy with respect to Q
17282 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
17284 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
17285 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
17286 ! hmnum=(hm2-hm1)/delta
17287 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
17288 ! & qinfrag(i,iset))
17289 ! write(iout,*) "harmonicnum frag", hmnum
17290 ! Calculating the derivatives of Q with respect to cartesian coordinates
17291 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
17293 ! write(iout,*) "dqwol "
17295 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17297 ! write(iout,*) "dxqwol "
17299 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17301 ! Calculating numerical gradients of dU/dQi and dQi/dxi
17302 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
17303 ! & ,idummy,idummy)
17304 ! The gradients of Uconst in Cs
17307 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
17308 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
17313 kstart=ifrag(1,ipair(1,i,iset),iset)
17314 kend=ifrag(2,ipair(1,i,iset),iset)
17315 lstart=ifrag(1,ipair(2,i,iset),iset)
17316 lend=ifrag(2,ipair(2,i,iset),iset)
17317 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
17318 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
17319 ! Calculating dU/dQ
17320 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
17321 ! hm1=harmonic(qpair(i),qinpair(i,iset))
17322 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
17323 ! hmnum=(hm2-hm1)/delta
17324 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
17325 ! & qinpair(i,iset))
17326 ! write(iout,*) "harmonicnum pair ", hmnum
17327 ! Calculating dQ/dXi
17328 call qwolynes_prim(kstart,kend,.false.,&
17330 ! write(iout,*) "dqwol "
17332 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
17334 ! write(iout,*) "dxqwol "
17336 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
17338 ! Calculating numerical gradients
17339 ! call qwol_num(kstart,kend,.false.
17341 ! The gradients of Uconst in Cs
17344 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
17345 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
17349 ! write(iout,*) "Uconst inside subroutine ", Uconst
17350 ! Transforming the gradients from Cs to dCs for the backbone
17354 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
17358 ! Transforming the gradients from Cs to dCs for the side chains
17361 dudxconst(j,i)=duxconst(j,i)
17364 ! write(iout,*) "dU/ddc backbone "
17366 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
17368 ! write(iout,*) "dU/ddX side chain "
17370 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
17372 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
17373 ! call dEconstrQ_num
17375 end subroutine EconstrQ
17376 !-----------------------------------------------------------------------------
17377 subroutine dEconstrQ_num
17378 ! Calculating numerical dUconst/ddc and dUconst/ddx
17379 ! implicit real*8 (a-h,o-z)
17380 ! include 'DIMENSIONS'
17381 ! include 'COMMON.CONTROL'
17382 ! include 'COMMON.VAR'
17383 ! include 'COMMON.MD'
17386 ! include 'COMMON.LANGEVIN'
17388 ! include 'COMMON.LANGEVIN.lang0'
17390 ! include 'COMMON.CHAIN'
17391 ! include 'COMMON.DERIV'
17392 ! include 'COMMON.GEO'
17393 ! include 'COMMON.LOCAL'
17394 ! include 'COMMON.INTERACT'
17395 ! include 'COMMON.IOUNITS'
17396 ! include 'COMMON.NAMES'
17397 ! include 'COMMON.TIME1'
17398 real(kind=8) :: uzap1,uzap2
17399 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
17400 integer :: kstart,kend,lstart,lend,idummy
17401 real(kind=8) :: delta=1.0d-7
17402 !el local variables
17408 dUcartan(j,i)=0.0d0
17409 cdummy(j,i)=dc(j,i)
17410 dc(j,i)=dc(j,i)+delta
17411 call chainbuild_cart
17414 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17416 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17420 kstart=ifrag(1,ipair(1,ii,iset),iset)
17421 kend=ifrag(2,ipair(1,ii,iset),iset)
17422 lstart=ifrag(1,ipair(2,ii,iset),iset)
17423 lend=ifrag(2,ipair(2,ii,iset),iset)
17424 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17425 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17428 dc(j,i)=cdummy(j,i)
17429 call chainbuild_cart
17432 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17434 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17438 kstart=ifrag(1,ipair(1,ii,iset),iset)
17439 kend=ifrag(2,ipair(1,ii,iset),iset)
17440 lstart=ifrag(1,ipair(2,ii,iset),iset)
17441 lend=ifrag(2,ipair(2,ii,iset),iset)
17442 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17443 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17446 ducartan(j,i)=(uzap2-uzap1)/(delta)
17449 ! Calculating numerical gradients for dU/ddx
17451 duxcartan(j,i)=0.0d0
17453 cdummy(j,i)=dc(j,i+nres)
17454 dc(j,i+nres)=dc(j,i+nres)+delta
17455 call chainbuild_cart
17458 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
17460 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
17464 kstart=ifrag(1,ipair(1,ii,iset),iset)
17465 kend=ifrag(2,ipair(1,ii,iset),iset)
17466 lstart=ifrag(1,ipair(2,ii,iset),iset)
17467 lend=ifrag(2,ipair(2,ii,iset),iset)
17468 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17469 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
17472 dc(j,i+nres)=cdummy(j,i)
17473 call chainbuild_cart
17476 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
17477 ifrag(2,ii,iset),.true.,idummy,idummy)
17478 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
17482 kstart=ifrag(1,ipair(1,ii,iset),iset)
17483 kend=ifrag(2,ipair(1,ii,iset),iset)
17484 lstart=ifrag(1,ipair(2,ii,iset),iset)
17485 lend=ifrag(2,ipair(2,ii,iset),iset)
17486 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
17487 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
17490 duxcartan(j,i)=(uzap2-uzap1)/(delta)
17493 write(iout,*) "Numerical dUconst/ddc backbone "
17495 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
17497 ! write(iout,*) "Numerical dUconst/ddx side-chain "
17499 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
17502 end subroutine dEconstrQ_num
17503 !-----------------------------------------------------------------------------
17505 !-----------------------------------------------------------------------------
17506 subroutine check_energies
17508 ! use random, only: ran_number
17512 ! include 'DIMENSIONS'
17513 ! include 'COMMON.CHAIN'
17514 ! include 'COMMON.VAR'
17515 ! include 'COMMON.IOUNITS'
17516 ! include 'COMMON.SBRIDGE'
17517 ! include 'COMMON.LOCAL'
17518 ! include 'COMMON.GEO'
17520 ! External functions
17521 !EL double precision ran_number
17522 !EL external ran_number
17525 integer :: i,j,k,l,lmax,p,pmax
17526 real(kind=8) :: rmin,rmax
17527 real(kind=8) :: eij
17530 real(kind=8) :: wi,rij,tj,pj
17552 !t wi=ran_number(0.0D0,pi)
17553 ! wi=ran_number(0.0D0,pi/6.0D0)
17555 !t tj=ran_number(0.0D0,pi)
17556 !t pj=ran_number(0.0D0,pi)
17557 ! pj=ran_number(0.0D0,pi/6.0D0)
17561 !t rij=ran_number(rmin,rmax)
17563 c(1,j)=d*sin(pj)*cos(tj)
17564 c(2,j)=d*sin(pj)*sin(tj)
17570 c(3,i)=-rij-d*cos(wi)
17573 dc(k,nres+i)=c(k,nres+i)-c(k,i)
17574 dc_norm(k,nres+i)=dc(k,nres+i)/d
17575 dc(k,nres+j)=c(k,nres+j)-c(k,j)
17576 dc_norm(k,nres+j)=dc(k,nres+j)/d
17579 call dyn_ssbond_ene(i,j,eij)
17584 end subroutine check_energies
17585 !-----------------------------------------------------------------------------
17586 subroutine dyn_ssbond_ene(resi,resj,eij)
17591 ! include 'DIMENSIONS'
17592 ! include 'COMMON.SBRIDGE'
17593 ! include 'COMMON.CHAIN'
17594 ! include 'COMMON.DERIV'
17595 ! include 'COMMON.LOCAL'
17596 ! include 'COMMON.INTERACT'
17597 ! include 'COMMON.VAR'
17598 ! include 'COMMON.IOUNITS'
17599 ! include 'COMMON.CALC'
17603 ! include 'COMMON.MD'
17604 ! use MD, only: totT,t_bath
17607 ! External functions
17608 !EL double precision h_base
17609 !EL external h_base
17612 integer :: resi,resj
17615 real(kind=8) :: eij
17618 logical :: havebond
17619 integer itypi,itypj
17620 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
17621 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
17622 real(kind=8),dimension(3) :: dcosom1,dcosom2
17624 real(kind=8) :: pom1,pom2
17625 real(kind=8) :: ljA,ljB,ljXs
17626 real(kind=8),dimension(1:3) :: d_ljB
17627 real(kind=8) :: ssA,ssB,ssC,ssXs
17628 real(kind=8) :: ssxm,ljxm,ssm,ljm
17629 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
17630 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
17631 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
17632 !-------FIRST METHOD
17634 real(kind=8),dimension(1:3) :: d_xm
17635 !-------END FIRST METHOD
17636 !-------SECOND METHOD
17637 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
17638 !-------END SECOND METHOD
17640 !-------TESTING CODE
17641 !el logical :: checkstop,transgrad
17642 !el common /sschecks/ checkstop,transgrad
17644 integer :: icheck,nicheck,jcheck,njcheck
17645 real(kind=8),dimension(-1:1) :: echeck
17646 real(kind=8) :: deps,ssx0,ljx0
17647 !-------END TESTING CODE
17653 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
17654 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
17657 dxi=dc_norm(1,nres+i)
17658 dyi=dc_norm(2,nres+i)
17659 dzi=dc_norm(3,nres+i)
17660 dsci_inv=vbld_inv(i+nres)
17663 xj=c(1,nres+j)-c(1,nres+i)
17664 yj=c(2,nres+j)-c(2,nres+i)
17665 zj=c(3,nres+j)-c(3,nres+i)
17666 dxj=dc_norm(1,nres+j)
17667 dyj=dc_norm(2,nres+j)
17668 dzj=dc_norm(3,nres+j)
17669 dscj_inv=vbld_inv(j+nres)
17671 chi1=chi(itypi,itypj)
17672 chi2=chi(itypj,itypi)
17679 alf12=0.5D0*(alf1+alf2)
17681 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
17682 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
17683 ! The following are set in sc_angular
17687 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
17688 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
17689 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
17691 rij=1.0D0/rij ! Reset this so it makes sense
17693 sig0ij=sigma(itypi,itypj)
17694 sig=sig0ij*dsqrt(1.0D0/sigsq)
17697 ljA=eps1*eps2rt**2*eps3rt**2
17698 ljB=ljA*bb_aq(itypi,itypj)
17699 ljA=ljA*aa_aq(itypi,itypj)
17700 ljxm=ljXs+(-2.0D0*aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
17705 deltat12=om2-om1+2.0d0
17706 cosphi=om12-om1*om2
17710 +akth*(deltat1*deltat1+deltat2*deltat2) &
17711 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
17712 ssxm=ssXs-0.5D0*ssB/ssA
17714 !-------TESTING CODE
17715 !$$$c Some extra output
17716 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
17717 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
17718 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
17719 !$$$ if (ssx0.gt.0.0d0) then
17720 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
17724 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
17725 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
17726 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
17728 !-------END TESTING CODE
17730 !-------TESTING CODE
17731 ! Stop and plot energy and derivative as a function of distance
17732 if (checkstop) then
17733 ssm=ssC-0.25D0*ssB*ssB/ssA
17734 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
17735 if (ssm.lt.ljm .and. &
17736 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
17744 if (.not.checkstop) then
17749 do icheck=0,nicheck
17750 do jcheck=-1,njcheck
17751 if (checkstop) rij=(ssxm-1.0d0)+ &
17752 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
17753 !-------END TESTING CODE
17755 if (rij.gt.ljxm) then
17758 fac=(1.0D0/ljd)**expon
17759 e1=fac*fac*aa_aq(itypi,itypj)
17760 e2=fac*bb_aq(itypi,itypj)
17761 eij=eps1*eps2rt*eps3rt*(e1+e2)
17764 eij=eij*eps2rt*eps3rt
17767 e1=e1*eps1*eps2rt**2*eps3rt**2
17768 ed=-expon*(e1+eij)/ljd
17770 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
17771 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
17772 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
17773 -2.0D0*alf12*eps3der+sigder*sigsq_om12
17774 else if (rij.lt.ssxm) then
17777 eij=ssA*ssd*ssd+ssB*ssd+ssC
17779 ed=2*akcm*ssd+akct*deltat12
17781 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
17782 eom1=-2*akth*deltat1-pom1-om2*pom2
17783 eom2= 2*akth*deltat2+pom1-om1*pom2
17786 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
17788 d_ssxm(1)=0.5D0*akct/ssA
17789 d_ssxm(2)=-d_ssxm(1)
17792 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
17793 d_ljxm(2)=d_ljxm(1)*sigsq_om2
17794 d_ljxm(3)=d_ljxm(1)*sigsq_om12
17795 d_ljxm(1)=d_ljxm(1)*sigsq_om1
17797 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
17798 xm=0.5d0*(ssxm+ljxm)
17800 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
17802 if (rij.lt.xm) then
17804 ssm=ssC-0.25D0*ssB*ssB/ssA
17805 d_ssm(1)=0.5D0*akct*ssB/ssA
17806 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
17807 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
17809 f1=(rij-xm)/(ssxm-xm)
17810 f2=(rij-ssxm)/(xm-ssxm)
17814 delta_inv=1.0d0/(xm-ssxm)
17815 deltasq_inv=delta_inv*delta_inv
17817 fac1=deltasq_inv*fac*(xm-rij)
17818 fac2=deltasq_inv*fac*(rij-ssxm)
17819 ed=delta_inv*(Ht*hd2-ssm*hd1)
17820 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
17821 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
17822 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
17825 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
17826 d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
17827 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
17828 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
17830 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
17831 f1=(rij-ljxm)/(xm-ljxm)
17832 f2=(rij-xm)/(ljxm-xm)
17836 delta_inv=1.0d0/(ljxm-xm)
17837 deltasq_inv=delta_inv*delta_inv
17839 fac1=deltasq_inv*fac*(ljxm-rij)
17840 fac2=deltasq_inv*fac*(rij-xm)
17841 ed=delta_inv*(ljm*hd2-Ht*hd1)
17842 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
17843 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
17844 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
17846 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
17848 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
17854 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
17855 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
17856 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
17858 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
17859 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
17860 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
17861 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
17862 !$$$ d_ssm(3)=omega
17864 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
17866 !$$$ d_ljm(k)=ljm*d_ljB(k)
17870 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
17871 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
17872 !$$$ d_ss(2)=akct*ssd
17873 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
17874 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
17877 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
17878 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
17879 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
17881 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
17882 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
17884 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
17886 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
17887 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
17888 !$$$ h1=h_base(f1,hd1)
17889 !$$$ h2=h_base(f2,hd2)
17890 !$$$ eij=ss*h1+ljf*h2
17891 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
17892 !$$$ deltasq_inv=delta_inv*delta_inv
17893 !$$$ fac=ljf*hd2-ss*hd1
17894 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
17895 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
17896 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
17897 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
17898 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
17899 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
17900 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
17902 !$$$ havebond=.false.
17903 !$$$ if (ed.gt.0.0d0) havebond=.true.
17904 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
17911 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
17912 ! write(iout,'(a15,f12.2,f8.1,2i5)')
17913 ! & "SSBOND_E_FORM",totT,t_bath,i,j
17917 dyn_ssbond_ij(i,j)=eij
17918 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
17919 dyn_ssbond_ij(i,j)=1.0d300
17922 ! write(iout,'(a15,f12.2,f8.1,2i5)')
17923 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
17928 !-------TESTING CODE
17929 !el if (checkstop) then
17930 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
17931 "CHECKSTOP",rij,eij,ed
17935 if (checkstop) then
17936 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
17939 if (checkstop) then
17943 !-------END TESTING CODE
17946 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
17947 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
17950 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
17953 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
17954 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
17955 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
17956 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
17957 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
17958 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
17962 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
17967 gvdwc(l,i)=gvdwc(l,i)-gg(l)
17968 gvdwc(l,j)=gvdwc(l,j)+gg(l)
17972 end subroutine dyn_ssbond_ene
17973 !--------------------------------------------------------------------------
17974 subroutine triple_ssbond_ene(resi,resj,resk,eij)
17979 ! include 'DIMENSIONS'
17980 ! include 'COMMON.SBRIDGE'
17981 ! include 'COMMON.CHAIN'
17982 ! include 'COMMON.DERIV'
17983 ! include 'COMMON.LOCAL'
17984 ! include 'COMMON.INTERACT'
17985 ! include 'COMMON.VAR'
17986 ! include 'COMMON.IOUNITS'
17987 ! include 'COMMON.CALC'
17991 ! include 'COMMON.MD'
17992 ! use MD, only: totT,t_bath
17995 double precision h_base
17999 integer resi,resj,resk,m,itypi,itypj,itypk
18001 !c Output arguments
18002 double precision eij,eij1,eij2,eij3
18006 !c integer itypi,itypj,k,l
18007 double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi
18008 double precision rrik,rrjk,rik,rjk,xi,xk,yi,yk,zi,zk,xij,yij,zij
18009 double precision xik,yik,zik,xjk,yjk,zjk,dxk,dyk,dzk
18010 double precision sig0ij,ljd,sig,fac,e1,e2
18011 double precision dcosom1(3),dcosom2(3),ed
18012 double precision pom1,pom2
18013 double precision ljA,ljB,ljXs
18014 double precision d_ljB(1:3)
18015 double precision ssA,ssB,ssC,ssXs
18016 double precision ssxm,ljxm,ssm,ljm
18017 double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3)
18019 if (dtriss.eq.0) return
18023 !C write(iout,*) resi,resj,resk
18025 dxi=dc_norm(1,nres+i)
18026 dyi=dc_norm(2,nres+i)
18027 dzi=dc_norm(3,nres+i)
18028 dsci_inv=vbld_inv(i+nres)
18037 dxj=dc_norm(1,nres+j)
18038 dyj=dc_norm(2,nres+j)
18039 dzj=dc_norm(3,nres+j)
18040 dscj_inv=vbld_inv(j+nres)
18046 dxk=dc_norm(1,nres+k)
18047 dyk=dc_norm(2,nres+k)
18048 dzk=dc_norm(3,nres+k)
18049 dscj_inv=vbld_inv(k+nres)
18059 rrij=(xij*xij+yij*yij+zij*zij)
18060 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
18061 rrik=(xik*xik+yik*yik+zik*zik)
18063 rrjk=(xjk*xjk+yjk*yjk+zjk*zjk)
18065 !C there are three combination of distances for each trisulfide bonds
18066 !C The first case the ith atom is the center
18067 !C Energy function is E=d/(a*(x-y)**2+b*(x+y)**2+c) where x is first
18068 !C distance y is second distance the a,b,c,d are parameters derived for
18069 !C this problem d parameter was set as a penalty currenlty set to 1.
18070 if ((iabs(j-i).le.2).or.(iabs(i-k).le.2)) then
18073 eij1=dtriss/(atriss*(rij-rik)**2+btriss*(rij+rik)**6+ctriss)
18075 !C second case jth atom is center
18076 if ((iabs(j-i).le.2).or.(iabs(j-k).le.2)) then
18079 eij2=dtriss/(atriss*(rij-rjk)**2+btriss*(rij+rjk)**6+ctriss)
18081 !C the third case kth atom is the center
18082 if ((iabs(i-k).le.2).or.(iabs(j-k).le.2)) then
18085 eij3=dtriss/(atriss*(rik-rjk)**2+btriss*(rik+rjk)**6+ctriss)
18091 !C write(iout,*)i,j,k,eij
18092 !C The energy penalty calculated now time for the gradient part
18093 !C derivative over rij
18094 fac=-eij1**2/dtriss*(2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
18095 -eij2**2/dtriss*(2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)
18100 gvdwx(m,i)=gvdwx(m,i)-gg(m)
18101 gvdwx(m,j)=gvdwx(m,j)+gg(m)
18105 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18106 gvdwc(l,j)=gvdwc(l,j)+gg(l)
18108 !C now derivative over rik
18109 fac=-eij1**2/dtriss* &
18110 (-2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
18111 -eij3**2/dtriss*(2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
18116 gvdwx(m,i)=gvdwx(m,i)-gg(m)
18117 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18120 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18121 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18123 !C now derivative over rjk
18124 fac=-eij2**2/dtriss* &
18125 (-2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)- &
18126 eij3**2/dtriss*(-2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
18131 gvdwx(m,j)=gvdwx(m,j)-gg(m)
18132 gvdwx(m,k)=gvdwx(m,k)+gg(m)
18135 gvdwc(l,j)=gvdwc(l,j)-gg(l)
18136 gvdwc(l,k)=gvdwc(l,k)+gg(l)
18139 end subroutine triple_ssbond_ene
18143 !-----------------------------------------------------------------------------
18144 real(kind=8) function h_base(x,deriv)
18145 ! A smooth function going 0->1 in range [0,1]
18146 ! It should NOT be called outside range [0,1], it will not work there.
18153 real(kind=8) :: deriv
18156 real(kind=8) :: xsq
18159 ! Two parabolas put together. First derivative zero at extrema
18160 !$$$ if (x.lt.0.5D0) then
18161 !$$$ h_base=2.0D0*x*x
18165 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
18166 !$$$ deriv=4.0D0*deriv
18169 ! Third degree polynomial. First derivative zero at extrema
18170 h_base=x*x*(3.0d0-2.0d0*x)
18171 deriv=6.0d0*x*(1.0d0-x)
18173 ! Fifth degree polynomial. First and second derivatives zero at extrema
18175 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
18177 !$$$ deriv=deriv*deriv
18178 !$$$ deriv=30.0d0*xsq*deriv
18181 end function h_base
18182 !-----------------------------------------------------------------------------
18183 subroutine dyn_set_nss
18184 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
18186 use MD_data, only: totT,t_bath
18188 ! include 'DIMENSIONS'
18192 ! include 'COMMON.SBRIDGE'
18193 ! include 'COMMON.CHAIN'
18194 ! include 'COMMON.IOUNITS'
18195 ! include 'COMMON.SETUP'
18196 ! include 'COMMON.MD'
18198 real(kind=8) :: emin
18199 integer :: i,j,imin,ierr
18200 integer :: diff,allnss,newnss
18201 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
18204 integer,dimension(0:nfgtasks) :: i_newnss
18205 integer,dimension(0:nfgtasks) :: displ
18206 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
18207 integer :: g_newnss
18212 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
18221 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
18225 if (allflag(i).eq.0 .and. &
18226 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
18227 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
18231 if (emin.lt.1.0d300) then
18234 if (allflag(i).eq.0 .and. &
18235 (allihpb(i).eq.allihpb(imin) .or. &
18236 alljhpb(i).eq.allihpb(imin) .or. &
18237 allihpb(i).eq.alljhpb(imin) .or. &
18238 alljhpb(i).eq.alljhpb(imin))) then
18245 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
18249 if (allflag(i).eq.1) then
18251 newihpb(newnss)=allihpb(i)
18252 newjhpb(newnss)=alljhpb(i)
18257 if (nfgtasks.gt.1)then
18259 call MPI_Reduce(newnss,g_newnss,1,&
18260 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
18261 call MPI_Gather(newnss,1,MPI_INTEGER,&
18262 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
18264 do i=1,nfgtasks-1,1
18265 displ(i)=i_newnss(i-1)+displ(i-1)
18267 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
18268 g_newihpb,i_newnss,displ,MPI_INTEGER,&
18270 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
18271 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
18273 if(fg_rank.eq.0) then
18274 ! print *,'g_newnss',g_newnss
18275 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
18276 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
18279 newihpb(i)=g_newihpb(i)
18280 newjhpb(i)=g_newjhpb(i)
18288 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
18289 ! print *,newnss,nss,maxdim
18295 if (idssb(i).eq.newihpb(j) .and. &
18296 jdssb(i).eq.newjhpb(j)) found=.true.
18300 ! write(iout,*) "found",found,i,j
18301 if (.not.found.and.fg_rank.eq.0) &
18302 write(iout,'(a15,f12.2,f8.1,2i5)') &
18303 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
18312 if (newihpb(i).eq.idssb(j) .and. &
18313 newjhpb(i).eq.jdssb(j)) found=.true.
18317 ! write(iout,*) "found",found,i,j
18318 if (.not.found.and.fg_rank.eq.0) &
18319 write(iout,'(a15,f12.2,f8.1,2i5)') &
18320 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
18327 idssb(i)=newihpb(i)
18328 jdssb(i)=newjhpb(i)
18332 end subroutine dyn_set_nss
18333 ! Lipid transfer energy function
18334 subroutine Eliptransfer(eliptran)
18335 !C this is done by Adasko
18336 !C print *,"wchodze"
18337 !C structure of box:
18339 !C--bordliptop-- buffore starts
18340 !C--bufliptop--- here true lipid starts
18342 !C--buflipbot--- lipid ends buffore starts
18343 !C--bordlipbot--buffore ends
18344 real(kind=8) :: fracinbuf,eliptran,sslip,positi,ssgradlip
18347 ! print *, "I am in eliptran"
18348 do i=ilip_start,ilip_end
18350 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))&
18353 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
18354 if (positi.le.0.0) positi=positi+boxzsize
18356 !C first for peptide groups
18357 !c for each residue check if it is in lipid or lipid water border area
18358 if ((positi.gt.bordlipbot) &
18359 .and.(positi.lt.bordliptop)) then
18360 !C the energy transfer exist
18361 if (positi.lt.buflipbot) then
18362 !C what fraction I am in
18364 ((positi-bordlipbot)/lipbufthick)
18365 !C lipbufthick is thickenes of lipid buffore
18366 sslip=sscalelip(fracinbuf)
18367 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
18368 eliptran=eliptran+sslip*pepliptran
18369 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
18370 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
18371 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
18373 !C print *,"doing sccale for lower part"
18374 !C print *,i,sslip,fracinbuf,ssgradlip
18375 elseif (positi.gt.bufliptop) then
18376 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
18377 sslip=sscalelip(fracinbuf)
18378 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
18379 eliptran=eliptran+sslip*pepliptran
18380 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
18381 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
18382 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
18383 !C print *, "doing sscalefor top part"
18384 !C print *,i,sslip,fracinbuf,ssgradlip
18386 eliptran=eliptran+pepliptran
18387 !C print *,"I am in true lipid"
18390 !C eliptran=elpitran+0.0 ! I am in water
18392 if (energy_dec) write(iout,*) i,"eliptran=",eliptran,positi,sslip
18394 ! here starts the side chain transfer
18395 do i=ilip_start,ilip_end
18396 if (itype(i,1).eq.ntyp1) cycle
18397 positi=(mod(c(3,i+nres),boxzsize))
18398 if (positi.le.0) positi=positi+boxzsize
18399 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18400 !c for each residue check if it is in lipid or lipid water border area
18401 !C respos=mod(c(3,i+nres),boxzsize)
18402 !C print *,positi,bordlipbot,buflipbot
18403 if ((positi.gt.bordlipbot) &
18404 .and.(positi.lt.bordliptop)) then
18405 !C the energy transfer exist
18406 if (positi.lt.buflipbot) then
18408 ((positi-bordlipbot)/lipbufthick)
18409 !C lipbufthick is thickenes of lipid buffore
18410 sslip=sscalelip(fracinbuf)
18411 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
18412 eliptran=eliptran+sslip*liptranene(itype(i,1))
18413 gliptranx(3,i)=gliptranx(3,i) &
18414 +ssgradlip*liptranene(itype(i,1))
18415 gliptranc(3,i-1)= gliptranc(3,i-1) &
18416 +ssgradlip*liptranene(itype(i,1))
18417 !C print *,"doing sccale for lower part"
18418 elseif (positi.gt.bufliptop) then
18420 ((bordliptop-positi)/lipbufthick)
18421 sslip=sscalelip(fracinbuf)
18422 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
18423 eliptran=eliptran+sslip*liptranene(itype(i,1))
18424 gliptranx(3,i)=gliptranx(3,i) &
18425 +ssgradlip*liptranene(itype(i,1))
18426 gliptranc(3,i-1)= gliptranc(3,i-1) &
18427 +ssgradlip*liptranene(itype(i,1))
18428 !C print *, "doing sscalefor top part",sslip,fracinbuf
18430 eliptran=eliptran+liptranene(itype(i,1))
18431 !C print *,"I am in true lipid"
18433 endif ! if in lipid or buffor
18435 !C eliptran=elpitran+0.0 ! I am in water
18436 if (energy_dec) write(iout,*) i,"eliptran=",eliptran
18439 end subroutine Eliptransfer
18440 !----------------------------------NANO FUNCTIONS
18441 !C-----------------------------------------------------------------------
18442 !C-----------------------------------------------------------
18443 !C This subroutine is to mimic the histone like structure but as well can be
18444 !C utilizet to nanostructures (infinit) small modification has to be used to
18445 !C make it finite (z gradient at the ends has to be changes as well as the x,y
18446 !C gradient has to be modified at the ends
18447 !C The energy function is Kihara potential
18448 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
18449 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
18450 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
18451 !C simple Kihara potential
18452 subroutine calctube(Etube)
18453 real(kind=8),dimension(3) :: vectube
18454 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18455 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi, &
18456 sc_aa_tube,sc_bb_tube
18459 do i=itube_start,itube_end
18461 enetube(i+nres)=0.0d0
18463 !C first we calculate the distance from tube center
18465 do i=itube_start,itube_end
18466 !C lets ommit dummy atoms for now
18467 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18468 !C now calculate distance from center of tube and direction vectors
18471 ! Find minimum distance in periodic box
18473 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18474 vectube(1)=vectube(1)+boxxsize*j
18475 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18476 vectube(2)=vectube(2)+boxysize*j
18477 xminact=abs(vectube(1)-tubecenter(1))
18478 yminact=abs(vectube(2)-tubecenter(2))
18479 if (xmin.gt.xminact) then
18483 if (ymin.gt.yminact) then
18490 vectube(1)=vectube(1)-tubecenter(1)
18491 vectube(2)=vectube(2)-tubecenter(2)
18493 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18494 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18496 !C as the tube is infinity we do not calculate the Z-vector use of Z
18499 !C now calculte the distance
18500 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18501 !C now normalize vector
18502 vectube(1)=vectube(1)/tub_r
18503 vectube(2)=vectube(2)/tub_r
18504 !C calculte rdiffrence between r and r0
18507 rdiff6=rdiff**6.0d0
18508 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18509 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
18510 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18511 !C print *,rdiff,rdiff6,pep_aa_tube
18512 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18513 !C now we calculate gradient
18514 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18515 6.0d0*pep_bb_tube)/rdiff6/rdiff
18516 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18518 !C now direction of gg_tube vector
18520 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18521 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18524 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18525 !C print *,gg_tube(1,0),"TU"
18528 do i=itube_start,itube_end
18529 !C Lets not jump over memory as we use many times iti
18531 !C lets ommit dummy atoms for now
18532 if ((iti.eq.ntyp1) &
18533 !C in UNRES uncomment the line below as GLY has no side-chain...
18539 vectube(1)=mod((c(1,i+nres)),boxxsize)
18540 vectube(1)=vectube(1)+boxxsize*j
18541 vectube(2)=mod((c(2,i+nres)),boxysize)
18542 vectube(2)=vectube(2)+boxysize*j
18544 xminact=abs(vectube(1)-tubecenter(1))
18545 yminact=abs(vectube(2)-tubecenter(2))
18546 if (xmin.gt.xminact) then
18550 if (ymin.gt.yminact) then
18557 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
18559 vectube(1)=vectube(1)-tubecenter(1)
18560 vectube(2)=vectube(2)-tubecenter(2)
18562 !C as the tube is infinity we do not calculate the Z-vector use of Z
18565 !C now calculte the distance
18566 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18567 !C now normalize vector
18568 vectube(1)=vectube(1)/tub_r
18569 vectube(2)=vectube(2)/tub_r
18571 !C calculte rdiffrence between r and r0
18574 rdiff6=rdiff**6.0d0
18575 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18576 sc_aa_tube=sc_aa_tube_par(iti)
18577 sc_bb_tube=sc_bb_tube_par(iti)
18578 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
18579 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
18580 6.0d0*sc_bb_tube/rdiff6/rdiff
18581 !C now direction of gg_tube vector
18583 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
18584 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
18587 do i=itube_start,itube_end
18588 Etube=Etube+enetube(i)+enetube(i+nres)
18590 !C print *,"ETUBE", etube
18592 end subroutine calctube
18593 !C TO DO 1) add to total energy
18594 !C 2) add to gradient summation
18595 !C 3) add reading parameters (AND of course oppening of PARAM file)
18596 !C 4) add reading the center of tube
18598 !C 6) add to zerograd
18599 !C 7) allocate matrices
18602 !C-----------------------------------------------------------------------
18603 !C-----------------------------------------------------------
18604 !C This subroutine is to mimic the histone like structure but as well can be
18605 !C utilizet to nanostructures (infinit) small modification has to be used to
18606 !C make it finite (z gradient at the ends has to be changes as well as the x,y
18607 !C gradient has to be modified at the ends
18608 !C The energy function is Kihara potential
18609 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
18610 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
18611 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
18612 !C simple Kihara potential
18613 subroutine calctube2(Etube)
18614 real(kind=8),dimension(3) :: vectube
18615 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18616 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi,fracinbuf,&
18617 sstube,ssgradtube,sc_aa_tube,sc_bb_tube
18620 do i=itube_start,itube_end
18622 enetube(i+nres)=0.0d0
18624 !C first we calculate the distance from tube center
18625 !C first sugare-phosphate group for NARES this would be peptide group
18627 do i=itube_start,itube_end
18628 !C lets ommit dummy atoms for now
18630 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18631 !C now calculate distance from center of tube and direction vectors
18632 !C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18633 !C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
18634 !C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18635 !C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
18639 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18640 vectube(1)=vectube(1)+boxxsize*j
18641 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18642 vectube(2)=vectube(2)+boxysize*j
18644 xminact=abs(vectube(1)-tubecenter(1))
18645 yminact=abs(vectube(2)-tubecenter(2))
18646 if (xmin.gt.xminact) then
18650 if (ymin.gt.yminact) then
18657 vectube(1)=vectube(1)-tubecenter(1)
18658 vectube(2)=vectube(2)-tubecenter(2)
18660 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18661 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18663 !C as the tube is infinity we do not calculate the Z-vector use of Z
18666 !C now calculte the distance
18667 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18668 !C now normalize vector
18669 vectube(1)=vectube(1)/tub_r
18670 vectube(2)=vectube(2)/tub_r
18671 !C calculte rdiffrence between r and r0
18674 rdiff6=rdiff**6.0d0
18675 !C THIS FRAGMENT MAKES TUBE FINITE
18676 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
18677 if (positi.le.0) positi=positi+boxzsize
18678 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18679 !c for each residue check if it is in lipid or lipid water border area
18680 !C respos=mod(c(3,i+nres),boxzsize)
18681 !C print *,positi,bordtubebot,buftubebot,bordtubetop
18682 if ((positi.gt.bordtubebot) &
18683 .and.(positi.lt.bordtubetop)) then
18684 !C the energy transfer exist
18685 if (positi.lt.buftubebot) then
18687 ((positi-bordtubebot)/tubebufthick)
18688 !C lipbufthick is thickenes of lipid buffore
18689 sstube=sscalelip(fracinbuf)
18690 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
18691 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
18692 enetube(i)=enetube(i)+sstube*tubetranenepep
18693 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18694 !C &+ssgradtube*tubetranene(itype(i,1))
18695 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18696 !C &+ssgradtube*tubetranene(itype(i,1))
18697 !C print *,"doing sccale for lower part"
18698 elseif (positi.gt.buftubetop) then
18700 ((bordtubetop-positi)/tubebufthick)
18701 sstube=sscalelip(fracinbuf)
18702 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
18703 enetube(i)=enetube(i)+sstube*tubetranenepep
18704 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18705 !C &+ssgradtube*tubetranene(itype(i,1))
18706 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18707 !C &+ssgradtube*tubetranene(itype(i,1))
18708 !C print *, "doing sscalefor top part",sslip,fracinbuf
18712 enetube(i)=enetube(i)+sstube*tubetranenepep
18713 !C print *,"I am in true lipid"
18717 !C ssgradtube=0.0d0
18719 endif ! if in lipid or buffor
18721 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18722 enetube(i)=enetube(i)+sstube* &
18723 (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
18724 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18725 !C print *,rdiff,rdiff6,pep_aa_tube
18726 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18727 !C now we calculate gradient
18728 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18729 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
18730 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18733 !C now direction of gg_tube vector
18735 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18736 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18738 gg_tube(3,i)=gg_tube(3,i) &
18739 +ssgradtube*enetube(i)/sstube/2.0d0
18740 gg_tube(3,i-1)= gg_tube(3,i-1) &
18741 +ssgradtube*enetube(i)/sstube/2.0d0
18744 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
18745 !C print *,gg_tube(1,0),"TU"
18746 do i=itube_start,itube_end
18747 !C Lets not jump over memory as we use many times iti
18749 !C lets ommit dummy atoms for now
18750 if ((iti.eq.ntyp1) &
18751 !!C in UNRES uncomment the line below as GLY has no side-chain...
18754 vectube(1)=c(1,i+nres)
18755 vectube(1)=mod(vectube(1),boxxsize)
18756 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
18757 vectube(2)=c(2,i+nres)
18758 vectube(2)=mod(vectube(2),boxysize)
18759 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
18761 vectube(1)=vectube(1)-tubecenter(1)
18762 vectube(2)=vectube(2)-tubecenter(2)
18763 !C THIS FRAGMENT MAKES TUBE FINITE
18764 positi=(mod(c(3,i+nres),boxzsize))
18765 if (positi.le.0) positi=positi+boxzsize
18766 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
18767 !c for each residue check if it is in lipid or lipid water border area
18768 !C respos=mod(c(3,i+nres),boxzsize)
18769 !C print *,positi,bordtubebot,buftubebot,bordtubetop
18771 if ((positi.gt.bordtubebot) &
18772 .and.(positi.lt.bordtubetop)) then
18773 !C the energy transfer exist
18774 if (positi.lt.buftubebot) then
18776 ((positi-bordtubebot)/tubebufthick)
18777 !C lipbufthick is thickenes of lipid buffore
18778 sstube=sscalelip(fracinbuf)
18779 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
18780 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
18781 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
18782 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18783 !C &+ssgradtube*tubetranene(itype(i,1))
18784 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18785 !C &+ssgradtube*tubetranene(itype(i,1))
18786 !C print *,"doing sccale for lower part"
18787 elseif (positi.gt.buftubetop) then
18789 ((bordtubetop-positi)/tubebufthick)
18791 sstube=sscalelip(fracinbuf)
18792 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
18793 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
18794 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
18795 !C &+ssgradtube*tubetranene(itype(i,1))
18796 !C gg_tube(3,i-1)= gg_tube(3,i-1)
18797 !C &+ssgradtube*tubetranene(itype(i,1))
18798 !C print *, "doing sscalefor top part",sslip,fracinbuf
18802 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
18803 !C print *,"I am in true lipid"
18807 !C ssgradtube=0.0d0
18809 endif ! if in lipid or buffor
18810 !CEND OF FINITE FRAGMENT
18811 !C as the tube is infinity we do not calculate the Z-vector use of Z
18814 !C now calculte the distance
18815 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18816 !C now normalize vector
18817 vectube(1)=vectube(1)/tub_r
18818 vectube(2)=vectube(2)/tub_r
18819 !C calculte rdiffrence between r and r0
18822 rdiff6=rdiff**6.0d0
18823 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18824 sc_aa_tube=sc_aa_tube_par(iti)
18825 sc_bb_tube=sc_bb_tube_par(iti)
18826 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)&
18827 *sstube+enetube(i+nres)
18828 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18829 !C now we calculate gradient
18830 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-&
18831 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
18832 !C now direction of gg_tube vector
18834 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
18835 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
18837 gg_tube_SC(3,i)=gg_tube_SC(3,i) &
18838 +ssgradtube*enetube(i+nres)/sstube
18839 gg_tube(3,i-1)= gg_tube(3,i-1) &
18840 +ssgradtube*enetube(i+nres)/sstube
18843 do i=itube_start,itube_end
18844 Etube=Etube+enetube(i)+enetube(i+nres)
18846 !C print *,"ETUBE", etube
18848 end subroutine calctube2
18849 !=====================================================================================================================================
18850 subroutine calcnano(Etube)
18851 real(kind=8),dimension(3) :: vectube
18853 real(kind=8) :: Etube,xtemp,xminact,yminact,&
18854 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,denominator,faccav,&
18855 sc_aa_tube,sc_bb_tube,zmin,ztemp,zminact
18856 integer:: i,j,iti,r
18859 ! print *,itube_start,itube_end,"poczatek"
18860 do i=itube_start,itube_end
18862 enetube(i+nres)=0.0d0
18864 !C first we calculate the distance from tube center
18865 !C first sugare-phosphate group for NARES this would be peptide group
18867 do i=itube_start,itube_end
18868 !C lets ommit dummy atoms for now
18869 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
18870 !C now calculate distance from center of tube and direction vectors
18876 vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
18877 vectube(1)=vectube(1)+boxxsize*j
18878 vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
18879 vectube(2)=vectube(2)+boxysize*j
18880 vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
18881 vectube(3)=vectube(3)+boxzsize*j
18884 xminact=dabs(vectube(1)-tubecenter(1))
18885 yminact=dabs(vectube(2)-tubecenter(2))
18886 zminact=dabs(vectube(3)-tubecenter(3))
18888 if (xmin.gt.xminact) then
18892 if (ymin.gt.yminact) then
18896 if (zmin.gt.zminact) then
18905 vectube(1)=vectube(1)-tubecenter(1)
18906 vectube(2)=vectube(2)-tubecenter(2)
18907 vectube(3)=vectube(3)-tubecenter(3)
18909 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
18910 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
18911 !C as the tube is infinity we do not calculate the Z-vector use of Z
18913 !C vectube(3)=0.0d0
18914 !C now calculte the distance
18915 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
18916 !C now normalize vector
18917 vectube(1)=vectube(1)/tub_r
18918 vectube(2)=vectube(2)/tub_r
18919 vectube(3)=vectube(3)/tub_r
18920 !C calculte rdiffrence between r and r0
18923 rdiff6=rdiff**6.0d0
18924 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
18925 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
18926 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
18927 !C print *,rdiff,rdiff6,pep_aa_tube
18928 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
18929 !C now we calculate gradient
18930 fac=(-12.0d0*pep_aa_tube/rdiff6- &
18931 6.0d0*pep_bb_tube)/rdiff6/rdiff
18932 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
18934 if (acavtubpep.eq.0.0d0) then
18939 denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
18941 (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
18944 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
18945 *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
18946 +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
18947 /denominator**2.0d0
18952 if (energy_dec) write(iout,*),i,rdiff,enetube(i),enecavtube(i)
18954 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
18955 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
18959 do i=itube_start,itube_end
18960 enecavtube(i)=0.0d0
18961 !C Lets not jump over memory as we use many times iti
18963 !C lets ommit dummy atoms for now
18964 if ((iti.eq.ntyp1) &
18965 !C in UNRES uncomment the line below as GLY has no side-chain...
18972 vectube(1)=dmod((c(1,i+nres)),boxxsize)
18973 vectube(1)=vectube(1)+boxxsize*j
18974 vectube(2)=dmod((c(2,i+nres)),boxysize)
18975 vectube(2)=vectube(2)+boxysize*j
18976 vectube(3)=dmod((c(3,i+nres)),boxzsize)
18977 vectube(3)=vectube(3)+boxzsize*j
18980 xminact=dabs(vectube(1)-tubecenter(1))
18981 yminact=dabs(vectube(2)-tubecenter(2))
18982 zminact=dabs(vectube(3)-tubecenter(3))
18984 if (xmin.gt.xminact) then
18988 if (ymin.gt.yminact) then
18992 if (zmin.gt.zminact) then
19001 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
19003 vectube(1)=vectube(1)-tubecenter(1)
19004 vectube(2)=vectube(2)-tubecenter(2)
19005 vectube(3)=vectube(3)-tubecenter(3)
19006 !C now calculte the distance
19007 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19008 !C now normalize vector
19009 vectube(1)=vectube(1)/tub_r
19010 vectube(2)=vectube(2)/tub_r
19011 vectube(3)=vectube(3)/tub_r
19013 !C calculte rdiffrence between r and r0
19016 rdiff6=rdiff**6.0d0
19017 sc_aa_tube=sc_aa_tube_par(iti)
19018 sc_bb_tube=sc_bb_tube_par(iti)
19019 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19020 !C enetube(i+nres)=0.0d0
19021 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19022 !C now we calculate gradient
19023 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
19024 6.0d0*sc_bb_tube/rdiff6/rdiff
19026 !C now direction of gg_tube vector
19027 !C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
19028 if (acavtub(iti).eq.0.0d0) then
19030 enecavtube(i+nres)=0.0d0
19033 denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
19034 enecavtube(i+nres)= &
19035 (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
19037 !C enecavtube(i)=0.0
19038 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
19039 *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
19040 +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
19041 /denominator**2.0d0
19046 !C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
19047 !C & enecavtube(i),faccav
19048 !C print *,"licz=",
19049 !C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
19050 !C print *,"finene=",enetube(i+nres)+enecavtube(i)
19052 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19053 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19055 if (energy_dec) write(iout,*),i,rdiff,enetube(i+nres),enecavtube(i+nres)
19060 do i=itube_start,itube_end
19061 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) &
19062 +enecavtube(i+nres)
19065 ! print *,"begin", i,"a"
19068 ! rdiff6=rdiff**6.0d0
19069 ! sc_aa_tube=sc_aa_tube_par(i)
19070 ! sc_bb_tube=sc_bb_tube_par(i)
19071 ! enetube(i)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19072 ! denominator=(1.0d0+dcavtub(i)*rdiff6*rdiff6)
19074 ! (bcavtub(i)*rdiff+acavtub(i)*dsqrt(rdiff)+ccavtub(i)) &
19077 ! print '(5(f10.3,1x))',rdiff,enetube(i),enecavtube(i),enecavtube(i)+enetube(i)
19079 ! print *,"end",i,"a"
19081 !C print *,"ETUBE", etube
19083 end subroutine calcnano
19085 !===============================================
19086 !--------------------------------------------------------------------------------
19087 !C first for shielding is setting of function of side-chains
19089 subroutine set_shield_fac2
19090 real(kind=8) :: div77_81=0.974996043d0, &
19091 div4_81=0.2222222222d0
19092 real (kind=8) :: dist_pep_side,dist_side_calf,dist_pept_group, &
19093 scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
19094 short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
19095 sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
19096 !C the vector between center of side_chain and peptide group
19097 real(kind=8),dimension(3) :: pep_side_long,side_calf, &
19098 pept_group,costhet_grad,cosphi_grad_long, &
19099 cosphi_grad_loc,pep_side_norm,side_calf_norm, &
19100 sh_frac_dist_grad,pep_side
19102 !C write(2,*) "ivec",ivec_start,ivec_end
19104 fac_shield(i)=0.0d0
19106 grad_shield(j,i)=0.0d0
19109 do i=ivec_start,ivec_end
19111 !C if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
19113 if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
19114 !Cif there two consequtive dummy atoms there is no peptide group between them
19115 !C the line below has to be changed for FGPROC>1
19118 if ((itype(k,1).eq.ntyp1).or.(itype(k,1).eq.10)) cycle
19122 !C first lets set vector conecting the ithe side-chain with kth side-chain
19123 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
19124 !C pep_side(j)=2.0d0
19125 !C and vector conecting the side-chain with its proper calfa
19126 side_calf(j)=c(j,k+nres)-c(j,k)
19127 !C side_calf(j)=2.0d0
19128 pept_group(j)=c(j,i)-c(j,i+1)
19129 !C lets have their lenght
19130 dist_pep_side=pep_side(j)**2+dist_pep_side
19131 dist_side_calf=dist_side_calf+side_calf(j)**2
19132 dist_pept_group=dist_pept_group+pept_group(j)**2
19134 dist_pep_side=sqrt(dist_pep_side)
19135 dist_pept_group=sqrt(dist_pept_group)
19136 dist_side_calf=sqrt(dist_side_calf)
19138 pep_side_norm(j)=pep_side(j)/dist_pep_side
19139 side_calf_norm(j)=dist_side_calf
19141 !C now sscale fraction
19142 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
19143 !C print *,buff_shield,"buff"
19145 if (sh_frac_dist.le.0.0) cycle
19146 !C print *,ishield_list(i),i
19147 !C If we reach here it means that this side chain reaches the shielding sphere
19148 !C Lets add him to the list for gradient
19149 ishield_list(i)=ishield_list(i)+1
19150 !C ishield_list is a list of non 0 side-chain that contribute to factor gradient
19151 !C this list is essential otherwise problem would be O3
19152 shield_list(ishield_list(i),i)=k
19153 !C Lets have the sscale value
19154 if (sh_frac_dist.gt.1.0) then
19155 scale_fac_dist=1.0d0
19157 sh_frac_dist_grad(j)=0.0d0
19160 scale_fac_dist=-sh_frac_dist*sh_frac_dist &
19161 *(2.0d0*sh_frac_dist-3.0d0)
19162 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
19163 /dist_pep_side/buff_shield*0.5d0
19165 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
19166 !C sh_frac_dist_grad(j)=0.0d0
19167 !C scale_fac_dist=1.0d0
19168 !C print *,"jestem",scale_fac_dist,fac_help_scale,
19169 !C & sh_frac_dist_grad(j)
19172 !C this is what is now we have the distance scaling now volume...
19173 short=short_r_sidechain(itype(k,1))
19174 long=long_r_sidechain(itype(k,1))
19175 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
19176 sinthet=short/dist_pep_side*costhet
19177 !C now costhet_grad
19180 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
19181 !C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
19182 !C & -short/dist_pep_side**2/costhet)
19183 !C costhet_fac=0.0d0
19185 costhet_grad(j)=costhet_fac*pep_side(j)
19187 !C remember for the final gradient multiply costhet_grad(j)
19188 !C for side_chain by factor -2 !
19189 !C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
19190 !C pep_side0pept_group is vector multiplication
19191 pep_side0pept_group=0.0d0
19193 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
19195 cosalfa=(pep_side0pept_group/ &
19196 (dist_pep_side*dist_side_calf))
19197 fac_alfa_sin=1.0d0-cosalfa**2
19198 fac_alfa_sin=dsqrt(fac_alfa_sin)
19199 rkprim=fac_alfa_sin*(long-short)+short
19202 !C now costhet_grad
19203 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
19205 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
19206 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ &
19210 cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
19211 +cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
19212 *(long-short)/fac_alfa_sin*cosalfa/ &
19213 ((dist_pep_side*dist_side_calf))* &
19214 ((side_calf(j))-cosalfa* &
19215 ((pep_side(j)/dist_pep_side)*dist_side_calf))
19216 !C cosphi_grad_long(j)=0.0d0
19217 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
19218 *(long-short)/fac_alfa_sin*cosalfa &
19219 /((dist_pep_side*dist_side_calf))* &
19221 cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
19222 !C cosphi_grad_loc(j)=0.0d0
19224 !C print *,sinphi,sinthet
19225 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) &
19228 !C now the gradient...
19230 grad_shield(j,i)=grad_shield(j,i) &
19231 !C gradient po skalowaniu
19232 +(sh_frac_dist_grad(j)*VofOverlap &
19233 !C gradient po costhet
19234 +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
19235 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
19236 sinphi/sinthet*costhet*costhet_grad(j) &
19237 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
19239 !C grad_shield_side is Cbeta sidechain gradient
19240 grad_shield_side(j,ishield_list(i),i)=&
19241 (sh_frac_dist_grad(j)*-2.0d0&
19243 -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
19244 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(&
19245 sinphi/sinthet*costhet*costhet_grad(j)&
19246 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
19249 grad_shield_loc(j,ishield_list(i),i)= &
19250 scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
19251 (1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(&
19252 sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
19256 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
19258 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
19260 !C write(2,*) "TOTAL VOLUME",i,itype(i,1),fac_shield(i)
19263 end subroutine set_shield_fac2
19264 !----------------------------------------------------------------------------
19265 ! SOUBROUTINE FOR AFM
19266 subroutine AFMvel(Eafmforce)
19267 use MD_data, only:totTafm
19268 real(kind=8),dimension(3) :: diffafm
19269 real(kind=8) :: afmdist,Eafmforce
19271 !C Only for check grad COMMENT if not used for checkgrad
19273 !C--------------------------------------------------------
19274 !C print *,"wchodze"
19278 diffafm(i)=c(i,afmend)-c(i,afmbeg)
19279 afmdist=afmdist+diffafm(i)**2
19281 afmdist=dsqrt(afmdist)
19283 Eafmforce=0.5d0*forceAFMconst &
19284 *(distafminit+totTafm*velAFMconst-afmdist)**2
19285 !C Eafmforce=-forceAFMconst*(dist-distafminit)
19287 gradafm(i,afmend-1)=-forceAFMconst* &
19288 (distafminit+totTafm*velAFMconst-afmdist) &
19289 *diffafm(i)/afmdist
19290 gradafm(i,afmbeg-1)=forceAFMconst* &
19291 (distafminit+totTafm*velAFMconst-afmdist) &
19292 *diffafm(i)/afmdist
19294 ! print *,'AFM',Eafmforce,totTafm*velAFMconst,afmdist
19296 end subroutine AFMvel
19297 !---------------------------------------------------------
19298 subroutine AFMforce(Eafmforce)
19300 real(kind=8),dimension(3) :: diffafm
19301 ! real(kind=8) ::afmdist
19302 real(kind=8) :: afmdist,Eafmforce
19307 diffafm(i)=c(i,afmend)-c(i,afmbeg)
19308 afmdist=afmdist+diffafm(i)**2
19310 afmdist=dsqrt(afmdist)
19311 ! print *,afmdist,distafminit
19312 Eafmforce=-forceAFMconst*(afmdist-distafminit)
19314 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/afmdist
19315 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/afmdist
19317 !C print *,'AFM',Eafmforce
19319 end subroutine AFMforce
19321 !-----------------------------------------------------------------------------
19323 subroutine read_ssHist
19326 ! include 'DIMENSIONS'
19327 ! include "DIMENSIONS.FREE"
19328 ! include 'COMMON.FREE'
19331 character(len=80) :: controlcard
19334 call card_concat(controlcard,.true.)
19335 read(controlcard,*) &
19336 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
19340 end subroutine read_ssHist
19342 !-----------------------------------------------------------------------------
19343 integer function indmat(i,j)
19345 ! get the position of the jth ijth fragment of the chain coordinate system
19346 ! in the fromto array.
19349 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
19351 end function indmat
19352 !-----------------------------------------------------------------------------
19353 real(kind=8) function sigm(x)
19359 !-----------------------------------------------------------------------------
19360 !-----------------------------------------------------------------------------
19361 subroutine alloc_ener_arrays
19362 !EL Allocation of arrays used by module energy
19363 use MD_data, only: mset
19364 !el local variables
19367 if(nres.lt.100) then
19369 elseif(nres.lt.200) then
19370 maxconts=0.8*nres ! Max. number of contacts per residue
19372 maxconts=0.6*nres ! (maxconts=maxres/4)
19374 maxcont=12*nres ! Max. number of SC contacts
19375 maxvar=6*nres ! Max. number of variables
19376 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
19377 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
19378 !----------------------
19379 ! arrays in subroutine init_int_table
19381 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
19382 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
19384 allocate(nint_gr(nres))
19385 allocate(nscp_gr(nres))
19386 allocate(ielstart(nres))
19387 allocate(ielend(nres))
19389 allocate(istart(nres,maxint_gr))
19390 allocate(iend(nres,maxint_gr))
19391 !(maxres,maxint_gr)
19392 allocate(iscpstart(nres,maxint_gr))
19393 allocate(iscpend(nres,maxint_gr))
19394 !(maxres,maxint_gr)
19395 allocate(ielstart_vdw(nres))
19396 allocate(ielend_vdw(nres))
19399 allocate(lentyp(0:nfgtasks-1))
19401 !----------------------
19403 ! common /contacts/
19404 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
19405 allocate(icont(2,maxcont))
19407 ! common /contacts1/
19408 allocate(num_cont(0:nres+4))
19410 allocate(jcont(maxconts,nres))
19412 allocate(facont(maxconts,nres))
19414 allocate(gacont(3,maxconts,nres))
19415 !(3,maxconts,maxres)
19416 ! common /contacts_hb/
19417 allocate(gacontp_hb1(3,maxconts,nres))
19418 allocate(gacontp_hb2(3,maxconts,nres))
19419 allocate(gacontp_hb3(3,maxconts,nres))
19420 allocate(gacontm_hb1(3,maxconts,nres))
19421 allocate(gacontm_hb2(3,maxconts,nres))
19422 allocate(gacontm_hb3(3,maxconts,nres))
19423 allocate(gacont_hbr(3,maxconts,nres))
19424 allocate(grij_hb_cont(3,maxconts,nres))
19425 !(3,maxconts,maxres)
19426 allocate(facont_hb(maxconts,nres))
19428 allocate(ees0p(maxconts,nres))
19429 allocate(ees0m(maxconts,nres))
19430 allocate(d_cont(maxconts,nres))
19431 allocate(ees0plist(maxconts,nres))
19434 allocate(num_cont_hb(nres))
19436 allocate(jcont_hb(maxconts,nres))
19439 allocate(Ug(2,2,nres))
19440 allocate(Ugder(2,2,nres))
19441 allocate(Ug2(2,2,nres))
19442 allocate(Ug2der(2,2,nres))
19444 allocate(obrot(2,nres))
19445 allocate(obrot2(2,nres))
19446 allocate(obrot_der(2,nres))
19447 allocate(obrot2_der(2,nres))
19449 ! common /precomp1/
19450 allocate(mu(2,nres))
19451 allocate(muder(2,nres))
19452 allocate(Ub2(2,nres))
19455 allocate(Ub2der(2,nres))
19456 allocate(Ctobr(2,nres))
19457 allocate(Ctobrder(2,nres))
19458 allocate(Dtobr2(2,nres))
19459 allocate(Dtobr2der(2,nres))
19461 allocate(EUg(2,2,nres))
19462 allocate(EUgder(2,2,nres))
19463 allocate(CUg(2,2,nres))
19464 allocate(CUgder(2,2,nres))
19465 allocate(DUg(2,2,nres))
19466 allocate(Dugder(2,2,nres))
19467 allocate(DtUg2(2,2,nres))
19468 allocate(DtUg2der(2,2,nres))
19470 ! common /precomp2/
19471 allocate(Ug2Db1t(2,nres))
19472 allocate(Ug2Db1tder(2,nres))
19473 allocate(CUgb2(2,nres))
19474 allocate(CUgb2der(2,nres))
19476 allocate(EUgC(2,2,nres))
19477 allocate(EUgCder(2,2,nres))
19478 allocate(EUgD(2,2,nres))
19479 allocate(EUgDder(2,2,nres))
19480 allocate(DtUg2EUg(2,2,nres))
19481 allocate(Ug2DtEUg(2,2,nres))
19483 allocate(Ug2DtEUgder(2,2,2,nres))
19484 allocate(DtUg2EUgder(2,2,2,nres))
19486 ! common /rotat_old/
19487 allocate(costab(nres))
19488 allocate(sintab(nres))
19489 allocate(costab2(nres))
19490 allocate(sintab2(nres))
19493 allocate(a_chuj(2,2,maxconts,nres))
19494 !(2,2,maxconts,maxres)(maxconts=maxres/4)
19495 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
19496 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
19497 ! common /contdistrib/
19498 allocate(ncont_sent(nres))
19499 allocate(ncont_recv(nres))
19501 allocate(iat_sent(nres))
19503 allocate(iint_sent(4,nres,nres))
19504 allocate(iint_sent_local(4,nres,nres))
19506 allocate(iturn3_sent(4,0:nres+4))
19507 allocate(iturn4_sent(4,0:nres+4))
19508 allocate(iturn3_sent_local(4,nres))
19509 allocate(iturn4_sent_local(4,nres))
19511 allocate(itask_cont_from(0:nfgtasks-1))
19512 allocate(itask_cont_to(0:nfgtasks-1))
19513 !(0:max_fg_procs-1)
19517 !----------------------
19520 allocate(dcdv(6,maxdim))
19521 allocate(dxdv(6,maxdim))
19523 allocate(dxds(6,nres))
19525 allocate(gradx(3,-1:nres,0:2))
19526 allocate(gradc(3,-1:nres,0:2))
19528 allocate(gvdwx(3,-1:nres))
19529 allocate(gvdwc(3,-1:nres))
19530 allocate(gelc(3,-1:nres))
19531 allocate(gelc_long(3,-1:nres))
19532 allocate(gvdwpp(3,-1:nres))
19533 allocate(gvdwc_scpp(3,-1:nres))
19534 allocate(gradx_scp(3,-1:nres))
19535 allocate(gvdwc_scp(3,-1:nres))
19536 allocate(ghpbx(3,-1:nres))
19537 allocate(ghpbc(3,-1:nres))
19538 allocate(gradcorr(3,-1:nres))
19539 allocate(gradcorr_long(3,-1:nres))
19540 allocate(gradcorr5_long(3,-1:nres))
19541 allocate(gradcorr6_long(3,-1:nres))
19542 allocate(gcorr6_turn_long(3,-1:nres))
19543 allocate(gradxorr(3,-1:nres))
19544 allocate(gradcorr5(3,-1:nres))
19545 allocate(gradcorr6(3,-1:nres))
19546 allocate(gliptran(3,-1:nres))
19547 allocate(gliptranc(3,-1:nres))
19548 allocate(gliptranx(3,-1:nres))
19549 allocate(gshieldx(3,-1:nres))
19550 allocate(gshieldc(3,-1:nres))
19551 allocate(gshieldc_loc(3,-1:nres))
19552 allocate(gshieldx_ec(3,-1:nres))
19553 allocate(gshieldc_ec(3,-1:nres))
19554 allocate(gshieldc_loc_ec(3,-1:nres))
19555 allocate(gshieldx_t3(3,-1:nres))
19556 allocate(gshieldc_t3(3,-1:nres))
19557 allocate(gshieldc_loc_t3(3,-1:nres))
19558 allocate(gshieldx_t4(3,-1:nres))
19559 allocate(gshieldc_t4(3,-1:nres))
19560 allocate(gshieldc_loc_t4(3,-1:nres))
19561 allocate(gshieldx_ll(3,-1:nres))
19562 allocate(gshieldc_ll(3,-1:nres))
19563 allocate(gshieldc_loc_ll(3,-1:nres))
19564 allocate(grad_shield(3,-1:nres))
19565 allocate(gg_tube_sc(3,-1:nres))
19566 allocate(gg_tube(3,-1:nres))
19567 allocate(gradafm(3,-1:nres))
19568 allocate(gradb_nucl(3,-1:nres))
19569 allocate(gradbx_nucl(3,-1:nres))
19571 allocate(grad_shield_side(3,50,nres))
19572 allocate(grad_shield_loc(3,50,nres))
19573 ! grad for shielding surroing
19574 allocate(gloc(0:maxvar,0:2))
19575 allocate(gloc_x(0:maxvar,2))
19577 allocate(gel_loc(3,-1:nres))
19578 allocate(gel_loc_long(3,-1:nres))
19579 allocate(gcorr3_turn(3,-1:nres))
19580 allocate(gcorr4_turn(3,-1:nres))
19581 allocate(gcorr6_turn(3,-1:nres))
19582 allocate(gradb(3,-1:nres))
19583 allocate(gradbx(3,-1:nres))
19585 allocate(gel_loc_loc(maxvar))
19586 allocate(gel_loc_turn3(maxvar))
19587 allocate(gel_loc_turn4(maxvar))
19588 allocate(gel_loc_turn6(maxvar))
19589 allocate(gcorr_loc(maxvar))
19590 allocate(g_corr5_loc(maxvar))
19591 allocate(g_corr6_loc(maxvar))
19593 allocate(gsccorc(3,-1:nres))
19594 allocate(gsccorx(3,-1:nres))
19596 allocate(gsccor_loc(-1:nres))
19598 allocate(dtheta(3,2,-1:nres))
19600 allocate(gscloc(3,-1:nres))
19601 allocate(gsclocx(3,-1:nres))
19603 allocate(dphi(3,3,-1:nres))
19604 allocate(dalpha(3,3,-1:nres))
19605 allocate(domega(3,3,-1:nres))
19607 ! common /deriv_scloc/
19608 allocate(dXX_C1tab(3,nres))
19609 allocate(dYY_C1tab(3,nres))
19610 allocate(dZZ_C1tab(3,nres))
19611 allocate(dXX_Ctab(3,nres))
19612 allocate(dYY_Ctab(3,nres))
19613 allocate(dZZ_Ctab(3,nres))
19614 allocate(dXX_XYZtab(3,nres))
19615 allocate(dYY_XYZtab(3,nres))
19616 allocate(dZZ_XYZtab(3,nres))
19619 allocate(jgrad_start(nres))
19620 allocate(jgrad_end(nres))
19622 !----------------------
19625 allocate(ibond_displ(0:nfgtasks-1))
19626 allocate(ibond_count(0:nfgtasks-1))
19627 allocate(ithet_displ(0:nfgtasks-1))
19628 allocate(ithet_count(0:nfgtasks-1))
19629 allocate(iphi_displ(0:nfgtasks-1))
19630 allocate(iphi_count(0:nfgtasks-1))
19631 allocate(iphi1_displ(0:nfgtasks-1))
19632 allocate(iphi1_count(0:nfgtasks-1))
19633 allocate(ivec_displ(0:nfgtasks-1))
19634 allocate(ivec_count(0:nfgtasks-1))
19635 allocate(iset_displ(0:nfgtasks-1))
19636 allocate(iset_count(0:nfgtasks-1))
19637 allocate(iint_count(0:nfgtasks-1))
19638 allocate(iint_displ(0:nfgtasks-1))
19639 !(0:max_fg_procs-1)
19640 !----------------------
19643 allocate(gcart(3,-1:nres))
19644 allocate(gxcart(3,-1:nres))
19646 allocate(gradcag(3,-1:nres))
19647 allocate(gradxag(3,-1:nres))
19649 ! common /back_constr/
19650 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
19651 allocate(dutheta(nres))
19652 allocate(dugamma(nres))
19654 allocate(duscdiff(3,nres))
19655 allocate(duscdiffx(3,nres))
19657 !el i io:read_fragments
19658 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
19659 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
19661 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
19662 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
19663 allocate(mset(0:nprocs)) !(maxprocs/20)
19665 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
19666 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
19667 allocate(dUdconst(3,0:nres))
19668 allocate(dUdxconst(3,0:nres))
19669 allocate(dqwol(3,0:nres))
19670 allocate(dxqwol(3,0:nres))
19672 !----------------------
19674 ! common /sbridge/ in io_common: read_bridge
19675 !el allocate((:),allocatable :: iss !(maxss)
19676 ! common /links/ in io_common: read_bridge
19677 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
19678 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
19679 ! common /dyn_ssbond/
19680 ! and side-chain vectors in theta or phi.
19681 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
19685 dyn_ssbond_ij(:,:)=1.0d300
19689 ! if (nss.gt.0) then
19690 allocate(idssb(maxdim),jdssb(maxdim))
19691 ! allocate(newihpb(nss),newjhpb(nss))
19694 allocate(ishield_list(nres))
19695 allocate(shield_list(50,nres))
19696 allocate(dyn_ss_mask(nres))
19697 allocate(fac_shield(nres))
19698 allocate(enetube(nres*2))
19699 allocate(enecavtube(nres*2))
19702 dyn_ss_mask(:)=.false.
19703 !----------------------
19705 ! Parameters of the SCCOR term
19707 !el in io_conf: parmread
19708 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
19709 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
19710 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
19711 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
19712 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
19713 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
19714 ! allocate(vlor1sccor(maxterm_sccor,20,20))
19715 ! allocate(vlor2sccor(maxterm_sccor,20,20))
19716 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
19718 allocate(gloc_sc(3,0:2*nres,0:10))
19719 !(3,0:maxres2,10)maxres2=2*maxres
19720 allocate(dcostau(3,3,3,2*nres))
19721 allocate(dsintau(3,3,3,2*nres))
19722 allocate(dtauangle(3,3,3,2*nres))
19723 allocate(dcosomicron(3,3,3,2*nres))
19724 allocate(domicron(3,3,3,2*nres))
19725 !(3,3,3,maxres2)maxres2=2*maxres
19726 !----------------------
19729 allocate(varall(maxvar))
19730 !(maxvar)(maxvar=6*maxres)
19731 allocate(mask_theta(nres))
19732 allocate(mask_phi(nres))
19733 allocate(mask_side(nres))
19735 !----------------------
19738 allocate(uy(3,nres))
19739 allocate(uz(3,nres))
19741 allocate(uygrad(3,3,2,nres))
19742 allocate(uzgrad(3,3,2,nres))
19746 end subroutine alloc_ener_arrays
19747 !-----------------------------------------------------------------
19748 subroutine ebond_nucl(estr_nucl)
19750 !c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
19753 real(kind=8),dimension(3) :: u,ud
19754 real(kind=8) :: usum,uprod,uprod1,uprod2,usumsqder
19755 real(kind=8) :: estr_nucl,diff
19756 integer :: iti,i,j,k,nbi
19758 !C print *,"I enter ebond"
19760 write (iout,*) "ibondp_start,ibondp_end",&
19761 ibondp_nucl_start,ibondp_nucl_end
19762 do i=ibondp_nucl_start,ibondp_nucl_end
19763 if (itype(i-1,2).eq.ntyp1_molec(2) .or. &
19764 itype(i,2).eq.ntyp1_molec(2)) cycle
19765 ! estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
19767 ! gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
19768 ! & *dc(j,i-1)/vbld(i)
19770 ! if (energy_dec) write(iout,*)
19771 ! & "estr1",i,vbld(i),distchainmax,
19772 ! & gnmr1(vbld(i),-1.0d0,distchainmax)
19774 diff = vbld(i)-vbldp0_nucl
19775 if(energy_dec)write(iout,*) "estr_nucl_bb" , i,vbld(i),&
19776 vbldp0_nucl,diff,AKP_nucl*diff*diff
19777 estr_nucl=estr_nucl+diff*diff
19780 gradb_nucl(j,i-1)=AKP_nucl*diff*dc(j,i-1)/vbld(i)
19782 !c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
19784 estr_nucl=0.5d0*AKP_nucl*estr_nucl
19785 print *,"partial sum", estr_nucl,AKP_nucl
19788 write (iout,*) "ibondp_start,ibondp_end",&
19789 ibond_nucl_start,ibond_nucl_end
19791 do i=ibond_nucl_start,ibond_nucl_end
19792 !C print *, "I am stuck",i
19794 if (iti.eq.ntyp1_molec(2)) cycle
19795 nbi=nbondterm_nucl(iti)
19798 diff=vbld(i+nres)-vbldsc0_nucl(1,iti)
19801 write (iout,*) "estr_nucl_sc", i,iti,vbld(i+nres),vbldsc0_nucl(1,iti),diff, &
19802 AKSC_nucl(1,iti),AKSC_nucl(1,iti)*diff*diff
19803 estr_nucl=estr_nucl+0.5d0*AKSC_nucl(1,iti)*diff*diff
19806 gradbx_nucl(j,i)=AKSC_nucl(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
19810 diff=vbld(i+nres)-vbldsc0_nucl(j,iti)
19811 ud(j)=aksc_nucl(j,iti)*diff
19812 u(j)=abond0_nucl(j,iti)+0.5d0*ud(j)*diff
19826 uprod2=uprod2*u(k)*u(k)
19830 usumsqder=usumsqder+ud(j)*uprod2
19832 estr_nucl=estr_nucl+uprod/usum
19834 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
19838 !C print *,"I am about to leave ebond"
19840 end subroutine ebond_nucl
19842 !-----------------------------------------------------------------------------
19843 subroutine ebend_nucl(etheta_nucl)
19844 real(kind=8),dimension(nntheterm_nucl+1) :: coskt,sinkt !mmaxtheterm
19845 real(kind=8),dimension(nsingle_nucl+1) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
19846 real(kind=8),dimension(ndouble_nucl+1,ndouble_nucl+1) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
19847 logical :: lprn=.true., lprn1=.false.
19848 !el local variables
19849 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
19850 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
19851 real(kind=8) :: aux,etheta_nucl,ccl,ssl,scl,csl,ethetacnstr
19852 ! local variables for constrains
19853 real(kind=8) :: difi,thetiii
19856 print *,"ithet_start",ithet_nucl_start," ithet_end",ithet_nucl_end,nres
19857 do i=ithet_nucl_start,ithet_nucl_end
19858 if ((itype(i-1,2).eq.ntyp1_molec(2)).or.&
19859 (itype(i-2,2).eq.ntyp1_molec(2)).or. &
19860 (itype(i,2).eq.ntyp1_molec(2))) cycle
19864 theti2=0.5d0*theta(i)
19865 ityp2=ithetyp_nucl(itype(i-1,2))
19866 do k=1,nntheterm_nucl
19867 coskt(k)=dcos(k*theti2)
19868 sinkt(k)=dsin(k*theti2)
19870 if (i.gt.3 .and. itype(i-2,2).ne.ntyp1_molec(2)) then
19873 if (phii.ne.phii) phii=150.0
19877 ityp1=ithetyp_nucl(itype(i-2,2))
19878 do k=1,nsingle_nucl
19879 cosph1(k)=dcos(k*phii)
19880 sinph1(k)=dsin(k*phii)
19884 ityp1=nthetyp_nucl+1
19885 do k=1,nsingle_nucl
19891 if (i.lt.nres .and. itype(i,2).ne.ntyp1_molec(2)) then
19894 if (phii1.ne.phii1) phii1=150.0
19895 phii1=pinorm(phii1)
19899 ityp3=ithetyp_nucl(itype(i,2))
19900 do k=1,nsingle_nucl
19901 cosph2(k)=dcos(k*phii1)
19902 sinph2(k)=dsin(k*phii1)
19906 ityp3=nthetyp_nucl+1
19907 do k=1,nsingle_nucl
19912 ethetai=aa0thet_nucl(ityp1,ityp2,ityp3)
19913 do k=1,ndouble_nucl
19915 ccl=cosph1(l)*cosph2(k-l)
19916 ssl=sinph1(l)*sinph2(k-l)
19917 scl=sinph1(l)*cosph2(k-l)
19918 csl=cosph1(l)*sinph2(k-l)
19919 cosph1ph2(l,k)=ccl-ssl
19920 cosph1ph2(k,l)=ccl+ssl
19921 sinph1ph2(l,k)=scl+csl
19922 sinph1ph2(k,l)=scl-csl
19926 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
19927 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
19928 write (iout,*) "coskt and sinkt",nntheterm_nucl
19929 do k=1,nntheterm_nucl
19930 write (iout,*) k,coskt(k),sinkt(k)
19933 do k=1,ntheterm_nucl
19934 ethetai=ethetai+aathet_nucl(k,ityp1,ityp2,ityp3)*sinkt(k)
19935 dethetai=dethetai+0.5d0*k*aathet_nucl(k,ityp1,ityp2,ityp3)&
19938 write (iout,*) "k",k," aathet",aathet_nucl(k,ityp1,ityp2,ityp3),&
19942 write (iout,*) "cosph and sinph"
19943 do k=1,nsingle_nucl
19944 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
19946 write (iout,*) "cosph1ph2 and sinph2ph2"
19947 do k=2,ndouble_nucl
19949 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
19950 sinph1ph2(l,k),sinph1ph2(k,l)
19953 write(iout,*) "ethetai",ethetai
19955 do m=1,ntheterm2_nucl
19956 do k=1,nsingle_nucl
19957 aux=bbthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)&
19958 +ccthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k)&
19959 +ddthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)&
19960 +eethet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k)
19961 ethetai=ethetai+sinkt(m)*aux
19962 dethetai=dethetai+0.5d0*m*aux*coskt(m)
19963 dephii=dephii+k*sinkt(m)*(&
19964 ccthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)-&
19965 bbthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k))
19966 dephii1=dephii1+k*sinkt(m)*(&
19967 eethet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)-&
19968 ddthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k))
19970 write (iout,*) "m",m," k",k," bbthet",&
19971 bbthet_nucl(k,m,ityp1,ityp2,ityp3)," ccthet",&
19972 ccthet_nucl(k,m,ityp1,ityp2,ityp3)," ddthet",&
19973 ddthet_nucl(k,m,ityp1,ityp2,ityp3)," eethet",&
19974 eethet_nucl(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
19978 write(iout,*) "ethetai",ethetai
19979 do m=1,ntheterm3_nucl
19980 do k=2,ndouble_nucl
19982 aux=ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
19983 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+&
19984 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
19985 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
19986 ethetai=ethetai+sinkt(m)*aux
19987 dethetai=dethetai+0.5d0*m*coskt(m)*aux
19988 dephii=dephii+l*sinkt(m)*(&
19989 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-&
19990 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
19991 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
19992 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
19993 dephii1=dephii1+(k-l)*sinkt(m)*( &
19994 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
19995 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
19996 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-&
19997 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
19999 write (iout,*) "m",m," k",k," l",l," ffthet", &
20000 ffthet_nucl(l,k,m,ityp1,ityp2,ityp3), &
20001 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ggthet",&
20002 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3),&
20003 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
20004 write (iout,*) cosph1ph2(l,k)*sinkt(m), &
20005 cosph1ph2(k,l)*sinkt(m),&
20006 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
20012 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
20013 i,theta(i)*rad2deg,phii*rad2deg, &
20014 phii1*rad2deg,ethetai
20015 etheta_nucl=etheta_nucl+ethetai
20016 print *,i,"partial sum",etheta_nucl
20017 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang_nucl*dephii
20018 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang_nucl*dephii1
20019 gloc(nphi+i-2,icg)=wang_nucl*dethetai
20022 end subroutine ebend_nucl
20023 !----------------------------------------------------
20024 subroutine etor_nucl(etors_nucl)
20025 ! implicit real*8 (a-h,o-z)
20026 ! include 'DIMENSIONS'
20027 ! include 'COMMON.VAR'
20028 ! include 'COMMON.GEO'
20029 ! include 'COMMON.LOCAL'
20030 ! include 'COMMON.TORSION'
20031 ! include 'COMMON.INTERACT'
20032 ! include 'COMMON.DERIV'
20033 ! include 'COMMON.CHAIN'
20034 ! include 'COMMON.NAMES'
20035 ! include 'COMMON.IOUNITS'
20036 ! include 'COMMON.FFIELD'
20037 ! include 'COMMON.TORCNSTR'
20038 ! include 'COMMON.CONTROL'
20039 real(kind=8) :: etors_nucl,edihcnstr
20041 !el local variables
20042 integer :: i,j,iblock,itori,itori1
20043 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
20044 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
20045 ! Set lprn=.true. for debugging
20049 print *,"iphi_nucl_start/end", iphi_nucl_start,iphi_nucl_end
20050 do i=iphi_nucl_start,iphi_nucl_end
20051 if (itype(i-2,2).eq.ntyp1_molec(2) .or. itype(i-1,2).eq.ntyp1_molec(2) &
20052 .or. itype(i-3,2).eq.ntyp1_molec(2) &
20053 .or. itype(i,2).eq.ntyp1_molec(2)) cycle
20055 itori=itortyp_nucl(itype(i-2,2))
20056 itori1=itortyp_nucl(itype(i-1,2))
20058 print *,i,itori,itori1
20060 !C Regular cosine and sine terms
20061 do j=1,nterm_nucl(itori,itori1)
20062 v1ij=v1_nucl(j,itori,itori1)
20063 v2ij=v2_nucl(j,itori,itori1)
20064 cosphi=dcos(j*phii)
20065 sinphi=dsin(j*phii)
20066 etors_nucl=etors_nucl+v1ij*cosphi+v2ij*sinphi
20067 if (energy_dec) etors_ii=etors_ii+&
20068 v1ij*cosphi+v2ij*sinphi
20069 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
20073 !C E = SUM ----------------------------------- - v1
20074 !C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
20076 cosphi=dcos(0.5d0*phii)
20077 sinphi=dsin(0.5d0*phii)
20078 do j=1,nlor_nucl(itori,itori1)
20079 vl1ij=vlor1_nucl(j,itori,itori1)
20080 vl2ij=vlor2_nucl(j,itori,itori1)
20081 vl3ij=vlor3_nucl(j,itori,itori1)
20082 pom=vl2ij*cosphi+vl3ij*sinphi
20083 pom1=1.0d0/(pom*pom+1.0d0)
20084 etors_nucl=etors_nucl+vl1ij*pom1
20085 if (energy_dec) etors_ii=etors_ii+ &
20088 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
20090 !C Subtract the constant term
20091 etors_nucl=etors_nucl-v0_nucl(itori,itori1)
20092 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
20093 'etor',i,etors_ii-v0_nucl(itori,itori1)
20095 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
20096 restyp(itype(i-2,2),2),i-2,restyp(itype(i-1,2),2),i-1,itori,itori1, &
20097 (v1_nucl(j,itori,itori1),j=1,6),(v2_nucl(j,itori,itori1),j=1,6)
20098 gloc(i-3,icg)=gloc(i-3,icg)+wtor_nucl*gloci
20099 !c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
20102 end subroutine etor_nucl
20104 !-----------------------------------------------------------------------------
20105 !-----------------------------------------------------------------------------