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,gUb2 !(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(4) :: gmuij,gmuij1,gmuij2,gmuji1,gmuji2
91 real(kind=8),dimension(:),allocatable :: costab,sintab,&
92 costab2,sintab2 !(maxres)
93 ! This common block contains dipole-interaction matrices and their
94 ! Cartesian derivatives.
96 real(kind=8),dimension(:,:,:,:),allocatable :: a_chuj !(2,2,maxconts,maxres)
97 real(kind=8),dimension(:,:,:,:,:,:),allocatable :: a_chuj_der !(2,2,3,5,maxconts,maxres)
99 real(kind=8),dimension(2,2,2) :: AEA,AEAderg,EAEA,AECA,&
100 AECAderg,ADtEA,ADtEA1,AEAb1,AEAb1derg,AEAb2
101 real(kind=8),dimension(2,2,2,2) :: EAEAderg,ADtEAderg,&
103 real(kind=8),dimension(2,2,3,5,2,2) :: AEAderx,EAEAderx,&
104 AECAderx,ADtEAderx,ADtEA1derx
105 real(kind=8),dimension(2,3,5,2,2,2) :: AEAb1derx,AEAb2derx
106 real(kind=8),dimension(3,2) :: g_contij
107 real(kind=8) :: ekont
108 ! 12/13/2008 (again Poland-Jaruzel war anniversary)
109 ! RE: Parallelization of 4th and higher order loc-el correlations
110 ! common /contdistrib/
111 integer,dimension(:),allocatable :: ncont_sent,ncont_recv !(maxres)
112 ! ncont_sent,ncont_recv są w multibody_ello i multibody_hb
113 !-----------------------------------------------------------------------------
116 ! real(kind=8),dimension(:,:),allocatable :: dcdv,dxdv !(6,maxdim)
117 ! real(kind=8),dimension(:,:),allocatable :: dxds !(6,maxres)
118 ! real(kind=8),dimension(:,:,:),allocatable :: gradx,gradc !(3,maxres,2)
119 real(kind=8),dimension(:,:),allocatable :: gvdwc,gelc,gelc_long,&
120 gvdwpp,gvdwc_scpp,gradx_scp,gvdwc_scp,ghpbx,ghpbc,&
121 gradcorr,gradcorr_long,gradcorr5_long,gradcorr6_long,&
122 gcorr6_turn_long,gradxorr,gradcorr5,gradcorr6,gliptran,gliptranc,&
124 gshieldx,gshieldc,gshieldc_loc,gshieldx_ec,&
125 gshieldc_ec,gshieldc_loc_ec,gshieldx_t3, &
126 gshieldc_t3,gshieldc_loc_t3,gshieldx_t4,gshieldc_t4, &
127 gshieldc_loc_t4,gshieldx_ll,gshieldc_ll,gshieldc_loc_ll,&
128 grad_shield,gg_tube,gg_tube_sc,gradafm !(3,maxres)
129 !-----------------------------NUCLEIC GRADIENT
130 real(kind=8),dimension(:,:),allocatable ::gradb_nucl,gradbx_nucl, &
131 gvdwpsb1,gelpp,gvdwpsb,gelsbc,gelsbx,gvdwsbx,gvdwsbc,gsbloc,&
132 gsblocx,gradcorr_nucl,gradxorr_nucl,gradcorr3_nucl,gradxorr3_nucl,&
134 !-----------------------------NUCLEIC-PROTEIN GRADIENT
135 real(kind=8),dimension(:,:),allocatable :: gvdwx_scbase,gvdwc_scbase,&
136 gvdwx_pepbase,gvdwc_pepbase,gvdwx_scpho,gvdwc_scpho,&
138 !------------------------------IONS GRADIENT
139 real(kind=8),dimension(:,:),allocatable :: gradcatcat, &
140 gradpepcat,gradpepcatx
141 ! real(kind=8),dimension(:,:),allocatable :: gloc,gloc_x !(maxvar,2)
144 real(kind=8),dimension(:,:),allocatable :: gel_loc,gel_loc_long,&
145 gcorr3_turn,gcorr4_turn,gcorr6_turn,gradb,gradbx !(3,maxres)
146 real(kind=8),dimension(:),allocatable :: gel_loc_loc,&
147 gel_loc_turn3,gel_loc_turn4,gel_loc_turn6,gcorr_loc,g_corr5_loc,&
148 g_corr6_loc !(maxvar)
149 real(kind=8),dimension(:,:),allocatable :: gsccorc,gsccorx !(3,maxres)
150 real(kind=8),dimension(:),allocatable :: gsccor_loc !(maxres)
151 ! real(kind=8),dimension(:,:,:),allocatable :: dtheta !(3,2,maxres)
152 real(kind=8),dimension(:,:),allocatable :: gscloc,gsclocx !(3,maxres)
153 ! real(kind=8),dimension(:,:,:),allocatable :: dphi,dalpha,domega !(3,3,maxres)
154 real(kind=8),dimension(:,:,:),allocatable :: grad_shield_side, &
155 grad_shield_loc ! (3,maxcontsshileding,maxnres)
158 real(kind=8), dimension(:),allocatable :: fac_shield
159 real(kind=8),dimension(3,5,2) :: derx,derx_turn
160 ! common /deriv_scloc/
161 real(kind=8),dimension(:,:),allocatable :: dXX_C1tab,dYY_C1tab,&
162 dZZ_C1tab,dXX_Ctab,dYY_Ctab,dZZ_Ctab,dXX_XYZtab,dYY_XYZtab,&
163 dZZ_XYZtab !(3,maxres)
164 !-----------------------------------------------------------------------------
167 real(kind=8) :: gvdwc_max,gvdwc_scp_max,gelc_max,gvdwpp_max,&
168 gradb_max,ghpbc_max,&
169 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
170 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
171 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
172 gsccorx_max,gsclocx_max
173 !-----------------------------------------------------------------------------
175 ! common /back_constr/
176 real(kind=8),dimension(:),allocatable :: dutheta,dugamma !(maxres)
177 real(kind=8),dimension(:,:),allocatable :: duscdiff,duscdiffx !(3,maxres)
179 real(kind=8) :: Ucdfrag,Ucdpair
180 real(kind=8),dimension(:,:),allocatable :: dUdconst,dUdxconst,&
181 dqwol,dxqwol !(3,0:MAXRES)
182 !-----------------------------------------------------------------------------
184 ! common /dyn_ssbond/
185 real(kind=8),dimension(:,:),allocatable :: dyn_ssbond_ij !(maxres,maxres)
186 !-----------------------------------------------------------------------------
188 ! Parameters of the SCCOR term
190 real(kind=8),dimension(:,:,:,:),allocatable :: dcostau,dsintau,&
191 dcosomicron,domicron !(3,3,3,maxres2)
192 !-----------------------------------------------------------------------------
195 real(kind=8),dimension(:,:),allocatable :: uy,uz !(3,maxres)
196 real(kind=8),dimension(:,:,:,:),allocatable :: uygrad,uzgrad !(3,3,2,maxres)
197 !-----------------------------------------------------------------------------
198 ! common /przechowalnia/
199 real(kind=8),dimension(:,:,:),allocatable :: zapas
200 real(kind=8),dimension(:,:,:,:),allocatable ::zapas2 !(max_dim,maxconts,max_fg_procs)
201 real(kind=8),dimension(:,:,:),allocatable :: fromto !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
202 !-----------------------------------------------------------------------------
203 !-----------------------------------------------------------------------------
206 !-----------------------------------------------------------------------------
208 !-----------------------------------------------------------------------------
209 ! energy_p_new_barrier.F
210 !-----------------------------------------------------------------------------
211 subroutine etotal(energia)
212 ! implicit real*8 (a-h,o-z)
213 ! include 'DIMENSIONS'
218 !MS$ATTRIBUTES C :: proc_proc
224 ! include 'COMMON.SETUP'
225 ! include 'COMMON.IOUNITS'
226 real(kind=8),dimension(0:n_ene) :: energia
227 ! include 'COMMON.LOCAL'
228 ! include 'COMMON.FFIELD'
229 ! include 'COMMON.DERIV'
230 ! include 'COMMON.INTERACT'
231 ! include 'COMMON.SBRIDGE'
232 ! include 'COMMON.CHAIN'
233 ! include 'COMMON.VAR'
234 ! include 'COMMON.MD'
235 ! include 'COMMON.CONTROL'
236 ! include 'COMMON.TIME1'
237 real(kind=8) :: time00
239 integer :: n_corr,n_corr1,ierror
240 real(kind=8) :: etors,edihcnstr,etors_d,esccor,ehpb
241 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,escloc,ees,eel_loc
242 real(kind=8) :: eello_turn3,eello_turn4,estr,ebe,eliptran,etube, &
243 Eafmforce,ethetacnstr
244 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
245 ! now energies for nulceic alone parameters
246 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
247 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
250 real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber
251 ! energies for protein nucleic acid interaction
252 real(kind=8) :: escbase,epepbase,escpho,epeppho
255 real(kind=8) :: weights_(n_ene) !,time_Bcast,time_Bcastw
256 ! shielding effect varibles for MPI
257 real(kind=8) :: fac_shieldbuf(nres), &
258 grad_shield_locbuf1(3*maxcontsshi*nres), &
259 grad_shield_sidebuf1(3*maxcontsshi*nres), &
260 grad_shield_locbuf2(3*maxcontsshi*nres), &
261 grad_shield_sidebuf2(3*maxcontsshi*nres), &
262 grad_shieldbuf1(3*nres), &
263 grad_shieldbuf2(3*nres)
265 integer ishield_listbuf(-1:nres), &
266 shield_listbuf(maxcontsshi,-1:nres),k,j,i,iii,impishi,mojint,jjj
269 ! real(kind=8), dimension(:),allocatable:: fac_shieldbuf
270 ! real(kind=8), dimension(:,:,:),allocatable:: &
271 ! grad_shield_locbuf,grad_shield_sidebuf
272 ! real(kind=8), dimension(:,:),allocatable:: &
274 ! integer, dimension(:),allocatable:: &
276 ! integer, dimension(:,:),allocatable:: shield_listbuf
278 ! if (.not.allocated(fac_shieldbuf)) then
279 ! allocate(fac_shieldbuf(nres))
280 ! allocate(grad_shield_locbuf(3,maxcontsshi,-1:nres))
281 ! allocate(grad_shield_sidebuf(3,maxcontsshi,-1:nres))
282 ! allocate(grad_shieldbuf(3,-1:nres))
283 ! allocate(ishield_listbuf(nres))
284 ! allocate(shield_listbuf(maxcontsshi,nres))
287 ! print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
288 ! & " nfgtasks",nfgtasks
289 if (nfgtasks.gt.1) then
291 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
292 if (fg_rank.eq.0) then
293 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
294 ! print *,"Processor",myrank," BROADCAST iorder"
295 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
296 ! FG slaves as WEIGHTS array.
316 weights_(26)=wvdwpp_nucl
322 weights_(32)=wbond_nucl
323 weights_(33)=wang_nucl
325 weights_(35)=wtor_nucl
326 weights_(36)=wtor_d_nucl
327 weights_(37)=wcorr_nucl
328 weights_(38)=wcorr3_nucl
330 weights_(42)=wcatprot
332 weights_(47)=wpepbase
335 ! wcatcat= weights(41)
336 ! wcatprot=weights(42)
338 ! FG Master broadcasts the WEIGHTS_ array
339 call MPI_Bcast(weights_(1),n_ene,&
340 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
342 ! FG slaves receive the WEIGHTS array
343 call MPI_Bcast(weights(1),n_ene,&
344 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
364 wvdwpp_nucl =weights(26)
370 wbond_nucl =weights(32)
371 wang_nucl =weights(33)
373 wtor_nucl =weights(35)
374 wtor_d_nucl =weights(36)
375 wcorr_nucl =weights(37)
376 wcorr3_nucl =weights(38)
383 ! welpsb=weights(28)*fact(1)
385 ! wcorr_nucl= weights(37)*fact(1)
386 ! wcorr3_nucl=weights(38)*fact(2)
387 ! wtor_nucl= weights(35)*fact(1)
388 ! wtor_d_nucl=weights(36)*fact(2)
391 time_Bcast=time_Bcast+MPI_Wtime()-time00
392 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
393 ! call chainbuild_cart
395 ! print *,'Processor',myrank,' calling etotal ipot=',ipot
396 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
398 ! if (modecalc.eq.12.or.modecalc.eq.14) then
399 ! call int_from_cart1(.false.)
406 ! Compute the side-chain and electrostatic interaction energy
407 ! print *, "Before EVDW"
408 ! goto (101,102,103,104,105,106) ipot
410 ! Lennard-Jones potential.
414 !d print '(a)','Exit ELJcall el'
416 ! Lennard-Jones-Kihara potential (shifted).
417 ! 102 call eljk(evdw)
421 ! Berne-Pechukas potential (dilated LJ, angular dependence).
426 ! Gay-Berne potential (shifted LJ, angular dependence).
429 ! print *,"MOMO",scelemode
430 if (scelemode.eq.0) then
436 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
437 ! 105 call egbv(evdw)
441 ! Soft-sphere potential
442 ! 106 call e_softsphere(evdw)
444 call e_softsphere(evdw)
446 ! Calculate electrostatic (H-bonding) energy of the main chain.
450 write(iout,*)"Wrong ipot"
455 ! print *,"after EGB"
457 if (shield_mode.eq.2) then
460 if (nfgtasks.gt.1) then
461 grad_shield_sidebuf1(:)=0.0d0
462 grad_shield_locbuf1(:)=0.0d0
463 grad_shield_sidebuf2(:)=0.0d0
464 grad_shield_locbuf2(:)=0.0d0
465 grad_shieldbuf1(:)=0.0d0
466 grad_shieldbuf2(:)=0.0d0
469 write(iout,*) "befor reduce fac_shield reduce"
471 write(2,*) "fac",itype(i,1),fac_shield(i),grad_shield(1,i)
472 write(2,*) "list", shield_list(1,i),ishield_list(i), &
473 grad_shield_side(1,1,i),grad_shield_loc(1,1,i)
482 grad_shieldbuf1(iii)=grad_shield(k,i)
489 grad_shield_sidebuf1(jjj)=grad_shield_side(k,j,i)
490 grad_shield_locbuf1(jjj)=grad_shield_loc(k,j,i)
494 call MPI_Allgatherv(fac_shield(ivec_start), &
495 ivec_count(fg_rank1), &
496 MPI_DOUBLE_PRECISION,fac_shieldbuf(1),ivec_count(0), &
498 MPI_DOUBLE_PRECISION,FG_COMM,IERROR)
499 call MPI_Allgatherv(shield_list(1,ivec_start), &
500 ivec_count(fg_rank1), &
501 MPI_I50,shield_listbuf(1,1),ivec_count(0), &
503 MPI_I50,FG_COMM,IERROR)
504 ! write(2,*) "After I50"
506 call MPI_Allgatherv(ishield_list(ivec_start), &
507 ivec_count(fg_rank1), &
508 MPI_INTEGER,ishield_listbuf(1),ivec_count(0), &
510 MPI_INTEGER,FG_COMM,IERROR)
511 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
513 ! write(2,*) ivec_count(fg_rank1)*3,ivec_count(0)*3,ivec_displ(0)*3,3*ivec_start-2
514 ! write (2,*) "before"
515 ! write(2,*) grad_shieldbuf1
516 ! call MPI_Allgatherv(grad_shieldbuf1(3*ivec_start-2), &
517 ! ivec_count(fg_rank1)*3, &
518 ! MPI_DOUBLE_PRECISION,grad_shieldbuf2(1),ivec_count(0), &
520 ! MPI_DOUBLE_PRECISION,FG_COMM,IERROR)
521 call MPI_Allreduce(grad_shieldbuf1(1),grad_shieldbuf2(1), &
523 MPI_DOUBLE_PRECISION, &
526 call MPI_Allreduce(grad_shield_sidebuf1(1),grad_shield_sidebuf2(1), &
527 nres*3*maxcontsshi, &
528 MPI_DOUBLE_PRECISION, &
532 call MPI_Allreduce(grad_shield_locbuf1(1),grad_shield_locbuf2(1), &
533 nres*3*maxcontsshi, &
534 MPI_DOUBLE_PRECISION, &
539 ! write(2,*) grad_shieldbuf2
541 ! call MPI_Allgatherv(grad_shield_sidebuf1(3*maxcontsshi*ivec_start-2), &
542 ! ivec_count(fg_rank1)*3*maxcontsshi, &
543 ! MPI_DOUBLE_PRECISION,grad_shield_sidebuf2(1),ivec_count(0)*3*maxcontsshi,&
544 ! ivec_displ(0)*3*maxcontsshi, &
545 ! MPI_DOUBLE_PRECISION,FG_COMM,IERROR)
546 ! write(2,*) "After grad_shield_side"
548 ! call MPI_Allgatherv(grad_shield_locbuf1(3*maxcontsshi*ivec_start-2), &
549 ! ivec_count(fg_rank1)*3*maxcontsshi, &
550 ! MPI_DOUBLE_PRECISION,grad_shield_locbuf2(1),ivec_count(0)*3*maxcontsshi, &
551 ! ivec_displ(0)*3*maxcontsshi, &
552 ! MPI_DOUBLE_PRECISION,FG_COMM,IERROR)
553 ! write(2,*) "After MPI_SHI"
558 fac_shield(i)=fac_shieldbuf(i)
559 ishield_list(i)=ishield_listbuf(i)
560 ! write(iout,*) i,fac_shield(i)
563 grad_shield(j,i)=grad_shieldbuf2(iii)
565 do j=1,ishield_list(i)
566 ! write (iout,*) "ishild", ishield_list(i),i
567 shield_list(j,i)=shield_listbuf(j,i)
572 grad_shield_loc(k,j,i)=grad_shield_locbuf2(jjj)
573 grad_shield_side(k,j,i)=grad_shield_sidebuf2(jjj)
579 write(iout,*) "after reduce fac_shield reduce"
581 write(2,*) "fac",itype(i,1),fac_shield(i),grad_shield(1,i)
582 write(2,*) "list", shield_list(1,i),ishield_list(i), &
583 grad_shield_side(1,1,i),grad_shield_loc(1,1,i)
591 ! print *,"AFTER EGB",ipot,evdw
593 !mc Sep-06: egb takes care of dynamic ss bonds too
595 ! if (dyn_ss) call dyn_set_nss
596 ! print *,"Processor",myrank," computed USCSC"
602 time_vec=time_vec+MPI_Wtime()-time01
608 ! print *,"Processor",myrank," left VEC_AND_DERIV"
611 ! print *,"after ipot if", ipot
612 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
613 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
614 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
615 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
617 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
618 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
619 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
620 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
622 ! print *,"just befor eelec call"
623 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
624 ! print *, "ELEC calc"
633 ! write (iout,*) "Soft-spheer ELEC potential"
634 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
637 ! print *,"Processor",myrank," computed UELEC"
639 ! Calculate excluded-volume interaction energy between peptide groups
642 ! write(iout,*) "in etotal calc exc;luded",ipot
646 call escp(evdw2,evdw2_14)
652 ! write (iout,*) "Soft-sphere SCP potential"
653 call escp_soft_sphere(evdw2,evdw2_14)
655 ! write(iout,*) "in etotal before ebond",ipot
658 ! Calculate the bond-stretching energy
661 ! print *,"EBOND",estr
662 ! write(iout,*) "in etotal afer ebond",ipot
665 ! Calculate the disulfide-bridge and other energy and the contributions
666 ! from other distance constraints.
667 ! print *,'Calling EHPB'
669 !elwrite(iout,*) "in etotal afer edis",ipot
670 ! print *,'EHPB exitted succesfully.'
672 ! Calculate the virtual-bond-angle energy.
673 ! write(iout,*) "in etotal afer edis",ipot
675 ! if (wang.gt.0.0d0) then
676 ! call ebend(ebe,ethetacnstr)
681 if (wang.gt.0d0) then
682 if (tor_mode.eq.0) then
685 !C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
693 if (with_theta_constr) call etheta_constr(ethetacnstr)
695 ! write(iout,*) "in etotal afer ebe",ipot
697 ! print *,"Processor",myrank," computed UB"
699 ! Calculate the SC local energy.
702 !elwrite(iout,*) "in etotal afer esc",ipot
703 ! print *,"Processor",myrank," computed USC"
705 ! Calculate the virtual-bond torsional energy.
707 !d print *,'nterm=',nterm
708 ! if (wtor.gt.0) then
709 ! call etor(etors,edihcnstr)
714 if (wtor.gt.0.0d0) then
715 if (tor_mode.eq.0) then
718 !C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
726 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
727 !c print *,"Processor",myrank," computed Utor"
729 ! print *,"Processor",myrank," computed Utor"
732 ! 6/23/01 Calculate double-torsional energy
734 !elwrite(iout,*) "in etotal",ipot
735 if (wtor_d.gt.0) then
740 ! print *,"Processor",myrank," computed Utord"
742 ! 21/5/07 Calculate local sicdechain correlation energy
744 if (wsccor.gt.0.0d0) then
745 call eback_sc_corr(esccor)
750 ! write(iout,*) "before multibody"
752 ! print *,"Processor",myrank," computed Usccorr"
754 ! 12/1/95 Multi-body terms
759 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
760 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
761 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
762 !d write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
763 !d &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
770 !elwrite(iout,*) "in etotal",ipot
771 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
772 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
773 !d write (iout,*) "multibody_hb ecorr",ecorr
775 ! write(iout,*) "afeter multibody hb"
777 ! print *,"Processor",myrank," computed Ucorr"
779 ! If performing constraint dynamics, call the constraint energy
780 ! after the equilibration time
781 if(usampl.and.totT.gt.eq_time) then
782 !elwrite(iout,*) "afeter multibody hb"
784 !elwrite(iout,*) "afeter multibody hb"
786 !elwrite(iout,*) "afeter multibody hb"
792 ! write(iout,*) "after Econstr"
794 if (wliptran.gt.0) then
795 ! print *,"PRZED WYWOLANIEM"
796 call Eliptransfer(eliptran)
800 if (fg_rank.eq.0) then
801 if (AFMlog.gt.0) then
802 call AFMforce(Eafmforce)
803 else if (selfguide.gt.0) then
804 call AFMvel(Eafmforce)
809 if (tubemode.eq.1) then
811 else if (tubemode.eq.2) then
812 call calctube2(etube)
813 elseif (tubemode.eq.3) then
818 !--------------------------------------------------------
819 ! write (iout,*) "NRES_MOLEC(2),",nres_molec(2)
820 ! print *,"before",ees,evdw1,ecorr
821 ! write(iout,*) ecorr_nucl,"ecorr_nucl",nres_molec(2)
822 if (nres_molec(2).gt.0) then
823 call ebond_nucl(estr_nucl)
824 call ebend_nucl(ebe_nucl)
825 call etor_nucl(etors_nucl)
826 call esb_gb(evdwsb,eelsb)
827 call epp_nucl_sub(evdwpp,eespp)
828 call epsb(evdwpsb,eelpsb)
830 call multibody_hb_nucl(ecorr_nucl,ecorr3_nucl,n_corr,n_corr1)
844 ! write(iout,*) ecorr_nucl,"ecorr_nucl",nres_molec(2)
845 ! print *,"before ecatcat",wcatcat
846 if (nfgtasks.gt.1) then
847 if (fg_rank.eq.0) then
848 call ecatcat(ecationcation)
851 call ecatcat(ecationcation)
853 if (oldion.gt.0) then
854 call ecat_prot(ecation_prot)
856 call ecats_prot_amber(ecation_prot)
858 if (nres_molec(2).gt.0) then
859 call eprot_sc_base(escbase)
860 call epep_sc_base(epepbase)
861 call eprot_sc_phosphate(escpho)
862 call eprot_pep_phosphate(epeppho)
869 ! call ecatcat(ecationcation)
870 ! print *,"after ebend", wtor_nucl
872 time_enecalc=time_enecalc+MPI_Wtime()-time00
874 ! print *,"Processor",myrank," computed Uconstr"
883 energia(2)=evdw2-evdw2_14
900 energia(8)=eello_turn3
901 energia(9)=eello_turn4
908 energia(19)=edihcnstr
910 energia(20)=Uconst+Uconst_back
913 energia(23)=Eafmforce
914 energia(24)=ethetacnstr
916 !---------------------------------------------------------------
923 energia(32)=estr_nucl
926 energia(35)=etors_nucl
927 energia(36)=etors_d_nucl
928 energia(37)=ecorr_nucl
929 energia(38)=ecorr3_nucl
930 !----------------------------------------------------------------------
931 ! Here are the energies showed per procesor if the are more processors
932 ! per molecule then we sum it up in sum_energy subroutine
933 ! print *," Processor",myrank," calls SUM_ENERGY"
934 energia(42)=ecation_prot
935 energia(41)=ecationcation
940 ! energia(50)=ecations_prot_amber
941 call sum_energy(energia,.true.)
942 if (dyn_ss) call dyn_set_nss
943 ! print *," Processor",myrank," left SUM_ENERGY"
945 time_sumene=time_sumene+MPI_Wtime()-time00
947 ! call enerprint(energia)
948 !elwrite(iout,*)"finish etotal"
950 end subroutine etotal
951 !-----------------------------------------------------------------------------
952 subroutine sum_energy(energia,reduce)
953 ! implicit real*8 (a-h,o-z)
954 ! include 'DIMENSIONS'
958 !MS$ATTRIBUTES C :: proc_proc
964 ! include 'COMMON.SETUP'
965 ! include 'COMMON.IOUNITS'
966 real(kind=8) :: energia(0:n_ene),enebuff(0:n_ene+1)
967 ! include 'COMMON.FFIELD'
968 ! include 'COMMON.DERIV'
969 ! include 'COMMON.INTERACT'
970 ! include 'COMMON.SBRIDGE'
971 ! include 'COMMON.CHAIN'
972 ! include 'COMMON.VAR'
973 ! include 'COMMON.CONTROL'
974 ! include 'COMMON.TIME1'
976 real(kind=8) :: evdw,evdw2,evdw2_14,ees,evdw1,ecorr,ecorr5,ecorr6
977 real(kind=8) :: eel_loc,eello_turn3,eello_turn4,eturn6,ebe,escloc
978 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,esccor,etot, &
979 eliptran,etube, Eafmforce,ethetacnstr
980 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
981 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
983 real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber
984 real(kind=8) :: escbase,epepbase,escpho,epeppho
988 real(kind=8) :: time00
989 if (nfgtasks.gt.1 .and. reduce) then
992 write (iout,*) "energies before REDUCE"
993 call enerprint(energia)
997 enebuff(i)=energia(i)
1000 call MPI_Barrier(FG_COMM,IERR)
1001 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
1003 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,&
1004 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
1006 write (iout,*) "energies after REDUCE"
1007 call enerprint(energia)
1010 time_Reduce=time_Reduce+MPI_Wtime()-time00
1012 if (fg_rank.eq.0) then
1016 evdw2=energia(2)+energia(18)
1017 evdw2_14=energia(18)
1032 eello_turn3=energia(8)
1033 eello_turn4=energia(9)
1040 edihcnstr=energia(19)
1044 eliptran=energia(22)
1045 Eafmforce=energia(23)
1046 ethetacnstr=energia(24)
1054 estr_nucl=energia(32)
1055 ebe_nucl=energia(33)
1057 etors_nucl=energia(35)
1058 etors_d_nucl=energia(36)
1059 ecorr_nucl=energia(37)
1060 ecorr3_nucl=energia(38)
1061 ecation_prot=energia(42)
1062 ecationcation=energia(41)
1064 epepbase=energia(47)
1067 ! ecations_prot_amber=energia(50)
1069 ! energia(41)=ecation_prot
1070 ! energia(42)=ecationcation
1074 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 &
1075 +wang*ebe+wtor*etors+wscloc*escloc &
1076 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
1077 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
1078 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
1079 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
1080 +Eafmforce+ethetacnstr &
1081 +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
1082 +wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
1083 +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
1084 +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
1085 +wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
1086 +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho
1088 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) &
1089 +wang*ebe+wtor*etors+wscloc*escloc &
1090 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
1091 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
1092 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
1093 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
1094 +Eafmforce+ethetacnstr &
1095 +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
1096 +wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
1097 +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
1098 +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
1099 +wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
1100 +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho
1106 if (isnan(etot).ne.0) energia(0)=1.0d+99
1108 if (isnan(etot)) energia(0)=1.0d+99
1113 idumm=proc_proc(etot,i)
1115 call proc_proc(etot,i)
1117 if(i.eq.1)energia(0)=1.0d+99
1122 ! call enerprint(energia)
1125 end subroutine sum_energy
1126 !-----------------------------------------------------------------------------
1127 subroutine rescale_weights(t_bath)
1128 ! implicit real*8 (a-h,o-z)
1132 ! include 'DIMENSIONS'
1133 ! include 'COMMON.IOUNITS'
1134 ! include 'COMMON.FFIELD'
1135 ! include 'COMMON.SBRIDGE'
1136 real(kind=8) :: kfac=2.4d0
1137 real(kind=8) :: x,x2,x3,x4,x5,licznik=1.12692801104297249644
1139 real(kind=8) :: t_bath,facT(6) !,facT2,facT3,facT4,facT5,facT6
1140 real(kind=8) :: T0=3.0d2
1143 ! facT=2*temp0/(t_bath+temp0)
1144 if (rescale_mode.eq.0) then
1151 else if (rescale_mode.eq.1) then
1152 facT(1)=kfac/(kfac-1.0d0+t_bath/temp0)
1153 facT(2)=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
1154 facT(3)=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
1155 facT(4)=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
1156 facT(5)=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
1158 !#if defined(WHAM_RUN) || defined(CLUSTER)
1160 ! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
1161 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1162 #elif defined(FUNCT)
1168 else if (rescale_mode.eq.2) then
1174 facT(1)=licznik/dlog(dexp(x)+dexp(-x))
1175 facT(2)=licznik/dlog(dexp(x2)+dexp(-x2))
1176 facT(3)=licznik/dlog(dexp(x3)+dexp(-x3))
1177 facT(4)=licznik/dlog(dexp(x4)+dexp(-x4))
1178 facT(5)=licznik/dlog(dexp(x5)+dexp(-x5))
1180 !#if defined(WHAM_RUN) || defined(CLUSTER)
1182 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1183 #elif defined(FUNCT)
1190 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
1191 write (*,*) "Wrong RESCALE_MODE",rescale_mode
1193 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1197 welec=weights(3)*fact(1)
1198 wcorr=weights(4)*fact(3)
1199 wcorr5=weights(5)*fact(4)
1200 wcorr6=weights(6)*fact(5)
1201 wel_loc=weights(7)*fact(2)
1202 wturn3=weights(8)*fact(2)
1203 wturn4=weights(9)*fact(3)
1204 wturn6=weights(10)*fact(5)
1205 wtor=weights(13)*fact(1)
1206 wtor_d=weights(14)*fact(2)
1207 wsccor=weights(21)*fact(1)
1208 welpsb=weights(28)*fact(1)
1209 wcorr_nucl= weights(37)*fact(1)
1210 wcorr3_nucl=weights(38)*fact(2)
1211 wtor_nucl= weights(35)*fact(1)
1212 wtor_d_nucl=weights(36)*fact(2)
1213 wpepbase=weights(47)*fact(1)
1215 end subroutine rescale_weights
1216 !-----------------------------------------------------------------------------
1217 subroutine enerprint(energia)
1218 ! implicit real*8 (a-h,o-z)
1219 ! include 'DIMENSIONS'
1220 ! include 'COMMON.IOUNITS'
1221 ! include 'COMMON.FFIELD'
1222 ! include 'COMMON.SBRIDGE'
1223 ! include 'COMMON.MD'
1224 real(kind=8) :: energia(0:n_ene)
1226 real(kind=8) :: etot,evdw,evdw2,ees,evdw1,ecorr,ecorr5,ecorr6,eel_loc
1227 real(kind=8) :: eello_turn6,eello_turn3,eello_turn4,ebe,escloc
1228 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,Uconst,esccor,eliptran,&
1229 etube,ethetacnstr,Eafmforce
1230 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
1231 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
1233 real(kind=8) :: ecation_prot,ecationcation,ecations_prot_amber
1234 real(kind=8) :: escbase,epepbase,escpho,epeppho
1240 evdw2=energia(2)+energia(18)
1252 eello_turn3=energia(8)
1253 eello_turn4=energia(9)
1254 eello_turn6=energia(10)
1260 edihcnstr=energia(19)
1264 eliptran=energia(22)
1265 Eafmforce=energia(23)
1266 ethetacnstr=energia(24)
1274 estr_nucl=energia(32)
1275 ebe_nucl=energia(33)
1277 etors_nucl=energia(35)
1278 etors_d_nucl=energia(36)
1279 ecorr_nucl=energia(37)
1280 ecorr3_nucl=energia(38)
1281 ecation_prot=energia(42)
1282 ecationcation=energia(41)
1284 epepbase=energia(47)
1287 ! ecations_prot_amber=energia(50)
1289 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,&
1290 estr,wbond,ebe,wang,&
1291 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
1293 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
1294 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,&
1295 edihcnstr,ethetacnstr,ebr*nss,&
1296 Uconst,eliptran,wliptran,Eafmforce,etube,wtube, & ! till now protein
1297 estr_nucl,wbond_nucl,ebe_nucl,wang_nucl, &
1298 evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb,&
1299 evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl,&
1300 etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
1301 ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, &
1302 escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
1304 10 format (/'Virtual-chain energies:'// &
1305 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
1306 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
1307 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
1308 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ &
1309 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
1310 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
1311 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
1312 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
1313 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
1314 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
1315 ' (SS bridges & dist. cnstr.)'/ &
1316 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1317 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1318 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1319 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
1320 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
1321 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
1322 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
1323 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
1324 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
1325 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
1326 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
1327 'UCONST= ',1pE16.6,' (Constraint energy)'/ &
1328 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/&
1329 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
1330 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
1331 'ESTR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
1332 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
1333 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
1334 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
1335 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
1336 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
1337 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
1338 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
1339 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
1340 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
1341 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
1342 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
1343 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
1344 'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ &
1345 'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ &
1346 'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ &
1347 'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
1348 'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
1349 'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
1350 'ETOT= ',1pE16.6,' (total)')
1352 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,&
1353 estr,wbond,ebe,wang,&
1354 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
1356 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
1357 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,&
1358 ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforce, &
1360 estr_nucl,wbond_nucl, ebe_nucl,wang_nucl,&
1361 evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb,&
1362 evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl,&
1363 etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
1364 ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, &
1365 escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
1367 10 format (/'Virtual-chain energies:'// &
1368 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
1369 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
1370 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
1371 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
1372 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
1373 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
1374 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
1375 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
1376 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
1377 ' (SS bridges & dist. cnstr.)'/ &
1378 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1379 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1380 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1381 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
1382 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
1383 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
1384 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
1385 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
1386 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
1387 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
1388 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
1389 'UCONST=',1pE16.6,' (Constraint energy)'/ &
1390 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ &
1391 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
1392 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
1393 'ESTR_nucl= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
1394 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
1395 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
1396 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
1397 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
1398 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
1399 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
1400 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
1401 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
1402 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
1403 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
1404 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
1405 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
1406 'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ &
1407 'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ &
1408 'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ &
1409 'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
1410 'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
1411 'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
1412 'ETOT= ',1pE16.6,' (total)')
1415 end subroutine enerprint
1416 !-----------------------------------------------------------------------------
1417 subroutine elj(evdw)
1419 ! This subroutine calculates the interaction energy of nonbonded side chains
1420 ! assuming the LJ potential of interaction.
1422 ! implicit real*8 (a-h,o-z)
1423 ! include 'DIMENSIONS'
1424 real(kind=8),parameter :: accur=1.0d-10
1425 ! include 'COMMON.GEO'
1426 ! include 'COMMON.VAR'
1427 ! include 'COMMON.LOCAL'
1428 ! include 'COMMON.CHAIN'
1429 ! include 'COMMON.DERIV'
1430 ! include 'COMMON.INTERACT'
1431 ! include 'COMMON.TORSION'
1432 ! include 'COMMON.SBRIDGE'
1433 ! include 'COMMON.NAMES'
1434 ! include 'COMMON.IOUNITS'
1435 ! include 'COMMON.CONTACTS'
1436 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1437 integer :: num_conti
1439 integer :: i,itypi,iint,j,itypi1,itypj,k
1440 real(kind=8) :: rij,rcut,fcont,fprimcont,rrij
1441 real(kind=8) :: evdw,xi,yi,zi,xj,yj,zj
1442 real(kind=8) :: eps0ij,fac,e1,e2,evdwij,sigij,r0ij
1444 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1446 ! allocate(num_cont(iatsc_s:iatsc_e)) !(maxres) nnt,nct-2
1447 ! allocate(jcont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres) (maxconts=maxres/4)
1448 ! allocate(facont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres)
1449 ! allocate(gacont(3,nres/4,iatsc_s:iatsc_e)) !(3,maxconts,maxres)
1451 do i=iatsc_s,iatsc_e
1452 itypi=iabs(itype(i,1))
1453 if (itypi.eq.ntyp1) cycle
1454 itypi1=iabs(itype(i+1,1))
1461 ! Calculate SC interaction energy.
1463 do iint=1,nint_gr(i)
1464 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1465 !d & 'iend=',iend(i,iint)
1466 do j=istart(i,iint),iend(i,iint)
1467 itypj=iabs(itype(j,1))
1468 if (itypj.eq.ntyp1) cycle
1472 ! Change 12/1/95 to calculate four-body interactions
1473 rij=xj*xj+yj*yj+zj*zj
1475 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1476 eps0ij=eps(itypi,itypj)
1478 e1=fac*fac*aa_aq(itypi,itypj)
1479 e2=fac*bb_aq(itypi,itypj)
1481 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1482 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1483 !d write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1484 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1485 !d & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1486 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1489 ! Calculate the components of the gradient in DC and X
1491 fac=-rrij*(e1+evdwij)
1496 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1497 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1498 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1499 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1503 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1507 ! 12/1/95, revised on 5/20/97
1509 ! Calculate the contact function. The ith column of the array JCONT will
1510 ! contain the numbers of atoms that make contacts with the atom I (of numbers
1511 ! greater than I). The arrays FACONT and GACONT will contain the values of
1512 ! the contact function and its derivative.
1514 ! Uncomment next line, if the correlation interactions include EVDW explicitly.
1515 ! if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1516 ! Uncomment next line, if the correlation interactions are contact function only
1517 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1519 sigij=sigma(itypi,itypj)
1520 r0ij=rs0(itypi,itypj)
1522 ! Check whether the SC's are not too far to make a contact.
1525 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1526 ! Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1528 if (fcont.gt.0.0D0) then
1529 ! If the SC-SC distance if close to sigma, apply spline.
1530 !Adam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1531 !Adam & fcont1,fprimcont1)
1532 !Adam fcont1=1.0d0-fcont1
1533 !Adam if (fcont1.gt.0.0d0) then
1534 !Adam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1535 !Adam fcont=fcont*fcont1
1537 ! Uncomment following 4 lines to have the geometric average of the epsilon0's
1538 !ga eps0ij=1.0d0/dsqrt(eps0ij)
1540 !ga gg(k)=gg(k)*eps0ij
1542 !ga eps0ij=-evdwij*eps0ij
1543 ! Uncomment for AL's type of SC correlation interactions.
1544 !adam eps0ij=-evdwij
1545 num_conti=num_conti+1
1546 jcont(num_conti,i)=j
1547 facont(num_conti,i)=fcont*eps0ij
1548 fprimcont=eps0ij*fprimcont/rij
1550 !Adam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1551 !Adam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1552 !Adam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1553 ! Uncomment following 3 lines for Skolnick's type of SC correlation.
1554 gacont(1,num_conti,i)=-fprimcont*xj
1555 gacont(2,num_conti,i)=-fprimcont*yj
1556 gacont(3,num_conti,i)=-fprimcont*zj
1557 !d write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1558 !d write (iout,'(2i3,3f10.5)')
1559 !d & i,j,(gacont(kk,num_conti,i),kk=1,3)
1565 num_cont(i)=num_conti
1569 gvdwc(j,i)=expon*gvdwc(j,i)
1570 gvdwx(j,i)=expon*gvdwx(j,i)
1573 !******************************************************************************
1577 ! To save time, the factor of EXPON has been extracted from ALL components
1578 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
1581 !******************************************************************************
1584 !-----------------------------------------------------------------------------
1585 subroutine eljk(evdw)
1587 ! This subroutine calculates the interaction energy of nonbonded side chains
1588 ! assuming the LJK potential of interaction.
1590 ! implicit real*8 (a-h,o-z)
1591 ! include 'DIMENSIONS'
1592 ! include 'COMMON.GEO'
1593 ! include 'COMMON.VAR'
1594 ! include 'COMMON.LOCAL'
1595 ! include 'COMMON.CHAIN'
1596 ! include 'COMMON.DERIV'
1597 ! include 'COMMON.INTERACT'
1598 ! include 'COMMON.IOUNITS'
1599 ! include 'COMMON.NAMES'
1600 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1603 integer :: i,iint,j,itypi,itypi1,k,itypj
1604 real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij
1605 real(kind=8) :: evdw,rij,r_shift_inv,fac,e1,e2,evdwij
1607 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1609 do i=iatsc_s,iatsc_e
1610 itypi=iabs(itype(i,1))
1611 if (itypi.eq.ntyp1) cycle
1612 itypi1=iabs(itype(i+1,1))
1617 ! Calculate SC interaction energy.
1619 do iint=1,nint_gr(i)
1620 do j=istart(i,iint),iend(i,iint)
1621 itypj=iabs(itype(j,1))
1622 if (itypj.eq.ntyp1) cycle
1626 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1627 fac_augm=rrij**expon
1628 e_augm=augm(itypi,itypj)*fac_augm
1629 r_inv_ij=dsqrt(rrij)
1631 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1632 fac=r_shift_inv**expon
1633 e1=fac*fac*aa_aq(itypi,itypj)
1634 e2=fac*bb_aq(itypi,itypj)
1636 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1637 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1638 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1639 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1640 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1641 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1642 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1645 ! Calculate the components of the gradient in DC and X
1647 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1652 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1653 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1654 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1655 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1659 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1667 gvdwc(j,i)=expon*gvdwc(j,i)
1668 gvdwx(j,i)=expon*gvdwx(j,i)
1673 !-----------------------------------------------------------------------------
1674 subroutine ebp(evdw)
1676 ! This subroutine calculates the interaction energy of nonbonded side chains
1677 ! assuming the Berne-Pechukas potential of interaction.
1681 ! implicit real*8 (a-h,o-z)
1682 ! include 'DIMENSIONS'
1683 ! include 'COMMON.GEO'
1684 ! include 'COMMON.VAR'
1685 ! include 'COMMON.LOCAL'
1686 ! include 'COMMON.CHAIN'
1687 ! include 'COMMON.DERIV'
1688 ! include 'COMMON.NAMES'
1689 ! include 'COMMON.INTERACT'
1690 ! include 'COMMON.IOUNITS'
1691 ! include 'COMMON.CALC'
1693 !el integer :: icall
1694 !el common /srutu/ icall
1695 ! double precision rrsave(maxdim)
1698 integer :: iint,itypi,itypi1,itypj
1699 real(kind=8) :: rrij,xi,yi,zi
1700 real(kind=8) :: evdw,fac,e1,e2,sigm,epsi
1702 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1704 ! if (icall.eq.0) then
1710 do i=iatsc_s,iatsc_e
1711 itypi=iabs(itype(i,1))
1712 if (itypi.eq.ntyp1) cycle
1713 itypi1=iabs(itype(i+1,1))
1717 dxi=dc_norm(1,nres+i)
1718 dyi=dc_norm(2,nres+i)
1719 dzi=dc_norm(3,nres+i)
1720 ! dsci_inv=dsc_inv(itypi)
1721 dsci_inv=vbld_inv(i+nres)
1723 ! Calculate SC interaction energy.
1725 do iint=1,nint_gr(i)
1726 do j=istart(i,iint),iend(i,iint)
1728 itypj=iabs(itype(j,1))
1729 if (itypj.eq.ntyp1) cycle
1730 ! dscj_inv=dsc_inv(itypj)
1731 dscj_inv=vbld_inv(j+nres)
1732 chi1=chi(itypi,itypj)
1733 chi2=chi(itypj,itypi)
1740 alf12=0.5D0*(alf1+alf2)
1741 ! For diagnostics only!!!
1754 dxj=dc_norm(1,nres+j)
1755 dyj=dc_norm(2,nres+j)
1756 dzj=dc_norm(3,nres+j)
1757 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1758 !d if (icall.eq.0) then
1764 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
1766 ! Calculate whole angle-dependent part of epsilon and contributions
1767 ! to its derivatives
1768 fac=(rrij*sigsq)**expon2
1769 e1=fac*fac*aa_aq(itypi,itypj)
1770 e2=fac*bb_aq(itypi,itypj)
1771 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1772 eps2der=evdwij*eps3rt
1773 eps3der=evdwij*eps2rt
1774 evdwij=evdwij*eps2rt*eps3rt
1777 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1778 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1779 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1780 !d & restyp(itypi,1),i,restyp(itypj,1),j,
1781 !d & epsi,sigm,chi1,chi2,chip1,chip2,
1782 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1783 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
1786 ! Calculate gradient components.
1787 e1=e1*eps1*eps2rt**2*eps3rt**2
1788 fac=-expon*(e1+evdwij)
1791 ! Calculate radial part of the gradient
1795 ! Calculate the angular part of the gradient and sum add the contributions
1796 ! to the appropriate components of the Cartesian gradient.
1804 !-----------------------------------------------------------------------------
1805 subroutine egb(evdw)
1807 ! This subroutine calculates the interaction energy of nonbonded side chains
1808 ! assuming the Gay-Berne potential of interaction.
1811 ! implicit real*8 (a-h,o-z)
1812 ! include 'DIMENSIONS'
1813 ! include 'COMMON.GEO'
1814 ! include 'COMMON.VAR'
1815 ! include 'COMMON.LOCAL'
1816 ! include 'COMMON.CHAIN'
1817 ! include 'COMMON.DERIV'
1818 ! include 'COMMON.NAMES'
1819 ! include 'COMMON.INTERACT'
1820 ! include 'COMMON.IOUNITS'
1821 ! include 'COMMON.CALC'
1822 ! include 'COMMON.CONTROL'
1823 ! include 'COMMON.SBRIDGE'
1826 integer :: iint,itypi,itypi1,itypj,subchap
1827 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
1828 real(kind=8) :: evdw,sig0ij
1829 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
1830 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
1831 sslipi,sslipj,faclip
1833 real(kind=8) :: fracinbuf
1835 !cccc energy_dec=.false.
1836 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1839 ! if (icall.eq.0) lprn=.false.
1849 do i=iatsc_s,iatsc_e
1850 !C print *,"I am in EVDW",i
1851 itypi=iabs(itype(i,1))
1852 ! if (i.ne.47) cycle
1853 if (itypi.eq.ntyp1) cycle
1854 itypi1=iabs(itype(i+1,1))
1858 xi=dmod(xi,boxxsize)
1859 if (xi.lt.0) xi=xi+boxxsize
1860 yi=dmod(yi,boxysize)
1861 if (yi.lt.0) yi=yi+boxysize
1862 zi=dmod(zi,boxzsize)
1863 if (zi.lt.0) zi=zi+boxzsize
1865 if ((zi.gt.bordlipbot) &
1866 .and.(zi.lt.bordliptop)) then
1867 !C the energy transfer exist
1868 if (zi.lt.buflipbot) then
1869 !C what fraction I am in
1871 ((zi-bordlipbot)/lipbufthick)
1872 !C lipbufthick is thickenes of lipid buffore
1873 sslipi=sscalelip(fracinbuf)
1874 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1875 elseif (zi.gt.bufliptop) then
1876 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1877 sslipi=sscalelip(fracinbuf)
1878 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1887 ! print *, sslipi,ssgradlipi
1888 dxi=dc_norm(1,nres+i)
1889 dyi=dc_norm(2,nres+i)
1890 dzi=dc_norm(3,nres+i)
1891 ! dsci_inv=dsc_inv(itypi)
1892 dsci_inv=vbld_inv(i+nres)
1893 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1894 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1896 ! Calculate SC interaction energy.
1898 do iint=1,nint_gr(i)
1899 do j=istart(i,iint),iend(i,iint)
1900 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1901 call dyn_ssbond_ene(i,j,evdwij)
1903 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1904 'evdw',i,j,evdwij,' ss'
1905 ! if (energy_dec) write (iout,*) &
1906 ! 'evdw',i,j,evdwij,' ss'
1907 do k=j+1,iend(i,iint)
1908 !C search over all next residues
1909 if (dyn_ss_mask(k)) then
1910 !C check if they are cysteins
1911 !C write(iout,*) 'k=',k
1913 !c write(iout,*) "PRZED TRI", evdwij
1914 ! evdwij_przed_tri=evdwij
1915 call triple_ssbond_ene(i,j,k,evdwij)
1916 !c if(evdwij_przed_tri.ne.evdwij) then
1917 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1920 !c write(iout,*) "PO TRI", evdwij
1921 !C call the energy function that removes the artifical triple disulfide
1922 !C bond the soubroutine is located in ssMD.F
1924 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1925 'evdw',i,j,evdwij,'tss'
1926 endif!dyn_ss_mask(k)
1930 itypj=iabs(itype(j,1))
1931 if (itypj.eq.ntyp1) cycle
1932 ! if (j.ne.78) cycle
1933 ! dscj_inv=dsc_inv(itypj)
1934 dscj_inv=vbld_inv(j+nres)
1935 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,&
1936 ! 1.0d0/vbld(j+nres) !d
1937 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
1938 sig0ij=sigma(itypi,itypj)
1939 chi1=chi(itypi,itypj)
1940 chi2=chi(itypj,itypi)
1947 alf12=0.5D0*(alf1+alf2)
1948 ! For diagnostics only!!!
1961 xj=dmod(xj,boxxsize)
1962 if (xj.lt.0) xj=xj+boxxsize
1963 yj=dmod(yj,boxysize)
1964 if (yj.lt.0) yj=yj+boxysize
1965 zj=dmod(zj,boxzsize)
1966 if (zj.lt.0) zj=zj+boxzsize
1967 ! print *,"tu",xi,yi,zi,xj,yj,zj
1968 ! print *,"tu2",j,j+nres,c(1,j),c(1,j+nres)
1969 ! this fragment set correct epsilon for lipid phase
1970 if ((zj.gt.bordlipbot) &
1971 .and.(zj.lt.bordliptop)) then
1972 !C the energy transfer exist
1973 if (zj.lt.buflipbot) then
1974 !C what fraction I am in
1976 ((zj-bordlipbot)/lipbufthick)
1977 !C lipbufthick is thickenes of lipid buffore
1978 sslipj=sscalelip(fracinbuf)
1979 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1980 elseif (zj.gt.bufliptop) then
1981 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1982 sslipj=sscalelip(fracinbuf)
1983 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1992 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1993 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1994 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1995 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1996 !------------------------------------------------
1997 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2005 xj=xj_safe+xshift*boxxsize
2006 yj=yj_safe+yshift*boxysize
2007 zj=zj_safe+zshift*boxzsize
2008 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2009 if(dist_temp.lt.dist_init) then
2019 if (subchap.eq.1) then
2028 dxj=dc_norm(1,nres+j)
2029 dyj=dc_norm(2,nres+j)
2030 dzj=dc_norm(3,nres+j)
2031 ! write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
2032 ! write (iout,*) "j",j," dc_norm",& !d
2033 ! dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
2034 ! write(iout,*)"rrij ",rrij
2035 ! write(iout,*)"xj yj zj ", xj, yj, zj
2036 ! write(iout,*)"xi yi zi ", xi, yi, zi
2037 ! write(iout,*)"c ", c(1,:), c(2,:), c(3,:)
2038 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2040 sss_ele_cut=sscale_ele(1.0d0/(rij))
2041 sss_ele_grad=sscagrad_ele(1.0d0/(rij))
2042 ! print *,sss_ele_cut,sss_ele_grad,&
2043 ! 1.0d0/(rij),r_cut_ele,rlamb_ele
2044 if (sss_ele_cut.le.0.0) cycle
2045 ! Calculate angle-dependent terms of energy and contributions to their
2049 sig=sig0ij*dsqrt(sigsq)
2050 rij_shift=1.0D0/rij-sig+sig0ij
2051 ! write(iout,*)" rij_shift",rij_shift," rij",rij," sig",sig,&
2053 ! for diagnostics; uncomment
2054 ! rij_shift=1.2*sig0ij
2055 ! I hate to put IF's in the loops, but here don't have another choice!!!!
2056 if (rij_shift.le.0.0D0) then
2058 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2059 !d & restyp(itypi,1),i,restyp(itypj,1),j,
2060 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
2064 !---------------------------------------------------------------
2065 rij_shift=1.0D0/rij_shift
2066 fac=rij_shift**expon
2068 e1=fac*fac*aa!(itypi,itypj)
2069 e2=fac*bb!(itypi,itypj)
2070 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2071 eps2der=evdwij*eps3rt
2072 eps3der=evdwij*eps2rt
2073 ! write(iout,*)"aa, bb ",aa(:,:),bb(:,:)
2074 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,& !d
2075 ! " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2," fac",fac !d
2076 evdwij=evdwij*eps2rt*eps3rt
2077 evdw=evdw+evdwij*sss_ele_cut
2079 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2080 epsi=bb**2/aa!(itypi,itypj)
2081 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
2082 restyp(itypi,1),i,restyp(itypj,1),j, &
2083 epsi,sigm,chi1,chi2,chip1,chip2, &
2084 eps1,eps2rt**2,eps3rt**2,sig,sig0ij, &
2085 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, &
2089 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2e10.2,e11.3)')&
2090 'evdw',i,j,evdwij,xi,xj,rij !,"egb"
2091 !C print *,i,j,c(1,i),c(1,j),c(2,i),c(2,j),c(3,i),c(3,j)
2092 ! if (energy_dec) write (iout,*) &
2094 ! print *,"ZALAMKA", evdw
2096 ! Calculate gradient components.
2097 e1=e1*eps1*eps2rt**2*eps3rt**2
2098 fac=-expon*(e1+evdwij)*rij_shift
2101 ! print *,'before fac',fac,rij,evdwij
2102 fac=fac+evdwij*sss_ele_grad/sss_ele_cut&
2104 ! print *,'grad part scale',fac, &
2105 ! evdwij*sss_ele_grad/sss_ele_cut &
2106 ! /sigma(itypi,itypj)*rij
2108 ! Calculate the radial part of the gradient
2112 !C Calculate the radial part of the gradient
2113 gg_lipi(3)=eps1*(eps2rt*eps2rt)&
2114 *(eps3rt*eps3rt)*sss_ele_cut/2.0d0*(faclip*faclip*&
2115 (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))&
2116 +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
2117 gg_lipj(3)=ssgradlipj*gg_lipi(3)
2118 gg_lipi(3)=gg_lipi(3)*ssgradlipi
2120 ! print *,'before sc_grad', gg(1),gg(2),gg(3)
2121 ! Calculate angular part of the gradient.
2127 ! print *,"ZALAMKA", evdw
2128 ! write (iout,*) "Number of loop steps in EGB:",ind
2129 !ccc energy_dec=.false.
2132 !-----------------------------------------------------------------------------
2133 subroutine egbv(evdw)
2135 ! This subroutine calculates the interaction energy of nonbonded side chains
2136 ! assuming the Gay-Berne-Vorobjev potential of interaction.
2140 ! implicit real*8 (a-h,o-z)
2141 ! include 'DIMENSIONS'
2142 ! include 'COMMON.GEO'
2143 ! include 'COMMON.VAR'
2144 ! include 'COMMON.LOCAL'
2145 ! include 'COMMON.CHAIN'
2146 ! include 'COMMON.DERIV'
2147 ! include 'COMMON.NAMES'
2148 ! include 'COMMON.INTERACT'
2149 ! include 'COMMON.IOUNITS'
2150 ! include 'COMMON.CALC'
2152 !el integer :: icall
2153 !el common /srutu/ icall
2156 integer :: iint,itypi,itypi1,itypj
2157 real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2,sigm
2158 real(kind=8) :: evdw,sig0ij,sig,rij_shift,epsi
2160 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
2163 ! if (icall.eq.0) lprn=.true.
2165 do i=iatsc_s,iatsc_e
2166 itypi=iabs(itype(i,1))
2167 if (itypi.eq.ntyp1) cycle
2168 itypi1=iabs(itype(i+1,1))
2172 dxi=dc_norm(1,nres+i)
2173 dyi=dc_norm(2,nres+i)
2174 dzi=dc_norm(3,nres+i)
2175 ! dsci_inv=dsc_inv(itypi)
2176 dsci_inv=vbld_inv(i+nres)
2178 ! Calculate SC interaction energy.
2180 do iint=1,nint_gr(i)
2181 do j=istart(i,iint),iend(i,iint)
2183 itypj=iabs(itype(j,1))
2184 if (itypj.eq.ntyp1) cycle
2185 ! dscj_inv=dsc_inv(itypj)
2186 dscj_inv=vbld_inv(j+nres)
2187 sig0ij=sigma(itypi,itypj)
2188 r0ij=r0(itypi,itypj)
2189 chi1=chi(itypi,itypj)
2190 chi2=chi(itypj,itypi)
2197 alf12=0.5D0*(alf1+alf2)
2198 ! For diagnostics only!!!
2211 dxj=dc_norm(1,nres+j)
2212 dyj=dc_norm(2,nres+j)
2213 dzj=dc_norm(3,nres+j)
2214 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2216 ! Calculate angle-dependent terms of energy and contributions to their
2220 sig=sig0ij*dsqrt(sigsq)
2221 rij_shift=1.0D0/rij-sig+r0ij
2222 ! I hate to put IF's in the loops, but here don't have another choice!!!!
2223 if (rij_shift.le.0.0D0) then
2228 !---------------------------------------------------------------
2229 rij_shift=1.0D0/rij_shift
2230 fac=rij_shift**expon
2231 e1=fac*fac*aa_aq(itypi,itypj)
2232 e2=fac*bb_aq(itypi,itypj)
2233 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2234 eps2der=evdwij*eps3rt
2235 eps3der=evdwij*eps2rt
2236 fac_augm=rrij**expon
2237 e_augm=augm(itypi,itypj)*fac_augm
2238 evdwij=evdwij*eps2rt*eps3rt
2239 evdw=evdw+evdwij+e_augm
2241 sigm=dabs(aa_aq(itypi,itypj)/&
2242 bb_aq(itypi,itypj))**(1.0D0/6.0D0)
2243 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
2244 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
2245 restyp(itypi,1),i,restyp(itypj,1),j,&
2246 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
2247 chi1,chi2,chip1,chip2,&
2248 eps1,eps2rt**2,eps3rt**2,&
2249 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
2252 ! Calculate gradient components.
2253 e1=e1*eps1*eps2rt**2*eps3rt**2
2254 fac=-expon*(e1+evdwij)*rij_shift
2256 fac=rij*fac-2*expon*rrij*e_augm
2257 ! Calculate the radial part of the gradient
2261 ! Calculate angular part of the gradient.
2267 !-----------------------------------------------------------------------------
2268 !el subroutine sc_angular in module geometry
2269 !-----------------------------------------------------------------------------
2270 subroutine e_softsphere(evdw)
2272 ! This subroutine calculates the interaction energy of nonbonded side chains
2273 ! assuming the LJ potential of interaction.
2275 ! implicit real*8 (a-h,o-z)
2276 ! include 'DIMENSIONS'
2277 real(kind=8),parameter :: accur=1.0d-10
2278 ! include 'COMMON.GEO'
2279 ! include 'COMMON.VAR'
2280 ! include 'COMMON.LOCAL'
2281 ! include 'COMMON.CHAIN'
2282 ! include 'COMMON.DERIV'
2283 ! include 'COMMON.INTERACT'
2284 ! include 'COMMON.TORSION'
2285 ! include 'COMMON.SBRIDGE'
2286 ! include 'COMMON.NAMES'
2287 ! include 'COMMON.IOUNITS'
2288 ! include 'COMMON.CONTACTS'
2289 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
2290 !d print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2292 integer :: i,iint,j,itypi,itypi1,itypj,k
2293 real(kind=8) :: evdw,xj,yj,zj,xi,yi,zi,rij,r0ij,r0ijsq,evdwij
2297 do i=iatsc_s,iatsc_e
2298 itypi=iabs(itype(i,1))
2299 if (itypi.eq.ntyp1) cycle
2300 itypi1=iabs(itype(i+1,1))
2305 ! Calculate SC interaction energy.
2307 do iint=1,nint_gr(i)
2308 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2309 !d & 'iend=',iend(i,iint)
2310 do j=istart(i,iint),iend(i,iint)
2311 itypj=iabs(itype(j,1))
2312 if (itypj.eq.ntyp1) cycle
2316 rij=xj*xj+yj*yj+zj*zj
2317 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2318 r0ij=r0(itypi,itypj)
2320 ! print *,i,j,r0ij,dsqrt(rij)
2321 if (rij.lt.r0ijsq) then
2322 evdwij=0.25d0*(rij-r0ijsq)**2
2330 ! Calculate the components of the gradient in DC and X
2336 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2337 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2338 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2339 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2343 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2350 end subroutine e_softsphere
2351 !-----------------------------------------------------------------------------
2352 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2354 ! Soft-sphere potential of p-p interaction
2356 ! implicit real*8 (a-h,o-z)
2357 ! include 'DIMENSIONS'
2358 ! include 'COMMON.CONTROL'
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),dimension(3) :: ggg
2371 !d write(iout,*) 'In EELEC_soft_sphere'
2373 integer :: i,j,k,num_conti,iteli,itelj
2374 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
2375 real(kind=8) :: dxi,dyi,dzi,xmedi,ymedi,zmedi,r0ij,r0ijsq
2376 real(kind=8) :: dxj,dyj,dzj,xj,yj,zj,rij,evdw1ij,fac
2384 do i=iatel_s,iatel_e
2385 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
2389 xmedi=c(1,i)+0.5d0*dxi
2390 ymedi=c(2,i)+0.5d0*dyi
2391 zmedi=c(3,i)+0.5d0*dzi
2393 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2394 do j=ielstart(i),ielend(i)
2395 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
2399 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2400 r0ij=rpp(iteli,itelj)
2405 xj=c(1,j)+0.5D0*dxj-xmedi
2406 yj=c(2,j)+0.5D0*dyj-ymedi
2407 zj=c(3,j)+0.5D0*dzj-zmedi
2408 rij=xj*xj+yj*yj+zj*zj
2409 if (rij.lt.r0ijsq) then
2410 evdw1ij=0.25d0*(rij-r0ijsq)**2
2418 ! Calculate contributions to the Cartesian gradient.
2424 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2425 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2428 ! Loop over residues i+1 thru j-1.
2432 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2437 !grad do i=nnt,nct-1
2439 !grad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2441 !grad do j=i+1,nct-1
2443 !grad gelc(k,i)=gelc(k,i)+gelc(k,j)
2448 end subroutine eelec_soft_sphere
2449 !-----------------------------------------------------------------------------
2450 subroutine vec_and_deriv
2451 ! implicit real*8 (a-h,o-z)
2452 ! include 'DIMENSIONS'
2456 ! include 'COMMON.IOUNITS'
2457 ! include 'COMMON.GEO'
2458 ! include 'COMMON.VAR'
2459 ! include 'COMMON.LOCAL'
2460 ! include 'COMMON.CHAIN'
2461 ! include 'COMMON.VECTORS'
2462 ! include 'COMMON.SETUP'
2463 ! include 'COMMON.TIME1'
2464 real(kind=8),dimension(3,3,2) :: uyder,uzder
2465 real(kind=8),dimension(2) :: vbld_inv_temp
2466 ! Compute the local reference systems. For reference system (i), the
2467 ! X-axis points from CA(i) to CA(i+1), the Y axis is in the
2468 ! CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2471 real(kind=8) :: facy,fac,costh
2474 do i=ivec_start,ivec_end
2478 if (i.eq.nres-1) then
2479 ! Case of the last full residue
2480 ! Compute the Z-axis
2481 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2482 costh=dcos(pi-theta(nres))
2483 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2487 ! Compute the derivatives of uz
2489 uzder(2,1,1)=-dc_norm(3,i-1)
2490 uzder(3,1,1)= dc_norm(2,i-1)
2491 uzder(1,2,1)= dc_norm(3,i-1)
2493 uzder(3,2,1)=-dc_norm(1,i-1)
2494 uzder(1,3,1)=-dc_norm(2,i-1)
2495 uzder(2,3,1)= dc_norm(1,i-1)
2498 uzder(2,1,2)= dc_norm(3,i)
2499 uzder(3,1,2)=-dc_norm(2,i)
2500 uzder(1,2,2)=-dc_norm(3,i)
2502 uzder(3,2,2)= dc_norm(1,i)
2503 uzder(1,3,2)= dc_norm(2,i)
2504 uzder(2,3,2)=-dc_norm(1,i)
2506 ! Compute the Y-axis
2509 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2511 ! Compute the derivatives of uy
2514 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) &
2515 -dc_norm(k,i)*dc_norm(j,i-1)
2516 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2518 uyder(j,j,1)=uyder(j,j,1)-costh
2519 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2524 uygrad(l,k,j,i)=uyder(l,k,j)
2525 uzgrad(l,k,j,i)=uzder(l,k,j)
2529 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2530 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2531 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2532 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2535 ! Compute the Z-axis
2536 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2537 costh=dcos(pi-theta(i+2))
2538 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2542 ! Compute the derivatives of uz
2544 uzder(2,1,1)=-dc_norm(3,i+1)
2545 uzder(3,1,1)= dc_norm(2,i+1)
2546 uzder(1,2,1)= dc_norm(3,i+1)
2548 uzder(3,2,1)=-dc_norm(1,i+1)
2549 uzder(1,3,1)=-dc_norm(2,i+1)
2550 uzder(2,3,1)= dc_norm(1,i+1)
2553 uzder(2,1,2)= dc_norm(3,i)
2554 uzder(3,1,2)=-dc_norm(2,i)
2555 uzder(1,2,2)=-dc_norm(3,i)
2557 uzder(3,2,2)= dc_norm(1,i)
2558 uzder(1,3,2)= dc_norm(2,i)
2559 uzder(2,3,2)=-dc_norm(1,i)
2561 ! Compute the Y-axis
2564 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2566 ! Compute the derivatives of uy
2569 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) &
2570 -dc_norm(k,i)*dc_norm(j,i+1)
2571 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2573 uyder(j,j,1)=uyder(j,j,1)-costh
2574 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2579 uygrad(l,k,j,i)=uyder(l,k,j)
2580 uzgrad(l,k,j,i)=uzder(l,k,j)
2584 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2585 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2586 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2587 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2591 vbld_inv_temp(1)=vbld_inv(i+1)
2592 if (i.lt.nres-1) then
2593 vbld_inv_temp(2)=vbld_inv(i+2)
2595 vbld_inv_temp(2)=vbld_inv(i)
2600 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2601 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2606 #if defined(PARVEC) && defined(MPI)
2607 if (nfgtasks1.gt.1) then
2609 ! print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2610 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2611 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2612 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),&
2613 MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2615 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),&
2616 MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2618 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),&
2619 ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),&
2620 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2621 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),&
2622 ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),&
2623 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2624 time_gather=time_gather+MPI_Wtime()-time00
2626 ! if (fg_rank.eq.0) then
2627 ! write (iout,*) "Arrays UY and UZ"
2629 ! write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2635 end subroutine vec_and_deriv
2636 !-----------------------------------------------------------------------------
2637 subroutine check_vecgrad
2638 ! implicit real*8 (a-h,o-z)
2639 ! include 'DIMENSIONS'
2640 ! include 'COMMON.IOUNITS'
2641 ! include 'COMMON.GEO'
2642 ! include 'COMMON.VAR'
2643 ! include 'COMMON.LOCAL'
2644 ! include 'COMMON.CHAIN'
2645 ! include 'COMMON.VECTORS'
2646 real(kind=8),dimension(3,3,2,nres) :: uygradt,uzgradt !(3,3,2,maxres)
2647 real(kind=8),dimension(3,nres) :: uyt,uzt !(3,maxres)
2648 real(kind=8),dimension(3,3,2) :: uygradn,uzgradn
2649 real(kind=8),dimension(3) :: erij
2650 real(kind=8) :: delta=1.0d-7
2656 !rc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2657 !rc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2658 !rc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2659 !d write(iout,'(2i5,2(3f10.5,5x))') i,1,
2660 !d & (dc_norm(if90,i),if90=1,3)
2661 !d write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2662 !d write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2663 !d write(iout,'(a)')
2669 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2670 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2683 !d write (iout,*) 'i=',i
2685 erij(k)=dc_norm(k,i)
2689 dc_norm(k,i)=erij(k)
2691 dc_norm(j,i)=dc_norm(j,i)+delta
2692 ! fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2694 ! dc_norm(k,i)=dc_norm(k,i)/fac
2696 ! write (iout,*) (dc_norm(k,i),k=1,3)
2697 ! write (iout,*) (erij(k),k=1,3)
2700 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2701 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2702 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2703 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2705 ! write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2706 ! & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2707 ! & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2710 dc_norm(k,i)=erij(k)
2713 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2714 !d & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2715 !d & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2716 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2717 !d & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2718 !d & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2719 !d write (iout,'(a)')
2723 end subroutine check_vecgrad
2724 !-----------------------------------------------------------------------------
2725 subroutine set_matrices
2726 ! implicit real*8 (a-h,o-z)
2727 ! include 'DIMENSIONS'
2730 ! include "COMMON.SETUP"
2732 integer :: status(MPI_STATUS_SIZE)
2734 ! include 'COMMON.IOUNITS'
2735 ! include 'COMMON.GEO'
2736 ! include 'COMMON.VAR'
2737 ! include 'COMMON.LOCAL'
2738 ! include 'COMMON.CHAIN'
2739 ! include 'COMMON.DERIV'
2740 ! include 'COMMON.INTERACT'
2741 ! include 'COMMON.CONTACTS'
2742 ! include 'COMMON.TORSION'
2743 ! include 'COMMON.VECTORS'
2744 ! include 'COMMON.FFIELD'
2745 real(kind=8) :: auxvec(2),auxmat(2,2)
2746 integer :: i,iti1,iti,k,l
2747 real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2,cost1,sint1,&
2748 sint1sq,sint1cub,sint1cost1,b1k,b2k,aux
2749 ! print *,"in set matrices"
2751 ! Compute the virtual-bond-torsional-angle dependent quantities needed
2752 ! to calculate the el-loc multibody terms of various order.
2757 do i=ivec_start+2,ivec_end+2
2761 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2762 if (itype(i-2,1).eq.0) then
2765 iti = itype2loc(itype(i-2,1))
2770 !c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2771 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2772 iti1 = itype2loc(itype(i-1,1))
2776 ! print *,i,itype(i-2,1),iti
2778 cost1=dcos(theta(i-1))
2779 sint1=dsin(theta(i-1))
2781 sint1cub=sint1sq*sint1
2782 sint1cost1=2*sint1*cost1
2783 ! print *,"cost1",cost1,theta(i-1)
2784 !c write (iout,*) "bnew1",i,iti
2785 !c write (iout,*) (bnew1(k,1,iti),k=1,3)
2786 !c write (iout,*) (bnew1(k,2,iti),k=1,3)
2787 !c write (iout,*) "bnew2",i,iti
2788 !c write (iout,*) (bnew2(k,1,iti),k=1,3)
2789 !c write (iout,*) (bnew2(k,2,iti),k=1,3)
2791 ! print *,bnew1(1,k,iti),"bnew1"
2793 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
2795 ! write(*,*) shape(b1)
2796 ! if(.not.allocated(b1)) print *, "WTF?"
2801 gtb1(k,i-2)=cost1*b1k-sint1sq*&
2802 (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
2803 ! print *,gtb1(k,i-2)
2805 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
2809 gtb2(k,i-2)=cost1*b2k-sint1sq*&
2810 (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
2811 ! print *,gtb2(k,i-2)
2816 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
2817 cc(1,k,i-2)=sint1sq*aux
2818 gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*&
2819 (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
2820 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
2821 dd(1,k,i-2)=sint1sq*aux
2822 gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*&
2823 (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
2825 ! print *,"after cc"
2826 cc(2,1,i-2)=cc(1,2,i-2)
2827 cc(2,2,i-2)=-cc(1,1,i-2)
2828 gtcc(2,1,i-2)=gtcc(1,2,i-2)
2829 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
2830 dd(2,1,i-2)=dd(1,2,i-2)
2831 dd(2,2,i-2)=-dd(1,1,i-2)
2832 gtdd(2,1,i-2)=gtdd(1,2,i-2)
2833 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
2834 ! print *,"after dd"
2838 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
2839 EE(l,k,i-2)=sint1sq*aux
2840 gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
2843 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
2844 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
2845 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
2846 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
2847 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
2848 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
2849 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
2850 ! print *,"after ee"
2852 !c b1tilde(1,i-2)=b1(1,i-2)
2853 !c b1tilde(2,i-2)=-b1(2,i-2)
2854 !c b2tilde(1,i-2)=b2(1,i-2)
2855 !c b2tilde(2,i-2)=-b2(2,i-2)
2857 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2858 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
2859 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
2860 write (iout,*) 'theta=', theta(i-1)
2863 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2864 ! write(iout,*) "i,",molnum(i)
2865 ! print *, "i,",molnum(i),i,itype(i-2,1)
2866 if (molnum(i).eq.1) then
2867 iti = itype2loc(itype(i-2,1))
2874 !c write (iout,*) "i",i-1," itype",itype(i-2)," iti",iti
2875 !c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2876 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2877 iti1 = itype2loc(itype(i-1,1))
2888 CC(k,l,i-2)=ccold(k,l,iti)
2889 DD(k,l,i-2)=ddold(k,l,iti)
2890 EE(k,l,i-2)=eeold(k,l,iti)
2894 b1tilde(1,i-2)= b1(1,i-2)
2895 b1tilde(2,i-2)=-b1(2,i-2)
2896 b2tilde(1,i-2)= b2(1,i-2)
2897 b2tilde(2,i-2)=-b2(2,i-2)
2899 Ctilde(1,1,i-2)= CC(1,1,i-2)
2900 Ctilde(1,2,i-2)= CC(1,2,i-2)
2901 Ctilde(2,1,i-2)=-CC(2,1,i-2)
2902 Ctilde(2,2,i-2)=-CC(2,2,i-2)
2904 Dtilde(1,1,i-2)= DD(1,1,i-2)
2905 Dtilde(1,2,i-2)= DD(1,2,i-2)
2906 Dtilde(2,1,i-2)=-DD(2,1,i-2)
2907 Dtilde(2,2,i-2)=-DD(2,2,i-2)
2910 do i=ivec_start+2,ivec_end+2
2916 if (i .lt. nres+1) then
2953 if (i .gt. 3 .and. i .lt. nres+1) then
2954 obrot_der(1,i-2)=-sin1
2955 obrot_der(2,i-2)= cos1
2956 Ugder(1,1,i-2)= sin1
2957 Ugder(1,2,i-2)=-cos1
2958 Ugder(2,1,i-2)=-cos1
2959 Ugder(2,2,i-2)=-sin1
2962 obrot2_der(1,i-2)=-dwasin2
2963 obrot2_der(2,i-2)= dwacos2
2964 Ug2der(1,1,i-2)= dwasin2
2965 Ug2der(1,2,i-2)=-dwacos2
2966 Ug2der(2,1,i-2)=-dwacos2
2967 Ug2der(2,2,i-2)=-dwasin2
2969 obrot_der(1,i-2)=0.0d0
2970 obrot_der(2,i-2)=0.0d0
2971 Ugder(1,1,i-2)=0.0d0
2972 Ugder(1,2,i-2)=0.0d0
2973 Ugder(2,1,i-2)=0.0d0
2974 Ugder(2,2,i-2)=0.0d0
2975 obrot2_der(1,i-2)=0.0d0
2976 obrot2_der(2,i-2)=0.0d0
2977 Ug2der(1,1,i-2)=0.0d0
2978 Ug2der(1,2,i-2)=0.0d0
2979 Ug2der(2,1,i-2)=0.0d0
2980 Ug2der(2,2,i-2)=0.0d0
2982 ! if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2983 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2984 if (itype(i-2,1).eq.0) then
2987 iti = itype2loc(itype(i-2,1))
2992 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2993 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2994 if (itype(i-1,1).eq.0) then
2997 iti1 = itype2loc(itype(i-1,1))
3002 ! print *,iti,i,"iti",iti1,itype(i-1,1),itype(i-2,1)
3003 !d write (iout,*) '*******i',i,' iti1',iti
3004 ! write (iout,*) 'b1',b1(:,iti)
3005 ! write (iout,*) 'b2',b2(:,i-2)
3006 !d write (iout,*) 'Ug',Ug(:,:,i-2)
3007 ! if (i .gt. iatel_s+2) then
3008 if (i .gt. nnt+2) then
3009 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
3011 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
3012 !c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
3015 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
3016 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
3017 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
3019 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
3020 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
3021 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
3022 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
3023 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
3034 DtUg2(l,k,i-2)=0.0d0
3038 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
3039 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
3041 muder(k,i-2)=Ub2der(k,i-2)
3043 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3044 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3045 if (itype(i-1,1).eq.0) then
3047 elseif (itype(i-1,1).le.ntyp) then
3048 iti1 = itype2loc(itype(i-1,1))
3056 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
3058 if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2)
3059 if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,i-1)
3060 if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2)
3061 !d write (iout,*) 'mu1',mu1(:,i-2)
3062 !d write (iout,*) 'mu2',mu2(:,i-2)
3063 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
3065 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
3066 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
3067 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
3068 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
3069 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
3070 ! Vectors and matrices dependent on a single virtual-bond dihedral.
3071 call matvec2(DD(1,1,i-2),b1tilde(1,i-1),auxvec(1))
3072 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
3073 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
3074 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
3075 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
3076 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
3077 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
3078 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
3079 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
3082 ! Matrices dependent on two consecutive virtual-bond dihedrals.
3083 ! The order of matrices is from left to right.
3084 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
3086 ! do i=max0(ivec_start,2),ivec_end
3088 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
3089 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
3090 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
3091 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
3092 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
3093 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
3094 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
3095 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
3098 #if defined(MPI) && defined(PARMAT)
3100 ! if (fg_rank.eq.0) then
3101 write (iout,*) "Arrays UG and UGDER before GATHER"
3103 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3104 ((ug(l,k,i),l=1,2),k=1,2),&
3105 ((ugder(l,k,i),l=1,2),k=1,2)
3107 write (iout,*) "Arrays UG2 and UG2DER"
3109 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3110 ((ug2(l,k,i),l=1,2),k=1,2),&
3111 ((ug2der(l,k,i),l=1,2),k=1,2)
3113 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3115 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3116 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
3117 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3119 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3121 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3122 costab(i),sintab(i),costab2(i),sintab2(i)
3124 write (iout,*) "Array MUDER"
3126 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3130 if (nfgtasks.gt.1) then
3132 ! write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
3133 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
3134 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
3136 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),&
3137 MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3139 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),&
3140 MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3142 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),&
3143 MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3145 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),&
3146 MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3148 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),&
3149 MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3151 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),&
3152 MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3154 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),&
3155 MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),&
3156 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3157 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),&
3158 MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),&
3159 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3160 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),&
3161 MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),&
3162 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3163 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),&
3164 MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),&
3165 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3166 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
3168 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),&
3169 MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3171 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),&
3172 MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3174 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),&
3175 MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3177 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),&
3178 MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3180 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),&
3181 MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3183 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),&
3184 ivec_count(fg_rank1),&
3185 MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3187 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),&
3188 MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3190 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),&
3191 MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3193 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),&
3194 MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3196 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),&
3197 MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3199 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),&
3200 MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3202 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),&
3203 MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3205 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),&
3206 MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3208 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),&
3209 ivec_count(fg_rank1),&
3210 MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3212 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),&
3213 MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3215 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),&
3216 MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3218 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),&
3219 MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3221 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),&
3222 MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3224 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),&
3225 ivec_count(fg_rank1),&
3226 MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3228 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),&
3229 ivec_count(fg_rank1),&
3230 MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3232 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),&
3233 ivec_count(fg_rank1),&
3234 MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
3235 MPI_MAT2,FG_COMM1,IERR)
3236 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),&
3237 ivec_count(fg_rank1),&
3238 MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
3239 MPI_MAT2,FG_COMM1,IERR)
3242 ! Passes matrix info through the ring
3245 if (irecv.lt.0) irecv=nfgtasks1-1
3248 if (inext.ge.nfgtasks1) inext=0
3250 ! write (iout,*) "isend",isend," irecv",irecv
3252 lensend=lentyp(isend)
3253 lenrecv=lentyp(irecv)
3254 ! write (iout,*) "lensend",lensend," lenrecv",lenrecv
3255 ! call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3256 ! & MPI_ROTAT1(lensend),inext,2200+isend,
3257 ! & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3258 ! & iprev,2200+irecv,FG_COMM,status,IERR)
3259 ! write (iout,*) "Gather ROTAT1"
3261 ! call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3262 ! & MPI_ROTAT2(lensend),inext,3300+isend,
3263 ! & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3264 ! & iprev,3300+irecv,FG_COMM,status,IERR)
3265 ! write (iout,*) "Gather ROTAT2"
3267 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,&
3268 MPI_ROTAT_OLD(lensend),inext,4400+isend,&
3269 costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),&
3270 iprev,4400+irecv,FG_COMM,status,IERR)
3271 ! write (iout,*) "Gather ROTAT_OLD"
3273 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,&
3274 MPI_PRECOMP11(lensend),inext,5500+isend,&
3275 mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),&
3276 iprev,5500+irecv,FG_COMM,status,IERR)
3277 ! write (iout,*) "Gather PRECOMP11"
3279 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,&
3280 MPI_PRECOMP12(lensend),inext,6600+isend,&
3281 Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),&
3282 iprev,6600+irecv,FG_COMM,status,IERR)
3283 ! write (iout,*) "Gather PRECOMP12"
3285 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
3287 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,&
3288 MPI_ROTAT2(lensend),inext,7700+isend,&
3289 ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),&
3290 iprev,7700+irecv,FG_COMM,status,IERR)
3291 ! write (iout,*) "Gather PRECOMP21"
3293 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,&
3294 MPI_PRECOMP22(lensend),inext,8800+isend,&
3295 EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),&
3296 iprev,8800+irecv,FG_COMM,status,IERR)
3297 ! write (iout,*) "Gather PRECOMP22"
3299 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,&
3300 MPI_PRECOMP23(lensend),inext,9900+isend,&
3301 Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,&
3302 MPI_PRECOMP23(lenrecv),&
3303 iprev,9900+irecv,FG_COMM,status,IERR)
3304 ! write (iout,*) "Gather PRECOMP23"
3309 if (irecv.lt.0) irecv=nfgtasks1-1
3312 time_gather=time_gather+MPI_Wtime()-time00
3315 ! if (fg_rank.eq.0) then
3316 write (iout,*) "Arrays UG and UGDER"
3318 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3319 ((ug(l,k,i),l=1,2),k=1,2),&
3320 ((ugder(l,k,i),l=1,2),k=1,2)
3322 write (iout,*) "Arrays UG2 and UG2DER"
3324 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3325 ((ug2(l,k,i),l=1,2),k=1,2),&
3326 ((ug2der(l,k,i),l=1,2),k=1,2)
3328 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3330 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3331 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
3332 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3334 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3336 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3337 costab(i),sintab(i),costab2(i),sintab2(i)
3339 write (iout,*) "Array MUDER"
3341 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3347 !d iti = itortyp(itype(i,1))
3350 !d write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3351 !d & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3355 end subroutine set_matrices
3356 !-----------------------------------------------------------------------------
3357 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3359 ! This subroutine calculates the average interaction energy and its gradient
3360 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
3361 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3362 ! The potential depends both on the distance of peptide-group centers and on
3363 ! the orientation of the CA-CA virtual bonds.
3366 ! implicit real*8 (a-h,o-z)
3370 ! include 'DIMENSIONS'
3371 ! include 'COMMON.CONTROL'
3372 ! include 'COMMON.SETUP'
3373 ! include 'COMMON.IOUNITS'
3374 ! include 'COMMON.GEO'
3375 ! include 'COMMON.VAR'
3376 ! include 'COMMON.LOCAL'
3377 ! include 'COMMON.CHAIN'
3378 ! include 'COMMON.DERIV'
3379 ! include 'COMMON.INTERACT'
3380 ! include 'COMMON.CONTACTS'
3381 ! include 'COMMON.TORSION'
3382 ! include 'COMMON.VECTORS'
3383 ! include 'COMMON.FFIELD'
3384 ! include 'COMMON.TIME1'
3385 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
3386 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
3387 real(kind=8),dimension(2,2) :: acipa !el,a_temp
3388 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3389 real(kind=8),dimension(4) :: muij
3390 !el integer :: num_conti,j1,j2
3391 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3392 !el dz_normi,xmedi,ymedi,zmedi
3394 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3395 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3398 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3400 real(kind=8) :: scal_el=1.0d0
3402 real(kind=8) :: scal_el=0.5d0
3405 ! 13-go grudnia roku pamietnego...
3406 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
3408 0.0d0,0.0d0,1.0d0/),shape(unmat))
3411 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
3412 real(kind=8) :: fac,t_eelecij,fracinbuf
3415 !d write(iout,*) 'In EELEC'
3416 ! print *,"IN EELEC"
3418 !d write(iout,*) 'Type',i
3419 !d write(iout,*) 'B1',B1(:,i)
3420 !d write(iout,*) 'B2',B2(:,i)
3421 !d write(iout,*) 'CC',CC(:,:,i)
3422 !d write(iout,*) 'DD',DD(:,:,i)
3423 !d write(iout,*) 'EE',EE(:,:,i)
3425 !d call check_vecgrad
3440 if (icheckgrad.eq.1) then
3443 ! dc_norm(1,i)=0.0d0
3444 ! dc_norm(2,i)=0.0d0
3445 ! dc_norm(3,i)=0.0d0
3448 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3450 dc_norm(k,i)=dc(k,i)*fac
3452 ! write (iout,*) 'i',i,' fac',fac
3455 ! print *,wel_loc,"wel_loc",wcorr4,wcorr5,wcorr6,wturn3,wturn4, &
3457 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3458 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
3459 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3460 ! call vec_and_deriv
3464 ! print *, "before set matrices"
3466 ! print *, "after set matrices"
3469 time_mat=time_mat+MPI_Wtime()-time01
3472 ! print *, "after set matrices"
3474 !d write (iout,*) 'i=',i
3476 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3479 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3480 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3493 !d print '(a)','Enter EELEC'
3494 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3495 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
3496 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
3498 gel_loc_loc(i)=0.0d0
3503 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3505 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
3509 ! print *,"before iturn3 loop"
3510 do i=iturn3_start,iturn3_end
3511 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
3512 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
3516 dx_normi=dc_norm(1,i)
3517 dy_normi=dc_norm(2,i)
3518 dz_normi=dc_norm(3,i)
3519 xmedi=c(1,i)+0.5d0*dxi
3520 ymedi=c(2,i)+0.5d0*dyi
3521 zmedi=c(3,i)+0.5d0*dzi
3522 xmedi=dmod(xmedi,boxxsize)
3523 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3524 ymedi=dmod(ymedi,boxysize)
3525 if (ymedi.lt.0) ymedi=ymedi+boxysize
3526 zmedi=dmod(zmedi,boxzsize)
3527 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3529 if ((zmedi.gt.bordlipbot) &
3530 .and.(zmedi.lt.bordliptop)) then
3531 !C the energy transfer exist
3532 if (zmedi.lt.buflipbot) then
3533 !C what fraction I am in
3535 ((zmedi-bordlipbot)/lipbufthick)
3536 !C lipbufthick is thickenes of lipid buffore
3537 sslipi=sscalelip(fracinbuf)
3538 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3539 elseif (zmedi.gt.bufliptop) then
3540 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3541 sslipi=sscalelip(fracinbuf)
3542 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3551 ! print *,i,sslipi,ssgradlipi
3552 call eelecij(i,i+2,ees,evdw1,eel_loc)
3553 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3554 num_cont_hb(i)=num_conti
3556 do i=iturn4_start,iturn4_end
3557 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
3558 .or. itype(i+3,1).eq.ntyp1 &
3559 .or. itype(i+4,1).eq.ntyp1) cycle
3560 ! print *,"before2",i,i+3, gshieldc_t4(2,i+3),gshieldc_t4(2,i)
3564 dx_normi=dc_norm(1,i)
3565 dy_normi=dc_norm(2,i)
3566 dz_normi=dc_norm(3,i)
3567 xmedi=c(1,i)+0.5d0*dxi
3568 ymedi=c(2,i)+0.5d0*dyi
3569 zmedi=c(3,i)+0.5d0*dzi
3570 xmedi=dmod(xmedi,boxxsize)
3571 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3572 ymedi=dmod(ymedi,boxysize)
3573 if (ymedi.lt.0) ymedi=ymedi+boxysize
3574 zmedi=dmod(zmedi,boxzsize)
3575 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3576 if ((zmedi.gt.bordlipbot) &
3577 .and.(zmedi.lt.bordliptop)) then
3578 !C the energy transfer exist
3579 if (zmedi.lt.buflipbot) then
3580 !C what fraction I am in
3582 ((zmedi-bordlipbot)/lipbufthick)
3583 !C lipbufthick is thickenes of lipid buffore
3584 sslipi=sscalelip(fracinbuf)
3585 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3586 elseif (zmedi.gt.bufliptop) then
3587 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3588 sslipi=sscalelip(fracinbuf)
3589 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3599 num_conti=num_cont_hb(i)
3600 call eelecij(i,i+3,ees,evdw1,eel_loc)
3601 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
3602 call eturn4(i,eello_turn4)
3603 ! print *,"before",i,i+3, gshieldc_t4(2,i+3),gshieldc_t4(2,i)
3604 num_cont_hb(i)=num_conti
3607 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3609 ! print *,"iatel_s,iatel_e,",iatel_s,iatel_e
3610 do i=iatel_s,iatel_e
3611 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
3615 dx_normi=dc_norm(1,i)
3616 dy_normi=dc_norm(2,i)
3617 dz_normi=dc_norm(3,i)
3618 xmedi=c(1,i)+0.5d0*dxi
3619 ymedi=c(2,i)+0.5d0*dyi
3620 zmedi=c(3,i)+0.5d0*dzi
3621 xmedi=dmod(xmedi,boxxsize)
3622 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3623 ymedi=dmod(ymedi,boxysize)
3624 if (ymedi.lt.0) ymedi=ymedi+boxysize
3625 zmedi=dmod(zmedi,boxzsize)
3626 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3627 if ((zmedi.gt.bordlipbot) &
3628 .and.(zmedi.lt.bordliptop)) then
3629 !C the energy transfer exist
3630 if (zmedi.lt.buflipbot) then
3631 !C what fraction I am in
3633 ((zmedi-bordlipbot)/lipbufthick)
3634 !C lipbufthick is thickenes of lipid buffore
3635 sslipi=sscalelip(fracinbuf)
3636 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3637 elseif (zmedi.gt.bufliptop) then
3638 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3639 sslipi=sscalelip(fracinbuf)
3640 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3650 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3651 num_conti=num_cont_hb(i)
3652 do j=ielstart(i),ielend(i)
3653 ! write (iout,*) i,j,itype(i,1),itype(j,1)
3654 if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
3655 call eelecij(i,j,ees,evdw1,eel_loc)
3657 num_cont_hb(i)=num_conti
3659 ! write (iout,*) "Number of loop steps in EELEC:",ind
3661 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
3662 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3664 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3665 !cc eel_loc=eel_loc+eello_turn3
3666 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
3668 end subroutine eelec
3669 !-----------------------------------------------------------------------------
3670 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3673 ! implicit real*8 (a-h,o-z)
3674 ! include 'DIMENSIONS'
3678 ! include 'COMMON.CONTROL'
3679 ! include 'COMMON.IOUNITS'
3680 ! include 'COMMON.GEO'
3681 ! include 'COMMON.VAR'
3682 ! include 'COMMON.LOCAL'
3683 ! include 'COMMON.CHAIN'
3684 ! include 'COMMON.DERIV'
3685 ! include 'COMMON.INTERACT'
3686 ! include 'COMMON.CONTACTS'
3687 ! include 'COMMON.TORSION'
3688 ! include 'COMMON.VECTORS'
3689 ! include 'COMMON.FFIELD'
3690 ! include 'COMMON.TIME1'
3691 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
3692 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
3693 real(kind=8),dimension(2,2) :: acipa !el,a_temp
3694 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3695 real(kind=8),dimension(4) :: muij
3696 real(kind=8) :: geel_loc_ij,geel_loc_ji
3697 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
3698 dist_temp, dist_init,rlocshield,fracinbuf
3699 integer xshift,yshift,zshift,ilist,iresshield
3700 !el integer :: num_conti,j1,j2
3701 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3702 !el dz_normi,xmedi,ymedi,zmedi
3704 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3705 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3708 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3710 real(kind=8) :: scal_el=1.0d0
3712 real(kind=8) :: scal_el=0.5d0
3715 ! 13-go grudnia roku pamietnego...
3716 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
3718 0.0d0,0.0d0,1.0d0/),shape(unmat))
3719 ! integer :: maxconts=nres/4
3721 integer :: k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap
3722 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
3723 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
3724 real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
3725 rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
3726 evdwij,el1,el2,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
3727 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
3728 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
3729 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
3730 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
3731 ecosgp,ecosam,ecosbm,ecosgm,ghalf
3733 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
3734 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
3736 ! time00=MPI_Wtime()
3737 !d write (iout,*) "eelecij",i,j
3741 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3742 aaa=app(iteli,itelj)
3743 bbb=bpp(iteli,itelj)
3744 ael6i=ael6(iteli,itelj)
3745 ael3i=ael3(iteli,itelj)
3749 dx_normj=dc_norm(1,j)
3750 dy_normj=dc_norm(2,j)
3751 dz_normj=dc_norm(3,j)
3752 ! xj=c(1,j)+0.5D0*dxj-xmedi
3753 ! yj=c(2,j)+0.5D0*dyj-ymedi
3754 ! zj=c(3,j)+0.5D0*dzj-zmedi
3759 if (xj.lt.0) xj=xj+boxxsize
3761 if (yj.lt.0) yj=yj+boxysize
3763 if (zj.lt.0) zj=zj+boxzsize
3764 if ((zj.gt.bordlipbot) &
3765 .and.(zj.lt.bordliptop)) then
3766 !C the energy transfer exist
3767 if (zj.lt.buflipbot) then
3768 !C what fraction I am in
3770 ((zj-bordlipbot)/lipbufthick)
3771 !C lipbufthick is thickenes of lipid buffore
3772 sslipj=sscalelip(fracinbuf)
3773 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
3774 elseif (zj.gt.bufliptop) then
3775 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
3776 sslipj=sscalelip(fracinbuf)
3777 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
3788 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3795 xj=xj_safe+xshift*boxxsize
3796 yj=yj_safe+yshift*boxysize
3797 zj=zj_safe+zshift*boxzsize
3798 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3799 if(dist_temp.lt.dist_init) then
3809 if (isubchap.eq.1) then
3820 rij=xj*xj+yj*yj+zj*zj
3823 !C print *,xmedi,ymedi,zmedi,xj,yj,zj,boxxsize,rij
3824 sss_ele_cut=sscale_ele(rij)
3825 sss_ele_grad=sscagrad_ele(rij)
3827 ! sss_ele_grad=0.0d0
3828 ! print *,sss_ele_cut,sss_ele_grad,&
3829 ! (rij),r_cut_ele,rlamb_ele
3830 ! if (sss_ele_cut.le.0.0) go to 128
3835 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3836 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3837 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3838 fac=cosa-3.0D0*cosb*cosg
3840 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3841 if (j.eq.i+2) ev1=scal_el*ev1
3846 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3849 if (shield_mode.gt.0) then
3850 !C fac_shield(i)=0.4
3851 !C fac_shield(j)=0.6
3852 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3853 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3855 ees=ees+eesij*sss_ele_cut
3856 !C FOR NOW SHIELD IS NOT USED WITH LIPSCALE
3857 !C & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3863 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)*sss_ele_cut
3864 !C print *,"TUCC",(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
3867 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
3868 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3869 ! ees=ees+eesij*sss_ele_cut
3870 evdw1=evdw1+evdwij*sss_ele_cut &
3871 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3872 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3873 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3874 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3875 !d & xmedi,ymedi,zmedi,xj,yj,zj
3877 if (energy_dec) then
3878 ! write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') &
3879 ! 'evdw1',i,j,evdwij,&
3880 ! iteli,itelj,aaa,evdw1
3881 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3882 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3885 ! Calculate contributions to the Cartesian gradient.
3888 facvdw=-6*rrmij*(ev1+evdwij)*sss_ele_cut &
3889 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3890 facel=-3*rrmij*(el1+eesij)*sss_ele_cut &
3891 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3897 ! Radial derivatives. First process both termini of the fragment (i,j)
3899 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj* &
3900 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3901 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj* &
3902 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3903 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj* &
3904 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3906 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3907 (shield_mode.gt.0)) then
3909 do ilist=1,ishield_list(i)
3910 iresshield=shield_list(ilist,i)
3912 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)&
3914 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3916 +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0 &
3918 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3921 do ilist=1,ishield_list(j)
3922 iresshield=shield_list(ilist,j)
3924 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j) &
3926 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3928 +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0 &
3930 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3934 gshieldc(k,i)=gshieldc(k,i)+ &
3935 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3938 gshieldc(k,j)=gshieldc(k,j)+ &
3939 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3942 gshieldc(k,i-1)=gshieldc(k,i-1)+ &
3943 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3946 gshieldc(k,j-1)=gshieldc(k,j-1)+ &
3947 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3955 ! ghalf=0.5D0*ggg(k)
3956 ! gelc(k,i)=gelc(k,i)+ghalf
3957 ! gelc(k,j)=gelc(k,j)+ghalf
3959 ! 9/28/08 AL Gradient compotents will be summed only at the end
3961 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3962 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3964 gelc_long(3,j)=gelc_long(3,j)+ &
3965 ssgradlipj*eesij/2.0d0*lipscale**2&
3968 gelc_long(3,i)=gelc_long(3,i)+ &
3969 ssgradlipi*eesij/2.0d0*lipscale**2&
3974 ! Loop over residues i+1 thru j-1.
3978 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3981 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj &
3982 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3983 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj &
3984 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3985 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj &
3986 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3989 ! ghalf=0.5D0*ggg(k)
3990 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3991 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3993 ! 9/28/08 AL Gradient compotents will be summed only at the end
3995 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3996 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3999 !C Lipidic part for scaling weight
4000 gvdwpp(3,j)=gvdwpp(3,j)+ &
4001 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
4002 gvdwpp(3,i)=gvdwpp(3,i)+ &
4003 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
4004 !! Loop over residues i+1 thru j-1.
4008 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
4012 facvdw=(ev1+evdwij)*sss_ele_cut &
4013 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4015 facel=(el1+eesij)*sss_ele_cut
4017 fac=-3*rrmij*(facvdw+facvdw+facel)
4022 ! Radial derivatives. First process both termini of the fragment (i,j)
4024 ggg(1)=fac*xj+sss_ele_grad*rmij*(eesij+evdwij)*xj
4025 ggg(2)=fac*yj+sss_ele_grad*rmij*(eesij+evdwij)*yj
4026 ggg(3)=fac*zj+sss_ele_grad*rmij*(eesij+evdwij)*zj
4028 ! ghalf=0.5D0*ggg(k)
4029 ! gelc(k,i)=gelc(k,i)+ghalf
4030 ! gelc(k,j)=gelc(k,j)+ghalf
4032 ! 9/28/08 AL Gradient compotents will be summed only at the end
4034 gelc_long(k,j)=gelc(k,j)+ggg(k)
4035 gelc_long(k,i)=gelc(k,i)-ggg(k)
4038 ! Loop over residues i+1 thru j-1.
4042 !grad gelc(l,k)=gelc(l,k)+ggg(l)
4045 ! 9/28/08 AL Gradient compotents will be summed only at the end
4047 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4049 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4051 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4054 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
4055 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
4057 gvdwpp(3,j)=gvdwpp(3,j)+ &
4058 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
4059 gvdwpp(3,i)=gvdwpp(3,i)+ &
4060 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
4066 ecosa=2.0D0*fac3*fac1+fac4
4069 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
4070 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
4072 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4073 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4075 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
4076 !d & (dcosg(k),k=1,3)
4078 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*sss_ele_cut &
4079 *fac_shield(i)**2*fac_shield(j)**2 &
4080 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4084 ! ghalf=0.5D0*ggg(k)
4085 ! gelc(k,i)=gelc(k,i)+ghalf
4086 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4087 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4088 ! gelc(k,j)=gelc(k,j)+ghalf
4089 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4090 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4094 !grad gelc(l,k)=gelc(l,k)+ggg(l)
4098 gelc(k,i)=gelc(k,i) &
4099 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4100 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
4102 *fac_shield(i)**2*fac_shield(j)**2 &
4103 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4105 gelc(k,j)=gelc(k,j) &
4106 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4107 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
4109 *fac_shield(i)**2*fac_shield(j)**2 &
4110 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4112 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4113 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4116 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
4117 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
4118 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4120 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
4121 ! energy of a peptide unit is assumed in the form of a second-order
4122 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
4123 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
4124 ! are computed for EVERY pair of non-contiguous peptide groups.
4126 if (j.lt.nres-1) then
4137 muij(kkk)=mu(k,i)*mu(l,j)
4139 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
4140 !c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
4141 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
4142 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
4143 !c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
4144 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
4149 !d write (iout,*) 'EELEC: i',i,' j',j
4150 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
4151 !d write(iout,*) 'muij',muij
4152 ury=scalar(uy(1,i),erij)
4153 urz=scalar(uz(1,i),erij)
4154 vry=scalar(uy(1,j),erij)
4155 vrz=scalar(uz(1,j),erij)
4156 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
4157 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
4158 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
4159 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
4160 fac=dsqrt(-ael6i)*r3ij
4165 !d write (iout,'(4i5,4f10.5)')
4166 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
4167 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
4168 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
4169 !d & uy(:,j),uz(:,j)
4170 !d write (iout,'(4f10.5)')
4171 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
4172 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
4173 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
4174 !d write (iout,'(9f10.5/)')
4175 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
4176 ! Derivatives of the elements of A in virtual-bond vectors
4177 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
4179 uryg(k,1)=scalar(erder(1,k),uy(1,i))
4180 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
4181 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
4182 urzg(k,1)=scalar(erder(1,k),uz(1,i))
4183 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
4184 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
4185 vryg(k,1)=scalar(erder(1,k),uy(1,j))
4186 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
4187 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
4188 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
4189 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
4190 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
4192 ! Compute radial contributions to the gradient
4210 ! Add the contributions coming from er
4213 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
4214 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
4215 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
4216 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
4219 ! Derivatives in DC(i)
4220 !grad ghalf1=0.5d0*agg(k,1)
4221 !grad ghalf2=0.5d0*agg(k,2)
4222 !grad ghalf3=0.5d0*agg(k,3)
4223 !grad ghalf4=0.5d0*agg(k,4)
4224 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
4225 -3.0d0*uryg(k,2)*vry)!+ghalf1
4226 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
4227 -3.0d0*uryg(k,2)*vrz)!+ghalf2
4228 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
4229 -3.0d0*urzg(k,2)*vry)!+ghalf3
4230 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
4231 -3.0d0*urzg(k,2)*vrz)!+ghalf4
4232 ! Derivatives in DC(i+1)
4233 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
4234 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
4235 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
4236 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
4237 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
4238 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
4239 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
4240 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
4241 ! Derivatives in DC(j)
4242 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
4243 -3.0d0*vryg(k,2)*ury)!+ghalf1
4244 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
4245 -3.0d0*vrzg(k,2)*ury)!+ghalf2
4246 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
4247 -3.0d0*vryg(k,2)*urz)!+ghalf3
4248 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
4249 -3.0d0*vrzg(k,2)*urz)!+ghalf4
4250 ! Derivatives in DC(j+1) or DC(nres-1)
4251 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
4252 -3.0d0*vryg(k,3)*ury)
4253 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
4254 -3.0d0*vrzg(k,3)*ury)
4255 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
4256 -3.0d0*vryg(k,3)*urz)
4257 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
4258 -3.0d0*vrzg(k,3)*urz)
4259 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
4261 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
4274 aggi(k,l)=-aggi(k,l)
4275 aggi1(k,l)=-aggi1(k,l)
4276 aggj(k,l)=-aggj(k,l)
4277 aggj1(k,l)=-aggj1(k,l)
4280 if (j.lt.nres-1) then
4286 aggi(k,l)=-aggi(k,l)
4287 aggi1(k,l)=-aggi1(k,l)
4288 aggj(k,l)=-aggj(k,l)
4289 aggj1(k,l)=-aggj1(k,l)
4300 aggi(k,l)=-aggi(k,l)
4301 aggi1(k,l)=-aggi1(k,l)
4302 aggj(k,l)=-aggj(k,l)
4303 aggj1(k,l)=-aggj1(k,l)
4308 IF (wel_loc.gt.0.0d0) THEN
4309 ! Contribution to the local-electrostatic energy coming from the i-j pair
4310 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
4312 if (shield_mode.eq.0) then
4316 eel_loc_ij=eel_loc_ij &
4317 *fac_shield(i)*fac_shield(j) &
4318 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4319 !C Now derivative over eel_loc
4320 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4321 (shield_mode.gt.0)) then
4324 do ilist=1,ishield_list(i)
4325 iresshield=shield_list(ilist,i)
4327 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij &
4330 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
4332 +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i) &
4335 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
4339 do ilist=1,ishield_list(j)
4340 iresshield=shield_list(ilist,j)
4342 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij &
4345 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
4347 +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j) &
4350 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
4357 gshieldc_ll(k,i)=gshieldc_ll(k,i)+ &
4358 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
4360 gshieldc_ll(k,j)=gshieldc_ll(k,j)+ &
4361 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
4363 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+ &
4364 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
4366 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+ &
4367 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
4374 geel_loc_ij=(a22*gmuij1(1)&
4378 *fac_shield(i)*fac_shield(j)&
4381 !c write(iout,*) "derivative over thatai"
4382 !c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4384 gloc(nphi+i,icg)=gloc(nphi+i,icg)+&
4386 !c write(iout,*) "derivative over thatai-1"
4387 !c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4394 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+&
4395 geel_loc_ij*wel_loc&
4396 *fac_shield(i)*fac_shield(j)&
4400 !c Derivative over j residue
4401 geel_loc_ji=a22*gmuji1(1)&
4405 !c write(iout,*) "derivative over thataj"
4406 !c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4409 gloc(nphi+j,icg)=gloc(nphi+j,icg)+&
4410 geel_loc_ji*wel_loc&
4411 *fac_shield(i)*fac_shield(j)&
4420 !c write(iout,*) "derivative over thataj-1"
4421 !c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4423 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+&
4424 geel_loc_ji*wel_loc&
4425 *fac_shield(i)*fac_shield(j)&
4429 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4431 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4432 ! 'eelloc',i,j,eel_loc_ij
4433 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,8f8.3)') &
4434 'eelloc',i,j,eel_loc_ij,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4435 ! print *,"EELLOC",i,gel_loc_loc(i-1)
4437 ! if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33
4438 ! if (energy_dec) write (iout,*) "muij",muij
4439 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
4441 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
4442 ! Partial derivatives in virtual-bond dihedral angles gamma
4444 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
4445 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
4446 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
4448 *fac_shield(i)*fac_shield(j) &
4449 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4451 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
4452 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
4453 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
4455 *fac_shield(i)*fac_shield(j) &
4456 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4457 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4459 ! ggg(1)=(agg(1,1)*muij(1)+ &
4460 ! agg(1,2)*muij(2)+agg(1,3)*muij(3)+agg(1,4)*muij(4)) &
4462 ! +eel_loc_ij*sss_ele_grad*rmij*xj
4463 ! ggg(2)=(agg(2,1)*muij(1)+ &
4464 ! agg(2,2)*muij(2)+agg(2,3)*muij(3)+agg(2,4)*muij(4)) &
4466 ! +eel_loc_ij*sss_ele_grad*rmij*yj
4467 ! ggg(3)=(agg(3,1)*muij(1)+ &
4468 ! agg(3,2)*muij(2)+agg(3,3)*muij(3)+agg(3,4)*muij(4)) &
4470 ! +eel_loc_ij*sss_ele_grad*rmij*zj
4476 ggg(l)=(agg(l,1)*muij(1)+ &
4477 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
4479 *fac_shield(i)*fac_shield(j) &
4480 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) &
4481 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4484 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4485 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4486 !grad ghalf=0.5d0*ggg(l)
4487 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
4488 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
4490 gel_loc_long(3,j)=gel_loc_long(3,j)+ &
4491 ssgradlipj*eel_loc_ij/2.0d0*lipscale/ &
4492 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
4494 gel_loc_long(3,i)=gel_loc_long(3,i)+ &
4495 ssgradlipi*eel_loc_ij/2.0d0*lipscale/ &
4496 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
4500 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4503 ! Remaining derivatives of eello
4505 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
4506 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
4508 *fac_shield(i)*fac_shield(j) &
4509 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4511 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4512 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
4513 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3) &
4514 +aggi1(l,4)*muij(4))&
4516 *fac_shield(i)*fac_shield(j) &
4517 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4519 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4520 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
4521 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
4523 *fac_shield(i)*fac_shield(j) &
4524 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4526 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4527 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
4528 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3) &
4529 +aggj1(l,4)*muij(4))&
4531 *fac_shield(i)*fac_shield(j) &
4532 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4534 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4537 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
4538 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
4539 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
4540 .and. num_conti.le.maxconts) then
4541 ! write (iout,*) i,j," entered corr"
4543 ! Calculate the contact function. The ith column of the array JCONT will
4544 ! contain the numbers of atoms that make contacts with the atom I (of numbers
4545 ! greater than I). The arrays FACONT and GACONT will contain the values of
4546 ! the contact function and its derivative.
4547 ! r0ij=1.02D0*rpp(iteli,itelj)
4548 ! r0ij=1.11D0*rpp(iteli,itelj)
4549 r0ij=2.20D0*rpp(iteli,itelj)
4550 ! r0ij=1.55D0*rpp(iteli,itelj)
4551 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4552 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
4553 if (fcont.gt.0.0D0) then
4554 num_conti=num_conti+1
4555 if (num_conti.gt.maxconts) then
4556 !el write (iout,*) "esrgresgdsrgdfsrgdswrgaresfgaerwgae"
4557 !el write (iout,*) "num_conti",num_conti, "maxconts",maxconts
4558 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
4559 ' will skip next contacts for this conf.', num_conti
4561 jcont_hb(num_conti,i)=j
4562 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
4563 !d & " jcont_hb",jcont_hb(num_conti,i)
4564 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
4565 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4566 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4568 d_cont(num_conti,i)=rij
4569 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4570 ! --- Electrostatic-interaction matrix ---
4571 a_chuj(1,1,num_conti,i)=a22
4572 a_chuj(1,2,num_conti,i)=a23
4573 a_chuj(2,1,num_conti,i)=a32
4574 a_chuj(2,2,num_conti,i)=a33
4575 ! --- Gradient of rij
4577 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4584 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4585 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4586 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4587 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4588 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4593 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4594 ! Calculate contact energies
4596 wij=cosa-3.0D0*cosb*cosg
4599 ! fac3=dsqrt(-ael6i)/r0ij**3
4600 fac3=dsqrt(-ael6i)*r3ij
4601 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4602 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4603 if (ees0tmp.gt.0) then
4604 ees0pij=dsqrt(ees0tmp)
4608 if (shield_mode.eq.0) then
4612 ees0plist(num_conti,i)=j
4614 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4615 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4616 if (ees0tmp.gt.0) then
4617 ees0mij=dsqrt(ees0tmp)
4622 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
4624 *fac_shield(i)*fac_shield(j)
4626 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
4628 *fac_shield(i)*fac_shield(j)
4630 ! Diagnostics. Comment out or remove after debugging!
4631 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4632 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4633 ! ees0m(num_conti,i)=0.0D0
4635 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4636 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4637 ! Angular derivatives of the contact function
4638 ees0pij1=fac3/ees0pij
4639 ees0mij1=fac3/ees0mij
4640 fac3p=-3.0D0*fac3*rrmij
4641 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4642 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4644 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4645 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4646 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4647 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4648 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4649 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4650 ecosap=ecosa1+ecosa2
4651 ecosbp=ecosb1+ecosb2
4652 ecosgp=ecosg1+ecosg2
4653 ecosam=ecosa1-ecosa2
4654 ecosbm=ecosb1-ecosb2
4655 ecosgm=ecosg1-ecosg2
4664 facont_hb(num_conti,i)=fcont
4665 fprimcont=fprimcont/rij
4666 !d facont_hb(num_conti,i)=1.0D0
4667 ! Following line is for diagnostics.
4670 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4671 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4674 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4675 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4677 gggp(1)=gggp(1)+ees0pijp*xj &
4678 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
4679 gggp(2)=gggp(2)+ees0pijp*yj &
4680 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
4681 gggp(3)=gggp(3)+ees0pijp*zj &
4682 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
4684 gggm(1)=gggm(1)+ees0mijp*xj &
4685 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
4687 gggm(2)=gggm(2)+ees0mijp*yj &
4688 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
4690 gggm(3)=gggm(3)+ees0mijp*zj &
4691 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
4693 ! Derivatives due to the contact function
4694 gacont_hbr(1,num_conti,i)=fprimcont*xj
4695 gacont_hbr(2,num_conti,i)=fprimcont*yj
4696 gacont_hbr(3,num_conti,i)=fprimcont*zj
4699 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
4700 ! following the change of gradient-summation algorithm.
4702 !grad ghalfp=0.5D0*gggp(k)
4703 !grad ghalfm=0.5D0*gggm(k)
4704 gacontp_hb1(k,num_conti,i)= & !ghalfp+
4705 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4706 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
4707 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4709 gacontp_hb2(k,num_conti,i)= & !ghalfp+
4710 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4711 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
4712 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4714 gacontp_hb3(k,num_conti,i)=gggp(k) &
4715 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4717 gacontm_hb1(k,num_conti,i)= & !ghalfm+
4718 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4719 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
4720 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4722 gacontm_hb2(k,num_conti,i)= & !ghalfm+
4723 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4724 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
4725 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4727 gacontm_hb3(k,num_conti,i)=gggm(k) &
4728 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4731 ! Diagnostics. Comment out or remove after debugging!
4733 !diag gacontp_hb1(k,num_conti,i)=0.0D0
4734 !diag gacontp_hb2(k,num_conti,i)=0.0D0
4735 !diag gacontp_hb3(k,num_conti,i)=0.0D0
4736 !diag gacontm_hb1(k,num_conti,i)=0.0D0
4737 !diag gacontm_hb2(k,num_conti,i)=0.0D0
4738 !diag gacontm_hb3(k,num_conti,i)=0.0D0
4741 endif ! num_conti.le.maxconts
4744 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4747 ghalf=0.5d0*agg(l,k)
4748 aggi(l,k)=aggi(l,k)+ghalf
4749 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4750 aggj(l,k)=aggj(l,k)+ghalf
4753 if (j.eq.nres-1 .and. i.lt.j-2) then
4756 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4762 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
4764 end subroutine eelecij
4765 !-----------------------------------------------------------------------------
4766 subroutine eturn3(i,eello_turn3)
4767 ! Third- and fourth-order contributions from turns
4770 ! implicit real*8 (a-h,o-z)
4771 ! include 'DIMENSIONS'
4772 ! include 'COMMON.IOUNITS'
4773 ! include 'COMMON.GEO'
4774 ! include 'COMMON.VAR'
4775 ! include 'COMMON.LOCAL'
4776 ! include 'COMMON.CHAIN'
4777 ! include 'COMMON.DERIV'
4778 ! include 'COMMON.INTERACT'
4779 ! include 'COMMON.CONTACTS'
4780 ! include 'COMMON.TORSION'
4781 ! include 'COMMON.VECTORS'
4782 ! include 'COMMON.FFIELD'
4783 ! include 'COMMON.CONTROL'
4784 real(kind=8),dimension(3) :: ggg
4785 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4786 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2,gpizda1,&
4787 gpizda2,auxgmat1,auxgmatt1,auxgmat2,auxgmatt2
4789 real(kind=8),dimension(2) :: auxvec,auxvec1
4790 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4791 real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
4792 !el integer :: num_conti,j1,j2
4793 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4794 !el dz_normi,xmedi,ymedi,zmedi
4796 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4797 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4800 integer :: i,j,l,k,ilist,iresshield
4801 real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield
4804 ! write (iout,*) "eturn3",i,j,j1,j2
4805 zj=(c(3,j)+c(3,j+1))/2.0d0
4807 if (zj.lt.0) zj=zj+boxzsize
4808 if ((zj.lt.0)) write (*,*) "CHUJ"
4809 if ((zj.gt.bordlipbot) &
4810 .and.(zj.lt.bordliptop)) then
4811 !C the energy transfer exist
4812 if (zj.lt.buflipbot) then
4813 !C what fraction I am in
4815 ((zj-bordlipbot)/lipbufthick)
4816 !C lipbufthick is thickenes of lipid buffore
4817 sslipj=sscalelip(fracinbuf)
4818 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4819 elseif (zj.gt.bufliptop) then
4820 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4821 sslipj=sscalelip(fracinbuf)
4822 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4836 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4838 ! Third-order contributions
4845 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4846 !d call checkint_turn3(i,a_temp,eello_turn3_num)
4847 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4848 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4849 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4850 call transpose2(auxmat(1,1),auxmat1(1,1))
4851 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4852 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4853 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4854 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4855 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4857 if (shield_mode.eq.0) then
4862 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) &
4863 *fac_shield(i)*fac_shield(j) &
4864 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4866 0.5d0*(pizda(1,1)+pizda(2,2)) &
4867 *fac_shield(i)*fac_shield(j)
4869 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4870 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4872 !C Derivatives in theta
4873 gloc(nphi+i,icg)=gloc(nphi+i,icg) &
4874 +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3&
4875 *fac_shield(i)*fac_shield(j)
4876 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)&
4877 +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3&
4878 *fac_shield(i)*fac_shield(j)
4883 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4884 (shield_mode.gt.0)) then
4887 do ilist=1,ishield_list(i)
4888 iresshield=shield_list(ilist,i)
4890 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4891 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4893 +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4894 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4898 do ilist=1,ishield_list(j)
4899 iresshield=shield_list(ilist,j)
4901 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4902 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4904 +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4905 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4912 gshieldc_t3(k,i)=gshieldc_t3(k,i)+ &
4913 grad_shield(k,i)*eello_t3/fac_shield(i)
4914 gshieldc_t3(k,j)=gshieldc_t3(k,j)+ &
4915 grad_shield(k,j)*eello_t3/fac_shield(j)
4916 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+ &
4917 grad_shield(k,i)*eello_t3/fac_shield(i)
4918 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+ &
4919 grad_shield(k,j)*eello_t3/fac_shield(j)
4923 !d write (2,*) 'i,',i,' j',j,'eello_turn3',
4924 !d & 0.5d0*(pizda(1,1)+pizda(2,2)),
4925 !d & ' eello_turn3_num',4*eello_turn3_num
4926 ! Derivatives in gamma(i)
4927 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4928 call transpose2(auxmat2(1,1),auxmat3(1,1))
4929 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4930 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))&
4931 *fac_shield(i)*fac_shield(j) &
4932 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4933 ! Derivatives in gamma(i+1)
4934 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4935 call transpose2(auxmat2(1,1),auxmat3(1,1))
4936 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4937 gel_loc_turn3(i+1)=gel_loc_turn3(i+1) &
4938 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4939 *fac_shield(i)*fac_shield(j) &
4940 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4942 ! Cartesian derivatives
4944 ! ghalf1=0.5d0*agg(l,1)
4945 ! ghalf2=0.5d0*agg(l,2)
4946 ! ghalf3=0.5d0*agg(l,3)
4947 ! ghalf4=0.5d0*agg(l,4)
4948 a_temp(1,1)=aggi(l,1)!+ghalf1
4949 a_temp(1,2)=aggi(l,2)!+ghalf2
4950 a_temp(2,1)=aggi(l,3)!+ghalf3
4951 a_temp(2,2)=aggi(l,4)!+ghalf4
4952 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4953 gcorr3_turn(l,i)=gcorr3_turn(l,i) &
4954 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4955 *fac_shield(i)*fac_shield(j) &
4956 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4958 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4959 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4960 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4961 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4962 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4963 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) &
4964 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4965 *fac_shield(i)*fac_shield(j) &
4966 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4968 a_temp(1,1)=aggj(l,1)!+ghalf1
4969 a_temp(1,2)=aggj(l,2)!+ghalf2
4970 a_temp(2,1)=aggj(l,3)!+ghalf3
4971 a_temp(2,2)=aggj(l,4)!+ghalf4
4972 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4973 gcorr3_turn(l,j)=gcorr3_turn(l,j) &
4974 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4975 *fac_shield(i)*fac_shield(j) &
4976 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4978 a_temp(1,1)=aggj1(l,1)
4979 a_temp(1,2)=aggj1(l,2)
4980 a_temp(2,1)=aggj1(l,3)
4981 a_temp(2,2)=aggj1(l,4)
4982 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4983 gcorr3_turn(l,j1)=gcorr3_turn(l,j1) &
4984 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4985 *fac_shield(i)*fac_shield(j) &
4986 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4988 gshieldc_t3(3,i)=gshieldc_t3(3,i)+ &
4989 ssgradlipi*eello_t3/4.0d0*lipscale
4990 gshieldc_t3(3,j)=gshieldc_t3(3,j)+ &
4991 ssgradlipj*eello_t3/4.0d0*lipscale
4992 gshieldc_t3(3,i-1)=gshieldc_t3(3,i-1)+ &
4993 ssgradlipi*eello_t3/4.0d0*lipscale
4994 gshieldc_t3(3,j-1)=gshieldc_t3(3,j-1)+ &
4995 ssgradlipj*eello_t3/4.0d0*lipscale
4998 end subroutine eturn3
4999 !-----------------------------------------------------------------------------
5000 subroutine eturn4(i,eello_turn4)
5001 ! Third- and fourth-order contributions from turns
5004 ! implicit real*8 (a-h,o-z)
5005 ! include 'DIMENSIONS'
5006 ! include 'COMMON.IOUNITS'
5007 ! include 'COMMON.GEO'
5008 ! include 'COMMON.VAR'
5009 ! include 'COMMON.LOCAL'
5010 ! include 'COMMON.CHAIN'
5011 ! include 'COMMON.DERIV'
5012 ! include 'COMMON.INTERACT'
5013 ! include 'COMMON.CONTACTS'
5014 ! include 'COMMON.TORSION'
5015 ! include 'COMMON.VECTORS'
5016 ! include 'COMMON.FFIELD'
5017 ! include 'COMMON.CONTROL'
5018 real(kind=8),dimension(3) :: ggg
5019 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
5020 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2,&
5022 gte1a,gtae3,gtae3e2, ae3gte2,&
5023 gtEpizda1,gtEpizda2,gtEpizda3
5025 real(kind=8),dimension(2) :: auxvec,auxvec1,auxgEvec1,auxgEvec2,&
5028 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
5029 real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
5030 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
5031 !el dz_normi,xmedi,ymedi,zmedi
5032 !el integer :: num_conti,j1,j2
5033 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
5034 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
5037 integer :: i,j,iti1,iti2,iti3,l,k,ilist,iresshield
5038 real(kind=8) :: eello_turn4,s1,s2,s3,zj,fracinbuf,eello_t4,&
5039 rlocshield,gs23,gs32,gsE13,gs13,gs21,gsE31,gsEE1,gsEE2,gsEE3
5042 ! if (j.ne.20) return
5043 ! print *,i,j,gshieldc_t4(2,j),gshieldc_t4(2,j+1)
5044 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5046 ! Fourth-order contributions
5054 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5055 !d call checkint_turn4(i,a_temp,eello_turn4_num)
5056 ! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
5057 zj=(c(3,j)+c(3,j+1))/2.0d0
5059 if (zj.lt.0) zj=zj+boxzsize
5060 if ((zj.gt.bordlipbot) &
5061 .and.(zj.lt.bordliptop)) then
5062 !C the energy transfer exist
5063 if (zj.lt.buflipbot) then
5064 !C what fraction I am in
5066 ((zj-bordlipbot)/lipbufthick)
5067 !C lipbufthick is thickenes of lipid buffore
5068 sslipj=sscalelip(fracinbuf)
5069 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
5070 elseif (zj.gt.bufliptop) then
5071 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
5072 sslipj=sscalelip(fracinbuf)
5073 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
5090 ! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
5091 call transpose2(EUg(1,1,i+1),e1t(1,1))
5092 call transpose2(Eug(1,1,i+2),e2t(1,1))
5093 call transpose2(Eug(1,1,i+3),e3t(1,1))
5094 !C Ematrix derivative in theta
5095 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
5096 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
5097 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
5099 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5100 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5101 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
5102 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
5103 !c auxalary matrix of E i+1
5104 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
5105 s1=scalar2(b1(1,iti2),auxvec(1))
5106 !c derivative of theta i+2 with constant i+3
5107 gs23=scalar2(gtb1(1,i+2),auxvec(1))
5108 !c derivative of theta i+2 with constant i+2
5109 gs32=scalar2(b1(1,i+2),auxgvec(1))
5110 !c derivative of E matix in theta of i+1
5111 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
5113 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5114 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
5115 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5116 !c auxilary matrix auxgvec of Ub2 with constant E matirx
5117 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
5118 !c auxilary matrix auxgEvec1 of E matix with Ub2 constant
5119 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
5120 s2=scalar2(b1(1,i+1),auxvec(1))
5121 !c derivative of theta i+1 with constant i+3
5122 gs13=scalar2(gtb1(1,i+1),auxvec(1))
5123 !c derivative of theta i+2 with constant i+1
5124 gs21=scalar2(b1(1,i+1),auxgvec(1))
5125 !c derivative of theta i+3 with constant i+1
5126 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
5128 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5129 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
5130 !c ae3gte2 is derivative over i+2
5131 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
5133 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5134 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
5136 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
5138 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
5140 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5141 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
5142 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
5143 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
5144 if (shield_mode.eq.0) then
5149 eello_turn4=eello_turn4-(s1+s2+s3) &
5150 *fac_shield(i)*fac_shield(j) &
5151 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5152 eello_t4=-(s1+s2+s3) &
5153 *fac_shield(i)*fac_shield(j)
5154 !C Now derivative over shield:
5155 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
5156 (shield_mode.gt.0)) then
5159 do ilist=1,ishield_list(i)
5160 iresshield=shield_list(ilist,i)
5162 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
5163 ! print *,"rlocshield",rlocshield,grad_shield_side(k,ilist,i),iresshield
5164 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
5166 +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
5167 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
5171 do ilist=1,ishield_list(j)
5172 iresshield=shield_list(ilist,j)
5174 ! print *,"rlocshieldj",j,rlocshield,grad_shield_side(k,ilist,j),iresshield
5175 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
5176 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
5178 +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
5179 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
5181 ! print *,"after", gshieldc_t4(k,iresshield-1),iresshield-1,gshieldc_t4(k,iresshield)
5186 gshieldc_t4(k,i)=gshieldc_t4(k,i)+ &
5187 grad_shield(k,i)*eello_t4/fac_shield(i)
5188 gshieldc_t4(k,j)=gshieldc_t4(k,j)+ &
5189 grad_shield(k,j)*eello_t4/fac_shield(j)
5190 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+ &
5191 grad_shield(k,i)*eello_t4/fac_shield(i)
5192 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+ &
5193 grad_shield(k,j)*eello_t4/fac_shield(j)
5194 ! print *,"gshieldc_t4(k,j+1)",j,gshieldc_t4(k,j+1)
5198 gloc(nphi+i,icg)=gloc(nphi+i,icg)&
5199 -(gs13+gsE13+gsEE1)*wturn4&
5200 *fac_shield(i)*fac_shield(j)
5201 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)&
5202 -(gs23+gs21+gsEE2)*wturn4&
5203 *fac_shield(i)*fac_shield(j)
5205 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)&
5206 -(gs32+gsE31+gsEE3)*wturn4&
5207 *fac_shield(i)*fac_shield(j)
5209 !c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
5212 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
5213 'eturn4',i,j,-(s1+s2+s3)
5214 !d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5215 !d & ' eello_turn4_num',8*eello_turn4_num
5216 ! Derivatives in gamma(i)
5217 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
5218 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
5219 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
5220 s1=scalar2(b1(1,i+1),auxvec(1))
5221 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
5222 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5223 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) &
5224 *fac_shield(i)*fac_shield(j) &
5225 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5227 ! Derivatives in gamma(i+1)
5228 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
5229 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
5230 s2=scalar2(b1(1,iti1),auxvec(1))
5231 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
5232 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
5233 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5234 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) &
5235 *fac_shield(i)*fac_shield(j) &
5236 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5238 ! Derivatives in gamma(i+2)
5239 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
5240 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
5241 s1=scalar2(b1(1,iti2),auxvec(1))
5242 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
5243 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
5244 s2=scalar2(b1(1,iti1),auxvec(1))
5245 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
5246 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
5247 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5248 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) &
5249 *fac_shield(i)*fac_shield(j) &
5250 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5252 ! Cartesian derivatives
5253 ! Derivatives of this turn contributions in DC(i+2)
5254 if (j.lt.nres-1) then
5256 a_temp(1,1)=agg(l,1)
5257 a_temp(1,2)=agg(l,2)
5258 a_temp(2,1)=agg(l,3)
5259 a_temp(2,2)=agg(l,4)
5260 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5261 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5262 s1=scalar2(b1(1,iti2),auxvec(1))
5263 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5264 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5265 s2=scalar2(b1(1,iti1),auxvec(1))
5266 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5267 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5268 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5270 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)&
5271 *fac_shield(i)*fac_shield(j) &
5272 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5276 ! Remaining derivatives of this turn contribution
5278 a_temp(1,1)=aggi(l,1)
5279 a_temp(1,2)=aggi(l,2)
5280 a_temp(2,1)=aggi(l,3)
5281 a_temp(2,2)=aggi(l,4)
5282 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5283 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5284 s1=scalar2(b1(1,iti2),auxvec(1))
5285 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5286 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5287 s2=scalar2(b1(1,iti1),auxvec(1))
5288 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5289 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5290 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5291 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) &
5292 *fac_shield(i)*fac_shield(j) &
5293 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5296 a_temp(1,1)=aggi1(l,1)
5297 a_temp(1,2)=aggi1(l,2)
5298 a_temp(2,1)=aggi1(l,3)
5299 a_temp(2,2)=aggi1(l,4)
5300 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5301 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5302 s1=scalar2(b1(1,iti2),auxvec(1))
5303 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5304 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5305 s2=scalar2(b1(1,iti1),auxvec(1))
5306 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5307 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5308 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5309 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) &
5310 *fac_shield(i)*fac_shield(j) &
5311 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5314 a_temp(1,1)=aggj(l,1)
5315 a_temp(1,2)=aggj(l,2)
5316 a_temp(2,1)=aggj(l,3)
5317 a_temp(2,2)=aggj(l,4)
5318 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5319 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5320 s1=scalar2(b1(1,iti2),auxvec(1))
5321 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5322 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5323 s2=scalar2(b1(1,iti1),auxvec(1))
5324 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5325 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5326 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5327 ! if (j.lt.nres-1) then
5328 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) &
5329 *fac_shield(i)*fac_shield(j) &
5330 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5333 a_temp(1,1)=aggj1(l,1)
5334 a_temp(1,2)=aggj1(l,2)
5335 a_temp(2,1)=aggj1(l,3)
5336 a_temp(2,2)=aggj1(l,4)
5337 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5338 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5339 s1=scalar2(b1(1,iti2),auxvec(1))
5340 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5341 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5342 s2=scalar2(b1(1,iti1),auxvec(1))
5343 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5344 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5345 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5346 ! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
5347 ! if (j.lt.nres-1) then
5348 ! print *,"juest before",j1, gcorr4_turn(l,j1)
5349 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) &
5350 *fac_shield(i)*fac_shield(j) &
5351 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5352 ! if (shield_mode.gt.0) then
5353 ! print *,"juest after",j1, gcorr4_turn(l,j1),gshieldc_t4(k,j1),gshieldc_loc_t4(k,j1),gel_loc_turn4(i+2)
5355 ! print *,"juest after",j1, gcorr4_turn(l,j1),gel_loc_turn4(i+2)
5359 gshieldc_t4(3,i)=gshieldc_t4(3,i)+ &
5360 ssgradlipi*eello_t4/4.0d0*lipscale
5361 gshieldc_t4(3,j)=gshieldc_t4(3,j)+ &
5362 ssgradlipj*eello_t4/4.0d0*lipscale
5363 gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+ &
5364 ssgradlipi*eello_t4/4.0d0*lipscale
5365 gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+ &
5366 ssgradlipj*eello_t4/4.0d0*lipscale
5369 end subroutine eturn4
5370 !-----------------------------------------------------------------------------
5371 subroutine unormderiv(u,ugrad,unorm,ungrad)
5372 ! This subroutine computes the derivatives of a normalized vector u, given
5373 ! the derivatives computed without normalization conditions, ugrad. Returns
5376 real(kind=8),dimension(3) :: u,vec
5377 real(kind=8),dimension(3,3) ::ugrad,ungrad
5378 real(kind=8) :: unorm !,scalar
5380 ! write (2,*) 'ugrad',ugrad
5383 vec(i)=scalar(ugrad(1,i),u(1))
5385 ! write (2,*) 'vec',vec
5388 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
5391 ! write (2,*) 'ungrad',ungrad
5393 end subroutine unormderiv
5394 !-----------------------------------------------------------------------------
5395 subroutine escp_soft_sphere(evdw2,evdw2_14)
5397 ! This subroutine calculates the excluded-volume interaction energy between
5398 ! peptide-group centers and side chains and its gradient in virtual-bond and
5399 ! side-chain vectors.
5401 ! implicit real*8 (a-h,o-z)
5402 ! include 'DIMENSIONS'
5403 ! include 'COMMON.GEO'
5404 ! include 'COMMON.VAR'
5405 ! include 'COMMON.LOCAL'
5406 ! include 'COMMON.CHAIN'
5407 ! include 'COMMON.DERIV'
5408 ! include 'COMMON.INTERACT'
5409 ! include 'COMMON.FFIELD'
5410 ! include 'COMMON.IOUNITS'
5411 ! include 'COMMON.CONTROL'
5412 real(kind=8),dimension(3) :: ggg
5414 integer :: i,iint,j,k,iteli,itypj
5415 real(kind=8) :: evdw2,evdw2_14,r0_scp,xi,yi,zi,xj,yj,zj,&
5416 fac,rij,r0ij,r0ijsq,evdwij,e1,e2
5421 !d print '(a)','Enter ESCP'
5422 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5423 do i=iatscp_s,iatscp_e
5424 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
5426 xi=0.5D0*(c(1,i)+c(1,i+1))
5427 yi=0.5D0*(c(2,i)+c(2,i+1))
5428 zi=0.5D0*(c(3,i)+c(3,i+1))
5430 do iint=1,nscp_gr(i)
5432 do j=iscpstart(i,iint),iscpend(i,iint)
5433 if (itype(j,1).eq.ntyp1) cycle
5434 itypj=iabs(itype(j,1))
5435 ! Uncomment following three lines for SC-p interactions
5439 ! Uncomment following three lines for Ca-p interactions
5443 rij=xj*xj+yj*yj+zj*zj
5446 if (rij.lt.r0ijsq) then
5447 evdwij=0.25d0*(rij-r0ijsq)**2
5455 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
5460 !grad if (j.lt.i) then
5461 !d write (iout,*) 'j<i'
5462 ! Uncomment following three lines for SC-p interactions
5464 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5467 !d write (iout,*) 'j>i'
5469 !grad ggg(k)=-ggg(k)
5470 ! Uncomment following line for SC-p interactions
5471 ! gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5475 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5477 !grad kstart=min0(i+1,j)
5478 !grad kend=max0(i-1,j-1)
5479 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5480 !d write (iout,*) ggg(1),ggg(2),ggg(3)
5481 !grad do k=kstart,kend
5483 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5487 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5488 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5495 end subroutine escp_soft_sphere
5496 !-----------------------------------------------------------------------------
5497 subroutine escp(evdw2,evdw2_14)
5499 ! This subroutine calculates the excluded-volume interaction energy between
5500 ! peptide-group centers and side chains and its gradient in virtual-bond and
5501 ! side-chain vectors.
5503 ! implicit real*8 (a-h,o-z)
5504 ! include 'DIMENSIONS'
5505 ! include 'COMMON.GEO'
5506 ! include 'COMMON.VAR'
5507 ! include 'COMMON.LOCAL'
5508 ! include 'COMMON.CHAIN'
5509 ! include 'COMMON.DERIV'
5510 ! include 'COMMON.INTERACT'
5511 ! include 'COMMON.FFIELD'
5512 ! include 'COMMON.IOUNITS'
5513 ! include 'COMMON.CONTROL'
5514 real(kind=8),dimension(3) :: ggg
5516 integer :: i,iint,j,k,iteli,itypj,subchap
5517 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
5519 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
5520 dist_temp, dist_init
5521 integer xshift,yshift,zshift
5525 !d print '(a)','Enter ESCP'
5526 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5527 do i=iatscp_s,iatscp_e
5528 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
5530 xi=0.5D0*(c(1,i)+c(1,i+1))
5531 yi=0.5D0*(c(2,i)+c(2,i+1))
5532 zi=0.5D0*(c(3,i)+c(3,i+1))
5534 if (xi.lt.0) xi=xi+boxxsize
5536 if (yi.lt.0) yi=yi+boxysize
5538 if (zi.lt.0) zi=zi+boxzsize
5540 do iint=1,nscp_gr(i)
5542 do j=iscpstart(i,iint),iscpend(i,iint)
5543 itypj=iabs(itype(j,1))
5544 if (itypj.eq.ntyp1) cycle
5545 ! Uncomment following three lines for SC-p interactions
5549 ! Uncomment following three lines for Ca-p interactions
5557 if (xj.lt.0) xj=xj+boxxsize
5559 if (yj.lt.0) yj=yj+boxysize
5561 if (zj.lt.0) zj=zj+boxzsize
5562 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5570 xj=xj_safe+xshift*boxxsize
5571 yj=yj_safe+yshift*boxysize
5572 zj=zj_safe+zshift*boxzsize
5573 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5574 if(dist_temp.lt.dist_init) then
5584 if (subchap.eq.1) then
5594 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5595 rij=dsqrt(1.0d0/rrij)
5596 sss_ele_cut=sscale_ele(rij)
5597 sss_ele_grad=sscagrad_ele(rij)
5598 ! print *,sss_ele_cut,sss_ele_grad,&
5599 ! (rij),r_cut_ele,rlamb_ele
5600 if (sss_ele_cut.le.0.0) cycle
5602 e1=fac*fac*aad(itypj,iteli)
5603 e2=fac*bad(itypj,iteli)
5604 if (iabs(j-i) .le. 2) then
5607 evdw2_14=evdw2_14+(e1+e2)*sss_ele_cut
5610 evdw2=evdw2+evdwij*sss_ele_cut
5611 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') &
5612 ! 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),&
5613 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
5616 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
5618 fac=-(evdwij+e1)*rrij*sss_ele_cut
5619 fac=fac+evdwij*sss_ele_grad/rij/expon
5623 !grad if (j.lt.i) then
5624 !d write (iout,*) 'j<i'
5625 ! Uncomment following three lines for SC-p interactions
5627 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5630 !d write (iout,*) 'j>i'
5632 !grad ggg(k)=-ggg(k)
5633 ! Uncomment following line for SC-p interactions
5634 !cgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5635 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5639 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5641 !grad kstart=min0(i+1,j)
5642 !grad kend=max0(i-1,j-1)
5643 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5644 !d write (iout,*) ggg(1),ggg(2),ggg(3)
5645 !grad do k=kstart,kend
5647 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5651 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5652 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5660 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5661 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5662 gradx_scp(j,i)=expon*gradx_scp(j,i)
5665 !******************************************************************************
5669 ! To save time the factor EXPON has been extracted from ALL components
5670 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
5673 !******************************************************************************
5676 !-----------------------------------------------------------------------------
5677 subroutine edis(ehpb)
5679 ! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5681 ! implicit real*8 (a-h,o-z)
5682 ! include 'DIMENSIONS'
5683 ! include 'COMMON.SBRIDGE'
5684 ! include 'COMMON.CHAIN'
5685 ! include 'COMMON.DERIV'
5686 ! include 'COMMON.VAR'
5687 ! include 'COMMON.INTERACT'
5688 ! include 'COMMON.IOUNITS'
5689 real(kind=8),dimension(3) :: ggg
5691 integer :: i,j,ii,jj,iii,jjj,k
5692 real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
5695 !d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5696 !d write(iout,*)'link_start=',link_start,' link_end=',link_end
5697 if (link_end.eq.0) return
5698 do i=link_start,link_end
5699 ! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5700 ! CA-CA distance used in regularization of structure.
5703 ! iii and jjj point to the residues for which the distance is assigned.
5704 if (ii.gt.nres) then
5711 ! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5712 ! & dhpb(i),dhpb1(i),forcon(i)
5713 ! 24/11/03 AL: SS bridges handled separately because of introducing a specific
5714 ! distance and angle dependent SS bond potential.
5715 !mc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5716 ! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5717 if (.not.dyn_ss .and. i.le.nss) then
5718 ! 15/02/13 CC dynamic SSbond - additional check
5719 if (ii.gt.nres .and. iabs(itype(iii,1)).eq.1 .and. &
5720 iabs(itype(jjj,1)).eq.1) then
5721 call ssbond_ene(iii,jjj,eij)
5723 !d write (iout,*) "eij",eij
5725 else if (ii.gt.nres .and. jj.gt.nres) then
5726 !c Restraints from contact prediction
5728 if (constr_dist.eq.11) then
5729 ehpb=ehpb+fordepth(i)**4.0d0 &
5730 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5731 fac=fordepth(i)**4.0d0 &
5732 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5733 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
5736 if (dhpb1(i).gt.0.0d0) then
5737 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5738 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5739 !c write (iout,*) "beta nmr",
5740 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5744 !C Get the force constant corresponding to this distance.
5746 !C Calculate the contribution to energy.
5747 ehpb=ehpb+waga*rdis*rdis
5748 !c write (iout,*) "beta reg",dd,waga*rdis*rdis
5750 !C Evaluate gradient.
5756 ggg(j)=fac*(c(j,jj)-c(j,ii))
5759 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5760 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5763 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5764 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5768 if (constr_dist.eq.11) then
5769 ehpb=ehpb+fordepth(i)**4.0d0 &
5770 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5771 fac=fordepth(i)**4.0d0 &
5772 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5773 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
5776 if (dhpb1(i).gt.0.0d0) then
5777 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5778 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5779 !c write (iout,*) "alph nmr",
5780 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5783 !C Get the force constant corresponding to this distance.
5785 !C Calculate the contribution to energy.
5786 ehpb=ehpb+waga*rdis*rdis
5787 !c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5789 !C Evaluate gradient.
5796 ggg(j)=fac*(c(j,jj)-c(j,ii))
5798 !cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5799 !C If this is a SC-SC distance, we need to calculate the contributions to the
5800 !C Cartesian gradient in the SC vectors (ghpbx).
5803 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5804 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5807 !cgrad do j=iii,jjj-1
5809 !cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5813 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5814 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5818 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5822 !-----------------------------------------------------------------------------
5823 subroutine ssbond_ene(i,j,eij)
5825 ! Calculate the distance and angle dependent SS-bond potential energy
5826 ! using a free-energy function derived based on RHF/6-31G** ab initio
5827 ! calculations of diethyl disulfide.
5829 ! A. Liwo and U. Kozlowska, 11/24/03
5831 ! implicit real*8 (a-h,o-z)
5832 ! include 'DIMENSIONS'
5833 ! include 'COMMON.SBRIDGE'
5834 ! include 'COMMON.CHAIN'
5835 ! include 'COMMON.DERIV'
5836 ! include 'COMMON.LOCAL'
5837 ! include 'COMMON.INTERACT'
5838 ! include 'COMMON.VAR'
5839 ! include 'COMMON.IOUNITS'
5840 real(kind=8),dimension(3) :: erij,dcosom1,dcosom2,gg
5842 integer :: i,j,itypi,itypj,k
5843 real(kind=8) :: eij,rij,rrij,xi,yi,zi,dxi,dyi,dzi,dsci_inv,&
5844 xj,yj,zj,dxj,dyj,dzj,om1,om2,om12,deltad,dscj_inv,&
5845 deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,&
5848 itypi=iabs(itype(i,1))
5852 dxi=dc_norm(1,nres+i)
5853 dyi=dc_norm(2,nres+i)
5854 dzi=dc_norm(3,nres+i)
5855 ! dsci_inv=dsc_inv(itypi)
5856 dsci_inv=vbld_inv(nres+i)
5857 itypj=iabs(itype(j,1))
5858 ! dscj_inv=dsc_inv(itypj)
5859 dscj_inv=vbld_inv(nres+j)
5863 dxj=dc_norm(1,nres+j)
5864 dyj=dc_norm(2,nres+j)
5865 dzj=dc_norm(3,nres+j)
5866 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5871 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5872 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5873 om12=dxi*dxj+dyi*dyj+dzi*dzj
5875 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5876 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5882 deltat12=om2-om1+2.0d0
5884 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
5885 +akct*deltad*deltat12 &
5886 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5887 ! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5888 ! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5889 ! & " deltat12",deltat12," eij",eij
5890 ed=2*akcm*deltad+akct*deltat12
5892 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5893 eom1=-2*akth*deltat1-pom1-om2*pom2
5894 eom2= 2*akth*deltat2+pom1-om1*pom2
5897 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5898 ghpbx(k,i)=ghpbx(k,i)-ggk &
5899 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
5900 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5901 ghpbx(k,j)=ghpbx(k,j)+ggk &
5902 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
5903 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5904 ghpbc(k,i)=ghpbc(k,i)-ggk
5905 ghpbc(k,j)=ghpbc(k,j)+ggk
5908 ! Calculate the components of the gradient in DC and X
5912 !grad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5916 end subroutine ssbond_ene
5917 !-----------------------------------------------------------------------------
5918 subroutine ebond(estr)
5920 ! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5922 ! implicit real*8 (a-h,o-z)
5923 ! include 'DIMENSIONS'
5924 ! include 'COMMON.LOCAL'
5925 ! include 'COMMON.GEO'
5926 ! include 'COMMON.INTERACT'
5927 ! include 'COMMON.DERIV'
5928 ! include 'COMMON.VAR'
5929 ! include 'COMMON.CHAIN'
5930 ! include 'COMMON.IOUNITS'
5931 ! include 'COMMON.NAMES'
5932 ! include 'COMMON.FFIELD'
5933 ! include 'COMMON.CONTROL'
5934 ! include 'COMMON.SETUP'
5935 real(kind=8),dimension(3) :: u,ud
5937 integer :: i,j,iti,nbi,k
5938 real(kind=8) :: estr,estr1,diff,uprod,usum,usumsqder,&
5943 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
5944 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
5946 do i=ibondp_start,ibondp_end
5947 if (itype(i-1,1).eq.ntyp1 .and. itype(i,1).eq.ntyp1) cycle
5948 if (itype(i-1,1).eq.ntyp1 .or. itype(i,1).eq.ntyp1) then
5949 !C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5951 !C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) &
5952 !C *dc(j,i-1)/vbld(i)
5954 !C if (energy_dec) write(iout,*) &
5955 !C "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5956 diff = vbld(i)-vbldpDUM
5958 diff = vbld(i)-vbldp0
5960 if (energy_dec) write (iout,'(a7,i5,4f7.3)') &
5961 "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5964 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5966 ! write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5969 estr=0.5d0*AKP*estr+estr1
5970 ! print *,"estr_bb",estr,AKP
5972 ! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5974 do i=ibond_start,ibond_end
5975 iti=iabs(itype(i,1))
5976 if (iti.eq.0) print *,"WARNING WRONG SETTTING",i
5977 if (iti.ne.10 .and. iti.ne.ntyp1) then
5980 diff=vbld(i+nres)-vbldsc0(1,iti)
5981 if (energy_dec) write (iout,*) &
5982 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5983 AKSC(1,iti),AKSC(1,iti)*diff*diff
5984 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5985 ! print *,"estr_sc",estr
5987 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5991 diff=vbld(i+nres)-vbldsc0(j,iti)
5992 ud(j)=aksc(j,iti)*diff
5993 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
6007 uprod2=uprod2*u(k)*u(k)
6011 usumsqder=usumsqder+ud(j)*uprod2
6013 estr=estr+uprod/usum
6014 ! print *,"estr_sc",estr,i
6016 if (energy_dec) write (iout,*) &
6017 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
6018 AKSC(1,iti),uprod/usum
6020 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
6026 end subroutine ebond
6028 !-----------------------------------------------------------------------------
6029 subroutine ebend(etheta)
6031 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6032 ! angles gamma and its derivatives in consecutive thetas and gammas.
6035 ! implicit real*8 (a-h,o-z)
6036 ! include 'DIMENSIONS'
6037 ! include 'COMMON.LOCAL'
6038 ! include 'COMMON.GEO'
6039 ! include 'COMMON.INTERACT'
6040 ! include 'COMMON.DERIV'
6041 ! include 'COMMON.VAR'
6042 ! include 'COMMON.CHAIN'
6043 ! include 'COMMON.IOUNITS'
6044 ! include 'COMMON.NAMES'
6045 ! include 'COMMON.FFIELD'
6046 ! include 'COMMON.CONTROL'
6047 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
6048 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
6049 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
6051 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
6052 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
6053 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6055 integer :: i,k,ichir1,ichir2,itype1,ichir11,ichir12,itype2,&
6057 real(kind=8) :: etheta,delta,ss,ssd,phii,phii1,thet_pred_mean,&
6058 athetk,bthetk,dthett,dthetg1,dthetg2,f0,fprim0,E_tc0,fprim_tc0,&
6059 f1,fprim1,E_tc1,ethetai,E_theta,E_tc
6060 real(kind=8),dimension(2) :: y,z
6063 ! time11=dexp(-2*time)
6066 ! write (*,'(a,i2)') 'EBEND ICG=',icg
6067 do i=ithet_start,ithet_end
6068 if (itype(i-1,1).eq.ntyp1) cycle
6069 ! Zero the energy function and its derivative at 0 or pi.
6070 call splinthet(theta(i),0.5d0*delta,ss,ssd)
6072 ichir1=isign(1,itype(i-2,1))
6073 ichir2=isign(1,itype(i,1))
6074 if (itype(i-2,1).eq.10) ichir1=isign(1,itype(i-1,1))
6075 if (itype(i,1).eq.10) ichir2=isign(1,itype(i-1,1))
6076 if (itype(i-1,1).eq.10) then
6077 itype1=isign(10,itype(i-2,1))
6078 ichir11=isign(1,itype(i-2,1))
6079 ichir12=isign(1,itype(i-2,1))
6080 itype2=isign(10,itype(i,1))
6081 ichir21=isign(1,itype(i,1))
6082 ichir22=isign(1,itype(i,1))
6085 if (i.gt.3 .and. itype(i-2,1).ne.ntyp1) then
6088 if (phii.ne.phii) phii=150.0
6098 if (i.lt.nres .and. itype(i,1).ne.ntyp1) then
6101 if (phii1.ne.phii1) phii1=150.0
6113 ! Calculate the "mean" value of theta from the part of the distribution
6114 ! dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
6115 ! In following comments this theta will be referred to as t_c.
6116 thet_pred_mean=0.0d0
6118 athetk=athet(k,it,ichir1,ichir2)
6119 bthetk=bthet(k,it,ichir1,ichir2)
6121 athetk=athet(k,itype1,ichir11,ichir12)
6122 bthetk=bthet(k,itype2,ichir21,ichir22)
6124 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
6126 dthett=thet_pred_mean*ssd
6127 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
6128 ! Derivatives of the "mean" values in gamma1 and gamma2.
6129 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) &
6130 +athet(2,it,ichir1,ichir2)*y(1))*ss
6131 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) &
6132 +bthet(2,it,ichir1,ichir2)*z(1))*ss
6134 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) &
6135 +athet(2,itype1,ichir11,ichir12)*y(1))*ss
6136 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) &
6137 +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
6139 if (theta(i).gt.pi-delta) then
6140 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,&
6142 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
6143 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6144 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,&
6146 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,&
6148 else if (theta(i).lt.delta) then
6149 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
6150 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6151 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,&
6153 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
6154 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,&
6157 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,&
6160 etheta=etheta+ethetai
6161 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6163 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
6164 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
6165 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
6167 ! print *,ithetaconstr_start,ithetaconstr_end,"TU"
6169 ! Ufff.... We've done all this!!!
6171 end subroutine ebend
6172 !-----------------------------------------------------------------------------
6173 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
6176 ! implicit real*8 (a-h,o-z)
6177 ! include 'DIMENSIONS'
6178 ! include 'COMMON.LOCAL'
6179 ! include 'COMMON.IOUNITS'
6180 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
6181 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
6182 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
6184 real(kind=8) :: thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc
6186 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
6187 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
6188 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6190 real(kind=8) :: sig,fac,escloci0,escloci1,esclocbi0,dersc12,&
6191 esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
6193 ! Calculate the contributions to both Gaussian lobes.
6194 ! 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
6195 ! The "polynomial part" of the "standard deviation" of this part of
6199 sig=sig*thet_pred_mean+polthet(j,it)
6201 ! Derivative of the "interior part" of the "standard deviation of the"
6202 ! gamma-dependent Gaussian lobe in t_c.
6203 sigtc=3*polthet(3,it)
6205 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
6208 ! Set the parameters of both Gaussian lobes of the distribution.
6209 ! "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
6210 fac=sig*sig+sigc0(it)
6213 ! Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
6214 sigsqtc=-4.0D0*sigcsq*sigtc
6215 ! print *,i,sig,sigtc,sigsqtc
6216 ! Following variable (sigtc) is d[sigma(t_c)]/dt_c
6217 sigtc=-sigtc/(fac*fac)
6218 ! Following variable is sigma(t_c)**(-2)
6219 sigcsq=sigcsq*sigcsq
6221 sig0inv=1.0D0/sig0i**2
6222 delthec=thetai-thet_pred_mean
6223 delthe0=thetai-theta0i
6224 term1=-0.5D0*sigcsq*delthec*delthec
6225 term2=-0.5D0*sig0inv*delthe0*delthe0
6226 ! Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
6227 ! NaNs in taking the logarithm. We extract the largest exponent which is added
6228 ! to the energy (this being the log of the distribution) at the end of energy
6229 ! term evaluation for this virtual-bond angle.
6230 if (term1.gt.term2) then
6232 term2=dexp(term2-termm)
6236 term1=dexp(term1-termm)
6239 ! The ratio between the gamma-independent and gamma-dependent lobes of
6240 ! the distribution is a Gaussian function of thet_pred_mean too.
6241 diffak=gthet(2,it)-thet_pred_mean
6242 ratak=diffak/gthet(3,it)**2
6243 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
6244 ! Let's differentiate it in thet_pred_mean NOW.
6246 ! Now put together the distribution terms to make complete distribution.
6247 termexp=term1+ak*term2
6248 termpre=sigc+ak*sig0i
6249 ! Contribution of the bending energy from this theta is just the -log of
6250 ! the sum of the contributions from the two lobes and the pre-exponential
6251 ! factor. Simple enough, isn't it?
6252 ethetai=(-dlog(termexp)-termm+dlog(termpre))
6253 ! NOW the derivatives!!!
6254 ! 6/6/97 Take into account the deformation.
6255 E_theta=(delthec*sigcsq*term1 &
6256 +ak*delthe0*sig0inv*term2)/termexp
6257 E_tc=((sigtc+aktc*sig0i)/termpre &
6258 -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ &
6259 aktc*term2)/termexp)
6261 end subroutine theteng
6263 !-----------------------------------------------------------------------------
6264 subroutine ebend(etheta)
6266 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6267 ! angles gamma and its derivatives in consecutive thetas and gammas.
6268 ! ab initio-derived potentials from
6269 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
6271 ! implicit real*8 (a-h,o-z)
6272 ! include 'DIMENSIONS'
6273 ! include 'COMMON.LOCAL'
6274 ! include 'COMMON.GEO'
6275 ! include 'COMMON.INTERACT'
6276 ! include 'COMMON.DERIV'
6277 ! include 'COMMON.VAR'
6278 ! include 'COMMON.CHAIN'
6279 ! include 'COMMON.IOUNITS'
6280 ! include 'COMMON.NAMES'
6281 ! include 'COMMON.FFIELD'
6282 ! include 'COMMON.CONTROL'
6283 real(kind=8),dimension(nntheterm) :: coskt,sinkt !mmaxtheterm
6284 real(kind=8),dimension(nsingle) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
6285 real(kind=8),dimension(ndouble,ndouble) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
6286 logical :: lprn=.false., lprn1=.false.
6288 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
6289 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
6290 real(kind=8) :: aux,etheta,ccl,ssl,scl,csl,ethetacnstr
6291 ! local variables for constrains
6292 real(kind=8) :: difi,thetiii
6294 ! write(iout,*) "in ebend",ithet_start,ithet_end
6297 do i=ithet_start,ithet_end
6298 if (itype(i-1,1).eq.ntyp1) cycle
6299 if (itype(i-2,1).eq.ntyp1.or.itype(i,1).eq.ntyp1) cycle
6300 if (iabs(itype(i+1,1)).eq.20) iblock=2
6301 if (iabs(itype(i+1,1)).ne.20) iblock=1
6305 theti2=0.5d0*theta(i)
6306 ityp2=ithetyp((itype(i-1,1)))
6308 coskt(k)=dcos(k*theti2)
6309 sinkt(k)=dsin(k*theti2)
6311 if (i.gt.3 .and. itype(max0(i-3,1),1).ne.ntyp1) then
6314 if (phii.ne.phii) phii=150.0
6318 ityp1=ithetyp((itype(i-2,1)))
6319 ! propagation of chirality for glycine type
6321 cosph1(k)=dcos(k*phii)
6322 sinph1(k)=dsin(k*phii)
6326 ityp1=ithetyp(itype(i-2,1))
6332 if (i.lt.nres .and. itype(i+1,1).ne.ntyp1) then
6335 if (phii1.ne.phii1) phii1=150.0
6340 ityp3=ithetyp((itype(i,1)))
6342 cosph2(k)=dcos(k*phii1)
6343 sinph2(k)=dsin(k*phii1)
6347 ityp3=ithetyp(itype(i,1))
6353 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
6356 ccl=cosph1(l)*cosph2(k-l)
6357 ssl=sinph1(l)*sinph2(k-l)
6358 scl=sinph1(l)*cosph2(k-l)
6359 csl=cosph1(l)*sinph2(k-l)
6360 cosph1ph2(l,k)=ccl-ssl
6361 cosph1ph2(k,l)=ccl+ssl
6362 sinph1ph2(l,k)=scl+csl
6363 sinph1ph2(k,l)=scl-csl
6367 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
6368 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
6369 write (iout,*) "coskt and sinkt"
6371 write (iout,*) k,coskt(k),sinkt(k)
6375 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
6376 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) &
6379 write (iout,*) "k",k,&
6380 "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),&
6384 write (iout,*) "cosph and sinph"
6386 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6388 write (iout,*) "cosph1ph2 and sinph2ph2"
6391 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
6392 sinph1ph2(l,k),sinph1ph2(k,l)
6395 write(iout,*) "ethetai",ethetai
6399 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) &
6400 +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) &
6401 +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) &
6402 +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
6403 ethetai=ethetai+sinkt(m)*aux
6404 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6405 dephii=dephii+k*sinkt(m)* &
6406 (ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- &
6407 bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
6408 dephii1=dephii1+k*sinkt(m)* &
6409 (eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- &
6410 ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
6412 write (iout,*) "m",m," k",k," bbthet", &
6413 bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", &
6414 ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", &
6415 ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", &
6416 eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
6420 write(iout,*) "ethetai",ethetai
6424 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
6425 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ &
6426 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
6427 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
6428 ethetai=ethetai+sinkt(m)*aux
6429 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6430 dephii=dephii+l*sinkt(m)* &
6431 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- &
6432 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
6433 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
6434 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6435 dephii1=dephii1+(k-l)*sinkt(m)* &
6436 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
6437 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
6438 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- &
6439 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6441 write (iout,*) "m",m," k",k," l",l," ffthet",&
6442 ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
6443 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",&
6444 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
6445 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),&
6447 write (iout,*) cosph1ph2(l,k)*sinkt(m),&
6448 cosph1ph2(k,l)*sinkt(m),&
6449 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6457 write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
6458 i,theta(i)*rad2deg,phii*rad2deg,&
6459 phii1*rad2deg,ethetai
6461 etheta=etheta+ethetai
6462 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6464 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6465 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6466 gloc(nphi+i-2,icg)=wang*dethetai
6468 !-----------thete constrains
6469 ! if (tor_mode.ne.2) then
6472 end subroutine ebend
6475 !-----------------------------------------------------------------------------
6476 subroutine esc(escloc)
6477 ! Calculate the local energy of a side chain and its derivatives in the
6478 ! corresponding virtual-bond valence angles THETA and the spherical angles
6482 ! implicit real*8 (a-h,o-z)
6483 ! include 'DIMENSIONS'
6484 ! include 'COMMON.GEO'
6485 ! include 'COMMON.LOCAL'
6486 ! include 'COMMON.VAR'
6487 ! include 'COMMON.INTERACT'
6488 ! include 'COMMON.DERIV'
6489 ! include 'COMMON.CHAIN'
6490 ! include 'COMMON.IOUNITS'
6491 ! include 'COMMON.NAMES'
6492 ! include 'COMMON.FFIELD'
6493 ! include 'COMMON.CONTROL'
6494 real(kind=8),dimension(3) :: x,dersc,xemp,dersc0,dersc1,&
6495 ddersc0,ddummy,xtemp,temp
6496 !el real(kind=8) :: time11,time12,time112,theti
6497 real(kind=8) :: escloc,delta
6498 !el integer :: it,nlobit
6499 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6502 real(kind=8) :: escloci0,escloci1,escloci,esclocbi0,&
6503 dersc12,esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
6506 ! write (iout,'(a)') 'ESC'
6507 do i=loc_start,loc_end
6509 if (it.eq.ntyp1) cycle
6510 if (it.eq.10) goto 1
6511 nlobit=nlob(iabs(it))
6512 ! print *,'i=',i,' it=',it,' nlobit=',nlobit
6513 ! write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6514 theti=theta(i+1)-pipol
6519 if (x(2).gt.pi-delta) then
6523 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6525 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6526 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),&
6528 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
6529 ddersc0(1),dersc(1))
6530 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),&
6531 ddersc0(3),dersc(3))
6533 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6535 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6536 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,&
6537 dersc0(2),esclocbi,dersc02)
6538 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
6540 call splinthet(x(2),0.5d0*delta,ss,ssd)
6545 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6547 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6548 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6550 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6552 ! write (iout,*) escloci
6553 else if (x(2).lt.delta) then
6557 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6559 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6560 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),&
6562 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
6563 ddersc0(1),dersc(1))
6564 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),&
6565 ddersc0(3),dersc(3))
6567 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6569 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6570 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,&
6571 dersc0(2),esclocbi,dersc02)
6572 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
6577 call splinthet(x(2),0.5d0*delta,ss,ssd)
6579 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6581 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6582 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6584 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6585 ! write (iout,*) escloci
6587 call enesc(x,escloci,dersc,ddummy,.false.)
6590 escloc=escloc+escloci
6591 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6593 ! write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6595 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ &
6597 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6598 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6603 !-----------------------------------------------------------------------------
6604 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6607 ! implicit real*8 (a-h,o-z)
6608 ! include 'DIMENSIONS'
6609 ! include 'COMMON.GEO'
6610 ! include 'COMMON.LOCAL'
6611 ! include 'COMMON.IOUNITS'
6612 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6613 real(kind=8),dimension(3) :: x,z,dersc,ddersc
6614 real(kind=8),dimension(3,nlobit,-1:1) :: Ax !(3,maxlob,-1:1)
6615 real(kind=8),dimension(nlobit,-1:1) :: contr !(maxlob,-1:1)
6616 real(kind=8) :: escloci
6619 integer :: j,iii,l,k !el,it,nlobit
6620 real(kind=8) :: escloc_i,x3,Axk,expfac,emin !el,theti,&
6621 !el time11,time12,time112
6622 ! write (iout,*) 'it=',it,' nlobit=',nlobit
6626 if (mixed) ddersc(j)=0.0d0
6630 ! Because of periodicity of the dependence of the SC energy in omega we have
6631 ! to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6632 ! To avoid underflows, first compute & store the exponents.
6640 z(k)=x(k)-censc(k,j,it)
6645 Axk=Axk+gaussc(l,k,j,it)*z(l)
6651 expfac=expfac+Ax(k,j,iii)*z(k)
6659 ! As in the case of ebend, we want to avoid underflows in exponentiation and
6660 ! subsequent NaNs and INFs in energy calculation.
6661 ! Find the largest exponent
6665 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6669 !d print *,'it=',it,' emin=',emin
6671 ! Compute the contribution to SC energy and derivatives
6676 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6677 if(adexp.ne.adexp) adexp=1.0
6680 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6682 !d print *,'j=',j,' expfac=',expfac
6683 escloc_i=escloc_i+expfac
6685 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6689 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) &
6690 +gaussc(k,2,j,it))*expfac
6697 dersc(1)=dersc(1)/cos(theti)**2
6698 ddersc(1)=ddersc(1)/cos(theti)**2
6701 escloci=-(dlog(escloc_i)-emin)
6703 dersc(j)=dersc(j)/escloc_i
6707 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6711 end subroutine enesc
6712 !-----------------------------------------------------------------------------
6713 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6716 ! implicit real*8 (a-h,o-z)
6717 ! include 'DIMENSIONS'
6718 ! include 'COMMON.GEO'
6719 ! include 'COMMON.LOCAL'
6720 ! include 'COMMON.IOUNITS'
6721 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6722 real(kind=8),dimension(3) :: x,z,dersc
6723 real(kind=8),dimension(3,nlobit) :: Ax !(3,maxlob)
6724 real(kind=8),dimension(nlobit) :: contr !(maxlob)
6725 real(kind=8) :: escloci,dersc12,emin
6728 integer :: j,k,l !el,it,nlobit
6729 real(kind=8) :: escloc_i,Axk,expfac !el,time11,time12,time112,theti
6739 z(k)=x(k)-censc(k,j,it)
6745 Axk=Axk+gaussc(l,k,j,it)*z(l)
6751 expfac=expfac+Ax(k,j)*z(k)
6756 ! As in the case of ebend, we want to avoid underflows in exponentiation and
6757 ! subsequent NaNs and INFs in energy calculation.
6758 ! Find the largest exponent
6761 if (emin.gt.contr(j)) emin=contr(j)
6765 ! Compute the contribution to SC energy and derivatives
6769 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6770 escloc_i=escloc_i+expfac
6772 dersc(k)=dersc(k)+Ax(k,j)*expfac
6774 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) &
6775 +gaussc(1,2,j,it))*expfac
6779 dersc(1)=dersc(1)/cos(theti)**2
6780 dersc12=dersc12/cos(theti)**2
6781 escloci=-(dlog(escloc_i)-emin)
6783 dersc(j)=dersc(j)/escloc_i
6785 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6787 end subroutine enesc_bound
6789 !-----------------------------------------------------------------------------
6790 subroutine esc(escloc)
6791 ! Calculate the local energy of a side chain and its derivatives in the
6792 ! corresponding virtual-bond valence angles THETA and the spherical angles
6793 ! ALPHA and OMEGA derived from AM1 all-atom calculations.
6794 ! added by Urszula Kozlowska. 07/11/2007
6797 ! implicit real*8 (a-h,o-z)
6798 ! include 'DIMENSIONS'
6799 ! include 'COMMON.GEO'
6800 ! include 'COMMON.LOCAL'
6801 ! include 'COMMON.VAR'
6802 ! include 'COMMON.SCROT'
6803 ! include 'COMMON.INTERACT'
6804 ! include 'COMMON.DERIV'
6805 ! include 'COMMON.CHAIN'
6806 ! include 'COMMON.IOUNITS'
6807 ! include 'COMMON.NAMES'
6808 ! include 'COMMON.FFIELD'
6809 ! include 'COMMON.CONTROL'
6810 ! include 'COMMON.VECTORS'
6811 real(kind=8),dimension(3) :: x_prime,y_prime,z_prime
6812 real(kind=8),dimension(65) :: x
6813 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1,sumene2,sumene3,&
6814 sumene4,s1,s1_6,s2,s2_6,de_dxx,de_dyy,de_dzz,de_dt
6815 real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
6816 real(kind=8),dimension(3) :: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,dYY_Ci,&
6817 dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
6819 integer :: i,j,k !el,it,nlobit
6820 real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
6821 !el real(kind=8) :: time11,time12,time112,theti
6822 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6823 real(kind=8) :: dscp1,dscp2,pom_s1,pom_s16,pom_s2,pom_s26,&
6824 pom,pom_dx,pom_dy,pom_dt1,pom_dt2,pom1,pom2,&
6825 sumene1x,sumene2x,sumene3x,sumene4x,&
6826 sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,&
6829 real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,&
6830 de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,&
6833 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
6837 do i=loc_start,loc_end
6838 if (itype(i,1).eq.ntyp1) cycle
6839 costtab(i+1) =dcos(theta(i+1))
6840 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6841 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6842 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6843 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6844 cosfac=dsqrt(cosfac2)
6845 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6846 sinfac=dsqrt(sinfac2)
6848 if (it.eq.10) goto 1
6850 ! Compute the axes of tghe local cartesian coordinates system; store in
6851 ! x_prime, y_prime and z_prime
6858 ! write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6859 ! & dc_norm(3,i+nres)
6861 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6862 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6865 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i,1)))
6868 ! write (2,*) "x_prime",(x_prime(j),j=1,3)
6869 ! write (2,*) "y_prime",(y_prime(j),j=1,3)
6870 ! write (2,*) "z_prime",(z_prime(j),j=1,3)
6871 ! write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6872 ! & " xy",scalar(x_prime(1),y_prime(1)),
6873 ! & " xz",scalar(x_prime(1),z_prime(1)),
6874 ! & " yy",scalar(y_prime(1),y_prime(1)),
6875 ! & " yz",scalar(y_prime(1),z_prime(1)),
6876 ! & " zz",scalar(z_prime(1),z_prime(1))
6878 ! Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6879 ! to local coordinate system. Store in xx, yy, zz.
6885 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6886 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6887 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6894 ! Compute the energy of the ith side cbain
6896 ! write (2,*) "xx",xx," yy",yy," zz",zz
6899 x(j) = sc_parmin(j,it)
6902 !c diagnostics - remove later
6904 yy1 = dsin(alph(2))*dcos(omeg(2))
6905 zz1 = -dsign(1.0,dfloat(itype(i,1)))*dsin(alph(2))*dsin(omeg(2))
6906 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
6907 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
6909 !," --- ", xx_w,yy_w,zz_w
6912 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6913 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6915 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6916 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6918 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6919 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6920 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6921 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6922 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6924 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6925 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6926 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6927 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6928 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6930 dsc_i = 0.743d0+x(61)
6932 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6933 *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6934 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6935 *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6936 s1=(1+x(63))/(0.1d0 + dscp1)
6937 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6938 s2=(1+x(65))/(0.1d0 + dscp2)
6939 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6940 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) &
6941 + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6942 ! write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6944 ! & dscp1,dscp2,sumene
6945 ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6946 escloc = escloc + sumene
6947 ! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i,1)
6952 ! This section to check the numerical derivatives of the energy of ith side
6953 ! chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6954 ! #define DEBUG in the code to turn it on.
6956 write (2,*) "sumene =",sumene
6960 write (2,*) xx,yy,zz
6961 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6962 de_dxx_num=(sumenep-sumene)/aincr
6964 write (2,*) "xx+ sumene from enesc=",sumenep
6967 write (2,*) xx,yy,zz
6968 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6969 de_dyy_num=(sumenep-sumene)/aincr
6971 write (2,*) "yy+ sumene from enesc=",sumenep
6974 write (2,*) xx,yy,zz
6975 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6976 de_dzz_num=(sumenep-sumene)/aincr
6978 write (2,*) "zz+ sumene from enesc=",sumenep
6979 costsave=cost2tab(i+1)
6980 sintsave=sint2tab(i+1)
6981 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6982 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6983 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6984 de_dt_num=(sumenep-sumene)/aincr
6985 write (2,*) " t+ sumene from enesc=",sumenep
6986 cost2tab(i+1)=costsave
6987 sint2tab(i+1)=sintsave
6988 ! End of diagnostics section.
6991 ! Compute the gradient of esc
6993 ! zz=zz*dsign(1.0,dfloat(itype(i,1)))
6994 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6995 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6996 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6997 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6998 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6999 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
7000 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
7001 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
7002 pom1=(sumene3*sint2tab(i+1)+sumene1) &
7003 *(pom_s1/dscp1+pom_s16*dscp1**4)
7004 pom2=(sumene4*cost2tab(i+1)+sumene2) &
7005 *(pom_s2/dscp2+pom_s26*dscp2**4)
7006 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
7007 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 &
7008 +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) &
7010 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
7011 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 &
7012 +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) &
7014 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) &
7015 +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
7018 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i,1)
7021 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
7022 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 &
7023 +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) &
7025 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
7026 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz &
7027 +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz &
7028 +x(59)*zz**2 +x(60)*xx*zz
7029 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) &
7030 +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
7033 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i,1)
7036 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
7037 +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx &
7038 +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) &
7039 +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) &
7040 +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 &
7041 +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy &
7042 +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
7043 + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
7045 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i,1)
7048 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
7049 -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
7050 +pom1*pom_dt1+pom2*pom_dt2
7052 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i,1)
7056 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
7057 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
7058 cosfac2xx=cosfac2*xx
7059 sinfac2yy=sinfac2*yy
7061 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* &
7063 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* &
7065 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
7066 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
7067 ! write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
7068 ! & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
7069 ! write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
7070 ! & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
7071 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
7072 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
7073 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
7074 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
7078 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
7079 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
7080 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
7081 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
7084 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
7085 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
7086 dZZ_XYZ(k)=vbld_inv(i+nres)* &
7087 (z_prime(k)-zz*dC_norm(k,i+nres))
7089 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
7090 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
7094 dXX_Ctab(k,i)=dXX_Ci(k)
7095 dXX_C1tab(k,i)=dXX_Ci1(k)
7096 dYY_Ctab(k,i)=dYY_Ci(k)
7097 dYY_C1tab(k,i)=dYY_Ci1(k)
7098 dZZ_Ctab(k,i)=dZZ_Ci(k)
7099 dZZ_C1tab(k,i)=dZZ_Ci1(k)
7100 dXX_XYZtab(k,i)=dXX_XYZ(k)
7101 dYY_XYZtab(k,i)=dYY_XYZ(k)
7102 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
7106 ! write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
7107 ! & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
7108 ! write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
7109 ! & dyy_ci(k)," dzz_ci",dzz_ci(k)
7110 ! write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
7112 ! write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
7113 ! & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
7114 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) &
7115 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
7116 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) &
7117 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
7118 gsclocx(k,i)= de_dxx*dxx_XYZ(k) &
7119 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
7121 ! write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
7122 ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
7124 ! to check gradient call subroutine check_grad
7130 !-----------------------------------------------------------------------------
7131 real(kind=8) function enesc(x,xx,yy,zz,cost2,sint2)
7133 real(kind=8),dimension(65) :: x
7134 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2,sumene3,&
7135 sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
7137 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
7138 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
7140 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
7141 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
7143 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
7144 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
7145 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
7146 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
7147 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
7149 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
7150 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
7151 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
7152 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
7153 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
7155 dsc_i = 0.743d0+x(61)
7157 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
7158 *(xx*cost2+yy*sint2))
7159 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
7160 *(xx*cost2-yy*sint2))
7161 s1=(1+x(63))/(0.1d0 + dscp1)
7162 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7163 s2=(1+x(65))/(0.1d0 + dscp2)
7164 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7165 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) &
7166 + (sumene4*cost2 +sumene2)*(s2+s2_6)
7171 !-----------------------------------------------------------------------------
7172 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
7174 ! This procedure calculates two-body contact function g(rij) and its derivative:
7177 ! g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
7180 ! where x=(rij-r0ij)/delta
7182 ! rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
7185 real(kind=8) :: rij,r0ij,eps0ij,fcont,fprimcont
7186 real(kind=8) :: x,x2,x4,delta
7190 if (x.lt.-1.0D0) then
7193 else if (x.le.1.0D0) then
7196 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
7197 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
7203 end subroutine gcont
7204 !-----------------------------------------------------------------------------
7205 subroutine splinthet(theti,delta,ss,ssder)
7206 ! implicit real*8 (a-h,o-z)
7207 ! include 'DIMENSIONS'
7208 ! include 'COMMON.VAR'
7209 ! include 'COMMON.GEO'
7210 real(kind=8) :: theti,delta,ss,ssder
7211 real(kind=8) :: thetup,thetlow
7214 if (theti.gt.pipol) then
7215 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
7217 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
7221 end subroutine splinthet
7222 !-----------------------------------------------------------------------------
7223 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
7225 real(kind=8) :: x,x0,delta,f0,f1,fprim0,f,fprim
7226 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
7227 a1=fprim0*delta/(f1-f0)
7233 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
7234 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
7236 end subroutine spline1
7237 !-----------------------------------------------------------------------------
7238 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
7240 real(kind=8) :: x,x0,delta,f0x,f1x,fprim0x,fx
7241 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
7246 a2=3*(f1x-f0x)-2*fprim0x*delta
7247 a3=fprim0x*delta-2*(f1x-f0x)
7248 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
7250 end subroutine spline2
7251 !-----------------------------------------------------------------------------
7253 !-----------------------------------------------------------------------------
7254 subroutine etor(etors,edihcnstr)
7255 ! implicit real*8 (a-h,o-z)
7256 ! include 'DIMENSIONS'
7257 ! include 'COMMON.VAR'
7258 ! include 'COMMON.GEO'
7259 ! include 'COMMON.LOCAL'
7260 ! include 'COMMON.TORSION'
7261 ! include 'COMMON.INTERACT'
7262 ! include 'COMMON.DERIV'
7263 ! include 'COMMON.CHAIN'
7264 ! include 'COMMON.NAMES'
7265 ! include 'COMMON.IOUNITS'
7266 ! include 'COMMON.FFIELD'
7267 ! include 'COMMON.TORCNSTR'
7268 ! include 'COMMON.CONTROL'
7269 real(kind=8) :: etors,edihcnstr
7273 real(kind=8) :: phii,fac,etors_ii
7275 ! Set lprn=.true. for debugging
7279 do i=iphi_start,iphi_end
7281 if (itype(i-2,1).eq.ntyp1.or. itype(i-1,1).eq.ntyp1 &
7282 .or. itype(i,1).eq.ntyp1) cycle
7283 itori=itortyp(itype(i-2,1))
7284 itori1=itortyp(itype(i-1,1))
7287 ! Proline-Proline pair is a special case...
7288 if (itori.eq.3 .and. itori1.eq.3) then
7289 if (phii.gt.-dwapi3) then
7291 fac=1.0D0/(1.0D0-cosphi)
7292 etorsi=v1(1,3,3)*fac
7293 etorsi=etorsi+etorsi
7294 etors=etors+etorsi-v1(1,3,3)
7295 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
7296 gloci=gloci-3*fac*etorsi*dsin(3*phii)
7299 v1ij=v1(j+1,itori,itori1)
7300 v2ij=v2(j+1,itori,itori1)
7303 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7304 if (energy_dec) etors_ii=etors_ii+ &
7305 v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7306 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7310 v1ij=v1(j,itori,itori1)
7311 v2ij=v2(j,itori,itori1)
7314 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7315 if (energy_dec) etors_ii=etors_ii+ &
7316 v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7317 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7320 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
7323 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
7324 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
7325 (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
7326 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7327 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7329 ! 6/20/98 - dihedral angle constraints
7332 itori=idih_constr(i)
7335 if (difi.gt.drange(i)) then
7337 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7338 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7339 else if (difi.lt.-drange(i)) then
7341 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7342 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7344 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
7345 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
7347 ! write (iout,*) 'edihcnstr',edihcnstr
7350 !-----------------------------------------------------------------------------
7351 subroutine etor_d(etors_d)
7352 real(kind=8) :: etors_d
7355 end subroutine etor_d
7357 !-----------------------------------------------------------------------------
7358 subroutine etor(etors)
7359 ! implicit real*8 (a-h,o-z)
7360 ! include 'DIMENSIONS'
7361 ! include 'COMMON.VAR'
7362 ! include 'COMMON.GEO'
7363 ! include 'COMMON.LOCAL'
7364 ! include 'COMMON.TORSION'
7365 ! include 'COMMON.INTERACT'
7366 ! include 'COMMON.DERIV'
7367 ! include 'COMMON.CHAIN'
7368 ! include 'COMMON.NAMES'
7369 ! include 'COMMON.IOUNITS'
7370 ! include 'COMMON.FFIELD'
7371 ! include 'COMMON.TORCNSTR'
7372 ! include 'COMMON.CONTROL'
7373 real(kind=8) :: etors,edihcnstr
7376 integer :: i,j,iblock,itori,itori1
7377 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
7378 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
7379 ! Set lprn=.true. for debugging
7383 do i=iphi_start,iphi_end
7384 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
7385 .or. itype(i-3,1).eq.ntyp1 &
7386 .or. itype(i,1).eq.ntyp1) cycle
7388 if (iabs(itype(i,1)).eq.20) then
7393 itori=itortyp(itype(i-2,1))
7394 itori1=itortyp(itype(i-1,1))
7397 ! Regular cosine and sine terms
7398 do j=1,nterm(itori,itori1,iblock)
7399 v1ij=v1(j,itori,itori1,iblock)
7400 v2ij=v2(j,itori,itori1,iblock)
7403 etors=etors+v1ij*cosphi+v2ij*sinphi
7404 if (energy_dec) etors_ii=etors_ii+ &
7405 v1ij*cosphi+v2ij*sinphi
7406 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7410 ! E = SUM ----------------------------------- - v1
7411 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7413 cosphi=dcos(0.5d0*phii)
7414 sinphi=dsin(0.5d0*phii)
7415 do j=1,nlor(itori,itori1,iblock)
7416 vl1ij=vlor1(j,itori,itori1)
7417 vl2ij=vlor2(j,itori,itori1)
7418 vl3ij=vlor3(j,itori,itori1)
7419 pom=vl2ij*cosphi+vl3ij*sinphi
7420 pom1=1.0d0/(pom*pom+1.0d0)
7421 etors=etors+vl1ij*pom1
7422 if (energy_dec) etors_ii=etors_ii+ &
7425 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7427 ! Subtract the constant term
7428 etors=etors-v0(itori,itori1,iblock)
7429 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
7430 'etor',i,etors_ii-v0(itori,itori1,iblock)
7432 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
7433 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
7434 (v1(j,itori,itori1,iblock),j=1,6),&
7435 (v2(j,itori,itori1,iblock),j=1,6)
7436 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7437 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7439 ! 6/20/98 - dihedral angle constraints
7442 !C The rigorous attempt to derive energy function
7443 !-------------------------------------------------------------------------------------------
7444 subroutine etor_kcc(etors)
7445 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
7446 real(kind=8) :: etors,glocig,glocit1,glocit2,sinthet1,&
7447 sinthet2,costhet1,costhet2,sint1t2,sint1t2n,phii,sinphi,cosphi,&
7448 sint1t2n1,sumvalc,gradvalct1,gradvalct2,sumvals,gradvalst1,&
7451 integer :: i,j,itori,itori1,nval,k,l
7453 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
7455 do i=iphi_start,iphi_end
7456 !C ANY TWO ARE DUMMY ATOMS in row CYCLE
7457 !c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7458 !c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7459 !c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7460 if (itype(i-2,1).eq.ntyp1.or. itype(i-1,1).eq.ntyp1 &
7461 .or. itype(i,1).eq.ntyp1 .or. itype(i-3,1).eq.ntyp1) cycle
7462 itori=itortyp(itype(i-2,1))
7463 itori1=itortyp(itype(i-1,1))
7468 !C to avoid multiple devision by 2
7469 !c theti22=0.5d0*theta(i)
7470 !C theta 12 is the theta_1 /2
7471 !C theta 22 is theta_2 /2
7472 !c theti12=0.5d0*theta(i-1)
7473 !C and appropriate sinus function
7474 sinthet1=dsin(theta(i-1))
7475 sinthet2=dsin(theta(i))
7476 costhet1=dcos(theta(i-1))
7477 costhet2=dcos(theta(i))
7478 !C to speed up lets store its mutliplication
7479 sint1t2=sinthet2*sinthet1
7481 !C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
7482 !C +d_n*sin(n*gamma)) *
7483 !C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
7484 !C we have two sum 1) Non-Chebyshev which is with n and gamma
7485 nval=nterm_kcc_Tb(itori,itori1)
7491 c1(j)=c1(j-1)*costhet1
7492 c2(j)=c2(j-1)*costhet2
7496 do j=1,nterm_kcc(itori,itori1)
7500 sint1t2n=sint1t2n*sint1t2
7506 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
7507 gradvalct1=gradvalct1+ &
7508 (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
7509 gradvalct2=gradvalct2+ &
7510 (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
7513 gradvalct1=-gradvalct1*sinthet1
7514 gradvalct2=-gradvalct2*sinthet2
7520 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
7521 gradvalst1=gradvalst1+ &
7522 (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
7523 gradvalst2=gradvalst2+ &
7524 (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
7527 gradvalst1=-gradvalst1*sinthet1
7528 gradvalst2=-gradvalst2*sinthet2
7529 if (lprn) write (iout,*)j,"sumvalc",sumvalc," sumvals",sumvals
7530 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
7531 !C glocig is the gradient local i site in gamma
7532 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
7533 !C now gradient over theta_1
7534 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)&
7535 +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
7536 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)&
7537 +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
7540 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
7541 !C derivative over theta1
7542 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
7543 !C now derivative over theta2
7544 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
7546 write (iout,*) i-2,i-1,itype(i-2,1),itype(i-1,1),itori,itori1,&
7547 theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
7548 write (iout,*) "c1",(c1(k),k=0,nval), &
7549 " c2",(c2(k),k=0,nval)
7553 end subroutine etor_kcc
7554 !------------------------------------------------------------------------------
7556 subroutine etor_constr(edihcnstr)
7557 real(kind=8) :: etors,edihcnstr
7560 integer :: i,j,iblock,itori,itori1
7561 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
7562 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom,&
7563 gaudih_i,gauder_i,s,cos_i,dexpcos_i
7565 if (raw_psipred) then
7566 do i=idihconstr_start,idihconstr_end
7567 itori=idih_constr(i)
7569 gaudih_i=vpsipred(1,i)
7573 cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
7574 dexpcos_i=dexp(-cos_i*cos_i)
7575 gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
7576 gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i)) &
7577 *cos_i*dexpcos_i/s**2
7579 edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
7580 gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
7582 write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)') &
7583 i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),&
7584 phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),&
7585 phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,&
7586 -wdihc*dlog(gaudih_i)
7590 do i=idihconstr_start,idihconstr_end
7591 itori=idih_constr(i)
7593 difi=pinorm(phii-phi0(i))
7594 if (difi.gt.drange(i)) then
7596 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7597 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7598 else if (difi.lt.-drange(i)) then
7600 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7601 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7611 end subroutine etor_constr
7612 !-----------------------------------------------------------------------------
7613 subroutine etor_d(etors_d)
7614 ! 6/23/01 Compute double torsional energy
7615 ! implicit real*8 (a-h,o-z)
7616 ! include 'DIMENSIONS'
7617 ! include 'COMMON.VAR'
7618 ! include 'COMMON.GEO'
7619 ! include 'COMMON.LOCAL'
7620 ! include 'COMMON.TORSION'
7621 ! include 'COMMON.INTERACT'
7622 ! include 'COMMON.DERIV'
7623 ! include 'COMMON.CHAIN'
7624 ! include 'COMMON.NAMES'
7625 ! include 'COMMON.IOUNITS'
7626 ! include 'COMMON.FFIELD'
7627 ! include 'COMMON.TORCNSTR'
7628 real(kind=8) :: etors_d,etors_d_ii
7631 integer :: i,j,k,l,itori,itori1,itori2,iblock
7632 real(kind=8) :: phii,phii1,gloci1,gloci2,&
7633 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
7634 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
7635 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
7636 ! Set lprn=.true. for debugging
7640 ! write(iout,*) "a tu??"
7641 do i=iphid_start,iphid_end
7643 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
7644 .or. itype(i-3,1).eq.ntyp1 &
7645 .or. itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
7646 itori=itortyp(itype(i-2,1))
7647 itori1=itortyp(itype(i-1,1))
7648 itori2=itortyp(itype(i,1))
7654 if (iabs(itype(i+1,1)).eq.20) iblock=2
7656 ! Regular cosine and sine terms
7657 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7658 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7659 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7660 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7661 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7662 cosphi1=dcos(j*phii)
7663 sinphi1=dsin(j*phii)
7664 cosphi2=dcos(j*phii1)
7665 sinphi2=dsin(j*phii1)
7666 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
7667 v2cij*cosphi2+v2sij*sinphi2
7668 if (energy_dec) etors_d_ii=etors_d_ii+ &
7669 v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
7670 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7671 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7673 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7675 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7676 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7677 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7678 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7679 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7680 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7681 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7682 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7683 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
7684 v1sdij*sinphi1p2+v2sdij*sinphi1m2
7685 if (energy_dec) etors_d_ii=etors_d_ii+ &
7686 v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
7687 v1sdij*sinphi1p2+v2sdij*sinphi1m2
7688 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
7689 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7690 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
7691 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7694 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
7695 'etor_d',i,etors_d_ii
7696 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7697 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7700 end subroutine etor_d
7703 subroutine ebend_kcc(etheta)
7705 double precision thybt1(maxang_kcc),etheta
7706 integer :: i,iti,j,ihelp
7707 real (kind=8) :: sinthet,costhet,sumth1thyb,gradthybt1
7708 !C Set lprn=.true. for debugging
7711 !C print *,"wchodze kcc"
7712 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
7714 do i=ithet_start,ithet_end
7715 !c print *,i,itype(i-1),itype(i),itype(i-2)
7716 if ((itype(i-1,1).eq.ntyp1).or.itype(i-2,1).eq.ntyp1 &
7717 .or.itype(i,1).eq.ntyp1) cycle
7718 iti=iabs(itortyp(itype(i-1,1)))
7719 sinthet=dsin(theta(i))
7720 costhet=dcos(theta(i))
7721 do j=1,nbend_kcc_Tb(iti)
7722 thybt1(j)=v1bend_chyb(j,iti)
7724 sumth1thyb=v1bend_chyb(0,iti)+ &
7725 tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
7726 if (lprn) write (iout,*) i-1,itype(i-1,1),iti,theta(i)*rad2deg,&
7728 ihelp=nbend_kcc_Tb(iti)-1
7729 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
7730 etheta=etheta+sumth1thyb
7731 !C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
7732 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
7735 end subroutine ebend_kcc
7737 !c-------------------------------------------------------------------------------------
7738 subroutine etheta_constr(ethetacnstr)
7739 real (kind=8) :: ethetacnstr,thetiii,difi
7742 !C print *,ithetaconstr_start,ithetaconstr_end,"TU"
7743 do i=ithetaconstr_start,ithetaconstr_end
7744 itheta=itheta_constr(i)
7745 thetiii=theta(itheta)
7746 difi=pinorm(thetiii-theta_constr0(i))
7747 if (difi.gt.theta_drange(i)) then
7748 difi=difi-theta_drange(i)
7749 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7750 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
7751 +for_thet_constr(i)*difi**3
7752 else if (difi.lt.-drange(i)) then
7754 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7755 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
7756 +for_thet_constr(i)*difi**3
7760 if (energy_dec) then
7761 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",&
7762 i,itheta,rad2deg*thetiii,&
7763 rad2deg*theta_constr0(i), rad2deg*theta_drange(i),&
7764 rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,&
7765 gloc(itheta+nphi-2,icg)
7769 end subroutine etheta_constr
7771 !-----------------------------------------------------------------------------
7772 subroutine eback_sc_corr(esccor)
7773 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
7774 ! conformational states; temporarily implemented as differences
7775 ! between UNRES torsional potentials (dependent on three types of
7776 ! residues) and the torsional potentials dependent on all 20 types
7777 ! of residues computed from AM1 energy surfaces of terminally-blocked
7778 ! amino-acid residues.
7779 ! implicit real*8 (a-h,o-z)
7780 ! include 'DIMENSIONS'
7781 ! include 'COMMON.VAR'
7782 ! include 'COMMON.GEO'
7783 ! include 'COMMON.LOCAL'
7784 ! include 'COMMON.TORSION'
7785 ! include 'COMMON.SCCOR'
7786 ! include 'COMMON.INTERACT'
7787 ! include 'COMMON.DERIV'
7788 ! include 'COMMON.CHAIN'
7789 ! include 'COMMON.NAMES'
7790 ! include 'COMMON.IOUNITS'
7791 ! include 'COMMON.FFIELD'
7792 ! include 'COMMON.CONTROL'
7793 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
7796 integer :: i,interty,j,isccori,isccori1,intertyp
7797 ! Set lprn=.true. for debugging
7800 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7802 do i=itau_start,itau_end
7803 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1)) cycle
7805 isccori=isccortyp(itype(i-2,1))
7806 isccori1=isccortyp(itype(i-1,1))
7808 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7810 do intertyp=1,3 !intertyp
7812 !c Added 09 May 2012 (Adasko)
7813 !c Intertyp means interaction type of backbone mainchain correlation:
7814 ! 1 = SC...Ca...Ca...Ca
7815 ! 2 = Ca...Ca...Ca...SC
7816 ! 3 = SC...Ca...Ca...SCi
7818 if (((intertyp.eq.3).and.((itype(i-2,1).eq.10).or. &
7819 (itype(i-1,1).eq.10).or.(itype(i-2,1).eq.ntyp1).or. &
7820 (itype(i-1,1).eq.ntyp1))) &
7821 .or. ((intertyp.eq.1).and.((itype(i-2,1).eq.10) &
7822 .or.(itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1) &
7823 .or.(itype(i,1).eq.ntyp1))) &
7824 .or.((intertyp.eq.2).and.((itype(i-1,1).eq.10).or. &
7825 (itype(i-1,1).eq.ntyp1).or.(itype(i-2,1).eq.ntyp1).or. &
7826 (itype(i-3,1).eq.ntyp1)))) cycle
7827 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1,1).eq.ntyp1)) cycle
7828 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres,1).eq.ntyp1)) &
7830 do j=1,nterm_sccor(isccori,isccori1)
7831 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7832 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7833 cosphi=dcos(j*tauangle(intertyp,i))
7834 sinphi=dsin(j*tauangle(intertyp,i))
7835 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
7836 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7837 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7839 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
7840 'esccor',i,intertyp,esccor_ii
7841 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7842 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7844 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
7845 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,isccori,isccori1,&
7846 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
7847 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7848 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7853 end subroutine eback_sc_corr
7854 !-----------------------------------------------------------------------------
7855 subroutine multibody(ecorr)
7856 ! This subroutine calculates multi-body contributions to energy following
7857 ! the idea of Skolnick et al. If side chains I and J make a contact and
7858 ! at the same time side chains I+1 and J+1 make a contact, an extra
7859 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7860 ! implicit real*8 (a-h,o-z)
7861 ! include 'DIMENSIONS'
7862 ! include 'COMMON.IOUNITS'
7863 ! include 'COMMON.DERIV'
7864 ! include 'COMMON.INTERACT'
7865 ! include 'COMMON.CONTACTS'
7866 real(kind=8),dimension(3) :: gx,gx1
7868 real(kind=8) :: ecorr
7869 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
7870 ! Set lprn=.true. for debugging
7874 write (iout,'(a)') 'Contact function values:'
7876 write (iout,'(i2,20(1x,i2,f10.5))') &
7877 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7882 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7883 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7895 num_conti=num_cont(i)
7896 num_conti1=num_cont(i1)
7901 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7902 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7903 !d & ' ishift=',ishift
7904 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7905 ! The system gains extra energy.
7906 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7907 endif ! j1==j+-ishift
7915 end subroutine multibody
7916 !-----------------------------------------------------------------------------
7917 real(kind=8) function esccorr(i,j,k,l,jj,kk)
7918 ! implicit real*8 (a-h,o-z)
7919 ! include 'DIMENSIONS'
7920 ! include 'COMMON.IOUNITS'
7921 ! include 'COMMON.DERIV'
7922 ! include 'COMMON.INTERACT'
7923 ! include 'COMMON.CONTACTS'
7924 real(kind=8),dimension(3) :: gx,gx1
7926 integer :: i,j,k,l,jj,kk,m,ll
7927 real(kind=8) :: eij,ekl
7931 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7932 ! Calculate the multi-body contribution to energy.
7933 ! Calculate multi-body contributions to the gradient.
7934 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7935 !d & k,l,(gacont(m,kk,k),m=1,3)
7937 gx(m) =ekl*gacont(m,jj,i)
7938 gx1(m)=eij*gacont(m,kk,k)
7939 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7940 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7941 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7942 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7946 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7951 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7956 end function esccorr
7957 !-----------------------------------------------------------------------------
7958 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7959 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7960 ! implicit real*8 (a-h,o-z)
7961 ! include 'DIMENSIONS'
7962 ! include 'COMMON.IOUNITS'
7965 ! integer :: maxconts !max_cont=maxconts =nres/4
7966 integer,parameter :: max_dim=26
7967 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7968 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7969 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7970 !el common /przechowalnia/ zapas
7971 integer :: status(MPI_STATUS_SIZE)
7972 integer,dimension((nres/4)*2) :: req !maxconts*2
7973 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
7975 ! include 'COMMON.SETUP'
7976 ! include 'COMMON.FFIELD'
7977 ! include 'COMMON.DERIV'
7978 ! include 'COMMON.INTERACT'
7979 ! include 'COMMON.CONTACTS'
7980 ! include 'COMMON.CONTROL'
7981 ! include 'COMMON.LOCAL'
7982 real(kind=8),dimension(3) :: gx,gx1
7983 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
7984 logical :: lprn,ldone
7986 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
7987 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
7989 ! Set lprn=.true. for debugging
7993 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7996 if (nfgtasks.le.1) goto 30
7998 write (iout,'(a)') 'Contact function values before RECEIVE:'
8000 write (iout,'(2i3,50(1x,i2,f5.2))') &
8001 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
8006 do i=1,ntask_cont_from
8009 do i=1,ntask_cont_to
8012 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8014 ! Make the list of contacts to send to send to other procesors
8015 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
8017 do i=iturn3_start,iturn3_end
8018 ! write (iout,*) "make contact list turn3",i," num_cont",
8020 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
8022 do i=iturn4_start,iturn4_end
8023 ! write (iout,*) "make contact list turn4",i," num_cont",
8025 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
8029 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
8031 do j=1,num_cont_hb(i)
8034 iproc=iint_sent_local(k,jjc,ii)
8035 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8036 if (iproc.gt.0) then
8037 ncont_sent(iproc)=ncont_sent(iproc)+1
8038 nn=ncont_sent(iproc)
8040 zapas(2,nn,iproc)=jjc
8041 zapas(3,nn,iproc)=facont_hb(j,i)
8042 zapas(4,nn,iproc)=ees0p(j,i)
8043 zapas(5,nn,iproc)=ees0m(j,i)
8044 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
8045 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
8046 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
8047 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
8048 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
8049 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
8050 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
8051 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
8052 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
8053 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
8054 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
8055 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
8056 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
8057 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
8058 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
8059 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
8060 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
8061 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
8062 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
8063 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
8064 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
8071 "Numbers of contacts to be sent to other processors",&
8072 (ncont_sent(i),i=1,ntask_cont_to)
8073 write (iout,*) "Contacts sent"
8074 do ii=1,ntask_cont_to
8076 iproc=itask_cont_to(ii)
8077 write (iout,*) nn," contacts to processor",iproc,&
8078 " of CONT_TO_COMM group"
8080 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8088 CorrelID1=nfgtasks+fg_rank+1
8090 ! Receive the numbers of needed contacts from other processors
8091 do ii=1,ntask_cont_from
8092 iproc=itask_cont_from(ii)
8094 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
8095 FG_COMM,req(ireq),IERR)
8097 ! write (iout,*) "IRECV ended"
8099 ! Send the number of contacts needed by other processors
8100 do ii=1,ntask_cont_to
8101 iproc=itask_cont_to(ii)
8103 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
8104 FG_COMM,req(ireq),IERR)
8106 ! write (iout,*) "ISEND ended"
8107 ! write (iout,*) "number of requests (nn)",ireq
8110 call MPI_Waitall(ireq,req,status_array,ierr)
8112 ! & "Numbers of contacts to be received from other processors",
8113 ! & (ncont_recv(i),i=1,ntask_cont_from)
8117 do ii=1,ntask_cont_from
8118 iproc=itask_cont_from(ii)
8120 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
8121 ! & " of CONT_TO_COMM group"
8125 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
8126 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8127 ! write (iout,*) "ireq,req",ireq,req(ireq)
8130 ! Send the contacts to processors that need them
8131 do ii=1,ntask_cont_to
8132 iproc=itask_cont_to(ii)
8134 ! write (iout,*) nn," contacts to processor",iproc,
8135 ! & " of CONT_TO_COMM group"
8138 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
8139 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8140 ! write (iout,*) "ireq,req",ireq,req(ireq)
8142 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8146 ! write (iout,*) "number of requests (contacts)",ireq
8147 ! write (iout,*) "req",(req(i),i=1,4)
8150 call MPI_Waitall(ireq,req,status_array,ierr)
8151 do iii=1,ntask_cont_from
8152 iproc=itask_cont_from(iii)
8155 write (iout,*) "Received",nn," contacts from processor",iproc,&
8156 " of CONT_FROM_COMM group"
8159 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
8164 ii=zapas_recv(1,i,iii)
8165 ! Flag the received contacts to prevent double-counting
8166 jj=-zapas_recv(2,i,iii)
8167 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8169 nnn=num_cont_hb(ii)+1
8172 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
8173 ees0p(nnn,ii)=zapas_recv(4,i,iii)
8174 ees0m(nnn,ii)=zapas_recv(5,i,iii)
8175 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
8176 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
8177 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
8178 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
8179 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
8180 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
8181 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
8182 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
8183 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
8184 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
8185 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
8186 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
8187 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
8188 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
8189 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
8190 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
8191 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
8192 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
8193 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
8194 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
8195 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
8200 write (iout,'(a)') 'Contact function values after receive:'
8202 write (iout,'(2i3,50(1x,i3,f5.2))') &
8203 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
8211 write (iout,'(a)') 'Contact function values:'
8213 write (iout,'(2i3,50(1x,i3,f5.2))') &
8214 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
8220 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
8221 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
8222 ! Remove the loop below after debugging !!!
8229 ! Calculate the local-electrostatic correlation terms
8230 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
8232 num_conti=num_cont_hb(i)
8233 num_conti1=num_cont_hb(i+1)
8240 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
8241 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
8242 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
8243 .or. j.lt.0 .and. j1.gt.0) .and. &
8244 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8245 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8246 ! The system gains extra energy.
8247 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8248 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
8249 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8251 else if (j1.eq.j) then
8252 ! Contacts I-J and I-(J+1) occur simultaneously.
8253 ! The system loses extra energy.
8254 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
8259 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8260 ! & ' jj=',jj,' kk=',kk
8262 ! Contacts I-J and (I+1)-J occur simultaneously.
8263 ! The system loses extra energy.
8264 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
8270 end subroutine multibody_hb
8271 !-----------------------------------------------------------------------------
8272 subroutine add_hb_contact(ii,jj,itask)
8273 ! implicit real*8 (a-h,o-z)
8274 ! include "DIMENSIONS"
8275 ! include "COMMON.IOUNITS"
8276 ! include "COMMON.CONTACTS"
8277 ! integer,parameter :: maxconts=nres/4
8278 integer,parameter :: max_dim=26
8279 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
8280 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
8281 ! common /przechowalnia/ zapas
8282 integer :: i,j,ii,jj,iproc,nn,jjc
8283 integer,dimension(4) :: itask
8284 ! write (iout,*) "itask",itask
8287 if (iproc.gt.0) then
8288 do j=1,num_cont_hb(ii)
8290 ! write (iout,*) "i",ii," j",jj," jjc",jjc
8292 ncont_sent(iproc)=ncont_sent(iproc)+1
8293 nn=ncont_sent(iproc)
8294 zapas(1,nn,iproc)=ii
8295 zapas(2,nn,iproc)=jjc
8296 zapas(3,nn,iproc)=facont_hb(j,ii)
8297 zapas(4,nn,iproc)=ees0p(j,ii)
8298 zapas(5,nn,iproc)=ees0m(j,ii)
8299 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
8300 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
8301 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
8302 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
8303 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
8304 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
8305 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
8306 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
8307 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
8308 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
8309 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
8310 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
8311 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
8312 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
8313 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
8314 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
8315 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
8316 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
8317 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
8318 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
8319 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
8326 end subroutine add_hb_contact
8327 !-----------------------------------------------------------------------------
8328 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
8329 ! This subroutine calculates multi-body contributions to hydrogen-bonding
8330 ! implicit real*8 (a-h,o-z)
8331 ! include 'DIMENSIONS'
8332 ! include 'COMMON.IOUNITS'
8333 integer,parameter :: max_dim=70
8336 ! integer :: maxconts !max_cont=maxconts=nres/4
8337 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8338 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
8339 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
8340 ! common /przechowalnia/ zapas
8341 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
8342 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
8345 ! include 'COMMON.SETUP'
8346 ! include 'COMMON.FFIELD'
8347 ! include 'COMMON.DERIV'
8348 ! include 'COMMON.LOCAL'
8349 ! include 'COMMON.INTERACT'
8350 ! include 'COMMON.CONTACTS'
8351 ! include 'COMMON.CHAIN'
8352 ! include 'COMMON.CONTROL'
8353 real(kind=8),dimension(3) :: gx,gx1
8354 integer,dimension(nres) :: num_cont_hb_old
8355 logical :: lprn,ldone
8356 !EL double precision eello4,eello5,eelo6,eello_turn6
8357 !EL external eello4,eello5,eello6,eello_turn6
8359 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
8360 j1,jp1,i1,num_conti1
8361 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
8362 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
8364 ! Set lprn=.true. for debugging
8369 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
8371 num_cont_hb_old(i)=num_cont_hb(i)
8375 if (nfgtasks.le.1) goto 30
8377 write (iout,'(a)') 'Contact function values before RECEIVE:'
8379 write (iout,'(2i3,50(1x,i2,f5.2))') &
8380 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
8385 do i=1,ntask_cont_from
8388 do i=1,ntask_cont_to
8391 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8393 ! Make the list of contacts to send to send to other procesors
8394 do i=iturn3_start,iturn3_end
8395 ! write (iout,*) "make contact list turn3",i," num_cont",
8397 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
8399 do i=iturn4_start,iturn4_end
8400 ! write (iout,*) "make contact list turn4",i," num_cont",
8402 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
8406 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
8408 do j=1,num_cont_hb(i)
8411 iproc=iint_sent_local(k,jjc,ii)
8412 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8413 if (iproc.ne.0) then
8414 ncont_sent(iproc)=ncont_sent(iproc)+1
8415 nn=ncont_sent(iproc)
8417 zapas(2,nn,iproc)=jjc
8418 zapas(3,nn,iproc)=d_cont(j,i)
8422 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
8427 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
8435 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
8446 "Numbers of contacts to be sent to other processors",&
8447 (ncont_sent(i),i=1,ntask_cont_to)
8448 write (iout,*) "Contacts sent"
8449 do ii=1,ntask_cont_to
8451 iproc=itask_cont_to(ii)
8452 write (iout,*) nn," contacts to processor",iproc,&
8453 " of CONT_TO_COMM group"
8455 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
8463 CorrelID1=nfgtasks+fg_rank+1
8465 ! Receive the numbers of needed contacts from other processors
8466 do ii=1,ntask_cont_from
8467 iproc=itask_cont_from(ii)
8469 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
8470 FG_COMM,req(ireq),IERR)
8472 ! write (iout,*) "IRECV ended"
8474 ! Send the number of contacts needed by other processors
8475 do ii=1,ntask_cont_to
8476 iproc=itask_cont_to(ii)
8478 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
8479 FG_COMM,req(ireq),IERR)
8481 ! write (iout,*) "ISEND ended"
8482 ! write (iout,*) "number of requests (nn)",ireq
8485 call MPI_Waitall(ireq,req,status_array,ierr)
8487 ! & "Numbers of contacts to be received from other processors",
8488 ! & (ncont_recv(i),i=1,ntask_cont_from)
8492 do ii=1,ntask_cont_from
8493 iproc=itask_cont_from(ii)
8495 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
8496 ! & " of CONT_TO_COMM group"
8500 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
8501 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8502 ! write (iout,*) "ireq,req",ireq,req(ireq)
8505 ! Send the contacts to processors that need them
8506 do ii=1,ntask_cont_to
8507 iproc=itask_cont_to(ii)
8509 ! write (iout,*) nn," contacts to processor",iproc,
8510 ! & " of CONT_TO_COMM group"
8513 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
8514 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8515 ! write (iout,*) "ireq,req",ireq,req(ireq)
8517 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8521 ! write (iout,*) "number of requests (contacts)",ireq
8522 ! write (iout,*) "req",(req(i),i=1,4)
8525 call MPI_Waitall(ireq,req,status_array,ierr)
8526 do iii=1,ntask_cont_from
8527 iproc=itask_cont_from(iii)
8530 write (iout,*) "Received",nn," contacts from processor",iproc,&
8531 " of CONT_FROM_COMM group"
8534 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
8539 ii=zapas_recv(1,i,iii)
8540 ! Flag the received contacts to prevent double-counting
8541 jj=-zapas_recv(2,i,iii)
8542 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8544 nnn=num_cont_hb(ii)+1
8547 d_cont(nnn,ii)=zapas_recv(3,i,iii)
8551 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8556 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8564 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8573 write (iout,'(a)') 'Contact function values after receive:'
8575 write (iout,'(2i3,50(1x,i3,5f6.3))') &
8576 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
8577 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8584 write (iout,'(a)') 'Contact function values:'
8586 write (iout,'(2i3,50(1x,i2,5f6.3))') &
8587 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
8588 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8595 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
8596 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
8597 ! Remove the loop below after debugging !!!
8604 ! Calculate the dipole-dipole interaction energies
8605 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8606 do i=iatel_s,iatel_e+1
8607 num_conti=num_cont_hb(i)
8616 ! Calculate the local-electrostatic correlation terms
8617 ! write (iout,*) "gradcorr5 in eello5 before loop"
8619 ! write (iout,'(i5,3f10.5)')
8620 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
8622 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
8623 ! write (iout,*) "corr loop i",i
8625 num_conti=num_cont_hb(i)
8626 num_conti1=num_cont_hb(i+1)
8633 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8634 ! & ' jj=',jj,' kk=',kk
8635 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
8636 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
8637 .or. j.lt.0 .and. j1.gt.0) .and. &
8638 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8639 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8640 ! The system gains extra energy.
8642 sqd1=dsqrt(d_cont(jj,i))
8643 sqd2=dsqrt(d_cont(kk,i1))
8644 sred_geom = sqd1*sqd2
8645 IF (sred_geom.lt.cutoff_corr) THEN
8646 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
8648 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
8649 !d & ' jj=',jj,' kk=',kk
8650 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
8651 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
8653 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
8654 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
8657 !d write (iout,*) 'sred_geom=',sred_geom,
8658 !d & ' ekont=',ekont,' fprim=',fprimcont,
8659 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
8660 !d write (iout,*) "g_contij",g_contij
8661 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
8662 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
8663 call calc_eello(i,jp,i+1,jp1,jj,kk)
8664 if (wcorr4.gt.0.0d0) &
8665 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
8666 if (energy_dec.and.wcorr4.gt.0.0d0) &
8667 write (iout,'(a6,4i5,0pf7.3)') &
8668 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
8669 ! write (iout,*) "gradcorr5 before eello5"
8671 ! write (iout,'(i5,3f10.5)')
8672 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
8674 if (wcorr5.gt.0.0d0) &
8675 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
8676 ! write (iout,*) "gradcorr5 after eello5"
8678 ! write (iout,'(i5,3f10.5)')
8679 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
8681 if (energy_dec.and.wcorr5.gt.0.0d0) &
8682 write (iout,'(a6,4i5,0pf7.3)') &
8683 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
8684 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
8685 !d write(2,*)'ijkl',i,jp,i+1,jp1
8686 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
8687 .or. wturn6.eq.0.0d0))then
8688 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
8689 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
8690 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
8691 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
8692 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
8693 !d & 'ecorr6=',ecorr6
8694 !d write (iout,'(4e15.5)') sred_geom,
8695 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
8696 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
8697 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
8698 else if (wturn6.gt.0.0d0 &
8699 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
8700 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8701 eturn6=eturn6+eello_turn6(i,jj,kk)
8702 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
8703 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8704 !d write (2,*) 'multibody_eello:eturn6',eturn6
8713 num_cont_hb(i)=num_cont_hb_old(i)
8715 ! write (iout,*) "gradcorr5 in eello5"
8717 ! write (iout,'(i5,3f10.5)')
8718 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
8721 end subroutine multibody_eello
8722 !-----------------------------------------------------------------------------
8723 subroutine add_hb_contact_eello(ii,jj,itask)
8724 ! implicit real*8 (a-h,o-z)
8725 ! include "DIMENSIONS"
8726 ! include "COMMON.IOUNITS"
8727 ! include "COMMON.CONTACTS"
8728 ! integer,parameter :: maxconts=nres/4
8729 integer,parameter :: max_dim=70
8730 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
8731 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
8732 ! common /przechowalnia/ zapas
8734 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
8735 integer,dimension(4) ::itask
8736 ! write (iout,*) "itask",itask
8739 if (iproc.gt.0) then
8740 do j=1,num_cont_hb(ii)
8742 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
8744 ncont_sent(iproc)=ncont_sent(iproc)+1
8745 nn=ncont_sent(iproc)
8746 zapas(1,nn,iproc)=ii
8747 zapas(2,nn,iproc)=jjc
8748 zapas(3,nn,iproc)=d_cont(j,ii)
8752 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8757 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8765 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8776 end subroutine add_hb_contact_eello
8777 !-----------------------------------------------------------------------------
8778 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8779 ! implicit real*8 (a-h,o-z)
8780 ! include 'DIMENSIONS'
8781 ! include 'COMMON.IOUNITS'
8782 ! include 'COMMON.DERIV'
8783 ! include 'COMMON.INTERACT'
8784 ! include 'COMMON.CONTACTS'
8785 real(kind=8),dimension(3) :: gx,gx1
8788 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
8789 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
8790 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
8791 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
8802 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8803 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8804 ! Following 4 lines for diagnostics.
8809 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8810 ! & 'Contacts ',i,j,
8811 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8812 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8814 ! Calculate the multi-body contribution to energy.
8815 ! ecorr=ecorr+ekont*ees
8816 ! Calculate multi-body contributions to the gradient.
8817 coeffpees0pij=coeffp*ees0pij
8818 coeffmees0mij=coeffm*ees0mij
8819 coeffpees0pkl=coeffp*ees0pkl
8820 coeffmees0mkl=coeffm*ees0mkl
8822 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8823 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
8824 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
8825 coeffmees0mkl*gacontm_hb1(ll,jj,i))
8826 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
8827 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
8828 coeffmees0mkl*gacontm_hb2(ll,jj,i))
8829 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8830 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
8831 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
8832 coeffmees0mij*gacontm_hb1(ll,kk,k))
8833 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
8834 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
8835 coeffmees0mij*gacontm_hb2(ll,kk,k))
8836 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
8837 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
8838 coeffmees0mkl*gacontm_hb3(ll,jj,i))
8839 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8840 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8841 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
8842 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
8843 coeffmees0mij*gacontm_hb3(ll,kk,k))
8844 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8845 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8846 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8851 !grad gradcorr(ll,m)=gradcorr(ll,m)+
8852 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
8853 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8854 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8859 !grad gradcorr(ll,m)=gradcorr(ll,m)+
8860 !grad & ees*eij*gacont_hbr(ll,kk,k)-
8861 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8862 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8865 ! write (iout,*) "ehbcorr",ekont*ees
8867 if (shield_mode.gt.0) then
8870 !C print *,i,j,fac_shield(i),fac_shield(j),
8871 !C &fac_shield(k),fac_shield(l)
8872 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
8873 (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
8874 do ilist=1,ishield_list(i)
8875 iresshield=shield_list(ilist,i)
8877 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
8878 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8880 +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
8881 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8885 do ilist=1,ishield_list(j)
8886 iresshield=shield_list(ilist,j)
8888 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
8889 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8891 +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
8892 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8897 do ilist=1,ishield_list(k)
8898 iresshield=shield_list(ilist,k)
8900 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
8901 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8903 +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
8904 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8908 do ilist=1,ishield_list(l)
8909 iresshield=shield_list(ilist,l)
8911 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
8912 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8914 +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
8915 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8920 gshieldc_ec(m,i)=gshieldc_ec(m,i)+ &
8921 grad_shield(m,i)*ehbcorr/fac_shield(i)
8922 gshieldc_ec(m,j)=gshieldc_ec(m,j)+ &
8923 grad_shield(m,j)*ehbcorr/fac_shield(j)
8924 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ &
8925 grad_shield(m,i)*ehbcorr/fac_shield(i)
8926 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ &
8927 grad_shield(m,j)*ehbcorr/fac_shield(j)
8929 gshieldc_ec(m,k)=gshieldc_ec(m,k)+ &
8930 grad_shield(m,k)*ehbcorr/fac_shield(k)
8931 gshieldc_ec(m,l)=gshieldc_ec(m,l)+ &
8932 grad_shield(m,l)*ehbcorr/fac_shield(l)
8933 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ &
8934 grad_shield(m,k)*ehbcorr/fac_shield(k)
8935 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ &
8936 grad_shield(m,l)*ehbcorr/fac_shield(l)
8942 end function ehbcorr
8944 !-----------------------------------------------------------------------------
8945 subroutine dipole(i,j,jj)
8946 ! implicit real*8 (a-h,o-z)
8947 ! include 'DIMENSIONS'
8948 ! include 'COMMON.IOUNITS'
8949 ! include 'COMMON.CHAIN'
8950 ! include 'COMMON.FFIELD'
8951 ! include 'COMMON.DERIV'
8952 ! include 'COMMON.INTERACT'
8953 ! include 'COMMON.CONTACTS'
8954 ! include 'COMMON.TORSION'
8955 ! include 'COMMON.VAR'
8956 ! include 'COMMON.GEO'
8957 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
8958 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
8959 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
8961 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
8962 allocate(dipderx(3,5,4,maxconts,nres))
8965 iti1 = itortyp(itype(i+1,1))
8966 if (j.lt.nres-1) then
8967 itj1 = itype2loc(itype(j+1,1))
8972 dipi(iii,1)=Ub2(iii,i)
8973 dipderi(iii)=Ub2der(iii,i)
8974 dipi(iii,2)=b1(iii,iti1)
8975 dipj(iii,1)=Ub2(iii,j)
8976 dipderj(iii)=Ub2der(iii,j)
8977 dipj(iii,2)=b1(iii,itj1)
8981 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8984 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8991 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
8995 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
9000 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
9001 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
9003 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
9005 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
9007 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
9010 end subroutine dipole
9012 !-----------------------------------------------------------------------------
9013 subroutine calc_eello(i,j,k,l,jj,kk)
9015 ! This subroutine computes matrices and vectors needed to calculate
9016 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
9019 ! implicit real*8 (a-h,o-z)
9020 ! include 'DIMENSIONS'
9021 ! include 'COMMON.IOUNITS'
9022 ! include 'COMMON.CHAIN'
9023 ! include 'COMMON.DERIV'
9024 ! include 'COMMON.INTERACT'
9025 ! include 'COMMON.CONTACTS'
9026 ! include 'COMMON.TORSION'
9027 ! include 'COMMON.VAR'
9028 ! include 'COMMON.GEO'
9029 ! include 'COMMON.FFIELD'
9030 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
9031 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
9032 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
9035 !el common /kutas/ lprn
9036 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
9037 !d & ' jj=',jj,' kk=',kk
9038 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
9039 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
9040 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
9043 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
9044 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
9047 call transpose2(aa1(1,1),aa1t(1,1))
9048 call transpose2(aa2(1,1),aa2t(1,1))
9051 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
9052 aa1tder(1,1,lll,kkk))
9053 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
9054 aa2tder(1,1,lll,kkk))
9058 ! parallel orientation of the two CA-CA-CA frames.
9060 iti=itortyp(itype(i,1))
9064 itk1=itortyp(itype(k+1,1))
9065 itj=itortyp(itype(j,1))
9066 if (l.lt.nres-1) then
9067 itl1=itortyp(itype(l+1,1))
9071 ! A1 kernel(j+1) A2T
9073 !d write (iout,'(3f10.5,5x,3f10.5)')
9074 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
9076 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
9077 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
9078 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9079 ! Following matrices are needed only for 6-th order cumulants
9080 IF (wcorr6.gt.0.0d0) THEN
9081 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
9082 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
9083 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9084 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
9085 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
9086 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
9087 ADtEAderx(1,1,1,1,1,1))
9089 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
9090 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
9091 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
9092 ADtEA1derx(1,1,1,1,1,1))
9094 ! End 6-th order cumulants
9097 !d write (2,*) 'In calc_eello6'
9099 !d write (2,*) 'iii=',iii
9101 !d write (2,*) 'kkk=',kkk
9103 !d write (2,'(3(2f10.5),5x)')
9104 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9109 call transpose2(EUgder(1,1,k),auxmat(1,1))
9110 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9111 call transpose2(EUg(1,1,k),auxmat(1,1))
9112 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9113 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9117 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
9118 EAEAderx(1,1,lll,kkk,iii,1))
9122 ! A1T kernel(i+1) A2
9123 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
9124 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
9125 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9126 ! Following matrices are needed only for 6-th order cumulants
9127 IF (wcorr6.gt.0.0d0) THEN
9128 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
9129 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
9130 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9131 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
9132 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
9133 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
9134 ADtEAderx(1,1,1,1,1,2))
9135 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
9136 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
9137 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
9138 ADtEA1derx(1,1,1,1,1,2))
9140 ! End 6-th order cumulants
9141 call transpose2(EUgder(1,1,l),auxmat(1,1))
9142 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
9143 call transpose2(EUg(1,1,l),auxmat(1,1))
9144 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9145 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9149 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
9150 EAEAderx(1,1,lll,kkk,iii,2))
9155 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9156 ! They are needed only when the fifth- or the sixth-order cumulants are
9158 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
9159 call transpose2(AEA(1,1,1),auxmat(1,1))
9160 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
9161 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9162 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9163 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9164 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
9165 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9166 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
9167 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
9168 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9169 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9170 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9171 call transpose2(AEA(1,1,2),auxmat(1,1))
9172 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
9173 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
9174 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
9175 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9176 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
9177 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
9178 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
9179 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
9180 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
9181 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
9182 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
9183 ! Calculate the Cartesian derivatives of the vectors.
9187 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9188 call matvec2(auxmat(1,1),b1(1,iti),&
9189 AEAb1derx(1,lll,kkk,iii,1,1))
9190 call matvec2(auxmat(1,1),Ub2(1,i),&
9191 AEAb2derx(1,lll,kkk,iii,1,1))
9192 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
9193 AEAb1derx(1,lll,kkk,iii,2,1))
9194 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
9195 AEAb2derx(1,lll,kkk,iii,2,1))
9196 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9197 call matvec2(auxmat(1,1),b1(1,itj),&
9198 AEAb1derx(1,lll,kkk,iii,1,2))
9199 call matvec2(auxmat(1,1),Ub2(1,j),&
9200 AEAb2derx(1,lll,kkk,iii,1,2))
9201 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
9202 AEAb1derx(1,lll,kkk,iii,2,2))
9203 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
9204 AEAb2derx(1,lll,kkk,iii,2,2))
9211 ! Antiparallel orientation of the two CA-CA-CA frames.
9213 iti=itortyp(itype(i,1))
9217 itk1=itortyp(itype(k+1,1))
9218 itl=itortyp(itype(l,1))
9219 itj=itortyp(itype(j,1))
9220 if (j.lt.nres-1) then
9221 itj1=itortyp(itype(j+1,1))
9225 ! A2 kernel(j-1)T A1T
9226 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
9227 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
9228 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9229 ! Following matrices are needed only for 6-th order cumulants
9230 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
9231 j.eq.i+4 .and. l.eq.i+3)) THEN
9232 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
9233 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
9234 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9235 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
9236 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
9237 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
9238 ADtEAderx(1,1,1,1,1,1))
9239 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
9240 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
9241 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
9242 ADtEA1derx(1,1,1,1,1,1))
9244 ! End 6-th order cumulants
9245 call transpose2(EUgder(1,1,k),auxmat(1,1))
9246 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9247 call transpose2(EUg(1,1,k),auxmat(1,1))
9248 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9249 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9253 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
9254 EAEAderx(1,1,lll,kkk,iii,1))
9258 ! A2T kernel(i+1)T A1
9259 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
9260 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
9261 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9262 ! Following matrices are needed only for 6-th order cumulants
9263 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
9264 j.eq.i+4 .and. l.eq.i+3)) THEN
9265 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
9266 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
9267 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9268 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
9269 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
9270 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
9271 ADtEAderx(1,1,1,1,1,2))
9272 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
9273 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
9274 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
9275 ADtEA1derx(1,1,1,1,1,2))
9277 ! End 6-th order cumulants
9278 call transpose2(EUgder(1,1,j),auxmat(1,1))
9279 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
9280 call transpose2(EUg(1,1,j),auxmat(1,1))
9281 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9282 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9286 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
9287 EAEAderx(1,1,lll,kkk,iii,2))
9292 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9293 ! They are needed only when the fifth- or the sixth-order cumulants are
9295 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
9296 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
9297 call transpose2(AEA(1,1,1),auxmat(1,1))
9298 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
9299 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9300 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9301 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9302 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
9303 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9304 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
9305 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
9306 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9307 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9308 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9309 call transpose2(AEA(1,1,2),auxmat(1,1))
9310 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
9311 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
9312 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
9313 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9314 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
9315 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
9316 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
9317 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
9318 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
9319 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
9320 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
9321 ! Calculate the Cartesian derivatives of the vectors.
9325 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9326 call matvec2(auxmat(1,1),b1(1,iti),&
9327 AEAb1derx(1,lll,kkk,iii,1,1))
9328 call matvec2(auxmat(1,1),Ub2(1,i),&
9329 AEAb2derx(1,lll,kkk,iii,1,1))
9330 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
9331 AEAb1derx(1,lll,kkk,iii,2,1))
9332 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
9333 AEAb2derx(1,lll,kkk,iii,2,1))
9334 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9335 call matvec2(auxmat(1,1),b1(1,itl),&
9336 AEAb1derx(1,lll,kkk,iii,1,2))
9337 call matvec2(auxmat(1,1),Ub2(1,l),&
9338 AEAb2derx(1,lll,kkk,iii,1,2))
9339 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
9340 AEAb1derx(1,lll,kkk,iii,2,2))
9341 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
9342 AEAb2derx(1,lll,kkk,iii,2,2))
9350 end subroutine calc_eello
9351 !-----------------------------------------------------------------------------
9352 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
9357 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
9358 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
9359 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
9360 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
9361 integer :: iii,kkk,lll
9364 !el common /kutas/ lprn
9365 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
9367 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
9370 !d if (lprn) write (2,*) 'In kernel'
9372 !d if (lprn) write (2,*) 'kkk=',kkk
9374 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
9375 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
9377 !d write (2,*) 'lll=',lll
9378 !d write (2,*) 'iii=1'
9380 !d write (2,'(3(2f10.5),5x)')
9381 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
9384 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
9385 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
9387 !d write (2,*) 'lll=',lll
9388 !d write (2,*) 'iii=2'
9390 !d write (2,'(3(2f10.5),5x)')
9391 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
9397 end subroutine kernel
9398 !-----------------------------------------------------------------------------
9399 real(kind=8) function eello4(i,j,k,l,jj,kk)
9400 ! implicit real*8 (a-h,o-z)
9401 ! include 'DIMENSIONS'
9402 ! include 'COMMON.IOUNITS'
9403 ! include 'COMMON.CHAIN'
9404 ! include 'COMMON.DERIV'
9405 ! include 'COMMON.INTERACT'
9406 ! include 'COMMON.CONTACTS'
9407 ! include 'COMMON.TORSION'
9408 ! include 'COMMON.VAR'
9409 ! include 'COMMON.GEO'
9410 real(kind=8),dimension(2,2) :: pizda
9411 real(kind=8),dimension(3) :: ggg1,ggg2
9412 real(kind=8) :: eel4,glongij,glongkl
9413 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
9414 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
9418 !d print *,'eello4:',i,j,k,l,jj,kk
9419 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
9420 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
9421 !old eij=facont_hb(jj,i)
9422 !old ekl=facont_hb(kk,k)
9424 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
9425 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
9426 gcorr_loc(k-1)=gcorr_loc(k-1) &
9427 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
9429 gcorr_loc(l-1)=gcorr_loc(l-1) &
9430 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9432 gcorr_loc(j-1)=gcorr_loc(j-1) &
9433 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9438 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
9439 -EAEAderx(2,2,lll,kkk,iii,1)
9440 !d derx(lll,kkk,iii)=0.0d0
9444 !d gcorr_loc(l-1)=0.0d0
9445 !d gcorr_loc(j-1)=0.0d0
9446 !d gcorr_loc(k-1)=0.0d0
9448 !d write (iout,*)'Contacts have occurred for peptide groups',
9449 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
9450 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
9451 if (j.lt.nres-1) then
9458 if (l.lt.nres-1) then
9466 !grad ggg1(ll)=eel4*g_contij(ll,1)
9467 !grad ggg2(ll)=eel4*g_contij(ll,2)
9468 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
9469 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
9470 !grad ghalf=0.5d0*ggg1(ll)
9471 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
9472 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
9473 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
9474 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
9475 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
9476 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
9477 !grad ghalf=0.5d0*ggg2(ll)
9478 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
9479 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
9480 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
9481 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
9482 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
9483 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
9487 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
9492 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
9497 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
9502 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
9506 !d write (2,*) iii,gcorr_loc(iii)
9509 !d write (2,*) 'ekont',ekont
9510 !d write (iout,*) 'eello4',ekont*eel4
9513 !-----------------------------------------------------------------------------
9514 real(kind=8) function eello5(i,j,k,l,jj,kk)
9515 ! implicit real*8 (a-h,o-z)
9516 ! include 'DIMENSIONS'
9517 ! include 'COMMON.IOUNITS'
9518 ! include 'COMMON.CHAIN'
9519 ! include 'COMMON.DERIV'
9520 ! include 'COMMON.INTERACT'
9521 ! include 'COMMON.CONTACTS'
9522 ! include 'COMMON.TORSION'
9523 ! include 'COMMON.VAR'
9524 ! include 'COMMON.GEO'
9525 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9526 real(kind=8),dimension(2) :: vv
9527 real(kind=8),dimension(3) :: ggg1,ggg2
9528 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
9529 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
9530 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
9531 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9536 ! /l\ / \ \ / \ / \ / C
9537 ! / \ / \ \ / \ / \ / C
9538 ! j| o |l1 | o | o| o | | o |o C
9539 ! \ |/k\| |/ \| / |/ \| |/ \| C
9540 ! \i/ \ / \ / / \ / \ C
9542 ! (I) (II) (III) (IV) C
9544 ! eello5_1 eello5_2 eello5_3 eello5_4 C
9546 ! Antiparallel chains C
9549 ! /j\ / \ \ / \ / \ / C
9550 ! / \ / \ \ / \ / \ / C
9551 ! j1| o |l | o | o| o | | o |o C
9552 ! \ |/k\| |/ \| / |/ \| |/ \| C
9553 ! \i/ \ / \ / / \ / \ C
9555 ! (I) (II) (III) (IV) C
9557 ! eello5_1 eello5_2 eello5_3 eello5_4 C
9559 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
9561 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9562 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9567 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9569 itk=itortyp(itype(k,1))
9570 itl=itortyp(itype(l,1))
9571 itj=itortyp(itype(j,1))
9576 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9577 !d & eel5_3_num,eel5_4_num)
9581 derx(lll,kkk,iii)=0.0d0
9585 !d eij=facont_hb(jj,i)
9586 !d ekl=facont_hb(kk,k)
9588 !d write (iout,*)'Contacts have occurred for peptide groups',
9589 !d & i,j,' fcont:',eij,' eij',' and ',k,l
9591 ! Contribution from the graph I.
9592 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9593 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9594 call transpose2(EUg(1,1,k),auxmat(1,1))
9595 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9596 vv(1)=pizda(1,1)-pizda(2,2)
9597 vv(2)=pizda(1,2)+pizda(2,1)
9598 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
9599 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9600 ! Explicit gradient in virtual-dihedral angles.
9601 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
9602 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
9603 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9604 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9605 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9606 vv(1)=pizda(1,1)-pizda(2,2)
9607 vv(2)=pizda(1,2)+pizda(2,1)
9608 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9609 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
9610 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9611 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9612 vv(1)=pizda(1,1)-pizda(2,2)
9613 vv(2)=pizda(1,2)+pizda(2,1)
9615 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9616 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
9617 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9619 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9620 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
9621 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9623 ! Cartesian gradient
9627 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
9629 vv(1)=pizda(1,1)-pizda(2,2)
9630 vv(2)=pizda(1,2)+pizda(2,1)
9631 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
9632 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
9633 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9639 ! Contribution from graph II
9640 call transpose2(EE(1,1,itk),auxmat(1,1))
9641 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
9642 vv(1)=pizda(1,1)+pizda(2,2)
9643 vv(2)=pizda(2,1)-pizda(1,2)
9644 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
9645 -0.5d0*scalar2(vv(1),Ctobr(1,k))
9646 ! Explicit gradient in virtual-dihedral angles.
9647 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9648 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
9649 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
9650 vv(1)=pizda(1,1)+pizda(2,2)
9651 vv(2)=pizda(2,1)-pizda(1,2)
9653 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9654 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
9655 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9657 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9658 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
9659 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9661 ! Cartesian gradient
9665 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
9667 vv(1)=pizda(1,1)+pizda(2,2)
9668 vv(2)=pizda(2,1)-pizda(1,2)
9669 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
9670 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
9671 -0.5d0*scalar2(vv(1),Ctobr(1,k))
9679 ! Parallel orientation
9680 ! Contribution from graph III
9681 call transpose2(EUg(1,1,l),auxmat(1,1))
9682 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9683 vv(1)=pizda(1,1)-pizda(2,2)
9684 vv(2)=pizda(1,2)+pizda(2,1)
9685 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
9686 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9687 ! Explicit gradient in virtual-dihedral angles.
9688 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9689 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
9690 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
9691 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9692 vv(1)=pizda(1,1)-pizda(2,2)
9693 vv(2)=pizda(1,2)+pizda(2,1)
9694 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9695 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
9696 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9697 call transpose2(EUgder(1,1,l),auxmat1(1,1))
9698 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9699 vv(1)=pizda(1,1)-pizda(2,2)
9700 vv(2)=pizda(1,2)+pizda(2,1)
9701 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9702 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
9703 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9704 ! Cartesian gradient
9708 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
9710 vv(1)=pizda(1,1)-pizda(2,2)
9711 vv(2)=pizda(1,2)+pizda(2,1)
9712 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
9713 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
9714 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9719 ! Contribution from graph IV
9721 call transpose2(EE(1,1,itl),auxmat(1,1))
9722 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9723 vv(1)=pizda(1,1)+pizda(2,2)
9724 vv(2)=pizda(2,1)-pizda(1,2)
9725 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
9726 -0.5d0*scalar2(vv(1),Ctobr(1,l))
9727 ! Explicit gradient in virtual-dihedral angles.
9728 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9729 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
9730 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9731 vv(1)=pizda(1,1)+pizda(2,2)
9732 vv(2)=pizda(2,1)-pizda(1,2)
9733 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9734 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
9735 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
9736 ! Cartesian gradient
9740 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
9742 vv(1)=pizda(1,1)+pizda(2,2)
9743 vv(2)=pizda(2,1)-pizda(1,2)
9744 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
9745 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
9746 -0.5d0*scalar2(vv(1),Ctobr(1,l))
9751 ! Antiparallel orientation
9752 ! Contribution from graph III
9754 call transpose2(EUg(1,1,j),auxmat(1,1))
9755 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9756 vv(1)=pizda(1,1)-pizda(2,2)
9757 vv(2)=pizda(1,2)+pizda(2,1)
9758 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
9759 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9760 ! Explicit gradient in virtual-dihedral angles.
9761 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9762 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
9763 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9764 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9765 vv(1)=pizda(1,1)-pizda(2,2)
9766 vv(2)=pizda(1,2)+pizda(2,1)
9767 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9768 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
9769 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9770 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9771 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9772 vv(1)=pizda(1,1)-pizda(2,2)
9773 vv(2)=pizda(1,2)+pizda(2,1)
9774 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9775 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
9776 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9777 ! Cartesian gradient
9781 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
9783 vv(1)=pizda(1,1)-pizda(2,2)
9784 vv(2)=pizda(1,2)+pizda(2,1)
9785 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
9786 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
9787 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9792 ! Contribution from graph IV
9794 call transpose2(EE(1,1,itj),auxmat(1,1))
9795 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9796 vv(1)=pizda(1,1)+pizda(2,2)
9797 vv(2)=pizda(2,1)-pizda(1,2)
9798 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
9799 -0.5d0*scalar2(vv(1),Ctobr(1,j))
9800 ! Explicit gradient in virtual-dihedral angles.
9801 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9802 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9803 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9804 vv(1)=pizda(1,1)+pizda(2,2)
9805 vv(2)=pizda(2,1)-pizda(1,2)
9806 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9807 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
9808 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9809 ! Cartesian gradient
9813 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
9815 vv(1)=pizda(1,1)+pizda(2,2)
9816 vv(2)=pizda(2,1)-pizda(1,2)
9817 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
9818 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
9819 -0.5d0*scalar2(vv(1),Ctobr(1,j))
9825 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9826 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9827 !d write (2,*) 'ijkl',i,j,k,l
9828 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9829 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
9831 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9832 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9833 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9834 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9835 if (j.lt.nres-1) then
9842 if (l.lt.nres-1) then
9852 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9853 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
9854 ! summed up outside the subrouine as for the other subroutines
9855 ! handling long-range interactions. The old code is commented out
9856 ! with "cgrad" to keep track of changes.
9858 !grad ggg1(ll)=eel5*g_contij(ll,1)
9859 !grad ggg2(ll)=eel5*g_contij(ll,2)
9860 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9861 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9862 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9863 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9864 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9865 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9866 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9867 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9869 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9870 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9871 !grad ghalf=0.5d0*ggg1(ll)
9873 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9874 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9875 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9876 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9877 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9878 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9879 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9880 !grad ghalf=0.5d0*ggg2(ll)
9882 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
9883 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9884 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
9885 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9886 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9887 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9892 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9893 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9898 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9899 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9905 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9910 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9914 !d write (2,*) iii,g_corr5_loc(iii)
9917 !d write (2,*) 'ekont',ekont
9918 !d write (iout,*) 'eello5',ekont*eel5
9921 !-----------------------------------------------------------------------------
9922 real(kind=8) function eello6(i,j,k,l,jj,kk)
9923 ! implicit real*8 (a-h,o-z)
9924 ! include 'DIMENSIONS'
9925 ! include 'COMMON.IOUNITS'
9926 ! include 'COMMON.CHAIN'
9927 ! include 'COMMON.DERIV'
9928 ! include 'COMMON.INTERACT'
9929 ! include 'COMMON.CONTACTS'
9930 ! include 'COMMON.TORSION'
9931 ! include 'COMMON.VAR'
9932 ! include 'COMMON.GEO'
9933 ! include 'COMMON.FFIELD'
9934 real(kind=8),dimension(3) :: ggg1,ggg2
9935 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
9937 real(kind=8) :: gradcorr6ij,gradcorr6kl
9938 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
9939 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9944 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9952 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9953 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9957 derx(lll,kkk,iii)=0.0d0
9961 !d eij=facont_hb(jj,i)
9962 !d ekl=facont_hb(kk,k)
9968 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9969 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9970 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9971 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9972 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9973 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9975 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9976 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9977 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9978 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9979 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9980 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9984 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9986 ! If turn contributions are considered, they will be handled separately.
9987 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9988 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9989 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9990 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9991 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9992 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9993 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9995 if (j.lt.nres-1) then
10002 if (l.lt.nres-1) then
10010 !grad ggg1(ll)=eel6*g_contij(ll,1)
10011 !grad ggg2(ll)=eel6*g_contij(ll,2)
10012 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
10013 !grad ghalf=0.5d0*ggg1(ll)
10015 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
10016 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
10017 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
10018 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
10019 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
10020 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
10021 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
10022 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
10023 !grad ghalf=0.5d0*ggg2(ll)
10024 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
10026 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
10027 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
10028 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
10029 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
10030 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
10031 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
10036 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
10037 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
10042 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
10043 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
10049 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
10054 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
10058 !d write (2,*) iii,g_corr6_loc(iii)
10061 !d write (2,*) 'ekont',ekont
10062 !d write (iout,*) 'eello6',ekont*eel6
10064 end function eello6
10065 !-----------------------------------------------------------------------------
10066 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
10068 ! implicit real*8 (a-h,o-z)
10069 ! include 'DIMENSIONS'
10070 ! include 'COMMON.IOUNITS'
10071 ! include 'COMMON.CHAIN'
10072 ! include 'COMMON.DERIV'
10073 ! include 'COMMON.INTERACT'
10074 ! include 'COMMON.CONTACTS'
10075 ! include 'COMMON.TORSION'
10076 ! include 'COMMON.VAR'
10077 ! include 'COMMON.GEO'
10078 real(kind=8),dimension(2) :: vv,vv1
10079 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
10081 !el logical :: lprn
10082 !el common /kutas/ lprn
10083 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
10084 real(kind=8) :: s1,s2,s3,s4,s5
10085 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10087 ! Parallel Antiparallel C
10093 ! \ j|/k\| / \ |/k\|l / C
10094 ! \ / \ / \ / \ / C
10098 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10099 itk=itortyp(itype(k,1))
10100 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
10101 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
10102 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
10103 call transpose2(EUgC(1,1,k),auxmat(1,1))
10104 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
10105 vv1(1)=pizda1(1,1)-pizda1(2,2)
10106 vv1(2)=pizda1(1,2)+pizda1(2,1)
10107 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10108 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
10109 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
10110 s5=scalar2(vv(1),Dtobr2(1,i))
10111 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
10112 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
10113 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
10114 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
10115 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
10116 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
10117 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
10118 +scalar2(vv(1),Dtobr2der(1,i)))
10119 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
10120 vv1(1)=pizda1(1,1)-pizda1(2,2)
10121 vv1(2)=pizda1(1,2)+pizda1(2,1)
10122 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
10123 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
10125 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
10126 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
10127 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
10128 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
10129 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
10131 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
10132 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
10133 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
10134 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
10135 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
10137 call transpose2(EUgCder(1,1,k),auxmat(1,1))
10138 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
10139 vv1(1)=pizda1(1,1)-pizda1(2,2)
10140 vv1(2)=pizda1(1,2)+pizda1(2,1)
10141 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
10142 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
10143 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
10144 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
10153 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
10154 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
10155 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
10156 call transpose2(EUgC(1,1,k),auxmat(1,1))
10157 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
10159 vv1(1)=pizda1(1,1)-pizda1(2,2)
10160 vv1(2)=pizda1(1,2)+pizda1(2,1)
10161 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10162 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
10163 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
10164 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
10165 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
10166 s5=scalar2(vv(1),Dtobr2(1,i))
10167 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
10172 end function eello6_graph1
10173 !-----------------------------------------------------------------------------
10174 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
10176 ! implicit real*8 (a-h,o-z)
10177 ! include 'DIMENSIONS'
10178 ! include 'COMMON.IOUNITS'
10179 ! include 'COMMON.CHAIN'
10180 ! include 'COMMON.DERIV'
10181 ! include 'COMMON.INTERACT'
10182 ! include 'COMMON.CONTACTS'
10183 ! include 'COMMON.TORSION'
10184 ! include 'COMMON.VAR'
10185 ! include 'COMMON.GEO'
10187 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
10188 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
10189 !el logical :: lprn
10190 !el common /kutas/ lprn
10191 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
10192 real(kind=8) :: s2,s3,s4
10193 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10195 ! Parallel Antiparallel C
10201 ! \ j|/k\| \ |/k\|l C
10206 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10207 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
10208 ! AL 7/4/01 s1 would occur in the sixth-order moment,
10209 ! but not in a cluster cumulant
10211 s1=dip(1,jj,i)*dip(1,kk,k)
10213 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
10214 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10215 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
10216 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
10217 call transpose2(EUg(1,1,k),auxmat(1,1))
10218 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
10219 vv(1)=pizda(1,1)-pizda(2,2)
10220 vv(2)=pizda(1,2)+pizda(2,1)
10221 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10222 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10224 eello6_graph2=-(s1+s2+s3+s4)
10226 eello6_graph2=-(s2+s3+s4)
10228 ! eello6_graph2=-s3
10229 ! Derivatives in gamma(i-1)
10232 s1=dipderg(1,jj,i)*dip(1,kk,k)
10234 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10235 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
10236 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10237 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10239 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10241 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10243 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
10245 ! Derivatives in gamma(k-1)
10247 s1=dip(1,jj,i)*dipderg(1,kk,k)
10249 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
10250 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10251 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
10252 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10253 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10254 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
10255 vv(1)=pizda(1,1)-pizda(2,2)
10256 vv(2)=pizda(1,2)+pizda(2,1)
10257 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10259 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10261 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10263 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
10264 ! Derivatives in gamma(j-1) or gamma(l-1)
10267 s1=dipderg(3,jj,i)*dip(1,kk,k)
10269 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
10270 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10271 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
10272 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
10273 vv(1)=pizda(1,1)-pizda(2,2)
10274 vv(2)=pizda(1,2)+pizda(2,1)
10275 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10278 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10280 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10283 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
10284 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
10286 ! Derivatives in gamma(l-1) or gamma(j-1)
10289 s1=dip(1,jj,i)*dipderg(3,kk,k)
10291 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
10292 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10293 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
10294 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10295 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
10296 vv(1)=pizda(1,1)-pizda(2,2)
10297 vv(2)=pizda(1,2)+pizda(2,1)
10298 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10301 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10303 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10306 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
10307 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
10309 ! Cartesian derivatives.
10311 write (2,*) 'In eello6_graph2'
10313 write (2,*) 'iii=',iii
10315 write (2,*) 'kkk=',kkk
10317 write (2,'(3(2f10.5),5x)') &
10318 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
10328 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
10330 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
10333 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
10335 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10336 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
10338 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
10339 call transpose2(EUg(1,1,k),auxmat(1,1))
10340 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
10342 vv(1)=pizda(1,1)-pizda(2,2)
10343 vv(2)=pizda(1,2)+pizda(2,1)
10344 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10345 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
10347 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10349 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10352 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10354 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10360 end function eello6_graph2
10361 !-----------------------------------------------------------------------------
10362 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
10363 ! implicit real*8 (a-h,o-z)
10364 ! include 'DIMENSIONS'
10365 ! include 'COMMON.IOUNITS'
10366 ! include 'COMMON.CHAIN'
10367 ! include 'COMMON.DERIV'
10368 ! include 'COMMON.INTERACT'
10369 ! include 'COMMON.CONTACTS'
10370 ! include 'COMMON.TORSION'
10371 ! include 'COMMON.VAR'
10372 ! include 'COMMON.GEO'
10373 real(kind=8),dimension(2) :: vv,auxvec
10374 real(kind=8),dimension(2,2) :: pizda,auxmat
10376 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
10377 real(kind=8) :: s1,s2,s3,s4
10378 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10380 ! Parallel Antiparallel C
10385 ! /| o |o o| o |\ C
10386 ! j|/k\| / |/k\|l / C
10391 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10393 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
10394 ! energy moment and not to the cluster cumulant.
10395 iti=itortyp(itype(i,1))
10396 if (j.lt.nres-1) then
10397 itj1=itortyp(itype(j+1,1))
10401 itk=itortyp(itype(k,1))
10402 itk1=itortyp(itype(k+1,1))
10403 if (l.lt.nres-1) then
10404 itl1=itortyp(itype(l+1,1))
10409 s1=dip(4,jj,i)*dip(4,kk,k)
10411 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
10412 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
10413 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
10414 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
10415 call transpose2(EE(1,1,itk),auxmat(1,1))
10416 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
10417 vv(1)=pizda(1,1)+pizda(2,2)
10418 vv(2)=pizda(2,1)-pizda(1,2)
10419 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10420 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
10421 !d & "sum",-(s2+s3+s4)
10423 eello6_graph3=-(s1+s2+s3+s4)
10425 eello6_graph3=-(s2+s3+s4)
10427 ! eello6_graph3=-s4
10428 ! Derivatives in gamma(k-1)
10429 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
10430 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
10431 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
10432 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
10433 ! Derivatives in gamma(l-1)
10434 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
10435 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
10436 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
10437 vv(1)=pizda(1,1)+pizda(2,2)
10438 vv(2)=pizda(2,1)-pizda(1,2)
10439 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10440 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10441 ! Cartesian derivatives.
10447 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
10449 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
10452 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
10454 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
10455 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
10457 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
10458 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
10460 vv(1)=pizda(1,1)+pizda(2,2)
10461 vv(2)=pizda(2,1)-pizda(1,2)
10462 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10464 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10466 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10469 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10471 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10473 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
10478 end function eello6_graph3
10479 !-----------------------------------------------------------------------------
10480 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
10481 ! implicit real*8 (a-h,o-z)
10482 ! include 'DIMENSIONS'
10483 ! include 'COMMON.IOUNITS'
10484 ! include 'COMMON.CHAIN'
10485 ! include 'COMMON.DERIV'
10486 ! include 'COMMON.INTERACT'
10487 ! include 'COMMON.CONTACTS'
10488 ! include 'COMMON.TORSION'
10489 ! include 'COMMON.VAR'
10490 ! include 'COMMON.GEO'
10491 ! include 'COMMON.FFIELD'
10492 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
10493 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
10495 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
10497 real(kind=8) :: s1,s2,s3,s4
10498 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10500 ! Parallel Antiparallel C
10505 ! /| o |o o| o |\ C
10506 ! \ j|/k\| \ |/k\|l C
10511 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10513 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
10514 ! energy moment and not to the cluster cumulant.
10515 !d write (2,*) 'eello_graph4: wturn6',wturn6
10516 iti=itortyp(itype(i,1))
10517 itj=itortyp(itype(j,1))
10518 if (j.lt.nres-1) then
10519 itj1=itortyp(itype(j+1,1))
10523 itk=itortyp(itype(k,1))
10524 if (k.lt.nres-1) then
10525 itk1=itortyp(itype(k+1,1))
10529 itl=itortyp(itype(l,1))
10530 if (l.lt.nres-1) then
10531 itl1=itortyp(itype(l+1,1))
10535 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
10536 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
10537 !d & ' itl',itl,' itl1',itl1
10539 if (imat.eq.1) then
10540 s1=dip(3,jj,i)*dip(3,kk,k)
10542 s1=dip(2,jj,j)*dip(2,kk,l)
10545 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
10546 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10548 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
10549 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
10551 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
10552 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
10554 call transpose2(EUg(1,1,k),auxmat(1,1))
10555 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10556 vv(1)=pizda(1,1)-pizda(2,2)
10557 vv(2)=pizda(2,1)+pizda(1,2)
10558 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10559 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10561 eello6_graph4=-(s1+s2+s3+s4)
10563 eello6_graph4=-(s2+s3+s4)
10565 ! Derivatives in gamma(i-1)
10568 if (imat.eq.1) then
10569 s1=dipderg(2,jj,i)*dip(3,kk,k)
10571 s1=dipderg(4,jj,j)*dip(2,kk,l)
10574 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10576 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
10577 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
10579 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
10580 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
10582 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10583 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10584 !d write (2,*) 'turn6 derivatives'
10586 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10588 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10592 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10594 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10598 ! Derivatives in gamma(k-1)
10600 if (imat.eq.1) then
10601 s1=dip(3,jj,i)*dipderg(2,kk,k)
10603 s1=dip(2,jj,j)*dipderg(4,kk,l)
10606 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10607 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10609 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
10610 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
10612 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
10613 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
10615 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10616 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
10617 vv(1)=pizda(1,1)-pizda(2,2)
10618 vv(2)=pizda(2,1)+pizda(1,2)
10619 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10620 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10622 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10624 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10628 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10630 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10633 ! Derivatives in gamma(j-1) or gamma(l-1)
10634 if (l.eq.j+1 .and. l.gt.1) then
10635 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10636 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10637 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10638 vv(1)=pizda(1,1)-pizda(2,2)
10639 vv(2)=pizda(2,1)+pizda(1,2)
10640 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10641 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10642 else if (j.gt.1) then
10643 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10644 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10645 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10646 vv(1)=pizda(1,1)-pizda(2,2)
10647 vv(2)=pizda(2,1)+pizda(1,2)
10648 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10649 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10650 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
10652 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
10655 ! Cartesian derivatives.
10661 if (imat.eq.1) then
10662 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
10664 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
10667 if (imat.eq.1) then
10668 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
10670 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
10674 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
10676 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10678 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
10679 b1(1,itj1),auxvec(1))
10680 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
10682 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
10683 b1(1,itl1),auxvec(1))
10684 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
10686 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
10688 vv(1)=pizda(1,1)-pizda(2,2)
10689 vv(2)=pizda(2,1)+pizda(1,2)
10690 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10692 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10694 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
10697 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
10700 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
10703 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
10705 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
10707 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10711 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10713 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10716 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10718 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10725 end function eello6_graph4
10726 !-----------------------------------------------------------------------------
10727 real(kind=8) function eello_turn6(i,jj,kk)
10728 ! implicit real*8 (a-h,o-z)
10729 ! include 'DIMENSIONS'
10730 ! include 'COMMON.IOUNITS'
10731 ! include 'COMMON.CHAIN'
10732 ! include 'COMMON.DERIV'
10733 ! include 'COMMON.INTERACT'
10734 ! include 'COMMON.CONTACTS'
10735 ! include 'COMMON.TORSION'
10736 ! include 'COMMON.VAR'
10737 ! include 'COMMON.GEO'
10738 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
10739 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
10740 real(kind=8),dimension(3) :: ggg1,ggg2
10741 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
10742 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
10743 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
10744 ! the respective energy moment and not to the cluster cumulant.
10745 !el local variables
10746 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
10747 integer :: j1,j2,l1,l2,ll
10748 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
10749 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
10758 iti=itortyp(itype(i,1))
10759 itk=itortyp(itype(k,1))
10760 itk1=itortyp(itype(k+1,1))
10761 itl=itortyp(itype(l,1))
10762 itj=itortyp(itype(j,1))
10763 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10764 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
10765 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10770 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10772 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
10776 derx_turn(lll,kkk,iii)=0.0d0
10783 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10785 !d write (2,*) 'eello6_5',eello6_5
10787 call transpose2(AEA(1,1,1),auxmat(1,1))
10788 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10789 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
10790 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10792 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
10793 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10794 s2 = scalar2(b1(1,itk),vtemp1(1))
10796 call transpose2(AEA(1,1,2),atemp(1,1))
10797 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10798 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10799 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10801 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10802 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10803 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10805 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10806 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10807 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10808 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10809 ss13 = scalar2(b1(1,itk),vtemp4(1))
10810 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10812 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10818 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10819 ! Derivatives in gamma(i+2)
10823 call transpose2(AEA(1,1,1),auxmatd(1,1))
10824 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10825 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10826 call transpose2(AEAderg(1,1,2),atempd(1,1))
10827 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10828 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10830 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10831 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10832 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10838 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10839 ! Derivatives in gamma(i+3)
10841 call transpose2(AEA(1,1,1),auxmatd(1,1))
10842 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10843 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
10844 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10846 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
10847 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10848 s2d = scalar2(b1(1,itk),vtemp1d(1))
10850 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10851 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10853 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10855 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10856 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10857 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10865 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
10866 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10868 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
10869 -0.5d0*ekont*(s2d+s12d)
10871 ! Derivatives in gamma(i+4)
10872 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10873 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10874 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10876 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10877 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10878 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10886 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10888 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10890 ! Derivatives in gamma(i+5)
10892 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10893 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10894 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10896 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
10897 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10898 s2d = scalar2(b1(1,itk),vtemp1d(1))
10900 call transpose2(AEA(1,1,2),atempd(1,1))
10901 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10902 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10904 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10905 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10907 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10908 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10909 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10917 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
10918 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10920 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
10921 -0.5d0*ekont*(s2d+s12d)
10923 ! Cartesian derivatives
10928 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10929 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10930 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10932 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
10933 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
10935 s2d = scalar2(b1(1,itk),vtemp1d(1))
10937 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10938 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10939 s8d = -(atempd(1,1)+atempd(2,2))* &
10940 scalar2(cc(1,1,itl),vtemp2(1))
10942 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
10944 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10945 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10952 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
10955 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
10959 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
10962 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
10971 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
10973 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10974 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10975 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10976 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10977 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
10979 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10980 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10981 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10985 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10986 !d & 16*eel_turn6_num
10988 if (j.lt.nres-1) then
10995 if (l.lt.nres-1) then
11003 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
11004 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
11005 !grad ghalf=0.5d0*ggg1(ll)
11007 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
11008 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
11009 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
11010 +ekont*derx_turn(ll,2,1)
11011 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
11012 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
11013 +ekont*derx_turn(ll,4,1)
11014 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
11015 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
11016 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
11017 !grad ghalf=0.5d0*ggg2(ll)
11019 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
11020 +ekont*derx_turn(ll,2,2)
11021 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
11022 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
11023 +ekont*derx_turn(ll,4,2)
11024 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
11025 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
11026 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
11031 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
11036 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
11042 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
11047 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
11051 !d write (2,*) iii,g_corr6_loc(iii)
11053 eello_turn6=ekont*eel_turn6
11054 !d write (2,*) 'ekont',ekont
11055 !d write (2,*) 'eel_turn6',ekont*eel_turn6
11057 end function eello_turn6
11058 !-----------------------------------------------------------------------------
11059 subroutine MATVEC2(A1,V1,V2)
11060 !DIR$ INLINEALWAYS MATVEC2
11062 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
11064 ! implicit real*8 (a-h,o-z)
11065 ! include 'DIMENSIONS'
11066 real(kind=8),dimension(2) :: V1,V2
11067 real(kind=8),dimension(2,2) :: A1
11068 real(kind=8) :: vaux1,vaux2
11072 ! 3 VI=VI+A1(I,K)*V1(K)
11076 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
11077 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
11081 end subroutine MATVEC2
11082 !-----------------------------------------------------------------------------
11083 subroutine MATMAT2(A1,A2,A3)
11085 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
11087 ! implicit real*8 (a-h,o-z)
11088 ! include 'DIMENSIONS'
11089 real(kind=8),dimension(2,2) :: A1,A2,A3
11090 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
11091 ! DIMENSION AI3(2,2)
11095 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
11101 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
11102 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
11103 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
11104 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
11110 end subroutine MATMAT2
11111 !-----------------------------------------------------------------------------
11112 real(kind=8) function scalar2(u,v)
11113 !DIR$ INLINEALWAYS scalar2
11115 real(kind=8),dimension(2) :: u,v
11118 scalar2=u(1)*v(1)+u(2)*v(2)
11120 end function scalar2
11121 !-----------------------------------------------------------------------------
11122 subroutine transpose2(a,at)
11123 !DIR$ INLINEALWAYS transpose2
11125 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
11128 real(kind=8),dimension(2,2) :: a,at
11134 end subroutine transpose2
11135 !-----------------------------------------------------------------------------
11136 subroutine transpose(n,a,at)
11139 real(kind=8),dimension(n,n) :: a,at
11146 end subroutine transpose
11147 !-----------------------------------------------------------------------------
11148 subroutine prodmat3(a1,a2,kk,transp,prod)
11149 !DIR$ INLINEALWAYS prodmat3
11151 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
11155 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
11157 !rc double precision auxmat(2,2),prod_(2,2)
11160 !rc call transpose2(kk(1,1),auxmat(1,1))
11161 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
11162 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11164 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
11165 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
11166 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
11167 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
11168 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
11169 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
11170 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
11171 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
11174 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
11175 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11177 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
11178 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
11179 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
11180 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
11181 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
11182 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
11183 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
11184 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
11187 ! call transpose2(a2(1,1),a2t(1,1))
11190 !rc print *,((prod_(i,j),i=1,2),j=1,2)
11191 !rc print *,((prod(i,j),i=1,2),j=1,2)
11194 end subroutine prodmat3
11195 !-----------------------------------------------------------------------------
11196 ! energy_p_new_barrier.F
11197 !-----------------------------------------------------------------------------
11198 subroutine sum_gradient
11199 ! implicit real*8 (a-h,o-z)
11200 use io_base, only: pdbout
11201 ! include 'DIMENSIONS'
11205 !MS$ATTRIBUTES C :: proc_proc
11211 real(kind=8),dimension(3,-1:nres) :: gradbufc,gradbufx,gradbufc_sum,&
11212 gloc_scbuf !(3,maxres)
11214 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
11216 !el local variables
11217 integer :: i,j,k,ierror,ierr
11218 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
11219 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
11220 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
11221 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
11222 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
11223 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
11224 gsccorr_max,gsccorrx_max,time00
11226 ! include 'COMMON.SETUP'
11227 ! include 'COMMON.IOUNITS'
11228 ! include 'COMMON.FFIELD'
11229 ! include 'COMMON.DERIV'
11230 ! include 'COMMON.INTERACT'
11231 ! include 'COMMON.SBRIDGE'
11232 ! include 'COMMON.CHAIN'
11233 ! include 'COMMON.VAR'
11234 ! include 'COMMON.CONTROL'
11235 ! include 'COMMON.TIME1'
11236 ! include 'COMMON.MAXGRAD'
11237 ! include 'COMMON.SCCOR'
11243 write (iout,*) "sum_gradient gvdwc, gvdwx"
11245 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
11246 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
11256 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
11257 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
11258 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
11261 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
11262 ! in virtual-bond-vector coordinates
11265 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
11267 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
11268 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
11270 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
11272 ! write (iout,'(i5,3f10.5,2x,f10.5)')
11273 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
11275 ! write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
11277 ! write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
11278 ! i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
11279 ! (gvdwc_scpp(j,i),j=1,3)
11281 ! write (iout,*) "gelc_long gvdwpp gel_loc_long"
11283 ! write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
11284 ! i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
11285 ! (gelc_loc_long(j,i),j=1,3)
11292 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
11293 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
11294 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
11295 wel_loc*gel_loc_long(j,i)+ &
11296 wcorr*gradcorr_long(j,i)+ &
11297 wcorr5*gradcorr5_long(j,i)+ &
11298 wcorr6*gradcorr6_long(j,i)+ &
11299 wturn6*gcorr6_turn_long(j,i)+ &
11300 wstrain*ghpbc(j,i) &
11301 +wliptran*gliptranc(j,i) &
11303 +welec*gshieldc(j,i) &
11304 +wcorr*gshieldc_ec(j,i) &
11305 +wturn3*gshieldc_t3(j,i)&
11306 +wturn4*gshieldc_t4(j,i)&
11307 +wel_loc*gshieldc_ll(j,i)&
11308 +wtube*gg_tube(j,i) &
11309 +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
11310 wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
11311 wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
11312 wcorr_nucl*gradcorr_nucl(j,i)&
11313 +wcorr3_nucl*gradcorr3_nucl(j,i)+&
11314 wcatprot* gradpepcat(j,i)+ &
11315 wcatcat*gradcatcat(j,i)+ &
11316 wscbase*gvdwc_scbase(j,i)+ &
11317 wpepbase*gvdwc_pepbase(j,i)+&
11318 wscpho*gvdwc_scpho(j,i)+ &
11319 wpeppho*gvdwc_peppho(j,i)
11330 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
11331 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
11332 welec*gelc_long(j,i)+ &
11333 wbond*gradb(j,i)+ &
11334 wel_loc*gel_loc_long(j,i)+ &
11335 wcorr*gradcorr_long(j,i)+ &
11336 wcorr5*gradcorr5_long(j,i)+ &
11337 wcorr6*gradcorr6_long(j,i)+ &
11338 wturn6*gcorr6_turn_long(j,i)+ &
11339 wstrain*ghpbc(j,i) &
11340 +wliptran*gliptranc(j,i) &
11342 +welec*gshieldc(j,i)&
11343 +wcorr*gshieldc_ec(j,i) &
11344 +wturn4*gshieldc_t4(j,i) &
11345 +wel_loc*gshieldc_ll(j,i)&
11346 +wtube*gg_tube(j,i) &
11347 +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
11348 wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
11349 wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
11350 wcorr_nucl*gradcorr_nucl(j,i) &
11351 +wcorr3_nucl*gradcorr3_nucl(j,i) +&
11352 wcatprot* gradpepcat(j,i)+ &
11353 wcatcat*gradcatcat(j,i)+ &
11354 wscbase*gvdwc_scbase(j,i)+ &
11355 wpepbase*gvdwc_pepbase(j,i)+&
11356 wscpho*gvdwc_scpho(j,i)+&
11357 wpeppho*gvdwc_peppho(j,i)
11364 if (nfgtasks.gt.1) then
11367 write (iout,*) "gradbufc before allreduce"
11369 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
11375 gradbufc_sum(j,i)=gradbufc(j,i)
11378 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
11379 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
11380 ! time_reduce=time_reduce+MPI_Wtime()-time00
11382 ! write (iout,*) "gradbufc_sum after allreduce"
11384 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
11389 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
11393 gradbufc(k,i)=0.0d0
11397 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
11398 write (iout,*) (i," jgrad_start",jgrad_start(i),&
11399 " jgrad_end ",jgrad_end(i),&
11400 i=igrad_start,igrad_end)
11403 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
11404 ! do not parallelize this part.
11406 ! do i=igrad_start,igrad_end
11407 ! do j=jgrad_start(i),jgrad_end(i)
11409 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
11414 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
11418 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
11422 write (iout,*) "gradbufc after summing"
11424 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
11432 write (iout,*) "gradbufc"
11434 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
11441 gradbufc_sum(j,i)=gradbufc(j,i)
11442 gradbufc(j,i)=0.0d0
11446 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
11450 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
11455 ! gradbufc(k,i)=0.0d0
11459 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
11465 write (iout,*) "gradbufc after summing"
11467 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
11476 gradbufc(k,nres)=0.0d0
11478 !el----------------
11479 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
11480 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
11481 !el-----------------
11485 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
11486 wel_loc*gel_loc(j,i)+ &
11487 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
11488 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
11489 wel_loc*gel_loc_long(j,i)+ &
11490 wcorr*gradcorr_long(j,i)+ &
11491 wcorr5*gradcorr5_long(j,i)+ &
11492 wcorr6*gradcorr6_long(j,i)+ &
11493 wturn6*gcorr6_turn_long(j,i))+ &
11494 wbond*gradb(j,i)+ &
11495 wcorr*gradcorr(j,i)+ &
11496 wturn3*gcorr3_turn(j,i)+ &
11497 wturn4*gcorr4_turn(j,i)+ &
11498 wcorr5*gradcorr5(j,i)+ &
11499 wcorr6*gradcorr6(j,i)+ &
11500 wturn6*gcorr6_turn(j,i)+ &
11501 wsccor*gsccorc(j,i) &
11502 +wscloc*gscloc(j,i) &
11503 +wliptran*gliptranc(j,i) &
11505 +welec*gshieldc(j,i) &
11506 +welec*gshieldc_loc(j,i) &
11507 +wcorr*gshieldc_ec(j,i) &
11508 +wcorr*gshieldc_loc_ec(j,i) &
11509 +wturn3*gshieldc_t3(j,i) &
11510 +wturn3*gshieldc_loc_t3(j,i) &
11511 +wturn4*gshieldc_t4(j,i) &
11512 +wturn4*gshieldc_loc_t4(j,i) &
11513 +wel_loc*gshieldc_ll(j,i) &
11514 +wel_loc*gshieldc_loc_ll(j,i) &
11515 +wtube*gg_tube(j,i) &
11516 +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
11517 +wvdwpsb*gvdwpsb1(j,i))&
11518 +wbond_nucl*gradb_nucl(j,i)+wsbloc*gsbloc(j,i)
11519 ! if (i.eq.21) then
11520 ! print *,"in sum",gradc(j,i,icg),wturn4*gcorr4_turn(j,i),&
11521 ! wturn4*gshieldc_t4(j,i), &
11522 ! wturn4*gshieldc_loc_t4(j,i)
11524 ! if ((i.le.2).and.(i.ge.1))
11525 ! print *,gradc(j,i,icg),&
11526 ! gradbufc(j,i),welec*gelc(j,i), &
11527 ! wel_loc*gel_loc(j,i), &
11528 ! wscp*gvdwc_scpp(j,i), &
11529 ! welec*gelc_long(j,i),wvdwpp*gvdwpp(j,i), &
11530 ! wel_loc*gel_loc_long(j,i), &
11531 ! wcorr*gradcorr_long(j,i), &
11532 ! wcorr5*gradcorr5_long(j,i), &
11533 ! wcorr6*gradcorr6_long(j,i), &
11534 ! wturn6*gcorr6_turn_long(j,i), &
11535 ! wbond*gradb(j,i), &
11536 ! wcorr*gradcorr(j,i), &
11537 ! wturn3*gcorr3_turn(j,i), &
11538 ! wturn4*gcorr4_turn(j,i), &
11539 ! wcorr5*gradcorr5(j,i), &
11540 ! wcorr6*gradcorr6(j,i), &
11541 ! wturn6*gcorr6_turn(j,i), &
11542 ! wsccor*gsccorc(j,i) &
11543 ! ,wscloc*gscloc(j,i) &
11544 ! ,wliptran*gliptranc(j,i) &
11546 ! ,welec*gshieldc(j,i) &
11547 ! ,welec*gshieldc_loc(j,i) &
11548 ! ,wcorr*gshieldc_ec(j,i) &
11549 ! ,wcorr*gshieldc_loc_ec(j,i) &
11550 ! ,wturn3*gshieldc_t3(j,i) &
11551 ! ,wturn3*gshieldc_loc_t3(j,i) &
11552 ! ,wturn4*gshieldc_t4(j,i) &
11553 ! ,wturn4*gshieldc_loc_t4(j,i) &
11554 ! ,wel_loc*gshieldc_ll(j,i) &
11555 ! ,wel_loc*gshieldc_loc_ll(j,i) &
11556 ! ,wtube*gg_tube(j,i) &
11557 ! ,wbond_nucl*gradb_nucl(j,i) &
11558 ! ,wvdwpp_nucl*gvdwpp_nucl(j,i),welpp*gelpp(j,i),&
11559 ! wvdwpsb*gvdwpsb1(j,i)&
11560 ! ,wbond_nucl*gradb_nucl(j,i),wsbloc*gsbloc(j,i)
11564 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
11565 wel_loc*gel_loc(j,i)+ &
11566 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
11567 welec*gelc_long(j,i)+ &
11568 wel_loc*gel_loc_long(j,i)+ &
11569 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
11570 wcorr5*gradcorr5_long(j,i)+ &
11571 wcorr6*gradcorr6_long(j,i)+ &
11572 wturn6*gcorr6_turn_long(j,i))+ &
11573 wbond*gradb(j,i)+ &
11574 wcorr*gradcorr(j,i)+ &
11575 wturn3*gcorr3_turn(j,i)+ &
11576 wturn4*gcorr4_turn(j,i)+ &
11577 wcorr5*gradcorr5(j,i)+ &
11578 wcorr6*gradcorr6(j,i)+ &
11579 wturn6*gcorr6_turn(j,i)+ &
11580 wsccor*gsccorc(j,i) &
11581 +wscloc*gscloc(j,i) &
11583 +wliptran*gliptranc(j,i) &
11584 +welec*gshieldc(j,i) &
11585 +welec*gshieldc_loc(j,i) &
11586 +wcorr*gshieldc_ec(j,i) &
11587 +wcorr*gshieldc_loc_ec(j,i) &
11588 +wturn3*gshieldc_t3(j,i) &
11589 +wturn3*gshieldc_loc_t3(j,i) &
11590 +wturn4*gshieldc_t4(j,i) &
11591 +wturn4*gshieldc_loc_t4(j,i) &
11592 +wel_loc*gshieldc_ll(j,i) &
11593 +wel_loc*gshieldc_loc_ll(j,i) &
11594 +wtube*gg_tube(j,i) &
11595 +wbond_nucl*gradb_nucl(j,i) &
11596 +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
11597 +wvdwpsb*gvdwpsb1(j,i))&
11598 +wsbloc*gsbloc(j,i)
11604 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
11605 wbond*gradbx(j,i)+ &
11606 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
11607 wsccor*gsccorx(j,i) &
11608 +wscloc*gsclocx(j,i) &
11609 +wliptran*gliptranx(j,i) &
11610 +welec*gshieldx(j,i) &
11611 +wcorr*gshieldx_ec(j,i) &
11612 +wturn3*gshieldx_t3(j,i) &
11613 +wturn4*gshieldx_t4(j,i) &
11614 +wel_loc*gshieldx_ll(j,i)&
11615 +wtube*gg_tube_sc(j,i) &
11616 +wbond_nucl*gradbx_nucl(j,i) &
11617 +wvdwsb*gvdwsbx(j,i) &
11618 +welsb*gelsbx(j,i) &
11619 +wcorr_nucl*gradxorr_nucl(j,i)&
11620 +wcorr3_nucl*gradxorr3_nucl(j,i) &
11621 +wsbloc*gsblocx(j,i) &
11622 +wcatprot* gradpepcatx(j,i)&
11623 +wscbase*gvdwx_scbase(j,i) &
11624 +wpepbase*gvdwx_pepbase(j,i)&
11625 +wscpho*gvdwx_scpho(j,i)
11626 ! if (i.eq.3) print *,"tu?", wscpho,gvdwx_scpho(j,i)
11632 write (iout,*) "gloc before adding corr"
11634 write (iout,*) i,gloc(i,icg)
11638 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
11639 +wcorr5*g_corr5_loc(i) &
11640 +wcorr6*g_corr6_loc(i) &
11641 +wturn4*gel_loc_turn4(i) &
11642 +wturn3*gel_loc_turn3(i) &
11643 +wturn6*gel_loc_turn6(i) &
11644 +wel_loc*gel_loc_loc(i)
11647 write (iout,*) "gloc after adding corr"
11649 write (iout,*) i,gloc(i,icg)
11654 if (nfgtasks.gt.1) then
11657 gradbufc(j,i)=gradc(j,i,icg)
11658 gradbufx(j,i)=gradx(j,i,icg)
11662 glocbuf(i)=gloc(i,icg)
11666 write (iout,*) "gloc_sc before reduce"
11669 write (iout,*) i,j,gloc_sc(j,i,icg)
11676 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
11680 call MPI_Barrier(FG_COMM,IERR)
11681 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
11683 call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,&
11684 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11685 call MPI_Reduce(gradbufx(1,0),gradx(1,0,icg),3*nres+3,&
11686 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11687 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
11688 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11689 time_reduce=time_reduce+MPI_Wtime()-time00
11690 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
11691 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11692 time_reduce=time_reduce+MPI_Wtime()-time00
11694 ! print *,"gradbuf",gradbufc(1,1),gradc(1,1,icg)
11696 write (iout,*) "gloc_sc after reduce"
11699 write (iout,*) i,j,gloc_sc(j,i,icg)
11705 write (iout,*) "gloc after reduce"
11707 write (iout,*) i,gloc(i,icg)
11712 if (gnorm_check) then
11714 ! Compute the maximum elements of the gradient
11717 gvdwc_scp_max=0.0d0
11724 gcorr3_turn_max=0.0d0
11725 gcorr4_turn_max=0.0d0
11726 gradcorr5_max=0.0d0
11727 gradcorr6_max=0.0d0
11728 gcorr6_turn_max=0.0d0
11732 gradx_scp_max=0.0d0
11738 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
11739 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
11740 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
11741 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
11742 gvdwc_scp_max=gvdwc_scp_norm
11743 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
11744 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
11745 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
11746 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
11747 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
11748 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
11749 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
11750 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
11751 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
11752 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
11753 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
11754 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
11755 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
11757 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
11758 gcorr3_turn_max=gcorr3_turn_norm
11759 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
11761 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
11762 gcorr4_turn_max=gcorr4_turn_norm
11763 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
11764 if (gradcorr5_norm.gt.gradcorr5_max) &
11765 gradcorr5_max=gradcorr5_norm
11766 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
11767 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
11768 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
11770 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
11771 gcorr6_turn_max=gcorr6_turn_norm
11772 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
11773 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
11774 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
11775 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
11776 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
11777 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
11778 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
11779 if (gradx_scp_norm.gt.gradx_scp_max) &
11780 gradx_scp_max=gradx_scp_norm
11781 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
11782 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
11783 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
11784 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
11785 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
11786 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
11787 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
11788 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
11792 open(istat,file=statname,position="append")
11794 open(istat,file=statname,access="append")
11796 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
11797 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
11798 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
11799 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
11800 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
11801 gsccorx_max,gsclocx_max
11803 if (gvdwc_max.gt.1.0d4) then
11804 write (iout,*) "gvdwc gvdwx gradb gradbx"
11806 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
11807 gradb(j,i),gradbx(j,i),j=1,3)
11809 call pdbout(0.0d0,'cipiszcze',iout)
11816 write (iout,*) "gradc gradx gloc"
11818 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
11819 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
11824 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
11827 end subroutine sum_gradient
11828 !-----------------------------------------------------------------------------
11830 ! implicit real*8 (a-h,o-z)
11832 ! include 'DIMENSIONS'
11833 ! include 'COMMON.CHAIN'
11834 ! include 'COMMON.DERIV'
11835 ! include 'COMMON.CALC'
11836 ! include 'COMMON.IOUNITS'
11837 real(kind=8), dimension(3) :: dcosom1,dcosom2
11838 ! print *,"wchodze"
11839 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 &
11840 +dCAVdOM1+ dGCLdOM1+ dPOLdOM1
11841 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 &
11842 +dCAVdOM2+ dGCLdOM2+ dPOLdOM2
11844 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
11845 -2.0D0*alf12*eps3der+sigder*sigsq_om12&
11846 +dCAVdOM12+ dGCLdOM12
11850 ! eom12=evdwij*eps1_om12
11852 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
11854 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
11855 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
11856 !C print *,sss_ele_cut,'in sc_grad'
11858 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
11859 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
11862 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
11863 !C print *,'gg',k,gg(k)
11865 ! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
11866 ! write (iout,*) "gg",(gg(k),k=1,3)
11868 gvdwx(k,i)=gvdwx(k,i)-gg(k) +gg_lipi(k)&
11869 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
11870 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
11873 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)&
11874 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
11875 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv &
11878 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
11879 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
11880 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
11881 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
11884 ! Calculate the components of the gradient in DC and X
11888 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
11892 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
11893 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
11896 end subroutine sc_grad
11898 subroutine sc_grad_cat
11899 ! implicit real*8 (a-h,o-z)
11901 ! include 'DIMENSIONS'
11902 ! include 'COMMON.CHAIN'
11903 ! include 'COMMON.DERIV'
11904 ! include 'COMMON.CALC'
11905 ! include 'COMMON.IOUNITS'
11906 real(kind=8), dimension(3) :: dcosom1,dcosom2
11907 ! print *,"wchodze"
11908 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 &
11909 +dCAVdOM1+ dGCLdOM1+ dPOLdOM1
11910 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 &
11911 +dCAVdOM2+ dGCLdOM2+ dPOLdOM2
11913 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
11914 -2.0D0*alf12*eps3der+sigder*sigsq_om12&
11915 +dCAVdOM12+ dGCLdOM12
11919 ! eom12=evdwij*eps1_om12
11921 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
11923 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
11924 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
11925 !C print *,sss_ele_cut,'in sc_grad'
11928 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
11929 dcosom2(k)=rij*(dc_norm(k,j)-om2*erij(k))
11932 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))
11933 !C print *,'gg',k,gg(k)
11935 ! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
11936 ! write (iout,*) "gg",(gg(k),k=1,3)
11938 gradpepcatx(k,i)=gradpepcatx(k,i)-gg(k) &
11939 +(eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
11940 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
11942 ! gradpepcatx(k,j)=gradpepcatx(k,j)+gg(k) &
11943 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)) &
11944 ! +eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv
11946 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
11947 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
11948 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
11949 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
11952 ! Calculate the components of the gradient in DC and X
11956 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
11960 gradpepcat(l,i)=gradpepcat(l,i)-gg(l)
11961 gradpepcat(l,j)=gradpepcat(l,j)+gg(l)
11963 end subroutine sc_grad_cat
11967 !-----------------------------------------------------------------------------
11968 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
11971 ! implicit real*8 (a-h,o-z)
11972 ! include 'DIMENSIONS'
11973 ! include 'COMMON.LOCAL'
11974 ! include 'COMMON.IOUNITS'
11975 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
11976 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
11977 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
11978 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
11979 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
11981 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
11982 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
11983 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
11984 !el local variables
11986 delthec=thetai-thet_pred_mean
11987 delthe0=thetai-theta0i
11988 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
11989 t3 = thetai-thet_pred_mean
11993 t14 = t12+t6*sigsqtc
11995 t21 = thetai-theta0i
12001 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
12002 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
12003 *(-t12*t9-ak*sig0inv*t27)
12005 end subroutine mixder
12007 !-----------------------------------------------------------------------------
12009 !-----------------------------------------------------------------------------
12011 !-----------------------------------------------------------------------------
12012 ! This subroutine calculates the derivatives of the consecutive virtual
12013 ! bond vectors and the SC vectors in the virtual-bond angles theta and
12014 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
12015 ! in the angles alpha and omega, describing the location of a side chain
12016 ! in its local coordinate system.
12018 ! The derivatives are stored in the following arrays:
12020 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
12021 ! The structure is as follows:
12023 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
12024 ! 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)
12025 ! . . . . . . . . . . . . . . . . . .
12026 ! 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)
12030 ! 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)
12032 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
12033 ! The structure is same as above.
12035 ! DCDS - the derivatives of the side chain vectors in the local spherical
12036 ! andgles alph and omega:
12038 ! 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)
12039 ! 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)
12043 ! 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)
12045 ! Version of March '95, based on an early version of November '91.
12047 !**********************************************************************
12048 ! implicit real*8 (a-h,o-z)
12049 ! include 'DIMENSIONS'
12050 ! include 'COMMON.VAR'
12051 ! include 'COMMON.CHAIN'
12052 ! include 'COMMON.DERIV'
12053 ! include 'COMMON.GEO'
12054 ! include 'COMMON.LOCAL'
12055 ! include 'COMMON.INTERACT'
12056 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
12057 real(kind=8),dimension(3,3) :: dp,temp
12058 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
12059 real(kind=8),dimension(3) :: xx,xx1
12060 !el local variables
12061 integer :: i,k,l,j,m,ind,ind1,jjj
12062 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
12063 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
12064 sint2,xp,yp,xxp,yyp,zzp,dj
12066 ! common /przechowalnia/ fromto
12067 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
12068 ! get the position of the jth ijth fragment of the chain coordinate system
12069 ! in the fromto array.
12070 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
12072 ! maxdim=(nres-1)*(nres-2)/2
12073 ! allocate(dcdv(6,maxdim),dxds(6,nres))
12074 ! calculate the derivatives of transformation matrix elements in theta
12077 !el call flush(iout) !el
12079 rdt(1,1,i)=-rt(1,2,i)
12080 rdt(1,2,i)= rt(1,1,i)
12082 rdt(2,1,i)=-rt(2,2,i)
12083 rdt(2,2,i)= rt(2,1,i)
12085 rdt(3,1,i)=-rt(3,2,i)
12086 rdt(3,2,i)= rt(3,1,i)
12090 ! derivatives in phi
12096 drt(2,1,i)= rt(3,1,i)
12097 drt(2,2,i)= rt(3,2,i)
12098 drt(2,3,i)= rt(3,3,i)
12099 drt(3,1,i)=-rt(2,1,i)
12100 drt(3,2,i)=-rt(2,2,i)
12101 drt(3,3,i)=-rt(2,3,i)
12104 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
12110 temp(k,l)=rt(k,l,i)
12115 fromto(k,l,ind)=temp(k,l)
12124 dpkl=dpkl+temp(k,m)*rt(m,l,j)
12127 fromto(k,l,ind)=dpkl
12138 ! Calculate derivatives.
12144 ! Derivatives of DC(i+1) in theta(i+2)
12150 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
12153 prordt(j,k,i)=dp(j,k)
12156 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
12159 ! Derivatives of SC(i+1) in theta(i+2)
12161 xx1(1)=-0.5D0*xloc(2,i+1)
12162 xx1(2)= 0.5D0*xloc(1,i+1)
12166 xj=xj+r(j,k,i)*xx1(k)
12173 rj=rj+prod(j,k,i)*xx(k)
12178 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
12179 ! than the other off-diagonal derivatives.
12184 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
12186 dxdv(j,ind1+1)=dxoiij
12188 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
12190 ! Derivatives of DC(i+1) in phi(i+2)
12196 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
12199 prodrt(j,k,i)=dp(j,k)
12201 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
12204 ! Derivatives of SC(i+1) in phi(i+2)
12207 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
12208 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
12212 rj=rj+prod(j,k,i)*xx(k)
12217 ! Derivatives of SC(i+1) in phi(i+3).
12222 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
12224 dxdv(j+3,ind1+1)=dxoiij
12227 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
12228 ! theta(nres) and phi(i+3) thru phi(nres).
12232 ind=indmat(i+1,j+1)
12233 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
12238 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
12243 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
12244 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
12245 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
12246 ! Derivatives of virtual-bond vectors in theta
12248 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
12250 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
12251 ! Derivatives of SC vectors in theta
12255 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
12257 dxdv(k,ind1+1)=dxoijk
12260 !--- Calculate the derivatives in phi
12266 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
12272 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
12277 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
12279 dxdv(k+3,ind1+1)=dxoijk
12284 ! Derivatives in alpha and omega:
12287 ! dsci=dsc(itype(i,1))
12292 if(alphi.ne.alphi) alphi=100.0
12293 if(omegi.ne.omegi) omegi=-100.0
12298 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
12299 cosalphi=dcos(alphi)
12300 sinalphi=dsin(alphi)
12301 cosomegi=dcos(omegi)
12302 sinomegi=dsin(omegi)
12303 temp(1,1)=-dsci*sinalphi
12304 temp(2,1)= dsci*cosalphi*cosomegi
12305 temp(3,1)=-dsci*cosalphi*sinomegi
12307 temp(2,2)=-dsci*sinalphi*sinomegi
12308 temp(3,2)=-dsci*sinalphi*cosomegi
12309 theta2=pi-0.5D0*theta(i+1)
12313 !d print *,((temp(l,k),l=1,3),k=1,2)
12317 xxp= xp*cost2+yp*sint2
12318 yyp=-xp*sint2+yp*cost2
12321 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
12322 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
12326 dj=dj+prod(k,l,i-1)*xx(l)
12334 end subroutine cartder
12335 !-----------------------------------------------------------------------------
12337 !-----------------------------------------------------------------------------
12338 subroutine check_cartgrad
12339 ! Check the gradient of Cartesian coordinates in internal coordinates.
12340 ! implicit real*8 (a-h,o-z)
12341 ! include 'DIMENSIONS'
12342 ! include 'COMMON.IOUNITS'
12343 ! include 'COMMON.VAR'
12344 ! include 'COMMON.CHAIN'
12345 ! include 'COMMON.GEO'
12346 ! include 'COMMON.LOCAL'
12347 ! include 'COMMON.DERIV'
12348 real(kind=8),dimension(6,nres) :: temp
12349 real(kind=8),dimension(3) :: xx,gg
12350 integer :: i,k,j,ii
12351 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
12352 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
12354 ! Check the gradient of the virtual-bond and SC vectors in the internal
12360 write (iout,'(a)') '**************** dx/dalpha'
12364 alph(i)=alph(i)+aincr
12366 temp(k,i)=dc(k,nres+i)
12370 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
12371 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
12373 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
12374 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
12380 write (iout,'(a)') '**************** dx/domega'
12384 omeg(i)=omeg(i)+aincr
12386 temp(k,i)=dc(k,nres+i)
12390 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
12391 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
12392 (aincr*dabs(dxds(k+3,i))+aincr))
12394 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
12395 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
12401 write (iout,'(a)') '**************** dx/dtheta'
12405 theta(i)=theta(i)+aincr
12408 temp(k,j)=dc(k,nres+j)
12414 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
12416 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
12417 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
12418 (aincr*dabs(dxdv(k,ii))+aincr))
12420 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
12421 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
12428 write (iout,'(a)') '***************** dx/dphi'
12431 phi(i)=phi(i)+aincr
12434 temp(k,j)=dc(k,nres+j)
12442 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
12443 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
12444 (aincr*dabs(dxdv(k+3,ii))+aincr))
12446 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
12447 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
12450 phi(i)=phi(i)-aincr
12453 write (iout,'(a)') '****************** ddc/dtheta'
12456 theta(i+2)=thet+aincr
12467 gg(k)=(dc(k,j)-temp(k,j))/aincr
12468 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
12469 (aincr*dabs(dcdv(k,ii))+aincr))
12471 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
12472 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
12482 write (iout,'(a)') '******************* ddc/dphi'
12485 phi(i+3)=phii+aincr
12496 gg(k)=(dc(k,j)-temp(k,j))/aincr
12497 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
12498 (aincr*dabs(dcdv(k+3,ii))+aincr))
12500 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
12501 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
12512 end subroutine check_cartgrad
12513 !-----------------------------------------------------------------------------
12514 subroutine check_ecart
12515 ! Check the gradient of the energy in Cartesian coordinates.
12516 ! implicit real*8 (a-h,o-z)
12517 ! include 'DIMENSIONS'
12518 ! include 'COMMON.CHAIN'
12519 ! include 'COMMON.DERIV'
12520 ! include 'COMMON.IOUNITS'
12521 ! include 'COMMON.VAR'
12522 ! include 'COMMON.CONTACTS'
12524 !el integer :: icall
12525 !el common /srutu/ icall
12526 real(kind=8),dimension(6) :: ggg
12527 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
12528 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
12529 real(kind=8),dimension(6,nres) :: grad_s
12530 real(kind=8),dimension(0:n_ene) :: energia,energia1
12531 integer :: uiparm(1)
12532 real(kind=8) :: urparm(1)
12534 integer :: nf,i,j,k
12535 real(kind=8) :: aincr,etot,etot1
12541 print '(a)','CG processor',me,' calling CHECK_CART.',aincr
12544 call geom_to_var(nvar,x)
12545 call etotal(energia)
12547 !el call enerprint(energia)
12548 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
12551 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
12555 grad_s(j,i)=gradc(j,i,icg)
12556 grad_s(j+3,i)=gradx(j,i,icg)
12560 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
12565 ddx(j)=dc(j,i+nres)
12568 dc(j,i)=dc(j,i)+aincr
12570 c(j,k)=c(j,k)+aincr
12571 c(j,k+nres)=c(j,k+nres)+aincr
12574 call etotal(energia1)
12576 ggg(j)=(etot1-etot)/aincr
12579 c(j,k)=c(j,k)-aincr
12580 c(j,k+nres)=c(j,k+nres)-aincr
12584 c(j,i+nres)=c(j,i+nres)+aincr
12585 dc(j,i+nres)=dc(j,i+nres)+aincr
12587 call etotal(energia1)
12589 ggg(j+3)=(etot1-etot)/aincr
12591 dc(j,i+nres)=ddx(j)
12593 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
12594 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
12597 end subroutine check_ecart
12599 !-----------------------------------------------------------------------------
12600 subroutine check_ecartint
12601 ! Check the gradient of the energy in Cartesian coordinates.
12602 use io_base, only: intout
12603 ! implicit real*8 (a-h,o-z)
12604 ! include 'DIMENSIONS'
12605 ! include 'COMMON.CONTROL'
12606 ! include 'COMMON.CHAIN'
12607 ! include 'COMMON.DERIV'
12608 ! include 'COMMON.IOUNITS'
12609 ! include 'COMMON.VAR'
12610 ! include 'COMMON.CONTACTS'
12611 ! include 'COMMON.MD'
12612 ! include 'COMMON.LOCAL'
12613 ! include 'COMMON.SPLITELE'
12615 !el integer :: icall
12616 !el common /srutu/ icall
12617 real(kind=8),dimension(6) :: ggg,ggg1
12618 real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
12619 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
12620 real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
12621 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
12622 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
12623 real(kind=8),dimension(0:n_ene) :: energia,energia1
12624 integer :: uiparm(1)
12625 real(kind=8) :: urparm(1)
12627 integer :: i,j,k,nf
12628 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
12636 ! call intcartderiv
12637 ! call checkintcartgrad
12640 write(iout,*) 'Calling CHECK_ECARTINT.'
12643 call geom_to_var(nvar,x)
12644 write (iout,*) "split_ene ",split_ene
12646 if (.not.split_ene) then
12648 call etotal(energia)
12653 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
12656 grad_s(j,0)=gcart(j,0)
12660 grad_s(j,i)=gcart(j,i)
12661 grad_s(j+3,i)=gxcart(j,i)
12665 !- split gradient check
12667 call etotal_long(energia)
12668 !el call enerprint(energia)
12672 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12673 (gxcart(j,i),j=1,3)
12676 grad_s(j,0)=gcart(j,0)
12680 grad_s(j,i)=gcart(j,i)
12681 grad_s(j+3,i)=gxcart(j,i)
12685 call etotal_short(energia)
12686 call enerprint(energia)
12690 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12691 (gxcart(j,i),j=1,3)
12694 grad_s1(j,0)=gcart(j,0)
12698 grad_s1(j,i)=gcart(j,i)
12699 grad_s1(j+3,i)=gxcart(j,i)
12703 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
12707 if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
12708 if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
12711 dcnorm_safe1(j)=dc_norm(j,i-1)
12712 dcnorm_safe2(j)=dc_norm(j,i)
12713 dxnorm_safe(j)=dc_norm(j,i+nres)
12716 c(j,i)=ddc(j)+aincr
12717 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
12718 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
12719 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
12720 dc(j,i)=c(j,i+1)-c(j,i)
12721 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12722 call int_from_cart1(.false.)
12723 if (.not.split_ene) then
12725 call etotal(energia1)
12727 write (iout,*) "ij",i,j," etot1",etot1
12730 call etotal_long(energia1)
12732 call etotal_short(energia1)
12735 !- end split gradient
12736 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12737 c(j,i)=ddc(j)-aincr
12738 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
12739 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
12740 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
12741 dc(j,i)=c(j,i+1)-c(j,i)
12742 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12743 call int_from_cart1(.false.)
12744 if (.not.split_ene) then
12746 call etotal(energia1)
12748 write (iout,*) "ij",i,j," etot2",etot2
12749 ggg(j)=(etot1-etot2)/(2*aincr)
12752 call etotal_long(energia1)
12754 ggg(j)=(etot11-etot21)/(2*aincr)
12755 call etotal_short(energia1)
12757 ggg1(j)=(etot12-etot22)/(2*aincr)
12758 !- end split gradient
12759 ! write (iout,*) "etot21",etot21," etot22",etot22
12761 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12763 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
12764 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
12765 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
12766 dc(j,i)=c(j,i+1)-c(j,i)
12767 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12768 dc_norm(j,i-1)=dcnorm_safe1(j)
12769 dc_norm(j,i)=dcnorm_safe2(j)
12770 dc_norm(j,i+nres)=dxnorm_safe(j)
12773 c(j,i+nres)=ddx(j)+aincr
12774 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12775 call int_from_cart1(.false.)
12776 if (.not.split_ene) then
12778 call etotal(energia1)
12782 call etotal_long(energia1)
12784 call etotal_short(energia1)
12787 !- end split gradient
12788 c(j,i+nres)=ddx(j)-aincr
12789 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12790 call int_from_cart1(.false.)
12791 if (.not.split_ene) then
12793 call etotal(energia1)
12795 ggg(j+3)=(etot1-etot2)/(2*aincr)
12798 call etotal_long(energia1)
12800 ggg(j+3)=(etot11-etot21)/(2*aincr)
12801 call etotal_short(energia1)
12803 ggg1(j+3)=(etot12-etot22)/(2*aincr)
12804 !- end split gradient
12806 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12808 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12809 dc_norm(j,i+nres)=dxnorm_safe(j)
12810 call int_from_cart1(.false.)
12812 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12813 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
12814 if (split_ene) then
12815 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12816 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
12818 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12819 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
12820 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
12824 end subroutine check_ecartint
12826 !-----------------------------------------------------------------------------
12827 subroutine check_ecartint
12828 ! Check the gradient of the energy in Cartesian coordinates.
12829 use io_base, only: intout
12830 ! implicit real*8 (a-h,o-z)
12831 ! include 'DIMENSIONS'
12832 ! include 'COMMON.CONTROL'
12833 ! include 'COMMON.CHAIN'
12834 ! include 'COMMON.DERIV'
12835 ! include 'COMMON.IOUNITS'
12836 ! include 'COMMON.VAR'
12837 ! include 'COMMON.CONTACTS'
12838 ! include 'COMMON.MD'
12839 ! include 'COMMON.LOCAL'
12840 ! include 'COMMON.SPLITELE'
12842 !el integer :: icall
12843 !el common /srutu/ icall
12844 real(kind=8),dimension(6) :: ggg,ggg1
12845 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
12846 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
12847 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
12848 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
12849 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
12850 real(kind=8),dimension(0:n_ene) :: energia,energia1
12851 integer :: uiparm(1)
12852 real(kind=8) :: urparm(1)
12854 integer :: i,j,k,nf
12855 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
12863 ! call intcartderiv
12864 ! call checkintcartgrad
12867 write(iout,*) 'Calling CHECK_ECARTINT.',aincr
12870 call geom_to_var(nvar,x)
12871 if (.not.split_ene) then
12872 call etotal(energia)
12874 !el call enerprint(energia)
12878 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
12881 grad_s(j,0)=gcart(j,0)
12885 grad_s(j,i)=gcart(j,i)
12886 ! if (i.eq.21) print *,"PRZEKAZANIE",gcart(j,i)
12888 ! if (i.le.2) print *,"tu?!",gcart(j,i),grad_s(j,i),gxcart(j,i)
12889 grad_s(j+3,i)=gxcart(j,i)
12893 !- split gradient check
12895 call etotal_long(energia)
12896 !el call enerprint(energia)
12900 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12901 (gxcart(j,i),j=1,3)
12904 grad_s(j,0)=gcart(j,0)
12908 grad_s(j,i)=gcart(j,i)
12909 ! if (i.eq.21) print *,"PRZEKAZANIE",gcart(j,i)
12910 grad_s(j+3,i)=gxcart(j,i)
12914 call etotal_short(energia)
12915 !el call enerprint(energia)
12919 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12920 (gxcart(j,i),j=1,3)
12923 grad_s1(j,0)=gcart(j,0)
12927 grad_s1(j,i)=gcart(j,i)
12928 grad_s1(j+3,i)=gxcart(j,i)
12932 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
12937 ddx(j)=dc(j,i+nres)
12939 dcnorm_safe(k)=dc_norm(k,i)
12940 dxnorm_safe(k)=dc_norm(k,i+nres)
12944 dc(j,i)=ddc(j)+aincr
12945 call chainbuild_cart
12947 ! Broadcast the order to compute internal coordinates to the slaves.
12948 ! if (nfgtasks.gt.1)
12949 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
12951 ! call int_from_cart1(.false.)
12952 if (.not.split_ene) then
12954 call etotal(energia1)
12956 ! call enerprint(energia1)
12959 call etotal_long(energia1)
12961 call etotal_short(energia1)
12963 ! write (iout,*) "etot11",etot11," etot12",etot12
12965 !- end split gradient
12966 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12967 dc(j,i)=ddc(j)-aincr
12968 call chainbuild_cart
12969 ! call int_from_cart1(.false.)
12970 if (.not.split_ene) then
12972 call etotal(energia1)
12974 ggg(j)=(etot1-etot2)/(2*aincr)
12977 call etotal_long(energia1)
12979 ggg(j)=(etot11-etot21)/(2*aincr)
12980 call etotal_short(energia1)
12982 ggg1(j)=(etot12-etot22)/(2*aincr)
12983 !- end split gradient
12984 ! write (iout,*) "etot21",etot21," etot22",etot22
12986 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12988 call chainbuild_cart
12991 dc(j,i+nres)=ddx(j)+aincr
12992 call chainbuild_cart
12993 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
12994 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
12995 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
12996 ! write (iout,*) "dxnormnorm",dsqrt(
12997 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
12998 ! write (iout,*) "dxnormnormsafe",dsqrt(
12999 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
13001 if (.not.split_ene) then
13003 call etotal(energia1)
13007 call etotal_long(energia1)
13009 call etotal_short(energia1)
13012 !- end split gradient
13013 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
13014 dc(j,i+nres)=ddx(j)-aincr
13015 call chainbuild_cart
13016 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
13017 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
13018 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
13020 ! write (iout,*) "dxnormnorm",dsqrt(
13021 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
13022 ! write (iout,*) "dxnormnormsafe",dsqrt(
13023 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
13024 if (.not.split_ene) then
13026 call etotal(energia1)
13028 ggg(j+3)=(etot1-etot2)/(2*aincr)
13031 call etotal_long(energia1)
13033 ggg(j+3)=(etot11-etot21)/(2*aincr)
13034 call etotal_short(energia1)
13036 ggg1(j+3)=(etot12-etot22)/(2*aincr)
13037 !- end split gradient
13039 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
13040 dc(j,i+nres)=ddx(j)
13041 call chainbuild_cart
13043 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
13044 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
13045 if (split_ene) then
13046 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
13047 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
13049 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
13050 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
13051 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
13055 end subroutine check_ecartint
13057 !-----------------------------------------------------------------------------
13058 subroutine check_eint
13059 ! Check the gradient of energy in internal coordinates.
13060 ! implicit real*8 (a-h,o-z)
13061 ! include 'DIMENSIONS'
13062 ! include 'COMMON.CHAIN'
13063 ! include 'COMMON.DERIV'
13064 ! include 'COMMON.IOUNITS'
13065 ! include 'COMMON.VAR'
13066 ! include 'COMMON.GEO'
13068 !el integer :: icall
13069 !el common /srutu/ icall
13070 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
13071 integer :: uiparm(1)
13072 real(kind=8) :: urparm(1)
13073 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
13074 character(len=6) :: key
13077 real(kind=8) :: xi,aincr,etot,etot1,etot2
13080 print '(a)','Calling CHECK_INT.'
13084 call geom_to_var(nvar,x)
13085 call var_to_geom(nvar,x)
13088 ! print *,'ICG=',ICG
13089 call etotal(energia)
13091 !el call enerprint(energia)
13092 ! print *,'ICG=',ICG
13094 if (MyID.ne.BossID) then
13095 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
13103 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
13104 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
13105 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
13109 x(i)=xi-0.5D0*aincr
13110 call var_to_geom(nvar,x)
13112 call etotal(energia1)
13114 x(i)=xi+0.5D0*aincr
13115 call var_to_geom(nvar,x)
13117 call etotal(energia2)
13119 gg(i)=(etot2-etot1)/aincr
13120 write (iout,*) i,etot1,etot2
13123 write (iout,'(/2a)')' Variable Numerical Analytical',&
13126 if (i.le.nphi) then
13129 else if (i.le.nphi+ntheta) then
13132 else if (i.le.nphi+ntheta+nside) then
13136 ii=i-(nphi+ntheta+nside)
13139 write (iout,'(i3,a,i3,3(1pd16.6))') &
13140 i,key,ii,gg(i),gana(i),&
13141 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
13144 end subroutine check_eint
13145 !-----------------------------------------------------------------------------
13147 !-----------------------------------------------------------------------------
13148 subroutine Econstr_back
13149 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
13150 ! implicit real*8 (a-h,o-z)
13151 ! include 'DIMENSIONS'
13152 ! include 'COMMON.CONTROL'
13153 ! include 'COMMON.VAR'
13154 ! include 'COMMON.MD'
13157 ! include 'COMMON.LANGEVIN'
13159 ! include 'COMMON.LANGEVIN.lang0'
13161 ! include 'COMMON.CHAIN'
13162 ! include 'COMMON.DERIV'
13163 ! include 'COMMON.GEO'
13164 ! include 'COMMON.LOCAL'
13165 ! include 'COMMON.INTERACT'
13166 ! include 'COMMON.IOUNITS'
13167 ! include 'COMMON.NAMES'
13168 ! include 'COMMON.TIME1'
13169 integer :: i,j,ii,k
13170 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
13172 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
13173 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
13174 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
13181 duscdiff(j,i)=0.0d0
13182 duscdiffx(j,i)=0.0d0
13186 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
13188 ! Deviations from theta angles
13191 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
13192 dtheta_i=theta(j)-thetaref(j)
13193 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
13194 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
13196 utheta(i)=utheta_i/(ii-1)
13198 ! Deviations from gamma angles
13201 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
13202 dgamma_i=pinorm(phi(j)-phiref(j))
13203 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
13204 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
13205 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
13206 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
13208 ugamma(i)=ugamma_i/(ii-2)
13210 ! Deviations from local SC geometry
13213 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
13214 dxx=xxtab(j)-xxref(j)
13215 dyy=yytab(j)-yyref(j)
13216 dzz=zztab(j)-zzref(j)
13217 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
13219 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
13220 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
13222 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
13223 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
13225 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
13226 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
13229 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
13230 ! & xxref(j),yyref(j),zzref(j)
13232 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
13233 ! write (iout,*) i," uscdiff",uscdiff(i)
13235 ! Put together deviations from local geometry
13237 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
13238 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
13239 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
13240 ! & " uconst_back",uconst_back
13241 utheta(i)=dsqrt(utheta(i))
13242 ugamma(i)=dsqrt(ugamma(i))
13243 uscdiff(i)=dsqrt(uscdiff(i))
13246 end subroutine Econstr_back
13247 !-----------------------------------------------------------------------------
13248 ! energy_p_new-sep_barrier.F
13249 !-----------------------------------------------------------------------------
13250 real(kind=8) function sscale(r)
13251 ! include "COMMON.SPLITELE"
13252 real(kind=8) :: r,gamm
13253 if(r.lt.r_cut-rlamb) then
13255 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
13256 gamm=(r-(r_cut-rlamb))/rlamb
13257 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
13262 end function sscale
13263 real(kind=8) function sscale_grad(r)
13264 ! include "COMMON.SPLITELE"
13265 real(kind=8) :: r,gamm
13266 if(r.lt.r_cut-rlamb) then
13268 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
13269 gamm=(r-(r_cut-rlamb))/rlamb
13270 sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
13275 end function sscale_grad
13277 !!!!!!!!!! PBCSCALE
13278 real(kind=8) function sscale_ele(r)
13279 ! include "COMMON.SPLITELE"
13280 real(kind=8) :: r,gamm
13281 if(r.lt.r_cut_ele-rlamb_ele) then
13283 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
13284 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
13285 sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
13290 end function sscale_ele
13292 real(kind=8) function sscagrad_ele(r)
13293 real(kind=8) :: r,gamm
13294 ! include "COMMON.SPLITELE"
13295 if(r.lt.r_cut_ele-rlamb_ele) then
13297 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
13298 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
13299 sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
13304 end function sscagrad_ele
13305 real(kind=8) function sscalelip(r)
13306 real(kind=8) r,gamm
13307 sscalelip=1.0d0+r*r*(2.0d0*r-3.0d0)
13309 end function sscalelip
13310 !C-----------------------------------------------------------------------
13311 real(kind=8) function sscagradlip(r)
13312 real(kind=8) r,gamm
13313 sscagradlip=r*(6.0d0*r-6.0d0)
13315 end function sscagradlip
13318 !-----------------------------------------------------------------------------
13319 subroutine elj_long(evdw)
13321 ! This subroutine calculates the interaction energy of nonbonded side chains
13322 ! assuming the LJ potential of interaction.
13324 ! implicit real*8 (a-h,o-z)
13325 ! include 'DIMENSIONS'
13326 ! include 'COMMON.GEO'
13327 ! include 'COMMON.VAR'
13328 ! include 'COMMON.LOCAL'
13329 ! include 'COMMON.CHAIN'
13330 ! include 'COMMON.DERIV'
13331 ! include 'COMMON.INTERACT'
13332 ! include 'COMMON.TORSION'
13333 ! include 'COMMON.SBRIDGE'
13334 ! include 'COMMON.NAMES'
13335 ! include 'COMMON.IOUNITS'
13336 ! include 'COMMON.CONTACTS'
13337 real(kind=8),parameter :: accur=1.0d-10
13338 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
13339 !el local variables
13340 integer :: i,iint,j,k,itypi,itypi1,itypj
13341 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
13342 real(kind=8) :: e1,e2,evdwij,evdw
13343 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
13345 do i=iatsc_s,iatsc_e
13347 if (itypi.eq.ntyp1) cycle
13348 itypi1=itype(i+1,1)
13353 ! Calculate SC interaction energy.
13355 do iint=1,nint_gr(i)
13356 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
13357 !d & 'iend=',iend(i,iint)
13358 do j=istart(i,iint),iend(i,iint)
13360 if (itypj.eq.ntyp1) cycle
13364 rij=xj*xj+yj*yj+zj*zj
13365 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
13366 if (sss.lt.1.0d0) then
13368 eps0ij=eps(itypi,itypj)
13370 e1=fac*fac*aa_aq(itypi,itypj)
13371 e2=fac*bb_aq(itypi,itypj)
13373 evdw=evdw+(1.0d0-sss)*evdwij
13375 ! Calculate the components of the gradient in DC and X
13377 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
13382 gvdwx(k,i)=gvdwx(k,i)-gg(k)
13383 gvdwx(k,j)=gvdwx(k,j)+gg(k)
13384 gvdwc(k,i)=gvdwc(k,i)-gg(k)
13385 gvdwc(k,j)=gvdwc(k,j)+gg(k)
13393 gvdwc(j,i)=expon*gvdwc(j,i)
13394 gvdwx(j,i)=expon*gvdwx(j,i)
13397 !******************************************************************************
13401 ! To save time, the factor of EXPON has been extracted from ALL components
13402 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
13405 !******************************************************************************
13407 end subroutine elj_long
13408 !-----------------------------------------------------------------------------
13409 subroutine elj_short(evdw)
13411 ! This subroutine calculates the interaction energy of nonbonded side chains
13412 ! assuming the LJ potential of interaction.
13414 ! implicit real*8 (a-h,o-z)
13415 ! include 'DIMENSIONS'
13416 ! include 'COMMON.GEO'
13417 ! include 'COMMON.VAR'
13418 ! include 'COMMON.LOCAL'
13419 ! include 'COMMON.CHAIN'
13420 ! include 'COMMON.DERIV'
13421 ! include 'COMMON.INTERACT'
13422 ! include 'COMMON.TORSION'
13423 ! include 'COMMON.SBRIDGE'
13424 ! include 'COMMON.NAMES'
13425 ! include 'COMMON.IOUNITS'
13426 ! include 'COMMON.CONTACTS'
13427 real(kind=8),parameter :: accur=1.0d-10
13428 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
13429 !el local variables
13430 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
13431 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
13432 real(kind=8) :: e1,e2,evdwij,evdw
13433 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
13435 do i=iatsc_s,iatsc_e
13437 if (itypi.eq.ntyp1) cycle
13438 itypi1=itype(i+1,1)
13445 ! Calculate SC interaction energy.
13447 do iint=1,nint_gr(i)
13448 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
13449 !d & 'iend=',iend(i,iint)
13450 do j=istart(i,iint),iend(i,iint)
13452 if (itypj.eq.ntyp1) cycle
13456 ! Change 12/1/95 to calculate four-body interactions
13457 rij=xj*xj+yj*yj+zj*zj
13458 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
13459 if (sss.gt.0.0d0) then
13461 eps0ij=eps(itypi,itypj)
13463 e1=fac*fac*aa_aq(itypi,itypj)
13464 e2=fac*bb_aq(itypi,itypj)
13466 evdw=evdw+sss*evdwij
13468 ! Calculate the components of the gradient in DC and X
13470 fac=-rrij*(e1+evdwij)*sss
13475 gvdwx(k,i)=gvdwx(k,i)-gg(k)
13476 gvdwx(k,j)=gvdwx(k,j)+gg(k)
13477 gvdwc(k,i)=gvdwc(k,i)-gg(k)
13478 gvdwc(k,j)=gvdwc(k,j)+gg(k)
13486 gvdwc(j,i)=expon*gvdwc(j,i)
13487 gvdwx(j,i)=expon*gvdwx(j,i)
13490 !******************************************************************************
13494 ! To save time, the factor of EXPON has been extracted from ALL components
13495 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
13498 !******************************************************************************
13500 end subroutine elj_short
13501 !-----------------------------------------------------------------------------
13502 subroutine eljk_long(evdw)
13504 ! This subroutine calculates the interaction energy of nonbonded side chains
13505 ! assuming the LJK potential of interaction.
13507 ! implicit real*8 (a-h,o-z)
13508 ! include 'DIMENSIONS'
13509 ! include 'COMMON.GEO'
13510 ! include 'COMMON.VAR'
13511 ! include 'COMMON.LOCAL'
13512 ! include 'COMMON.CHAIN'
13513 ! include 'COMMON.DERIV'
13514 ! include 'COMMON.INTERACT'
13515 ! include 'COMMON.IOUNITS'
13516 ! include 'COMMON.NAMES'
13517 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
13519 !el local variables
13520 integer :: i,iint,j,k,itypi,itypi1,itypj
13521 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
13522 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
13523 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
13525 do i=iatsc_s,iatsc_e
13527 if (itypi.eq.ntyp1) cycle
13528 itypi1=itype(i+1,1)
13533 ! Calculate SC interaction energy.
13535 do iint=1,nint_gr(i)
13536 do j=istart(i,iint),iend(i,iint)
13538 if (itypj.eq.ntyp1) cycle
13542 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13543 fac_augm=rrij**expon
13544 e_augm=augm(itypi,itypj)*fac_augm
13545 r_inv_ij=dsqrt(rrij)
13547 sss=sscale(rij/sigma(itypi,itypj))
13548 if (sss.lt.1.0d0) then
13549 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
13550 fac=r_shift_inv**expon
13551 e1=fac*fac*aa_aq(itypi,itypj)
13552 e2=fac*bb_aq(itypi,itypj)
13553 evdwij=e_augm+e1+e2
13554 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
13555 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
13556 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
13557 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
13558 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
13559 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
13560 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
13561 evdw=evdw+(1.0d0-sss)*evdwij
13563 ! Calculate the components of the gradient in DC and X
13565 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
13566 fac=fac*(1.0d0-sss)
13571 gvdwx(k,i)=gvdwx(k,i)-gg(k)
13572 gvdwx(k,j)=gvdwx(k,j)+gg(k)
13573 gvdwc(k,i)=gvdwc(k,i)-gg(k)
13574 gvdwc(k,j)=gvdwc(k,j)+gg(k)
13582 gvdwc(j,i)=expon*gvdwc(j,i)
13583 gvdwx(j,i)=expon*gvdwx(j,i)
13587 end subroutine eljk_long
13588 !-----------------------------------------------------------------------------
13589 subroutine eljk_short(evdw)
13591 ! This subroutine calculates the interaction energy of nonbonded side chains
13592 ! assuming the LJK potential of interaction.
13594 ! implicit real*8 (a-h,o-z)
13595 ! include 'DIMENSIONS'
13596 ! include 'COMMON.GEO'
13597 ! include 'COMMON.VAR'
13598 ! include 'COMMON.LOCAL'
13599 ! include 'COMMON.CHAIN'
13600 ! include 'COMMON.DERIV'
13601 ! include 'COMMON.INTERACT'
13602 ! include 'COMMON.IOUNITS'
13603 ! include 'COMMON.NAMES'
13604 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
13606 !el local variables
13607 integer :: i,iint,j,k,itypi,itypi1,itypj
13608 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
13609 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
13610 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
13612 do i=iatsc_s,iatsc_e
13614 if (itypi.eq.ntyp1) cycle
13615 itypi1=itype(i+1,1)
13620 ! Calculate SC interaction energy.
13622 do iint=1,nint_gr(i)
13623 do j=istart(i,iint),iend(i,iint)
13625 if (itypj.eq.ntyp1) cycle
13629 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13630 fac_augm=rrij**expon
13631 e_augm=augm(itypi,itypj)*fac_augm
13632 r_inv_ij=dsqrt(rrij)
13634 sss=sscale(rij/sigma(itypi,itypj))
13635 if (sss.gt.0.0d0) then
13636 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
13637 fac=r_shift_inv**expon
13638 e1=fac*fac*aa_aq(itypi,itypj)
13639 e2=fac*bb_aq(itypi,itypj)
13640 evdwij=e_augm+e1+e2
13641 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
13642 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
13643 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
13644 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
13645 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
13646 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
13647 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
13648 evdw=evdw+sss*evdwij
13650 ! Calculate the components of the gradient in DC and X
13652 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
13658 gvdwx(k,i)=gvdwx(k,i)-gg(k)
13659 gvdwx(k,j)=gvdwx(k,j)+gg(k)
13660 gvdwc(k,i)=gvdwc(k,i)-gg(k)
13661 gvdwc(k,j)=gvdwc(k,j)+gg(k)
13669 gvdwc(j,i)=expon*gvdwc(j,i)
13670 gvdwx(j,i)=expon*gvdwx(j,i)
13674 end subroutine eljk_short
13675 !-----------------------------------------------------------------------------
13676 subroutine ebp_long(evdw)
13678 ! This subroutine calculates the interaction energy of nonbonded side chains
13679 ! assuming the Berne-Pechukas potential of interaction.
13682 ! implicit real*8 (a-h,o-z)
13683 ! include 'DIMENSIONS'
13684 ! include 'COMMON.GEO'
13685 ! include 'COMMON.VAR'
13686 ! include 'COMMON.LOCAL'
13687 ! include 'COMMON.CHAIN'
13688 ! include 'COMMON.DERIV'
13689 ! include 'COMMON.NAMES'
13690 ! include 'COMMON.INTERACT'
13691 ! include 'COMMON.IOUNITS'
13692 ! include 'COMMON.CALC'
13694 !el integer :: icall
13695 !el common /srutu/ icall
13696 ! double precision rrsave(maxdim)
13698 !el local variables
13699 integer :: iint,itypi,itypi1,itypj
13700 real(kind=8) :: rrij,xi,yi,zi,fac
13701 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
13703 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
13705 ! if (icall.eq.0) then
13711 do i=iatsc_s,iatsc_e
13713 if (itypi.eq.ntyp1) cycle
13714 itypi1=itype(i+1,1)
13718 dxi=dc_norm(1,nres+i)
13719 dyi=dc_norm(2,nres+i)
13720 dzi=dc_norm(3,nres+i)
13721 ! dsci_inv=dsc_inv(itypi)
13722 dsci_inv=vbld_inv(i+nres)
13724 ! Calculate SC interaction energy.
13726 do iint=1,nint_gr(i)
13727 do j=istart(i,iint),iend(i,iint)
13730 if (itypj.eq.ntyp1) cycle
13731 ! dscj_inv=dsc_inv(itypj)
13732 dscj_inv=vbld_inv(j+nres)
13733 chi1=chi(itypi,itypj)
13734 chi2=chi(itypj,itypi)
13741 alf12=0.5D0*(alf1+alf2)
13745 dxj=dc_norm(1,nres+j)
13746 dyj=dc_norm(2,nres+j)
13747 dzj=dc_norm(3,nres+j)
13748 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13750 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13752 if (sss.lt.1.0d0) then
13754 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
13756 ! Calculate whole angle-dependent part of epsilon and contributions
13757 ! to its derivatives
13758 fac=(rrij*sigsq)**expon2
13759 e1=fac*fac*aa_aq(itypi,itypj)
13760 e2=fac*bb_aq(itypi,itypj)
13761 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13762 eps2der=evdwij*eps3rt
13763 eps3der=evdwij*eps2rt
13764 evdwij=evdwij*eps2rt*eps3rt
13765 evdw=evdw+evdwij*(1.0d0-sss)
13767 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13768 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13769 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
13770 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13771 !d & epsi,sigm,chi1,chi2,chip1,chip2,
13772 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
13773 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
13776 ! Calculate gradient components.
13777 e1=e1*eps1*eps2rt**2*eps3rt**2
13778 fac=-expon*(e1+evdwij)
13781 ! Calculate radial part of the gradient
13785 ! Calculate the angular part of the gradient and sum add the contributions
13786 ! to the appropriate components of the Cartesian gradient.
13787 call sc_grad_scale(1.0d0-sss)
13794 end subroutine ebp_long
13795 !-----------------------------------------------------------------------------
13796 subroutine ebp_short(evdw)
13798 ! This subroutine calculates the interaction energy of nonbonded side chains
13799 ! assuming the Berne-Pechukas potential of interaction.
13802 ! implicit real*8 (a-h,o-z)
13803 ! include 'DIMENSIONS'
13804 ! include 'COMMON.GEO'
13805 ! include 'COMMON.VAR'
13806 ! include 'COMMON.LOCAL'
13807 ! include 'COMMON.CHAIN'
13808 ! include 'COMMON.DERIV'
13809 ! include 'COMMON.NAMES'
13810 ! include 'COMMON.INTERACT'
13811 ! include 'COMMON.IOUNITS'
13812 ! include 'COMMON.CALC'
13814 !el integer :: icall
13815 !el common /srutu/ icall
13816 ! double precision rrsave(maxdim)
13818 !el local variables
13819 integer :: iint,itypi,itypi1,itypj
13820 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
13821 real(kind=8) :: sss,e1,e2,evdw
13823 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
13825 ! if (icall.eq.0) then
13831 do i=iatsc_s,iatsc_e
13833 if (itypi.eq.ntyp1) cycle
13834 itypi1=itype(i+1,1)
13838 dxi=dc_norm(1,nres+i)
13839 dyi=dc_norm(2,nres+i)
13840 dzi=dc_norm(3,nres+i)
13841 ! dsci_inv=dsc_inv(itypi)
13842 dsci_inv=vbld_inv(i+nres)
13844 ! Calculate SC interaction energy.
13846 do iint=1,nint_gr(i)
13847 do j=istart(i,iint),iend(i,iint)
13850 if (itypj.eq.ntyp1) cycle
13851 ! dscj_inv=dsc_inv(itypj)
13852 dscj_inv=vbld_inv(j+nres)
13853 chi1=chi(itypi,itypj)
13854 chi2=chi(itypj,itypi)
13861 alf12=0.5D0*(alf1+alf2)
13865 dxj=dc_norm(1,nres+j)
13866 dyj=dc_norm(2,nres+j)
13867 dzj=dc_norm(3,nres+j)
13868 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13870 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13872 if (sss.gt.0.0d0) then
13874 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
13876 ! Calculate whole angle-dependent part of epsilon and contributions
13877 ! to its derivatives
13878 fac=(rrij*sigsq)**expon2
13879 e1=fac*fac*aa_aq(itypi,itypj)
13880 e2=fac*bb_aq(itypi,itypj)
13881 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13882 eps2der=evdwij*eps3rt
13883 eps3der=evdwij*eps2rt
13884 evdwij=evdwij*eps2rt*eps3rt
13885 evdw=evdw+evdwij*sss
13887 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13888 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13889 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
13890 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13891 !d & epsi,sigm,chi1,chi2,chip1,chip2,
13892 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
13893 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
13896 ! Calculate gradient components.
13897 e1=e1*eps1*eps2rt**2*eps3rt**2
13898 fac=-expon*(e1+evdwij)
13901 ! Calculate radial part of the gradient
13905 ! Calculate the angular part of the gradient and sum add the contributions
13906 ! to the appropriate components of the Cartesian gradient.
13907 call sc_grad_scale(sss)
13914 end subroutine ebp_short
13915 !-----------------------------------------------------------------------------
13916 subroutine egb_long(evdw)
13918 ! This subroutine calculates the interaction energy of nonbonded side chains
13919 ! assuming the Gay-Berne potential of interaction.
13922 ! implicit real*8 (a-h,o-z)
13923 ! include 'DIMENSIONS'
13924 ! include 'COMMON.GEO'
13925 ! include 'COMMON.VAR'
13926 ! include 'COMMON.LOCAL'
13927 ! include 'COMMON.CHAIN'
13928 ! include 'COMMON.DERIV'
13929 ! include 'COMMON.NAMES'
13930 ! include 'COMMON.INTERACT'
13931 ! include 'COMMON.IOUNITS'
13932 ! include 'COMMON.CALC'
13933 ! include 'COMMON.CONTROL'
13935 !el local variables
13936 integer :: iint,itypi,itypi1,itypj,subchap
13937 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
13938 real(kind=8) :: sss,e1,e2,evdw,sss_grad
13939 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13940 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13941 ssgradlipi,ssgradlipj
13945 !cccc energy_dec=.false.
13946 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13949 ! if (icall.eq.0) lprn=.false.
13951 do i=iatsc_s,iatsc_e
13953 if (itypi.eq.ntyp1) cycle
13954 itypi1=itype(i+1,1)
13958 xi=mod(xi,boxxsize)
13959 if (xi.lt.0) xi=xi+boxxsize
13960 yi=mod(yi,boxysize)
13961 if (yi.lt.0) yi=yi+boxysize
13962 zi=mod(zi,boxzsize)
13963 if (zi.lt.0) zi=zi+boxzsize
13964 if ((zi.gt.bordlipbot) &
13965 .and.(zi.lt.bordliptop)) then
13966 !C the energy transfer exist
13967 if (zi.lt.buflipbot) then
13968 !C what fraction I am in
13970 ((zi-bordlipbot)/lipbufthick)
13971 !C lipbufthick is thickenes of lipid buffore
13972 sslipi=sscalelip(fracinbuf)
13973 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
13974 elseif (zi.gt.bufliptop) then
13975 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
13976 sslipi=sscalelip(fracinbuf)
13977 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
13987 dxi=dc_norm(1,nres+i)
13988 dyi=dc_norm(2,nres+i)
13989 dzi=dc_norm(3,nres+i)
13990 ! dsci_inv=dsc_inv(itypi)
13991 dsci_inv=vbld_inv(i+nres)
13992 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
13993 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
13995 ! Calculate SC interaction energy.
13997 do iint=1,nint_gr(i)
13998 do j=istart(i,iint),iend(i,iint)
13999 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
14000 ! call dyn_ssbond_ene(i,j,evdwij)
14002 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
14003 ! 'evdw',i,j,evdwij,' ss'
14004 ! if (energy_dec) write (iout,*) &
14005 ! 'evdw',i,j,evdwij,' ss'
14006 ! do k=j+1,iend(i,iint)
14007 !C search over all next residues
14008 ! if (dyn_ss_mask(k)) then
14009 !C check if they are cysteins
14010 !C write(iout,*) 'k=',k
14012 !c write(iout,*) "PRZED TRI", evdwij
14013 ! evdwij_przed_tri=evdwij
14014 ! call triple_ssbond_ene(i,j,k,evdwij)
14015 !c if(evdwij_przed_tri.ne.evdwij) then
14016 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
14019 !c write(iout,*) "PO TRI", evdwij
14020 !C call the energy function that removes the artifical triple disulfide
14021 !C bond the soubroutine is located in ssMD.F
14023 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
14024 'evdw',i,j,evdwij,'tss'
14025 ! endif!dyn_ss_mask(k)
14031 if (itypj.eq.ntyp1) cycle
14032 ! dscj_inv=dsc_inv(itypj)
14033 dscj_inv=vbld_inv(j+nres)
14034 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
14035 ! & 1.0d0/vbld(j+nres)
14036 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
14037 sig0ij=sigma(itypi,itypj)
14038 chi1=chi(itypi,itypj)
14039 chi2=chi(itypj,itypi)
14046 alf12=0.5D0*(alf1+alf2)
14050 ! Searching for nearest neighbour
14051 xj=mod(xj,boxxsize)
14052 if (xj.lt.0) xj=xj+boxxsize
14053 yj=mod(yj,boxysize)
14054 if (yj.lt.0) yj=yj+boxysize
14055 zj=mod(zj,boxzsize)
14056 if (zj.lt.0) zj=zj+boxzsize
14057 if ((zj.gt.bordlipbot) &
14058 .and.(zj.lt.bordliptop)) then
14059 !C the energy transfer exist
14060 if (zj.lt.buflipbot) then
14061 !C what fraction I am in
14063 ((zj-bordlipbot)/lipbufthick)
14064 !C lipbufthick is thickenes of lipid buffore
14065 sslipj=sscalelip(fracinbuf)
14066 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
14067 elseif (zj.gt.bufliptop) then
14068 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
14069 sslipj=sscalelip(fracinbuf)
14070 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
14079 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
14080 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
14081 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
14082 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
14084 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14092 xj=xj_safe+xshift*boxxsize
14093 yj=yj_safe+yshift*boxysize
14094 zj=zj_safe+zshift*boxzsize
14095 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14096 if(dist_temp.lt.dist_init) then
14097 dist_init=dist_temp
14106 if (subchap.eq.1) then
14116 dxj=dc_norm(1,nres+j)
14117 dyj=dc_norm(2,nres+j)
14118 dzj=dc_norm(3,nres+j)
14119 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14121 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
14122 sss_ele_cut=sscale_ele(1.0d0/(rij))
14123 sss_ele_grad=sscagrad_ele(1.0d0/(rij))
14124 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
14125 if (sss_ele_cut.le.0.0) cycle
14126 if (sss.lt.1.0d0) then
14128 ! Calculate angle-dependent terms of energy and contributions to their
14132 sig=sig0ij*dsqrt(sigsq)
14133 rij_shift=1.0D0/rij-sig+sig0ij
14134 ! for diagnostics; uncomment
14135 ! rij_shift=1.2*sig0ij
14136 ! I hate to put IF's in the loops, but here don't have another choice!!!!
14137 if (rij_shift.le.0.0D0) then
14139 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
14140 !d & restyp(itypi,1),i,restyp(itypj,1),j,
14141 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
14145 !---------------------------------------------------------------
14146 rij_shift=1.0D0/rij_shift
14147 fac=rij_shift**expon
14150 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
14151 eps2der=evdwij*eps3rt
14152 eps3der=evdwij*eps2rt
14153 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
14154 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
14155 evdwij=evdwij*eps2rt*eps3rt
14156 evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
14158 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
14159 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
14160 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
14161 restyp(itypi,1),i,restyp(itypj,1),j,&
14162 epsi,sigm,chi1,chi2,chip1,chip2,&
14163 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
14164 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
14168 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
14170 ! if (energy_dec) write (iout,*) &
14171 ! 'evdw',i,j,evdwij,"egb_long"
14173 ! Calculate gradient components.
14174 e1=e1*eps1*eps2rt**2*eps3rt**2
14175 fac=-expon*(e1+evdwij)*rij_shift
14178 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
14179 *rij-sss_grad/(1.0-sss)*rij &
14180 /sigmaii(itypi,itypj))
14182 ! Calculate the radial part of the gradient
14186 ! Calculate angular part of the gradient.
14187 call sc_grad_scale(1.0d0-sss)
14193 ! write (iout,*) "Number of loop steps in EGB:",ind
14194 !ccc energy_dec=.false.
14196 end subroutine egb_long
14197 !-----------------------------------------------------------------------------
14198 subroutine egb_short(evdw)
14200 ! This subroutine calculates the interaction energy of nonbonded side chains
14201 ! assuming the Gay-Berne potential of interaction.
14204 ! implicit real*8 (a-h,o-z)
14205 ! include 'DIMENSIONS'
14206 ! include 'COMMON.GEO'
14207 ! include 'COMMON.VAR'
14208 ! include 'COMMON.LOCAL'
14209 ! include 'COMMON.CHAIN'
14210 ! include 'COMMON.DERIV'
14211 ! include 'COMMON.NAMES'
14212 ! include 'COMMON.INTERACT'
14213 ! include 'COMMON.IOUNITS'
14214 ! include 'COMMON.CALC'
14215 ! include 'COMMON.CONTROL'
14217 !el local variables
14218 integer :: iint,itypi,itypi1,itypj,subchap
14219 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
14220 real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad
14221 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14222 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
14223 ssgradlipi,ssgradlipj
14225 !cccc energy_dec=.false.
14226 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
14229 ! if (icall.eq.0) lprn=.false.
14231 do i=iatsc_s,iatsc_e
14233 if (itypi.eq.ntyp1) cycle
14234 itypi1=itype(i+1,1)
14238 xi=mod(xi,boxxsize)
14239 if (xi.lt.0) xi=xi+boxxsize
14240 yi=mod(yi,boxysize)
14241 if (yi.lt.0) yi=yi+boxysize
14242 zi=mod(zi,boxzsize)
14243 if (zi.lt.0) zi=zi+boxzsize
14244 if ((zi.gt.bordlipbot) &
14245 .and.(zi.lt.bordliptop)) then
14246 !C the energy transfer exist
14247 if (zi.lt.buflipbot) then
14248 !C what fraction I am in
14250 ((zi-bordlipbot)/lipbufthick)
14251 !C lipbufthick is thickenes of lipid buffore
14252 sslipi=sscalelip(fracinbuf)
14253 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
14254 elseif (zi.gt.bufliptop) then
14255 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
14256 sslipi=sscalelip(fracinbuf)
14257 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
14267 dxi=dc_norm(1,nres+i)
14268 dyi=dc_norm(2,nres+i)
14269 dzi=dc_norm(3,nres+i)
14270 ! dsci_inv=dsc_inv(itypi)
14271 dsci_inv=vbld_inv(i+nres)
14273 dxi=dc_norm(1,nres+i)
14274 dyi=dc_norm(2,nres+i)
14275 dzi=dc_norm(3,nres+i)
14276 ! dsci_inv=dsc_inv(itypi)
14277 dsci_inv=vbld_inv(i+nres)
14278 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
14279 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
14281 ! Calculate SC interaction energy.
14283 do iint=1,nint_gr(i)
14284 do j=istart(i,iint),iend(i,iint)
14285 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
14286 call dyn_ssbond_ene(i,j,evdwij)
14288 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
14289 'evdw',i,j,evdwij,' ss'
14290 do k=j+1,iend(i,iint)
14291 !C search over all next residues
14292 if (dyn_ss_mask(k)) then
14293 !C check if they are cysteins
14294 !C write(iout,*) 'k=',k
14296 !c write(iout,*) "PRZED TRI", evdwij
14297 ! evdwij_przed_tri=evdwij
14298 call triple_ssbond_ene(i,j,k,evdwij)
14299 !c if(evdwij_przed_tri.ne.evdwij) then
14300 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
14303 !c write(iout,*) "PO TRI", evdwij
14304 !C call the energy function that removes the artifical triple disulfide
14305 !C bond the soubroutine is located in ssMD.F
14307 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
14308 'evdw',i,j,evdwij,'tss'
14309 endif!dyn_ss_mask(k)
14312 ! if (energy_dec) write (iout,*) &
14313 ! 'evdw',i,j,evdwij,' ss'
14317 if (itypj.eq.ntyp1) cycle
14318 ! dscj_inv=dsc_inv(itypj)
14319 dscj_inv=vbld_inv(j+nres)
14320 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
14321 ! & 1.0d0/vbld(j+nres)
14322 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
14323 sig0ij=sigma(itypi,itypj)
14324 chi1=chi(itypi,itypj)
14325 chi2=chi(itypj,itypi)
14332 alf12=0.5D0*(alf1+alf2)
14333 ! xj=c(1,nres+j)-xi
14334 ! yj=c(2,nres+j)-yi
14335 ! zj=c(3,nres+j)-zi
14339 ! Searching for nearest neighbour
14340 xj=mod(xj,boxxsize)
14341 if (xj.lt.0) xj=xj+boxxsize
14342 yj=mod(yj,boxysize)
14343 if (yj.lt.0) yj=yj+boxysize
14344 zj=mod(zj,boxzsize)
14345 if (zj.lt.0) zj=zj+boxzsize
14346 if ((zj.gt.bordlipbot) &
14347 .and.(zj.lt.bordliptop)) then
14348 !C the energy transfer exist
14349 if (zj.lt.buflipbot) then
14350 !C what fraction I am in
14352 ((zj-bordlipbot)/lipbufthick)
14353 !C lipbufthick is thickenes of lipid buffore
14354 sslipj=sscalelip(fracinbuf)
14355 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
14356 elseif (zj.gt.bufliptop) then
14357 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
14358 sslipj=sscalelip(fracinbuf)
14359 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
14368 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
14369 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
14370 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
14371 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
14373 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14382 xj=xj_safe+xshift*boxxsize
14383 yj=yj_safe+yshift*boxysize
14384 zj=zj_safe+zshift*boxzsize
14385 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14386 if(dist_temp.lt.dist_init) then
14387 dist_init=dist_temp
14396 if (subchap.eq.1) then
14406 dxj=dc_norm(1,nres+j)
14407 dyj=dc_norm(2,nres+j)
14408 dzj=dc_norm(3,nres+j)
14409 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14411 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
14412 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
14413 sss_ele_cut=sscale_ele(1.0d0/(rij))
14414 sss_ele_grad=sscagrad_ele(1.0d0/(rij))
14415 if (sss_ele_cut.le.0.0) cycle
14417 if (sss.gt.0.0d0) then
14419 ! Calculate angle-dependent terms of energy and contributions to their
14423 sig=sig0ij*dsqrt(sigsq)
14424 rij_shift=1.0D0/rij-sig+sig0ij
14425 ! for diagnostics; uncomment
14426 ! rij_shift=1.2*sig0ij
14427 ! I hate to put IF's in the loops, but here don't have another choice!!!!
14428 if (rij_shift.le.0.0D0) then
14430 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
14431 !d & restyp(itypi,1),i,restyp(itypj,1),j,
14432 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
14436 !---------------------------------------------------------------
14437 rij_shift=1.0D0/rij_shift
14438 fac=rij_shift**expon
14441 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
14442 eps2der=evdwij*eps3rt
14443 eps3der=evdwij*eps2rt
14444 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
14445 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
14446 evdwij=evdwij*eps2rt*eps3rt
14447 evdw=evdw+evdwij*sss*sss_ele_cut
14449 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
14450 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
14451 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
14452 restyp(itypi,1),i,restyp(itypj,1),j,&
14453 epsi,sigm,chi1,chi2,chip1,chip2,&
14454 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
14455 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
14459 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
14461 ! if (energy_dec) write (iout,*) &
14462 ! 'evdw',i,j,evdwij,"egb_short"
14464 ! Calculate gradient components.
14465 e1=e1*eps1*eps2rt**2*eps3rt**2
14466 fac=-expon*(e1+evdwij)*rij_shift
14469 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
14470 *rij+sss_grad/sss*rij &
14471 /sigmaii(itypi,itypj))
14474 ! Calculate the radial part of the gradient
14478 ! Calculate angular part of the gradient.
14479 call sc_grad_scale(sss)
14485 ! write (iout,*) "Number of loop steps in EGB:",ind
14486 !ccc energy_dec=.false.
14488 end subroutine egb_short
14489 !-----------------------------------------------------------------------------
14490 subroutine egbv_long(evdw)
14492 ! This subroutine calculates the interaction energy of nonbonded side chains
14493 ! assuming the Gay-Berne-Vorobjev potential of interaction.
14496 ! implicit real*8 (a-h,o-z)
14497 ! include 'DIMENSIONS'
14498 ! include 'COMMON.GEO'
14499 ! include 'COMMON.VAR'
14500 ! include 'COMMON.LOCAL'
14501 ! include 'COMMON.CHAIN'
14502 ! include 'COMMON.DERIV'
14503 ! include 'COMMON.NAMES'
14504 ! include 'COMMON.INTERACT'
14505 ! include 'COMMON.IOUNITS'
14506 ! include 'COMMON.CALC'
14508 !el integer :: icall
14509 !el common /srutu/ icall
14511 !el local variables
14512 integer :: iint,itypi,itypi1,itypj
14513 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
14514 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
14516 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
14519 ! if (icall.eq.0) lprn=.true.
14521 do i=iatsc_s,iatsc_e
14523 if (itypi.eq.ntyp1) cycle
14524 itypi1=itype(i+1,1)
14528 dxi=dc_norm(1,nres+i)
14529 dyi=dc_norm(2,nres+i)
14530 dzi=dc_norm(3,nres+i)
14531 ! dsci_inv=dsc_inv(itypi)
14532 dsci_inv=vbld_inv(i+nres)
14534 ! Calculate SC interaction energy.
14536 do iint=1,nint_gr(i)
14537 do j=istart(i,iint),iend(i,iint)
14540 if (itypj.eq.ntyp1) cycle
14541 ! dscj_inv=dsc_inv(itypj)
14542 dscj_inv=vbld_inv(j+nres)
14543 sig0ij=sigma(itypi,itypj)
14544 r0ij=r0(itypi,itypj)
14545 chi1=chi(itypi,itypj)
14546 chi2=chi(itypj,itypi)
14553 alf12=0.5D0*(alf1+alf2)
14557 dxj=dc_norm(1,nres+j)
14558 dyj=dc_norm(2,nres+j)
14559 dzj=dc_norm(3,nres+j)
14560 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14563 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
14565 if (sss.lt.1.0d0) then
14567 ! Calculate angle-dependent terms of energy and contributions to their
14571 sig=sig0ij*dsqrt(sigsq)
14572 rij_shift=1.0D0/rij-sig+r0ij
14573 ! I hate to put IF's in the loops, but here don't have another choice!!!!
14574 if (rij_shift.le.0.0D0) then
14579 !---------------------------------------------------------------
14580 rij_shift=1.0D0/rij_shift
14581 fac=rij_shift**expon
14582 e1=fac*fac*aa_aq(itypi,itypj)
14583 e2=fac*bb_aq(itypi,itypj)
14584 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
14585 eps2der=evdwij*eps3rt
14586 eps3der=evdwij*eps2rt
14587 fac_augm=rrij**expon
14588 e_augm=augm(itypi,itypj)*fac_augm
14589 evdwij=evdwij*eps2rt*eps3rt
14590 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
14592 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
14593 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
14594 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
14595 restyp(itypi,1),i,restyp(itypj,1),j,&
14596 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
14597 chi1,chi2,chip1,chip2,&
14598 eps1,eps2rt**2,eps3rt**2,&
14599 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
14602 ! Calculate gradient components.
14603 e1=e1*eps1*eps2rt**2*eps3rt**2
14604 fac=-expon*(e1+evdwij)*rij_shift
14606 fac=rij*fac-2*expon*rrij*e_augm
14607 ! Calculate the radial part of the gradient
14611 ! Calculate angular part of the gradient.
14612 call sc_grad_scale(1.0d0-sss)
14617 end subroutine egbv_long
14618 !-----------------------------------------------------------------------------
14619 subroutine egbv_short(evdw)
14621 ! This subroutine calculates the interaction energy of nonbonded side chains
14622 ! assuming the Gay-Berne-Vorobjev potential of interaction.
14625 ! implicit real*8 (a-h,o-z)
14626 ! include 'DIMENSIONS'
14627 ! include 'COMMON.GEO'
14628 ! include 'COMMON.VAR'
14629 ! include 'COMMON.LOCAL'
14630 ! include 'COMMON.CHAIN'
14631 ! include 'COMMON.DERIV'
14632 ! include 'COMMON.NAMES'
14633 ! include 'COMMON.INTERACT'
14634 ! include 'COMMON.IOUNITS'
14635 ! include 'COMMON.CALC'
14637 !el integer :: icall
14638 !el common /srutu/ icall
14640 !el local variables
14641 integer :: iint,itypi,itypi1,itypj
14642 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
14643 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
14645 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
14648 ! if (icall.eq.0) lprn=.true.
14650 do i=iatsc_s,iatsc_e
14652 if (itypi.eq.ntyp1) cycle
14653 itypi1=itype(i+1,1)
14657 dxi=dc_norm(1,nres+i)
14658 dyi=dc_norm(2,nres+i)
14659 dzi=dc_norm(3,nres+i)
14660 ! dsci_inv=dsc_inv(itypi)
14661 dsci_inv=vbld_inv(i+nres)
14663 ! Calculate SC interaction energy.
14665 do iint=1,nint_gr(i)
14666 do j=istart(i,iint),iend(i,iint)
14669 if (itypj.eq.ntyp1) cycle
14670 ! dscj_inv=dsc_inv(itypj)
14671 dscj_inv=vbld_inv(j+nres)
14672 sig0ij=sigma(itypi,itypj)
14673 r0ij=r0(itypi,itypj)
14674 chi1=chi(itypi,itypj)
14675 chi2=chi(itypj,itypi)
14682 alf12=0.5D0*(alf1+alf2)
14686 dxj=dc_norm(1,nres+j)
14687 dyj=dc_norm(2,nres+j)
14688 dzj=dc_norm(3,nres+j)
14689 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14692 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
14694 if (sss.gt.0.0d0) then
14696 ! Calculate angle-dependent terms of energy and contributions to their
14700 sig=sig0ij*dsqrt(sigsq)
14701 rij_shift=1.0D0/rij-sig+r0ij
14702 ! I hate to put IF's in the loops, but here don't have another choice!!!!
14703 if (rij_shift.le.0.0D0) then
14708 !---------------------------------------------------------------
14709 rij_shift=1.0D0/rij_shift
14710 fac=rij_shift**expon
14711 e1=fac*fac*aa_aq(itypi,itypj)
14712 e2=fac*bb_aq(itypi,itypj)
14713 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
14714 eps2der=evdwij*eps3rt
14715 eps3der=evdwij*eps2rt
14716 fac_augm=rrij**expon
14717 e_augm=augm(itypi,itypj)*fac_augm
14718 evdwij=evdwij*eps2rt*eps3rt
14719 evdw=evdw+(evdwij+e_augm)*sss
14721 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
14722 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
14723 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
14724 restyp(itypi,1),i,restyp(itypj,1),j,&
14725 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
14726 chi1,chi2,chip1,chip2,&
14727 eps1,eps2rt**2,eps3rt**2,&
14728 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
14731 ! Calculate gradient components.
14732 e1=e1*eps1*eps2rt**2*eps3rt**2
14733 fac=-expon*(e1+evdwij)*rij_shift
14735 fac=rij*fac-2*expon*rrij*e_augm
14736 ! Calculate the radial part of the gradient
14740 ! Calculate angular part of the gradient.
14741 call sc_grad_scale(sss)
14746 end subroutine egbv_short
14747 !-----------------------------------------------------------------------------
14748 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
14750 ! This subroutine calculates the average interaction energy and its gradient
14751 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
14752 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
14753 ! The potential depends both on the distance of peptide-group centers and on
14754 ! the orientation of the CA-CA virtual bonds.
14756 ! implicit real*8 (a-h,o-z)
14762 ! include 'DIMENSIONS'
14763 ! include 'COMMON.CONTROL'
14764 ! include 'COMMON.SETUP'
14765 ! include 'COMMON.IOUNITS'
14766 ! include 'COMMON.GEO'
14767 ! include 'COMMON.VAR'
14768 ! include 'COMMON.LOCAL'
14769 ! include 'COMMON.CHAIN'
14770 ! include 'COMMON.DERIV'
14771 ! include 'COMMON.INTERACT'
14772 ! include 'COMMON.CONTACTS'
14773 ! include 'COMMON.TORSION'
14774 ! include 'COMMON.VECTORS'
14775 ! include 'COMMON.FFIELD'
14776 ! include 'COMMON.TIME1'
14777 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
14778 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
14779 real(kind=8),dimension(2,2) :: acipa !el,a_temp
14780 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
14781 real(kind=8),dimension(4) :: muij
14782 !el integer :: num_conti,j1,j2
14783 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
14784 !el dz_normi,xmedi,ymedi,zmedi
14785 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
14786 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14787 !el num_conti,j1,j2
14788 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14790 real(kind=8) :: scal_el=1.0d0
14792 real(kind=8) :: scal_el=0.5d0
14795 ! 13-go grudnia roku pamietnego...
14796 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
14797 0.0d0,1.0d0,0.0d0,&
14798 0.0d0,0.0d0,1.0d0/),shape(unmat))
14799 !el local variables
14801 real(kind=8) :: fac
14802 real(kind=8) :: dxj,dyj,dzj
14803 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
14805 ! allocate(num_cont_hb(nres)) !(maxres)
14806 !d write(iout,*) 'In EELEC'
14808 !d write(iout,*) 'Type',i
14809 !d write(iout,*) 'B1',B1(:,i)
14810 !d write(iout,*) 'B2',B2(:,i)
14811 !d write(iout,*) 'CC',CC(:,:,i)
14812 !d write(iout,*) 'DD',DD(:,:,i)
14813 !d write(iout,*) 'EE',EE(:,:,i)
14815 !d call check_vecgrad
14817 if (icheckgrad.eq.1) then
14819 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
14821 dc_norm(k,i)=dc(k,i)*fac
14823 ! write (iout,*) 'i',i,' fac',fac
14826 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
14827 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
14828 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
14829 ! call vec_and_deriv
14833 ! print *, "before set matrices"
14835 ! print *,"after set martices"
14837 time_mat=time_mat+MPI_Wtime()-time01
14841 !d write (iout,*) 'i=',i
14843 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
14846 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
14847 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
14860 !d print '(a)','Enter EELEC'
14861 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
14862 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
14863 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
14865 gel_loc_loc(i)=0.0d0
14870 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
14872 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
14874 do i=iturn3_start,iturn3_end
14875 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1 &
14876 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
14880 dx_normi=dc_norm(1,i)
14881 dy_normi=dc_norm(2,i)
14882 dz_normi=dc_norm(3,i)
14883 xmedi=c(1,i)+0.5d0*dxi
14884 ymedi=c(2,i)+0.5d0*dyi
14885 zmedi=c(3,i)+0.5d0*dzi
14886 xmedi=dmod(xmedi,boxxsize)
14887 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14888 ymedi=dmod(ymedi,boxysize)
14889 if (ymedi.lt.0) ymedi=ymedi+boxysize
14890 zmedi=dmod(zmedi,boxzsize)
14891 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14893 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
14894 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
14895 num_cont_hb(i)=num_conti
14897 do i=iturn4_start,iturn4_end
14898 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
14899 .or. itype(i+3,1).eq.ntyp1 &
14900 .or. itype(i+4,1).eq.ntyp1) cycle
14904 dx_normi=dc_norm(1,i)
14905 dy_normi=dc_norm(2,i)
14906 dz_normi=dc_norm(3,i)
14907 xmedi=c(1,i)+0.5d0*dxi
14908 ymedi=c(2,i)+0.5d0*dyi
14909 zmedi=c(3,i)+0.5d0*dzi
14910 xmedi=dmod(xmedi,boxxsize)
14911 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14912 ymedi=dmod(ymedi,boxysize)
14913 if (ymedi.lt.0) ymedi=ymedi+boxysize
14914 zmedi=dmod(zmedi,boxzsize)
14915 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14916 num_conti=num_cont_hb(i)
14917 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
14918 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
14919 call eturn4(i,eello_turn4)
14920 num_cont_hb(i)=num_conti
14923 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
14925 do i=iatel_s,iatel_e
14926 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
14930 dx_normi=dc_norm(1,i)
14931 dy_normi=dc_norm(2,i)
14932 dz_normi=dc_norm(3,i)
14933 xmedi=c(1,i)+0.5d0*dxi
14934 ymedi=c(2,i)+0.5d0*dyi
14935 zmedi=c(3,i)+0.5d0*dzi
14936 xmedi=dmod(xmedi,boxxsize)
14937 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14938 ymedi=dmod(ymedi,boxysize)
14939 if (ymedi.lt.0) ymedi=ymedi+boxysize
14940 zmedi=dmod(zmedi,boxzsize)
14941 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14942 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
14943 num_conti=num_cont_hb(i)
14944 do j=ielstart(i),ielend(i)
14945 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
14946 call eelecij_scale(i,j,ees,evdw1,eel_loc)
14948 num_cont_hb(i)=num_conti
14950 ! write (iout,*) "Number of loop steps in EELEC:",ind
14952 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
14953 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
14955 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
14956 !cc eel_loc=eel_loc+eello_turn3
14957 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
14959 end subroutine eelec_scale
14960 !-----------------------------------------------------------------------------
14961 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
14962 ! implicit real*8 (a-h,o-z)
14965 ! include 'DIMENSIONS'
14969 ! include 'COMMON.CONTROL'
14970 ! include 'COMMON.IOUNITS'
14971 ! include 'COMMON.GEO'
14972 ! include 'COMMON.VAR'
14973 ! include 'COMMON.LOCAL'
14974 ! include 'COMMON.CHAIN'
14975 ! include 'COMMON.DERIV'
14976 ! include 'COMMON.INTERACT'
14977 ! include 'COMMON.CONTACTS'
14978 ! include 'COMMON.TORSION'
14979 ! include 'COMMON.VECTORS'
14980 ! include 'COMMON.FFIELD'
14981 ! include 'COMMON.TIME1'
14982 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
14983 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
14984 real(kind=8),dimension(2,2) :: acipa !el,a_temp
14985 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
14986 real(kind=8),dimension(4) :: muij
14987 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14988 dist_temp, dist_init,sss_grad
14989 integer xshift,yshift,zshift
14991 !el integer :: num_conti,j1,j2
14992 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
14993 !el dz_normi,xmedi,ymedi,zmedi
14994 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
14995 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14996 !el num_conti,j1,j2
14997 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14999 real(kind=8) :: scal_el=1.0d0
15001 real(kind=8) :: scal_el=0.5d0
15004 ! 13-go grudnia roku pamietnego...
15005 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
15006 0.0d0,1.0d0,0.0d0,&
15007 0.0d0,0.0d0,1.0d0/),shape(unmat))
15008 !el local variables
15009 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m,isubchap
15010 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
15011 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
15012 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
15013 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
15014 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
15015 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
15016 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
15017 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
15018 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
15019 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
15020 ecosam,ecosbm,ecosgm,ghalf,time00
15021 ! integer :: maxconts
15022 ! maxconts = nres/4
15023 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
15024 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
15025 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
15026 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
15027 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
15028 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
15029 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
15030 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
15031 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
15032 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
15033 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
15034 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
15035 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
15037 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
15038 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
15043 !d write (iout,*) "eelecij",i,j
15047 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
15048 aaa=app(iteli,itelj)
15049 bbb=bpp(iteli,itelj)
15050 ael6i=ael6(iteli,itelj)
15051 ael3i=ael3(iteli,itelj)
15055 dx_normj=dc_norm(1,j)
15056 dy_normj=dc_norm(2,j)
15057 dz_normj=dc_norm(3,j)
15058 ! xj=c(1,j)+0.5D0*dxj-xmedi
15059 ! yj=c(2,j)+0.5D0*dyj-ymedi
15060 ! zj=c(3,j)+0.5D0*dzj-zmedi
15061 xj=c(1,j)+0.5D0*dxj
15062 yj=c(2,j)+0.5D0*dyj
15063 zj=c(3,j)+0.5D0*dzj
15064 xj=mod(xj,boxxsize)
15065 if (xj.lt.0) xj=xj+boxxsize
15066 yj=mod(yj,boxysize)
15067 if (yj.lt.0) yj=yj+boxysize
15068 zj=mod(zj,boxzsize)
15069 if (zj.lt.0) zj=zj+boxzsize
15071 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15078 xj=xj_safe+xshift*boxxsize
15079 yj=yj_safe+yshift*boxysize
15080 zj=zj_safe+zshift*boxzsize
15081 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15082 if(dist_temp.lt.dist_init) then
15083 dist_init=dist_temp
15092 if (isubchap.eq.1) then
15103 rij=xj*xj+yj*yj+zj*zj
15107 ! For extracting the short-range part of Evdwpp
15108 sss=sscale(rij/rpp(iteli,itelj))
15109 sss_ele_cut=sscale_ele(rij)
15110 sss_ele_grad=sscagrad_ele(rij)
15111 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
15112 ! sss_ele_cut=1.0d0
15113 ! sss_ele_grad=0.0d0
15114 if (sss_ele_cut.le.0.0) go to 128
15118 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
15119 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
15120 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
15121 fac=cosa-3.0D0*cosb*cosg
15123 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
15124 if (j.eq.i+2) ev1=scal_el*ev1
15129 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
15132 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
15133 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
15134 ees=ees+eesij*sss_ele_cut
15135 evdw1=evdw1+evdwij*(1.0d0-sss)*sss_ele_cut
15136 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
15137 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
15138 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
15139 !d & xmedi,ymedi,zmedi,xj,yj,zj
15141 if (energy_dec) then
15142 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
15143 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
15147 ! Calculate contributions to the Cartesian gradient.
15150 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
15151 facel=-3*rrmij*(el1+eesij)*sss_ele_cut
15157 ! Radial derivatives. First process both termini of the fragment (i,j)
15159 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj
15160 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj
15161 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj
15163 ! ghalf=0.5D0*ggg(k)
15164 ! gelc(k,i)=gelc(k,i)+ghalf
15165 ! gelc(k,j)=gelc(k,j)+ghalf
15167 ! 9/28/08 AL Gradient compotents will be summed only at the end
15169 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
15170 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
15173 ! Loop over residues i+1 thru j-1.
15177 !grad gelc(l,k)=gelc(l,k)+ggg(l)
15180 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*(1.0d0-sss) &
15181 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
15182 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*(1.0d0-sss) &
15183 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
15184 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*(1.0d0-sss) &
15185 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
15187 ! ghalf=0.5D0*ggg(k)
15188 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
15189 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
15191 ! 9/28/08 AL Gradient compotents will be summed only at the end
15193 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
15194 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
15197 ! Loop over residues i+1 thru j-1.
15201 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
15205 facvdw=(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
15206 facel=(el1+eesij)*sss_ele_cut
15208 fac=-3*rrmij*(facvdw+facvdw+facel)
15213 ! Radial derivatives. First process both termini of the fragment (i,j)
15219 ! ghalf=0.5D0*ggg(k)
15220 ! gelc(k,i)=gelc(k,i)+ghalf
15221 ! gelc(k,j)=gelc(k,j)+ghalf
15223 ! 9/28/08 AL Gradient compotents will be summed only at the end
15225 gelc_long(k,j)=gelc(k,j)+ggg(k)
15226 gelc_long(k,i)=gelc(k,i)-ggg(k)
15229 ! Loop over residues i+1 thru j-1.
15233 !grad gelc(l,k)=gelc(l,k)+ggg(l)
15236 ! 9/28/08 AL Gradient compotents will be summed only at the end
15241 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
15242 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
15248 ecosa=2.0D0*fac3*fac1+fac4
15251 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
15252 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
15254 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
15255 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
15257 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
15258 !d & (dcosg(k),k=1,3)
15260 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k) )*sss_ele_cut
15263 ! ghalf=0.5D0*ggg(k)
15264 ! gelc(k,i)=gelc(k,i)+ghalf
15265 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
15266 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
15267 ! gelc(k,j)=gelc(k,j)+ghalf
15268 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
15269 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
15273 !grad gelc(l,k)=gelc(l,k)+ggg(l)
15277 gelc(k,i)=gelc(k,i) &
15278 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15279 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
15281 gelc(k,j)=gelc(k,j) &
15282 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15283 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
15285 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
15286 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
15288 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
15289 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
15290 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
15292 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
15293 ! energy of a peptide unit is assumed in the form of a second-order
15294 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
15295 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
15296 ! are computed for EVERY pair of non-contiguous peptide groups.
15298 if (j.lt.nres-1) then
15309 muij(kkk)=mu(k,i)*mu(l,j)
15312 !d write (iout,*) 'EELEC: i',i,' j',j
15313 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
15314 !d write(iout,*) 'muij',muij
15315 ury=scalar(uy(1,i),erij)
15316 urz=scalar(uz(1,i),erij)
15317 vry=scalar(uy(1,j),erij)
15318 vrz=scalar(uz(1,j),erij)
15319 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
15320 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
15321 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
15322 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
15323 fac=dsqrt(-ael6i)*r3ij
15328 !d write (iout,'(4i5,4f10.5)')
15329 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
15330 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
15331 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
15332 !d & uy(:,j),uz(:,j)
15333 !d write (iout,'(4f10.5)')
15334 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
15335 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
15336 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
15337 !d write (iout,'(9f10.5/)')
15338 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
15339 ! Derivatives of the elements of A in virtual-bond vectors
15340 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
15342 uryg(k,1)=scalar(erder(1,k),uy(1,i))
15343 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
15344 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
15345 urzg(k,1)=scalar(erder(1,k),uz(1,i))
15346 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
15347 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
15348 vryg(k,1)=scalar(erder(1,k),uy(1,j))
15349 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
15350 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
15351 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
15352 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
15353 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
15355 ! Compute radial contributions to the gradient
15373 ! Add the contributions coming from er
15376 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
15377 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
15378 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
15379 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
15382 ! Derivatives in DC(i)
15383 !grad ghalf1=0.5d0*agg(k,1)
15384 !grad ghalf2=0.5d0*agg(k,2)
15385 !grad ghalf3=0.5d0*agg(k,3)
15386 !grad ghalf4=0.5d0*agg(k,4)
15387 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
15388 -3.0d0*uryg(k,2)*vry)!+ghalf1
15389 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
15390 -3.0d0*uryg(k,2)*vrz)!+ghalf2
15391 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
15392 -3.0d0*urzg(k,2)*vry)!+ghalf3
15393 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
15394 -3.0d0*urzg(k,2)*vrz)!+ghalf4
15395 ! Derivatives in DC(i+1)
15396 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
15397 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
15398 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
15399 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
15400 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
15401 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
15402 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
15403 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
15404 ! Derivatives in DC(j)
15405 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
15406 -3.0d0*vryg(k,2)*ury)!+ghalf1
15407 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
15408 -3.0d0*vrzg(k,2)*ury)!+ghalf2
15409 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
15410 -3.0d0*vryg(k,2)*urz)!+ghalf3
15411 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
15412 -3.0d0*vrzg(k,2)*urz)!+ghalf4
15413 ! Derivatives in DC(j+1) or DC(nres-1)
15414 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
15415 -3.0d0*vryg(k,3)*ury)
15416 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
15417 -3.0d0*vrzg(k,3)*ury)
15418 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
15419 -3.0d0*vryg(k,3)*urz)
15420 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
15421 -3.0d0*vrzg(k,3)*urz)
15422 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
15424 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
15437 aggi(k,l)=-aggi(k,l)
15438 aggi1(k,l)=-aggi1(k,l)
15439 aggj(k,l)=-aggj(k,l)
15440 aggj1(k,l)=-aggj1(k,l)
15443 if (j.lt.nres-1) then
15449 aggi(k,l)=-aggi(k,l)
15450 aggi1(k,l)=-aggi1(k,l)
15451 aggj(k,l)=-aggj(k,l)
15452 aggj1(k,l)=-aggj1(k,l)
15463 aggi(k,l)=-aggi(k,l)
15464 aggi1(k,l)=-aggi1(k,l)
15465 aggj(k,l)=-aggj(k,l)
15466 aggj1(k,l)=-aggj1(k,l)
15471 IF (wel_loc.gt.0.0d0) THEN
15472 ! Contribution to the local-electrostatic energy coming from the i-j pair
15473 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
15475 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
15476 ! print *,"EELLOC",i,gel_loc_loc(i-1)
15477 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
15478 'eelloc',i,j,eel_loc_ij
15479 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
15481 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
15482 ! Partial derivatives in virtual-bond dihedral angles gamma
15484 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
15485 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
15486 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
15488 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
15489 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
15490 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
15496 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
15498 ggg(l)=(agg(l,1)*muij(1)+ &
15499 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
15501 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
15503 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
15504 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
15505 !grad ghalf=0.5d0*ggg(l)
15506 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
15507 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
15511 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
15514 ! Remaining derivatives of eello
15516 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
15517 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
15520 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
15521 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))&
15524 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
15525 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
15528 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
15529 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))&
15534 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
15535 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
15536 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
15537 .and. num_conti.le.maxconts) then
15538 ! write (iout,*) i,j," entered corr"
15540 ! Calculate the contact function. The ith column of the array JCONT will
15541 ! contain the numbers of atoms that make contacts with the atom I (of numbers
15542 ! greater than I). The arrays FACONT and GACONT will contain the values of
15543 ! the contact function and its derivative.
15544 ! r0ij=1.02D0*rpp(iteli,itelj)
15545 ! r0ij=1.11D0*rpp(iteli,itelj)
15546 r0ij=2.20D0*rpp(iteli,itelj)
15547 ! r0ij=1.55D0*rpp(iteli,itelj)
15548 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
15549 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
15550 if (fcont.gt.0.0D0) then
15551 num_conti=num_conti+1
15552 if (num_conti.gt.maxconts) then
15553 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
15554 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
15555 ' will skip next contacts for this conf.',num_conti
15557 jcont_hb(num_conti,i)=j
15558 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
15559 !d & " jcont_hb",jcont_hb(num_conti,i)
15560 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
15561 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
15562 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
15564 d_cont(num_conti,i)=rij
15565 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
15566 ! --- Electrostatic-interaction matrix ---
15567 a_chuj(1,1,num_conti,i)=a22
15568 a_chuj(1,2,num_conti,i)=a23
15569 a_chuj(2,1,num_conti,i)=a32
15570 a_chuj(2,2,num_conti,i)=a33
15571 ! --- Gradient of rij
15573 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
15580 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
15581 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
15582 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
15583 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
15584 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
15589 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
15590 ! Calculate contact energies
15592 wij=cosa-3.0D0*cosb*cosg
15595 ! fac3=dsqrt(-ael6i)/r0ij**3
15596 fac3=dsqrt(-ael6i)*r3ij
15597 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
15598 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
15599 if (ees0tmp.gt.0) then
15600 ees0pij=dsqrt(ees0tmp)
15604 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
15605 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
15606 if (ees0tmp.gt.0) then
15607 ees0mij=dsqrt(ees0tmp)
15612 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
15615 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
15618 ! Diagnostics. Comment out or remove after debugging!
15619 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
15620 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
15621 ! ees0m(num_conti,i)=0.0D0
15623 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
15624 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
15625 ! Angular derivatives of the contact function
15626 ees0pij1=fac3/ees0pij
15627 ees0mij1=fac3/ees0mij
15628 fac3p=-3.0D0*fac3*rrmij
15629 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
15630 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
15632 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
15633 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
15634 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
15635 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
15636 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
15637 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
15638 ecosap=ecosa1+ecosa2
15639 ecosbp=ecosb1+ecosb2
15640 ecosgp=ecosg1+ecosg2
15641 ecosam=ecosa1-ecosa2
15642 ecosbm=ecosb1-ecosb2
15643 ecosgm=ecosg1-ecosg2
15652 facont_hb(num_conti,i)=fcont
15653 fprimcont=fprimcont/rij
15654 !d facont_hb(num_conti,i)=1.0D0
15655 ! Following line is for diagnostics.
15658 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
15659 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
15662 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
15663 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
15665 ! gggp(1)=gggp(1)+ees0pijp*xj
15666 ! gggp(2)=gggp(2)+ees0pijp*yj
15667 ! gggp(3)=gggp(3)+ees0pijp*zj
15668 ! gggm(1)=gggm(1)+ees0mijp*xj
15669 ! gggm(2)=gggm(2)+ees0mijp*yj
15670 ! gggm(3)=gggm(3)+ees0mijp*zj
15671 gggp(1)=gggp(1)+ees0pijp*xj &
15672 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
15673 gggp(2)=gggp(2)+ees0pijp*yj &
15674 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
15675 gggp(3)=gggp(3)+ees0pijp*zj &
15676 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
15678 gggm(1)=gggm(1)+ees0mijp*xj &
15679 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
15681 gggm(2)=gggm(2)+ees0mijp*yj &
15682 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
15684 gggm(3)=gggm(3)+ees0mijp*zj &
15685 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
15687 ! Derivatives due to the contact function
15688 gacont_hbr(1,num_conti,i)=fprimcont*xj
15689 gacont_hbr(2,num_conti,i)=fprimcont*yj
15690 gacont_hbr(3,num_conti,i)=fprimcont*zj
15693 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
15694 ! following the change of gradient-summation algorithm.
15696 !grad ghalfp=0.5D0*gggp(k)
15697 !grad ghalfm=0.5D0*gggm(k)
15698 ! gacontp_hb1(k,num_conti,i)= & !ghalfp
15699 ! +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15700 ! + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
15701 ! gacontp_hb2(k,num_conti,i)= & !ghalfp
15702 ! +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15703 ! + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
15704 ! gacontp_hb3(k,num_conti,i)=gggp(k)
15705 ! gacontm_hb1(k,num_conti,i)= &!ghalfm
15706 ! +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15707 ! + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
15708 ! gacontm_hb2(k,num_conti,i)= & !ghalfm
15709 ! +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15710 ! + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
15711 ! gacontm_hb3(k,num_conti,i)=gggm(k)
15712 gacontp_hb1(k,num_conti,i)= & !ghalfp+
15713 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15714 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
15717 gacontp_hb2(k,num_conti,i)= & !ghalfp+
15718 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15719 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
15722 gacontp_hb3(k,num_conti,i)=gggp(k) &
15725 gacontm_hb1(k,num_conti,i)= & !ghalfm+
15726 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15727 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
15730 gacontm_hb2(k,num_conti,i)= & !ghalfm+
15731 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15732 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
15735 gacontm_hb3(k,num_conti,i)=gggm(k) &
15740 endif ! num_conti.le.maxconts
15743 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
15746 ghalf=0.5d0*agg(l,k)
15747 aggi(l,k)=aggi(l,k)+ghalf
15748 aggi1(l,k)=aggi1(l,k)+agg(l,k)
15749 aggj(l,k)=aggj(l,k)+ghalf
15752 if (j.eq.nres-1 .and. i.lt.j-2) then
15755 aggj1(l,k)=aggj1(l,k)+agg(l,k)
15761 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
15763 end subroutine eelecij_scale
15764 !-----------------------------------------------------------------------------
15765 subroutine evdwpp_short(evdw1)
15769 ! implicit real*8 (a-h,o-z)
15770 ! include 'DIMENSIONS'
15771 ! include 'COMMON.CONTROL'
15772 ! include 'COMMON.IOUNITS'
15773 ! include 'COMMON.GEO'
15774 ! include 'COMMON.VAR'
15775 ! include 'COMMON.LOCAL'
15776 ! include 'COMMON.CHAIN'
15777 ! include 'COMMON.DERIV'
15778 ! include 'COMMON.INTERACT'
15779 ! include 'COMMON.CONTACTS'
15780 ! include 'COMMON.TORSION'
15781 ! include 'COMMON.VECTORS'
15782 ! include 'COMMON.FFIELD'
15783 real(kind=8),dimension(3) :: ggg
15784 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
15786 real(kind=8) :: scal_el=1.0d0
15788 real(kind=8) :: scal_el=0.5d0
15790 !el local variables
15791 integer :: i,j,k,iteli,itelj,num_conti,isubchap
15792 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
15793 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
15794 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
15795 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
15796 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15797 dist_temp, dist_init,sss_grad
15798 integer xshift,yshift,zshift
15802 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
15803 ! & " iatel_e_vdw",iatel_e_vdw
15805 do i=iatel_s_vdw,iatel_e_vdw
15806 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1) cycle
15810 dx_normi=dc_norm(1,i)
15811 dy_normi=dc_norm(2,i)
15812 dz_normi=dc_norm(3,i)
15813 xmedi=c(1,i)+0.5d0*dxi
15814 ymedi=c(2,i)+0.5d0*dyi
15815 zmedi=c(3,i)+0.5d0*dzi
15816 xmedi=dmod(xmedi,boxxsize)
15817 if (xmedi.lt.0) xmedi=xmedi+boxxsize
15818 ymedi=dmod(ymedi,boxysize)
15819 if (ymedi.lt.0) ymedi=ymedi+boxysize
15820 zmedi=dmod(zmedi,boxzsize)
15821 if (zmedi.lt.0) zmedi=zmedi+boxzsize
15823 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
15824 ! & ' ielend',ielend_vdw(i)
15826 do j=ielstart_vdw(i),ielend_vdw(i)
15827 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
15831 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
15832 aaa=app(iteli,itelj)
15833 bbb=bpp(iteli,itelj)
15837 dx_normj=dc_norm(1,j)
15838 dy_normj=dc_norm(2,j)
15839 dz_normj=dc_norm(3,j)
15840 ! xj=c(1,j)+0.5D0*dxj-xmedi
15841 ! yj=c(2,j)+0.5D0*dyj-ymedi
15842 ! zj=c(3,j)+0.5D0*dzj-zmedi
15843 xj=c(1,j)+0.5D0*dxj
15844 yj=c(2,j)+0.5D0*dyj
15845 zj=c(3,j)+0.5D0*dzj
15846 xj=mod(xj,boxxsize)
15847 if (xj.lt.0) xj=xj+boxxsize
15848 yj=mod(yj,boxysize)
15849 if (yj.lt.0) yj=yj+boxysize
15850 zj=mod(zj,boxzsize)
15851 if (zj.lt.0) zj=zj+boxzsize
15853 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15860 xj=xj_safe+xshift*boxxsize
15861 yj=yj_safe+yshift*boxysize
15862 zj=zj_safe+zshift*boxzsize
15863 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15864 if(dist_temp.lt.dist_init) then
15865 dist_init=dist_temp
15874 if (isubchap.eq.1) then
15885 rij=xj*xj+yj*yj+zj*zj
15888 sss=sscale(rij/rpp(iteli,itelj))
15889 sss_ele_cut=sscale_ele(rij)
15890 sss_ele_grad=sscagrad_ele(rij)
15891 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
15892 if (sss_ele_cut.le.0.0) cycle
15893 if (sss.gt.0.0d0) then
15898 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
15899 if (j.eq.i+2) ev1=scal_el*ev1
15902 if (energy_dec) then
15903 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
15905 evdw1=evdw1+evdwij*sss*sss_ele_cut
15907 ! Calculate contributions to the Cartesian gradient.
15909 facvdw=-6*rrmij*(ev1+evdwij)*sss*sss_ele_cut
15913 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*sss &
15914 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
15915 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*sss &
15916 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
15917 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*sss &
15918 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
15921 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
15922 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
15928 end subroutine evdwpp_short
15929 !-----------------------------------------------------------------------------
15930 subroutine escp_long(evdw2,evdw2_14)
15932 ! This subroutine calculates the excluded-volume interaction energy between
15933 ! peptide-group centers and side chains and its gradient in virtual-bond and
15934 ! side-chain vectors.
15936 ! implicit real*8 (a-h,o-z)
15937 ! include 'DIMENSIONS'
15938 ! include 'COMMON.GEO'
15939 ! include 'COMMON.VAR'
15940 ! include 'COMMON.LOCAL'
15941 ! include 'COMMON.CHAIN'
15942 ! include 'COMMON.DERIV'
15943 ! include 'COMMON.INTERACT'
15944 ! include 'COMMON.FFIELD'
15945 ! include 'COMMON.IOUNITS'
15946 ! include 'COMMON.CONTROL'
15947 real(kind=8),dimension(3) :: ggg
15948 !el local variables
15949 integer :: i,iint,j,k,iteli,itypj,subchap
15950 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
15951 real(kind=8) :: evdw2,evdw2_14,evdwij
15952 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15953 dist_temp, dist_init
15957 !d print '(a)','Enter ESCP'
15958 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
15959 do i=iatscp_s,iatscp_e
15960 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
15962 xi=0.5D0*(c(1,i)+c(1,i+1))
15963 yi=0.5D0*(c(2,i)+c(2,i+1))
15964 zi=0.5D0*(c(3,i)+c(3,i+1))
15965 xi=mod(xi,boxxsize)
15966 if (xi.lt.0) xi=xi+boxxsize
15967 yi=mod(yi,boxysize)
15968 if (yi.lt.0) yi=yi+boxysize
15969 zi=mod(zi,boxzsize)
15970 if (zi.lt.0) zi=zi+boxzsize
15972 do iint=1,nscp_gr(i)
15974 do j=iscpstart(i,iint),iscpend(i,iint)
15976 if (itypj.eq.ntyp1) cycle
15977 ! Uncomment following three lines for SC-p interactions
15978 ! xj=c(1,nres+j)-xi
15979 ! yj=c(2,nres+j)-yi
15980 ! zj=c(3,nres+j)-zi
15981 ! Uncomment following three lines for Ca-p interactions
15985 xj=mod(xj,boxxsize)
15986 if (xj.lt.0) xj=xj+boxxsize
15987 yj=mod(yj,boxysize)
15988 if (yj.lt.0) yj=yj+boxysize
15989 zj=mod(zj,boxzsize)
15990 if (zj.lt.0) zj=zj+boxzsize
15991 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15999 xj=xj_safe+xshift*boxxsize
16000 yj=yj_safe+yshift*boxysize
16001 zj=zj_safe+zshift*boxzsize
16002 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
16003 if(dist_temp.lt.dist_init) then
16004 dist_init=dist_temp
16013 if (subchap.eq.1) then
16022 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
16024 rij=dsqrt(1.0d0/rrij)
16025 sss_ele_cut=sscale_ele(rij)
16026 sss_ele_grad=sscagrad_ele(rij)
16027 ! print *,sss_ele_cut,sss_ele_grad,&
16028 ! (rij),r_cut_ele,rlamb_ele
16029 if (sss_ele_cut.le.0.0) cycle
16030 sss=sscale((rij/rscp(itypj,iteli)))
16031 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
16032 if (sss.lt.1.0d0) then
16035 e1=fac*fac*aad(itypj,iteli)
16036 e2=fac*bad(itypj,iteli)
16037 if (iabs(j-i) .le. 2) then
16040 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)*sss_ele_cut
16043 evdw2=evdw2+evdwij*(1.0d0-sss)*sss_ele_cut
16044 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
16045 'evdw2',i,j,sss,evdwij
16047 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
16049 fac=-(evdwij+e1)*rrij*(1.0d0-sss)*sss_ele_cut
16050 fac=fac+evdwij*sss_ele_grad/rij/expon*(1.0d0-sss)&
16051 -evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
16055 ! Uncomment following three lines for SC-p interactions
16057 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
16059 ! Uncomment following line for SC-p interactions
16060 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
16062 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
16063 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
16072 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
16073 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
16074 gradx_scp(j,i)=expon*gradx_scp(j,i)
16077 !******************************************************************************
16081 ! To save time the factor EXPON has been extracted from ALL components
16082 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
16085 !******************************************************************************
16087 end subroutine escp_long
16088 !-----------------------------------------------------------------------------
16089 subroutine escp_short(evdw2,evdw2_14)
16091 ! This subroutine calculates the excluded-volume interaction energy between
16092 ! peptide-group centers and side chains and its gradient in virtual-bond and
16093 ! side-chain vectors.
16095 ! implicit real*8 (a-h,o-z)
16096 ! include 'DIMENSIONS'
16097 ! include 'COMMON.GEO'
16098 ! include 'COMMON.VAR'
16099 ! include 'COMMON.LOCAL'
16100 ! include 'COMMON.CHAIN'
16101 ! include 'COMMON.DERIV'
16102 ! include 'COMMON.INTERACT'
16103 ! include 'COMMON.FFIELD'
16104 ! include 'COMMON.IOUNITS'
16105 ! include 'COMMON.CONTROL'
16106 real(kind=8),dimension(3) :: ggg
16107 !el local variables
16108 integer :: i,iint,j,k,iteli,itypj,subchap
16109 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
16110 real(kind=8) :: evdw2,evdw2_14,evdwij
16111 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
16112 dist_temp, dist_init
16116 !d print '(a)','Enter ESCP'
16117 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
16118 do i=iatscp_s,iatscp_e
16119 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
16121 xi=0.5D0*(c(1,i)+c(1,i+1))
16122 yi=0.5D0*(c(2,i)+c(2,i+1))
16123 zi=0.5D0*(c(3,i)+c(3,i+1))
16124 xi=mod(xi,boxxsize)
16125 if (xi.lt.0) xi=xi+boxxsize
16126 yi=mod(yi,boxysize)
16127 if (yi.lt.0) yi=yi+boxysize
16128 zi=mod(zi,boxzsize)
16129 if (zi.lt.0) zi=zi+boxzsize
16131 do iint=1,nscp_gr(i)
16133 do j=iscpstart(i,iint),iscpend(i,iint)
16135 if (itypj.eq.ntyp1) cycle
16136 ! Uncomment following three lines for SC-p interactions
16137 ! xj=c(1,nres+j)-xi
16138 ! yj=c(2,nres+j)-yi
16139 ! zj=c(3,nres+j)-zi
16140 ! Uncomment following three lines for Ca-p interactions
16147 xj=mod(xj,boxxsize)
16148 if (xj.lt.0) xj=xj+boxxsize
16149 yj=mod(yj,boxysize)
16150 if (yj.lt.0) yj=yj+boxysize
16151 zj=mod(zj,boxzsize)
16152 if (zj.lt.0) zj=zj+boxzsize
16153 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
16161 xj=xj_safe+xshift*boxxsize
16162 yj=yj_safe+yshift*boxysize
16163 zj=zj_safe+zshift*boxzsize
16164 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
16165 if(dist_temp.lt.dist_init) then
16166 dist_init=dist_temp
16175 if (subchap.eq.1) then
16185 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
16186 rij=dsqrt(1.0d0/rrij)
16187 sss_ele_cut=sscale_ele(rij)
16188 sss_ele_grad=sscagrad_ele(rij)
16189 ! print *,sss_ele_cut,sss_ele_grad,&
16190 ! (rij),r_cut_ele,rlamb_ele
16191 if (sss_ele_cut.le.0.0) cycle
16192 sss=sscale(rij/rscp(itypj,iteli))
16193 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
16194 if (sss.gt.0.0d0) then
16197 e1=fac*fac*aad(itypj,iteli)
16198 e2=fac*bad(itypj,iteli)
16199 if (iabs(j-i) .le. 2) then
16202 evdw2_14=evdw2_14+(e1+e2)*sss*sss_ele_cut
16205 evdw2=evdw2+evdwij*sss*sss_ele_cut
16206 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
16207 'evdw2',i,j,sss,evdwij
16209 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
16211 fac=-(evdwij+e1)*rrij*sss*sss_ele_cut
16212 fac=fac+evdwij*sss_ele_grad/rij/expon*sss &
16213 +evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
16218 ! Uncomment following three lines for SC-p interactions
16220 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
16222 ! Uncomment following line for SC-p interactions
16223 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
16225 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
16226 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
16235 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
16236 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
16237 gradx_scp(j,i)=expon*gradx_scp(j,i)
16240 !******************************************************************************
16244 ! To save time the factor EXPON has been extracted from ALL components
16245 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
16248 !******************************************************************************
16250 end subroutine escp_short
16251 !-----------------------------------------------------------------------------
16252 ! energy_p_new-sep_barrier.F
16253 !-----------------------------------------------------------------------------
16254 subroutine sc_grad_scale(scalfac)
16255 ! implicit real*8 (a-h,o-z)
16257 ! include 'DIMENSIONS'
16258 ! include 'COMMON.CHAIN'
16259 ! include 'COMMON.DERIV'
16260 ! include 'COMMON.CALC'
16261 ! include 'COMMON.IOUNITS'
16262 real(kind=8),dimension(3) :: dcosom1,dcosom2
16263 real(kind=8) :: scalfac
16264 !el local variables
16265 ! integer :: i,j,k,l
16267 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
16268 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
16269 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
16270 -2.0D0*alf12*eps3der+sigder*sigsq_om12
16274 ! eom12=evdwij*eps1_om12
16276 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
16277 ! & " sigder",sigder
16278 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
16279 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
16281 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
16282 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
16285 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac&
16288 ! write (iout,*) "gg",(gg(k),k=1,3)
16290 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
16291 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
16292 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
16294 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
16295 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
16296 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac&
16298 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
16299 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
16300 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
16301 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
16304 ! Calculate the components of the gradient in DC and X
16307 gvdwc(l,i)=gvdwc(l,i)-gg(l)
16308 gvdwc(l,j)=gvdwc(l,j)+gg(l)
16311 end subroutine sc_grad_scale
16312 !-----------------------------------------------------------------------------
16313 ! energy_split-sep.F
16314 !-----------------------------------------------------------------------------
16315 subroutine etotal_long(energia)
16317 ! Compute the long-range slow-varying contributions to the energy
16319 ! implicit real*8 (a-h,o-z)
16320 ! include 'DIMENSIONS'
16321 use MD_data, only: totT,usampl,eq_time
16325 !MS$ATTRIBUTES C :: proc_proc
16330 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
16332 ! include 'COMMON.SETUP'
16333 ! include 'COMMON.IOUNITS'
16334 ! include 'COMMON.FFIELD'
16335 ! include 'COMMON.DERIV'
16336 ! include 'COMMON.INTERACT'
16337 ! include 'COMMON.SBRIDGE'
16338 ! include 'COMMON.CHAIN'
16339 ! include 'COMMON.VAR'
16340 ! include 'COMMON.LOCAL'
16341 ! include 'COMMON.MD'
16342 real(kind=8),dimension(0:n_ene) :: energia
16343 !el local variables
16344 integer :: i,n_corr,n_corr1,ierror,ierr
16345 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
16346 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
16347 ecorr,ecorr5,ecorr6,eturn6,time00
16348 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
16349 !elwrite(iout,*)"in etotal long"
16351 if (modecalc.eq.12.or.modecalc.eq.14) then
16353 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
16355 call int_from_cart1(.false.)
16358 !elwrite(iout,*)"in etotal long"
16361 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
16362 ! & " absolute rank",myrank," nfgtasks",nfgtasks
16364 if (nfgtasks.gt.1) then
16366 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
16367 if (fg_rank.eq.0) then
16368 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
16369 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
16371 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
16372 ! FG slaves as WEIGHTS array.
16379 weights_(7)=wel_loc
16382 weights_(10)=wturn6
16384 weights_(12)=wscloc
16386 weights_(14)=wtor_d
16387 weights_(15)=wstrain
16388 weights_(16)=wvdwpp
16390 weights_(18)=scal14
16391 weights_(21)=wsccor
16392 ! FG Master broadcasts the WEIGHTS_ array
16393 call MPI_Bcast(weights_(1),n_ene,&
16394 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
16396 ! FG slaves receive the WEIGHTS array
16397 call MPI_Bcast(weights(1),n_ene,&
16398 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
16413 wstrain=weights(15)
16419 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
16421 time_Bcast=time_Bcast+MPI_Wtime()-time00
16422 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
16423 ! call chainbuild_cart
16424 ! call int_from_cart1(.false.)
16426 ! write (iout,*) 'Processor',myrank,
16427 ! & ' calling etotal_short ipot=',ipot
16429 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
16431 !d print *,'nnt=',nnt,' nct=',nct
16433 !elwrite(iout,*)"in etotal long"
16434 ! Compute the side-chain and electrostatic interaction energy
16436 goto (101,102,103,104,105,106) ipot
16437 ! Lennard-Jones potential.
16438 101 call elj_long(evdw)
16439 !d print '(a)','Exit ELJ'
16441 ! Lennard-Jones-Kihara potential (shifted).
16442 102 call eljk_long(evdw)
16444 ! Berne-Pechukas potential (dilated LJ, angular dependence).
16445 103 call ebp_long(evdw)
16447 ! Gay-Berne potential (shifted LJ, angular dependence).
16448 104 call egb_long(evdw)
16450 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
16451 105 call egbv_long(evdw)
16453 ! Soft-sphere potential
16454 106 call e_softsphere(evdw)
16456 ! Calculate electrostatic (H-bonding) energy of the main chain.
16460 if (ipot.lt.6) then
16462 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
16463 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
16464 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
16465 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
16467 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
16468 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
16469 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
16470 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
16472 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
16481 ! write (iout,*) "Soft-spheer ELEC potential"
16482 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
16486 ! Calculate excluded-volume interaction energy between peptide groups
16489 if (ipot.lt.6) then
16490 if(wscp.gt.0d0) then
16491 call escp_long(evdw2,evdw2_14)
16497 call escp_soft_sphere(evdw2,evdw2_14)
16500 ! 12/1/95 Multi-body terms
16504 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
16505 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
16506 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
16507 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
16508 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
16515 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
16516 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
16519 ! If performing constraint dynamics, call the constraint energy
16520 ! after the equilibration time
16521 if(usampl.and.totT.gt.eq_time) then
16536 energia(2)=evdw2-evdw2_14
16537 energia(18)=evdw2_14
16546 energia(3)=ees+evdw1
16553 energia(8)=eello_turn3
16554 energia(9)=eello_turn4
16556 energia(20)=Uconst+Uconst_back
16557 call sum_energy(energia,.true.)
16558 ! write (iout,*) "Exit ETOTAL_LONG"
16561 end subroutine etotal_long
16562 !-----------------------------------------------------------------------------
16563 subroutine etotal_short(energia)
16565 ! Compute the short-range fast-varying contributions to the energy
16567 ! implicit real*8 (a-h,o-z)
16568 ! include 'DIMENSIONS'
16572 !MS$ATTRIBUTES C :: proc_proc
16577 integer :: ierror,ierr
16578 real(kind=8),dimension(n_ene) :: weights_
16579 real(kind=8) :: time00
16581 ! include 'COMMON.SETUP'
16582 ! include 'COMMON.IOUNITS'
16583 ! include 'COMMON.FFIELD'
16584 ! include 'COMMON.DERIV'
16585 ! include 'COMMON.INTERACT'
16586 ! include 'COMMON.SBRIDGE'
16587 ! include 'COMMON.CHAIN'
16588 ! include 'COMMON.VAR'
16589 ! include 'COMMON.LOCAL'
16590 real(kind=8),dimension(0:n_ene) :: energia
16591 !el local variables
16593 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
16594 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr
16597 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
16599 if (modecalc.eq.12.or.modecalc.eq.14) then
16601 if (fg_rank.eq.0) call int_from_cart1(.false.)
16603 call int_from_cart1(.false.)
16607 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
16608 ! & " absolute rank",myrank," nfgtasks",nfgtasks
16610 if (nfgtasks.gt.1) then
16612 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
16613 if (fg_rank.eq.0) then
16614 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
16615 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
16617 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
16618 ! FG slaves as WEIGHTS array.
16625 weights_(7)=wel_loc
16628 weights_(10)=wturn6
16630 weights_(12)=wscloc
16632 weights_(14)=wtor_d
16633 weights_(15)=wstrain
16634 weights_(16)=wvdwpp
16636 weights_(18)=scal14
16637 weights_(21)=wsccor
16638 ! FG Master broadcasts the WEIGHTS_ array
16639 call MPI_Bcast(weights_(1),n_ene,&
16640 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
16642 ! FG slaves receive the WEIGHTS array
16643 call MPI_Bcast(weights(1),n_ene,&
16644 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
16659 wstrain=weights(15)
16665 ! write (iout,*),"Processor",myrank," BROADCAST weights"
16666 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
16668 ! write (iout,*) "Processor",myrank," BROADCAST c"
16669 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
16671 ! write (iout,*) "Processor",myrank," BROADCAST dc"
16672 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
16674 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
16675 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
16677 ! write (iout,*) "Processor",myrank," BROADCAST theta"
16678 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
16680 ! write (iout,*) "Processor",myrank," BROADCAST phi"
16681 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
16683 ! write (iout,*) "Processor",myrank," BROADCAST alph"
16684 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
16686 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
16687 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
16689 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
16690 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
16692 time_Bcast=time_Bcast+MPI_Wtime()-time00
16693 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
16695 ! write (iout,*) 'Processor',myrank,
16696 ! & ' calling etotal_short ipot=',ipot
16698 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
16700 ! call int_from_cart1(.false.)
16702 ! Compute the side-chain and electrostatic interaction energy
16704 goto (101,102,103,104,105,106) ipot
16705 ! Lennard-Jones potential.
16706 101 call elj_short(evdw)
16707 !d print '(a)','Exit ELJ'
16709 ! Lennard-Jones-Kihara potential (shifted).
16710 102 call eljk_short(evdw)
16712 ! Berne-Pechukas potential (dilated LJ, angular dependence).
16713 103 call ebp_short(evdw)
16715 ! Gay-Berne potential (shifted LJ, angular dependence).
16716 104 call egb_short(evdw)
16718 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
16719 105 call egbv_short(evdw)
16721 ! Soft-sphere potential - already dealt with in the long-range part
16723 ! 106 call e_softsphere_short(evdw)
16725 ! Calculate electrostatic (H-bonding) energy of the main chain.
16729 ! Calculate the short-range part of Evdwpp
16731 call evdwpp_short(evdw1)
16733 ! Calculate the short-range part of ESCp
16735 if (ipot.lt.6) then
16736 call escp_short(evdw2,evdw2_14)
16739 ! Calculate the bond-stretching energy
16743 ! Calculate the disulfide-bridge and other energy and the contributions
16744 ! from other distance constraints.
16747 ! Calculate the virtual-bond-angle energy.
16749 ! Calculate the SC local energy.
16754 if (wang.gt.0d0) then
16755 if (tor_mode.eq.0) then
16758 !C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
16760 call ebend_kcc(ebe)
16766 if (with_theta_constr) call etheta_constr(ethetacnstr)
16768 ! write(iout,*) "in etotal afer ebe",ipot
16770 ! print *,"Processor",myrank," computed UB"
16772 ! Calculate the SC local energy.
16775 !elwrite(iout,*) "in etotal afer esc",ipot
16776 ! print *,"Processor",myrank," computed USC"
16778 ! Calculate the virtual-bond torsional energy.
16780 !d print *,'nterm=',nterm
16781 ! if (wtor.gt.0) then
16782 ! call etor(etors,edihcnstr)
16787 if (wtor.gt.0.0d0) then
16788 if (tor_mode.eq.0) then
16791 !C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
16793 call etor_kcc(etors)
16799 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
16801 ! Calculate the virtual-bond torsional energy.
16804 ! 6/23/01 Calculate double-torsional energy
16806 if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
16807 call etor_d(etors_d)
16810 ! 21/5/07 Calculate local sicdechain correlation energy
16812 if (wsccor.gt.0.0d0) then
16813 call eback_sc_corr(esccor)
16818 ! Put energy components into an array
16825 energia(2)=evdw2-evdw2_14
16826 energia(18)=evdw2_14
16839 energia(14)=etors_d
16842 energia(19)=edihcnstr
16844 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
16846 call sum_energy(energia,.true.)
16847 ! write (iout,*) "Exit ETOTAL_SHORT"
16850 end subroutine etotal_short
16851 !-----------------------------------------------------------------------------
16853 !-----------------------------------------------------------------------------
16854 real(kind=8) function gnmr1(y,ymin,ymax)
16856 real(kind=8) :: y,ymin,ymax
16857 real(kind=8) :: wykl=4.0d0
16858 if (y.lt.ymin) then
16859 gnmr1=(ymin-y)**wykl/wykl
16860 else if (y.gt.ymax) then
16861 gnmr1=(y-ymax)**wykl/wykl
16867 !-----------------------------------------------------------------------------
16868 real(kind=8) function gnmr1prim(y,ymin,ymax)
16870 real(kind=8) :: y,ymin,ymax
16871 real(kind=8) :: wykl=4.0d0
16872 if (y.lt.ymin) then
16873 gnmr1prim=-(ymin-y)**(wykl-1)
16874 else if (y.gt.ymax) then
16875 gnmr1prim=(y-ymax)**(wykl-1)
16880 end function gnmr1prim
16881 !----------------------------------------------------------------------------
16882 real(kind=8) function rlornmr1(y,ymin,ymax,sigma)
16883 real(kind=8) y,ymin,ymax,sigma
16884 real(kind=8) wykl /4.0d0/
16885 if (y.lt.ymin) then
16886 rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl)
16887 else if (y.gt.ymax) then
16888 rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
16893 end function rlornmr1
16894 !------------------------------------------------------------------------------
16895 real(kind=8) function rlornmr1prim(y,ymin,ymax,sigma)
16896 real(kind=8) y,ymin,ymax,sigma
16897 real(kind=8) wykl /4.0d0/
16898 if (y.lt.ymin) then
16899 rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ &
16900 ((ymin-y)**wykl+sigma**wykl)**2
16901 else if (y.gt.ymax) then
16902 rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ &
16903 ((y-ymax)**wykl+sigma**wykl)**2
16908 end function rlornmr1prim
16910 real(kind=8) function harmonic(y,ymax)
16912 real(kind=8) :: y,ymax
16913 real(kind=8) :: wykl=2.0d0
16914 harmonic=(y-ymax)**wykl
16916 end function harmonic
16917 !-----------------------------------------------------------------------------
16918 real(kind=8) function harmonicprim(y,ymax)
16919 real(kind=8) :: y,ymin,ymax
16920 real(kind=8) :: wykl=2.0d0
16921 harmonicprim=(y-ymax)*wykl
16923 end function harmonicprim
16924 !-----------------------------------------------------------------------------
16926 !-----------------------------------------------------------------------------
16927 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
16929 use io_base, only:intout,briefout
16930 ! implicit real*8 (a-h,o-z)
16931 ! include 'DIMENSIONS'
16932 ! include 'COMMON.CHAIN'
16933 ! include 'COMMON.DERIV'
16934 ! include 'COMMON.VAR'
16935 ! include 'COMMON.INTERACT'
16936 ! include 'COMMON.FFIELD'
16937 ! include 'COMMON.MD'
16938 ! include 'COMMON.IOUNITS'
16939 real(kind=8),external :: ufparm
16940 integer :: uiparm(1)
16941 real(kind=8) :: urparm(1)
16942 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
16943 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
16944 integer :: n,nf,ind,ind1,i,k,j
16946 ! This subroutine calculates total internal coordinate gradient.
16947 ! Depending on the number of function evaluations, either whole energy
16948 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
16949 ! internal coordinates are reevaluated or only the cartesian-in-internal
16950 ! coordinate derivatives are evaluated. The subroutine was designed to work
16956 !d print *,'grad',nf,icg
16957 if (nf-nfl+1) 20,30,40
16958 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
16959 ! write (iout,*) 'grad 20'
16960 if (nf.eq.0) return
16962 30 call var_to_geom(n,x)
16964 ! write (iout,*) 'grad 30'
16966 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
16969 ! write (iout,*) 'grad 40'
16970 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
16972 ! Convert the Cartesian gradient into internal-coordinate gradient.
16982 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
16984 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
16987 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
16993 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
16995 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
16996 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
16999 if (i.gt.1) g(i-1)=gphii
17000 if (n.gt.nphi) g(nphi+i)=gthetai
17002 if (n.le.nphi+ntheta) goto 10
17004 if (itype(i,1).ne.10) then
17008 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
17011 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
17013 g(ialph(i,1))=galphai
17014 g(ialph(i,1)+nside)=gomegai
17018 ! Add the components corresponding to local energy terms.
17022 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
17023 g(i)=g(i)+gloc(i,icg)
17025 ! Uncomment following three lines for diagnostics.
17027 !elwrite(iout,*) "in gradient after calling intout"
17028 !d call briefout(0,0.0d0)
17029 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
17031 end subroutine gradient
17032 !-----------------------------------------------------------------------------
17033 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
17036 ! implicit real*8 (a-h,o-z)
17037 ! include 'DIMENSIONS'
17038 ! include 'COMMON.DERIV'
17039 ! include 'COMMON.IOUNITS'
17040 ! include 'COMMON.GEO'
17043 !el common /chuju/ jjj
17044 real(kind=8) :: energia(0:n_ene)
17045 integer :: uiparm(1)
17046 real(kind=8) :: urparm(1)
17048 real(kind=8),external :: ufparm
17049 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
17050 ! if (jjj.gt.0) then
17051 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
17055 !d print *,'func',nf,nfl,icg
17056 call var_to_geom(n,x)
17059 !d write (iout,*) 'ETOTAL called from FUNC'
17060 call etotal(energia)
17063 ! if (jjj.gt.0) then
17064 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
17065 ! write (iout,*) 'f=',etot
17069 end subroutine func
17070 !-----------------------------------------------------------------------------
17071 subroutine cartgrad
17072 ! implicit real*8 (a-h,o-z)
17073 ! include 'DIMENSIONS'
17075 use MD_data, only: totT,usampl,eq_time
17079 ! include 'COMMON.CHAIN'
17080 ! include 'COMMON.DERIV'
17081 ! include 'COMMON.VAR'
17082 ! include 'COMMON.INTERACT'
17083 ! include 'COMMON.FFIELD'
17084 ! include 'COMMON.MD'
17085 ! include 'COMMON.IOUNITS'
17086 ! include 'COMMON.TIME1'
17090 ! This subrouting calculates total Cartesian coordinate gradient.
17091 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
17102 !el write (iout,*) "After sum_gradient"
17104 !el write (iout,*) "After sum_gradient"
17106 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
17107 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
17111 ! If performing constraint dynamics, add the gradients of the constraint energy
17112 if(usampl.and.totT.gt.eq_time) then
17115 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
17116 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
17120 gloc(i,icg)=gloc(i,icg)+dugamma(i)
17123 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
17126 !elwrite (iout,*) "After sum_gradient"
17131 !elwrite (iout,*) "After sum_gradient"
17133 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
17135 ! call checkintcartgrad
17136 ! write(iout,*) 'calling int_to_cart'
17139 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
17143 gcart(j,i)=gradc(j,i,icg)
17144 gxcart(j,i)=gradx(j,i,icg)
17145 ! if (i.le.2) print *,"gcart_one",gcart(j,i),gradc(j,i,icg)
17148 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
17149 (gxcart(j,i),j=1,3),gloc(i,icg)
17155 ! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
17157 ! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
17160 time_inttocart=time_inttocart+MPI_Wtime()-time01
17163 write (iout,*) "gcart and gxcart after int_to_cart"
17165 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
17166 (gxcart(j,i),j=1,3)
17172 write (iout,*) "CARGRAD"
17176 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
17177 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
17179 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
17180 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
17182 ! Correction: dummy residues
17185 ! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
17186 gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
17189 if (nct.lt.nres) then
17191 ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
17192 gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
17197 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
17201 end subroutine cartgrad
17202 !-----------------------------------------------------------------------------
17203 subroutine zerograd
17204 ! implicit real*8 (a-h,o-z)
17205 ! include 'DIMENSIONS'
17206 ! include 'COMMON.DERIV'
17207 ! include 'COMMON.CHAIN'
17208 ! include 'COMMON.VAR'
17209 ! include 'COMMON.MD'
17210 ! include 'COMMON.SCCOR'
17212 !el local variables
17213 integer :: i,j,intertyp,k
17214 ! Initialize Cartesian-coordinate gradient
17216 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
17217 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
17219 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
17220 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
17221 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
17222 ! allocate(gradcorr_long(3,nres))
17223 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
17224 ! allocate(gcorr6_turn_long(3,nres))
17225 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
17227 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
17229 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
17230 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
17232 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
17233 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
17235 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
17236 ! allocate(gscloc(3,nres)) !(3,maxres)
17237 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
17241 ! common /deriv_scloc/
17242 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
17243 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
17244 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
17246 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
17250 ! gradc(j,i,icg)=0.0d0
17251 ! gradx(j,i,icg)=0.0d0
17253 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
17254 !elwrite(iout,*) "icg",icg
17258 gradx_scp(j,i)=0.0D0
17260 gvdwc_scp(j,i)=0.0D0
17261 gvdwc_scpp(j,i)=0.0d0
17263 gelc_long(j,i)=0.0D0
17268 gel_loc_long(j,i)=0.0d0
17271 gcorr3_turn(j,i)=0.0d0
17272 gcorr4_turn(j,i)=0.0d0
17273 gradcorr(j,i)=0.0d0
17274 gradcorr_long(j,i)=0.0d0
17275 gradcorr5_long(j,i)=0.0d0
17276 gradcorr6_long(j,i)=0.0d0
17277 gcorr6_turn_long(j,i)=0.0d0
17278 gradcorr5(j,i)=0.0d0
17279 gradcorr6(j,i)=0.0d0
17280 gcorr6_turn(j,i)=0.0d0
17283 gradc(j,i,icg)=0.0d0
17284 gradx(j,i,icg)=0.0d0
17287 gliptran(j,i)=0.0d0
17288 gliptranx(j,i)=0.0d0
17289 gliptranc(j,i)=0.0d0
17290 gshieldx(j,i)=0.0d0
17291 gshieldc(j,i)=0.0d0
17292 gshieldc_loc(j,i)=0.0d0
17293 gshieldx_ec(j,i)=0.0d0
17294 gshieldc_ec(j,i)=0.0d0
17295 gshieldc_loc_ec(j,i)=0.0d0
17296 gshieldx_t3(j,i)=0.0d0
17297 gshieldc_t3(j,i)=0.0d0
17298 gshieldc_loc_t3(j,i)=0.0d0
17299 gshieldx_t4(j,i)=0.0d0
17300 gshieldc_t4(j,i)=0.0d0
17301 gshieldc_loc_t4(j,i)=0.0d0
17302 gshieldx_ll(j,i)=0.0d0
17303 gshieldc_ll(j,i)=0.0d0
17304 gshieldc_loc_ll(j,i)=0.0d0
17306 gg_tube_sc(j,i)=0.0d0
17308 gradb_nucl(j,i)=0.0d0
17309 gradbx_nucl(j,i)=0.0d0
17310 gvdwpp_nucl(j,i)=0.0d0
17314 gvdwpsb1(j,i)=0.0d0
17318 gradcorr_nucl(j,i)=0.0d0
17319 gradcorr3_nucl(j,i)=0.0d0
17320 gradxorr_nucl(j,i)=0.0d0
17321 gradxorr3_nucl(j,i)=0.0d0
17325 gradpepcat(j,i)=0.0d0
17326 gradpepcatx(j,i)=0.0d0
17327 gradcatcat(j,i)=0.0d0
17328 gvdwx_scbase(j,i)=0.0d0
17329 gvdwc_scbase(j,i)=0.0d0
17330 gvdwx_pepbase(j,i)=0.0d0
17331 gvdwc_pepbase(j,i)=0.0d0
17332 gvdwx_scpho(j,i)=0.0d0
17333 gvdwc_scpho(j,i)=0.0d0
17334 gvdwc_peppho(j,i)=0.0d0
17340 gloc_sc(intertyp,i,icg)=0.0d0
17349 grad_shield_side(k,j,i)=0.0d0
17350 grad_shield_loc(k,j,i)=0.0d0
17357 ! Initialize the gradient of local energy terms.
17359 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
17360 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
17361 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
17362 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
17363 ! allocate(gel_loc_turn3(nres))
17364 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
17365 ! allocate(gsccor_loc(nres)) !(maxres)
17371 gel_loc_loc(i)=0.0d0
17373 g_corr5_loc(i)=0.0d0
17374 g_corr6_loc(i)=0.0d0
17375 gel_loc_turn3(i)=0.0d0
17376 gel_loc_turn4(i)=0.0d0
17377 gel_loc_turn6(i)=0.0d0
17378 gsccor_loc(i)=0.0d0
17380 ! initialize gcart and gxcart
17381 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
17389 end subroutine zerograd
17390 !-----------------------------------------------------------------------------
17391 real(kind=8) function fdum()
17395 !-----------------------------------------------------------------------------
17397 !-----------------------------------------------------------------------------
17398 subroutine intcartderiv
17399 ! implicit real*8 (a-h,o-z)
17400 ! include 'DIMENSIONS'
17404 ! include 'COMMON.SETUP'
17405 ! include 'COMMON.CHAIN'
17406 ! include 'COMMON.VAR'
17407 ! include 'COMMON.GEO'
17408 ! include 'COMMON.INTERACT'
17409 ! include 'COMMON.DERIV'
17410 ! include 'COMMON.IOUNITS'
17411 ! include 'COMMON.LOCAL'
17412 ! include 'COMMON.SCCOR'
17413 real(kind=8) :: pi4,pi34
17414 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
17415 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
17416 dcosomega,dsinomega !(3,3,maxres)
17417 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
17420 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
17421 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
17422 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
17423 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
17427 !el from module energy-------------
17428 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
17429 !el allocate(dsintau(3,3,3,itau_start:itau_end))
17430 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
17432 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
17433 !el allocate(dsintau(3,3,3,0:nres2))
17434 !el allocate(dtauangle(3,3,3,0:nres2))
17435 !el allocate(domicron(3,2,2,0:nres2))
17436 !el allocate(dcosomicron(3,2,2,0:nres2))
17440 #if defined(MPI) && defined(PARINTDER)
17441 if (nfgtasks.gt.1 .and. me.eq.king) &
17442 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
17447 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
17448 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
17450 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
17453 dtheta(j,1,i)=0.0d0
17454 dtheta(j,2,i)=0.0d0
17460 ! Derivatives of theta's
17461 #if defined(MPI) && defined(PARINTDER)
17462 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
17463 do i=max0(ithet_start-1,3),ithet_end
17467 cost=dcos(theta(i))
17468 sint=sqrt(1-cost*cost)
17470 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
17472 if (itype(i-1,1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
17473 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
17475 if (itype(i-1,1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
17478 #if defined(MPI) && defined(PARINTDER)
17479 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
17480 do i=max0(ithet_start-1,3),ithet_end
17484 if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1)) then
17485 cost1=dcos(omicron(1,i))
17486 sint1=sqrt(1-cost1*cost1)
17487 cost2=dcos(omicron(2,i))
17488 sint2=sqrt(1-cost2*cost2)
17490 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
17491 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
17492 cost1*dc_norm(j,i-2))/ &
17494 domicron(j,1,1,i)=-1.0/sint1*dcosomicron(j,1,1,i)
17495 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
17496 +cost1*(dc_norm(j,i-1+nres)))/ &
17498 domicron(j,1,2,i)=-1.0/sint1*dcosomicron(j,1,2,i)
17499 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
17500 !C Looks messy but better than if in loop
17501 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
17502 +cost2*dc_norm(j,i-1))/ &
17504 domicron(j,2,1,i)=-1.0/sint2*dcosomicron(j,2,1,i)
17505 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
17506 +cost2*(-dc_norm(j,i-1+nres)))/ &
17508 ! write(iout,*) "vbld", i,itype(i,1),vbld(i-1+nres)
17509 domicron(j,2,2,i)=-1.0/sint2*dcosomicron(j,2,2,i)
17513 !elwrite(iout,*) "after vbld write"
17514 ! Derivatives of phi:
17515 ! If phi is 0 or 180 degrees, then the formulas
17516 ! have to be derived by power series expansion of the
17517 ! conventional formulas around 0 and 180.
17519 do i=iphi1_start,iphi1_end
17523 ! if (itype(i-1,1).eq.21 .or. itype(i-2,1).eq.21 ) cycle
17524 ! the conventional case
17525 sint=dsin(theta(i))
17526 sint1=dsin(theta(i-1))
17528 cost=dcos(theta(i))
17529 cost1=dcos(theta(i-1))
17531 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
17532 fac0=1.0d0/(sint1*sint)
17535 fac3=cosg*cost1/(sint1*sint1)
17536 fac4=cosg*cost/(sint*sint)
17537 ! Obtaining the gamma derivatives from sine derivative
17538 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
17539 phi(i).gt.pi34.and.phi(i).le.pi.or. &
17540 phi(i).ge.-pi.and.phi(i).le.-pi34) then
17541 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
17542 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
17543 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
17547 cosg_inv=1.0d0/cosg
17548 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
17549 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
17550 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
17551 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
17553 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
17554 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17555 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
17556 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
17557 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
17558 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
17559 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
17561 ! Bug fixed 3/24/05 (AL)
17563 ! Obtaining the gamma derivatives from cosine derivative
17566 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
17567 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
17568 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
17569 dc_norm(j,i-3))/vbld(i-2)
17570 dphi(j,1,i)=-1.0/sing*dcosphi(j,1,i)
17571 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
17572 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
17574 dphi(j,2,i)=-1.0/sing*dcosphi(j,2,i)
17575 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
17576 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
17577 dc_norm(j,i-1))/vbld(i)
17578 dphi(j,3,i)=-1.0/sing*dcosphi(j,3,i)
17581 write(iout,*) "just after",dphi(j,3,i),sing,dcosphi(j,3,i)
17588 !alculate derivative of Tauangle
17590 do i=itau_start,itau_end
17593 !elwrite(iout,*) " vecpr",i,nres
17595 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
17596 ! if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10).or.
17597 ! & (itype(i-1,1).eq.ntyp1).or.(itype(i,1).eq.ntyp1)) cycle
17598 !c dtauangle(j,intertyp,dervityp,residue number)
17599 !c INTERTYP=1 SC...Ca...Ca..Ca
17600 ! the conventional case
17601 sint=dsin(theta(i))
17602 sint1=dsin(omicron(2,i-1))
17603 sing=dsin(tauangle(1,i))
17604 cost=dcos(theta(i))
17605 cost1=dcos(omicron(2,i-1))
17606 cosg=dcos(tauangle(1,i))
17607 !elwrite(iout,*) " vecpr5",i,nres
17609 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
17610 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
17611 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
17612 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
17614 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
17615 fac0=1.0d0/(sint1*sint)
17618 fac3=cosg*cost1/(sint1*sint1)
17619 fac4=cosg*cost/(sint*sint)
17620 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
17621 ! Obtaining the gamma derivatives from sine derivative
17622 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
17623 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
17624 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
17625 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
17626 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
17627 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
17631 cosg_inv=1.0d0/cosg
17632 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
17633 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
17634 *vbld_inv(i-2+nres)
17635 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
17636 dsintau(j,1,2,i)= &
17637 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
17638 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17639 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
17640 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
17641 ! Bug fixed 3/24/05 (AL)
17642 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
17643 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
17644 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
17645 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
17647 ! Obtaining the gamma derivatives from cosine derivative
17650 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
17651 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
17652 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
17653 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
17654 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
17655 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
17657 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
17658 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
17659 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
17660 dc_norm(j,i-1))/vbld(i)
17661 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
17662 ! write (iout,*) "else",i
17666 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
17669 !C Second case Ca...Ca...Ca...SC
17671 do i=itau_start,itau_end
17675 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
17676 (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle
17677 ! the conventional case
17678 sint=dsin(omicron(1,i))
17679 sint1=dsin(theta(i-1))
17680 sing=dsin(tauangle(2,i))
17681 cost=dcos(omicron(1,i))
17682 cost1=dcos(theta(i-1))
17683 cosg=dcos(tauangle(2,i))
17685 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
17687 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
17688 fac0=1.0d0/(sint1*sint)
17691 fac3=cosg*cost1/(sint1*sint1)
17692 fac4=cosg*cost/(sint*sint)
17693 ! Obtaining the gamma derivatives from sine derivative
17694 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
17695 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
17696 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
17697 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
17698 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
17699 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
17703 cosg_inv=1.0d0/cosg
17704 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
17705 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
17706 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
17707 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
17708 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
17709 dsintau(j,2,2,i)= &
17710 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
17711 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17712 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
17713 ! & sing*ctgt*domicron(j,1,2,i),
17714 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17715 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
17716 ! Bug fixed 3/24/05 (AL)
17717 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
17718 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
17719 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
17720 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
17722 ! Obtaining the gamma derivatives from cosine derivative
17725 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
17726 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
17727 dc_norm(j,i-3))/vbld(i-2)
17728 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
17729 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
17730 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
17731 dcosomicron(j,1,1,i)
17732 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
17733 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
17734 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
17735 dc_norm(j,i-1+nres))/vbld(i-1+nres)
17736 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
17737 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
17742 !CC third case SC...Ca...Ca...SC
17745 do i=itau_start,itau_end
17749 ! the conventional case
17750 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
17751 (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
17752 sint=dsin(omicron(1,i))
17753 sint1=dsin(omicron(2,i-1))
17754 sing=dsin(tauangle(3,i))
17755 cost=dcos(omicron(1,i))
17756 cost1=dcos(omicron(2,i-1))
17757 cosg=dcos(tauangle(3,i))
17759 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
17760 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
17762 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
17763 fac0=1.0d0/(sint1*sint)
17766 fac3=cosg*cost1/(sint1*sint1)
17767 fac4=cosg*cost/(sint*sint)
17768 ! Obtaining the gamma derivatives from sine derivative
17769 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
17770 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
17771 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
17772 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
17773 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
17774 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
17778 cosg_inv=1.0d0/cosg
17779 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
17780 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
17781 *vbld_inv(i-2+nres)
17782 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
17783 dsintau(j,3,2,i)= &
17784 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
17785 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17786 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
17787 ! Bug fixed 3/24/05 (AL)
17788 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
17789 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
17790 *vbld_inv(i-1+nres)
17791 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
17792 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
17794 ! Obtaining the gamma derivatives from cosine derivative
17797 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
17798 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
17799 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
17800 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
17801 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
17802 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
17803 dcosomicron(j,1,1,i)
17804 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
17805 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
17806 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
17807 dc_norm(j,i-1+nres))/vbld(i-1+nres)
17808 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
17809 ! write(iout,*) "else",i
17815 ! Derivatives of side-chain angles alpha and omega
17816 #if defined(MPI) && defined(PARINTDER)
17817 do i=ibond_start,ibond_end
17821 if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
17822 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
17825 fac8=fac5/vbld(i+1)
17826 fac9=fac5/vbld(i+nres)
17827 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
17828 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
17829 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
17830 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
17831 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
17832 sina=sqrt(1-cosa*cosa)
17834 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
17836 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
17837 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
17838 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
17839 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
17840 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
17841 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
17842 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
17843 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
17845 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
17847 ! obtaining the derivatives of omega from sines
17848 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
17849 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
17850 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
17851 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
17853 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
17854 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
17855 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
17856 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
17857 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
17858 coso_inv=1.0d0/dcos(omeg(i))
17860 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
17861 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
17862 (sino*dc_norm(j,i-1))/vbld(i)
17863 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
17864 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
17865 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
17866 -sino*dc_norm(j,i)/vbld(i+1)
17867 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
17868 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
17869 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
17871 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
17874 ! obtaining the derivatives of omega from cosines
17875 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
17876 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
17881 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
17882 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
17883 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
17884 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
17885 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
17886 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
17887 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
17888 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
17889 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
17890 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
17891 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
17892 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
17893 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
17894 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
17895 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
17901 dalpha(k,j,i)=0.0d0
17902 domega(k,j,i)=0.0d0
17908 #if defined(MPI) && defined(PARINTDER)
17909 if (nfgtasks.gt.1) then
17911 !d write (iout,*) "Gather dtheta"
17912 !d call flush(iout)
17913 write (iout,*) "dtheta before gather"
17915 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
17918 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
17919 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
17920 king,FG_COMM,IERROR)
17923 !d write (iout,*) "Gather dphi"
17924 !d call flush(iout)
17925 write (iout,*) "dphi before gather"
17927 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
17931 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
17932 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
17933 king,FG_COMM,IERROR)
17934 !d write (iout,*) "Gather dalpha"
17935 !d call flush(iout)
17937 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
17938 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
17939 king,FG_COMM,IERROR)
17940 !d write (iout,*) "Gather domega"
17941 !d call flush(iout)
17942 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
17943 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
17944 king,FG_COMM,IERROR)
17950 write (iout,*) "dtheta after gather"
17952 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
17954 write (iout,*) "dphi after gather"
17956 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
17958 write (iout,*) "dalpha after gather"
17960 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
17962 write (iout,*) "domega after gather"
17964 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
17969 end subroutine intcartderiv
17970 !-----------------------------------------------------------------------------
17971 subroutine checkintcartgrad
17972 ! implicit real*8 (a-h,o-z)
17973 ! include 'DIMENSIONS'
17977 ! include 'COMMON.CHAIN'
17978 ! include 'COMMON.VAR'
17979 ! include 'COMMON.GEO'
17980 ! include 'COMMON.INTERACT'
17981 ! include 'COMMON.DERIV'
17982 ! include 'COMMON.IOUNITS'
17983 ! include 'COMMON.SETUP'
17984 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
17985 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
17986 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
17987 real(kind=8),dimension(3) :: dc_norm_s
17988 real(kind=8) :: aincr=1.0d-5
17990 real(kind=8) :: dcji
17993 theta_s(i)=theta(i)
17997 ! Check theta gradient
17999 "Analytical (upper) and numerical (lower) gradient of theta"
18004 dc(j,i-2)=dcji+aincr
18005 call chainbuild_cart
18006 call int_from_cart1(.false.)
18007 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
18010 dc(j,i-1)=dc(j,i-1)+aincr
18011 call chainbuild_cart
18012 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
18015 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
18016 !el (dtheta(j,2,i),j=1,3)
18017 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
18018 !el (dthetanum(j,2,i),j=1,3)
18019 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
18020 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
18021 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
18024 ! Check gamma gradient
18026 "Analytical (upper) and numerical (lower) gradient of gamma"
18030 dc(j,i-3)=dcji+aincr
18031 call chainbuild_cart
18032 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
18035 dc(j,i-2)=dcji+aincr
18036 call chainbuild_cart
18037 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
18040 dc(j,i-1)=dc(j,i-1)+aincr
18041 call chainbuild_cart
18042 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
18045 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
18046 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
18047 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
18048 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
18049 !el write (iout,'(5x,3(3f10.5,5x))') &
18050 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
18051 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
18052 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
18055 ! Check alpha gradient
18057 "Analytical (upper) and numerical (lower) gradient of alpha"
18059 if(itype(i,1).ne.10) then
18062 dc(j,i-1)=dcji+aincr
18063 call chainbuild_cart
18064 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
18069 call chainbuild_cart
18070 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
18074 dc(j,i+nres)=dc(j,i+nres)+aincr
18075 call chainbuild_cart
18076 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
18081 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
18082 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
18083 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
18084 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
18085 !el write (iout,'(5x,3(3f10.5,5x))') &
18086 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
18087 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
18088 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
18091 ! Check omega gradient
18093 "Analytical (upper) and numerical (lower) gradient of omega"
18095 if(itype(i,1).ne.10) then
18098 dc(j,i-1)=dcji+aincr
18099 call chainbuild_cart
18100 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
18105 call chainbuild_cart
18106 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
18110 dc(j,i+nres)=dc(j,i+nres)+aincr
18111 call chainbuild_cart
18112 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
18117 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
18118 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
18119 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
18120 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
18121 !el write (iout,'(5x,3(3f10.5,5x))') &
18122 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
18123 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
18124 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
18128 end subroutine checkintcartgrad
18129 !-----------------------------------------------------------------------------
18131 !-----------------------------------------------------------------------------
18132 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
18133 ! implicit real*8 (a-h,o-z)
18134 ! include 'DIMENSIONS'
18135 ! include 'COMMON.IOUNITS'
18136 ! include 'COMMON.CHAIN'
18137 ! include 'COMMON.INTERACT'
18138 ! include 'COMMON.VAR'
18139 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
18140 integer :: kkk,nsep=3
18141 real(kind=8) :: qm !dist,
18142 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
18143 logical :: lprn=.false.
18145 ! real(kind=8) :: sigm,x
18147 !el sigm(x)=0.25d0*x ! local function
18153 do il=seg1+nsep,seg2
18156 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
18157 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
18158 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
18160 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
18161 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
18164 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
18165 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
18166 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
18167 dijCM=dist(il+nres,jl+nres)
18168 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
18170 qq = qq+qqij+qqijCM
18176 if((seg3-il).lt.3) then
18183 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
18184 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
18185 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
18187 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
18188 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
18191 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
18192 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
18193 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
18194 dijCM=dist(il+nres,jl+nres)
18195 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
18197 qq = qq+qqij+qqijCM
18202 if (qqmax.le.qq) qqmax=qq
18204 qwolynes=1.0d0-qqmax
18206 end function qwolynes
18207 !-----------------------------------------------------------------------------
18208 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
18209 ! implicit real*8 (a-h,o-z)
18210 ! include 'DIMENSIONS'
18211 ! include 'COMMON.IOUNITS'
18212 ! include 'COMMON.CHAIN'
18213 ! include 'COMMON.INTERACT'
18214 ! include 'COMMON.VAR'
18215 ! include 'COMMON.MD'
18216 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
18217 integer :: nsep=3, kkk
18218 !el real(kind=8) :: dist
18219 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
18220 logical :: lprn=.false.
18222 real(kind=8) :: sim,dd0,fac,ddqij
18223 !el sigm(x)=0.25d0*x ! local function
18233 do il=seg1+nsep,seg2
18236 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
18237 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
18238 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
18240 sim = 1.0d0/sigm(d0ij)
18243 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
18245 ddqij = (c(k,il)-c(k,jl))*fac
18246 dqwol(k,il)=dqwol(k,il)+ddqij
18247 dqwol(k,jl)=dqwol(k,jl)-ddqij
18250 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
18253 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
18254 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
18255 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
18256 dijCM=dist(il+nres,jl+nres)
18257 sim = 1.0d0/sigm(d0ijCM)
18260 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
18262 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
18263 dxqwol(k,il)=dxqwol(k,il)+ddqij
18264 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
18271 if((seg3-il).lt.3) then
18278 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
18279 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
18280 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
18282 sim = 1.0d0/sigm(d0ij)
18285 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
18287 ddqij = (c(k,il)-c(k,jl))*fac
18288 dqwol(k,il)=dqwol(k,il)+ddqij
18289 dqwol(k,jl)=dqwol(k,jl)-ddqij
18291 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
18294 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
18295 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
18296 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
18297 dijCM=dist(il+nres,jl+nres)
18298 sim = 1.0d0/sigm(d0ijCM)
18301 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
18303 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
18304 dxqwol(k,il)=dxqwol(k,il)+ddqij
18305 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
18314 dqwol(j,i)=dqwol(j,i)/nl
18315 dxqwol(j,i)=dxqwol(j,i)/nl
18319 end subroutine qwolynes_prim
18320 !-----------------------------------------------------------------------------
18321 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
18322 ! implicit real*8 (a-h,o-z)
18323 ! include 'DIMENSIONS'
18324 ! include 'COMMON.IOUNITS'
18325 ! include 'COMMON.CHAIN'
18326 ! include 'COMMON.INTERACT'
18327 ! include 'COMMON.VAR'
18328 integer :: seg1,seg2,seg3,seg4
18330 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
18331 real(kind=8),dimension(3,0:2*nres) :: cdummy
18332 real(kind=8) :: q1,q2
18333 real(kind=8) :: delta=1.0d-10
18338 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
18340 c(j,i)=c(j,i)+delta
18341 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
18342 qwolan(j,i)=(q2-q1)/delta
18348 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
18349 cdummy(j,i+nres)=c(j,i+nres)
18350 c(j,i+nres)=c(j,i+nres)+delta
18351 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
18352 qwolxan(j,i)=(q2-q1)/delta
18353 c(j,i+nres)=cdummy(j,i+nres)
18356 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
18358 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
18360 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
18362 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
18365 end subroutine qwol_num
18366 !-----------------------------------------------------------------------------
18367 subroutine EconstrQ
18368 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
18369 ! implicit real*8 (a-h,o-z)
18370 ! include 'DIMENSIONS'
18371 ! include 'COMMON.CONTROL'
18372 ! include 'COMMON.VAR'
18373 ! include 'COMMON.MD'
18376 ! include 'COMMON.LANGEVIN'
18378 ! include 'COMMON.LANGEVIN.lang0'
18380 ! include 'COMMON.CHAIN'
18381 ! include 'COMMON.DERIV'
18382 ! include 'COMMON.GEO'
18383 ! include 'COMMON.LOCAL'
18384 ! include 'COMMON.INTERACT'
18385 ! include 'COMMON.IOUNITS'
18386 ! include 'COMMON.NAMES'
18387 ! include 'COMMON.TIME1'
18388 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
18389 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
18391 integer :: kstart,kend,lstart,lend,idummy
18392 real(kind=8) :: delta=1.0d-7
18393 integer :: i,j,k,ii
18397 dudconst(j,i)=0.0d0
18398 duxconst(j,i)=0.0d0
18399 dudxconst(j,i)=0.0d0
18404 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
18406 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
18407 ! Calculating the derivatives of Constraint energy with respect to Q
18408 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
18410 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
18411 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
18412 ! hmnum=(hm2-hm1)/delta
18413 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
18414 ! & qinfrag(i,iset))
18415 ! write(iout,*) "harmonicnum frag", hmnum
18416 ! Calculating the derivatives of Q with respect to cartesian coordinates
18417 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
18419 ! write(iout,*) "dqwol "
18421 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
18423 ! write(iout,*) "dxqwol "
18425 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
18427 ! Calculating numerical gradients of dU/dQi and dQi/dxi
18428 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
18429 ! & ,idummy,idummy)
18430 ! The gradients of Uconst in Cs
18433 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
18434 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
18439 kstart=ifrag(1,ipair(1,i,iset),iset)
18440 kend=ifrag(2,ipair(1,i,iset),iset)
18441 lstart=ifrag(1,ipair(2,i,iset),iset)
18442 lend=ifrag(2,ipair(2,i,iset),iset)
18443 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
18444 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
18445 ! Calculating dU/dQ
18446 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
18447 ! hm1=harmonic(qpair(i),qinpair(i,iset))
18448 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
18449 ! hmnum=(hm2-hm1)/delta
18450 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
18451 ! & qinpair(i,iset))
18452 ! write(iout,*) "harmonicnum pair ", hmnum
18453 ! Calculating dQ/dXi
18454 call qwolynes_prim(kstart,kend,.false.,&
18456 ! write(iout,*) "dqwol "
18458 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
18460 ! write(iout,*) "dxqwol "
18462 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
18464 ! Calculating numerical gradients
18465 ! call qwol_num(kstart,kend,.false.
18467 ! The gradients of Uconst in Cs
18470 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
18471 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
18475 ! write(iout,*) "Uconst inside subroutine ", Uconst
18476 ! Transforming the gradients from Cs to dCs for the backbone
18480 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
18484 ! Transforming the gradients from Cs to dCs for the side chains
18487 dudxconst(j,i)=duxconst(j,i)
18490 ! write(iout,*) "dU/ddc backbone "
18492 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
18494 ! write(iout,*) "dU/ddX side chain "
18496 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
18498 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
18499 ! call dEconstrQ_num
18501 end subroutine EconstrQ
18502 !-----------------------------------------------------------------------------
18503 subroutine dEconstrQ_num
18504 ! Calculating numerical dUconst/ddc and dUconst/ddx
18505 ! implicit real*8 (a-h,o-z)
18506 ! include 'DIMENSIONS'
18507 ! include 'COMMON.CONTROL'
18508 ! include 'COMMON.VAR'
18509 ! include 'COMMON.MD'
18512 ! include 'COMMON.LANGEVIN'
18514 ! include 'COMMON.LANGEVIN.lang0'
18516 ! include 'COMMON.CHAIN'
18517 ! include 'COMMON.DERIV'
18518 ! include 'COMMON.GEO'
18519 ! include 'COMMON.LOCAL'
18520 ! include 'COMMON.INTERACT'
18521 ! include 'COMMON.IOUNITS'
18522 ! include 'COMMON.NAMES'
18523 ! include 'COMMON.TIME1'
18524 real(kind=8) :: uzap1,uzap2
18525 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
18526 integer :: kstart,kend,lstart,lend,idummy
18527 real(kind=8) :: delta=1.0d-7
18528 !el local variables
18534 dUcartan(j,i)=0.0d0
18535 cdummy(j,i)=dc(j,i)
18536 dc(j,i)=dc(j,i)+delta
18537 call chainbuild_cart
18540 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
18542 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
18546 kstart=ifrag(1,ipair(1,ii,iset),iset)
18547 kend=ifrag(2,ipair(1,ii,iset),iset)
18548 lstart=ifrag(1,ipair(2,ii,iset),iset)
18549 lend=ifrag(2,ipair(2,ii,iset),iset)
18550 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
18551 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
18554 dc(j,i)=cdummy(j,i)
18555 call chainbuild_cart
18558 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
18560 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
18564 kstart=ifrag(1,ipair(1,ii,iset),iset)
18565 kend=ifrag(2,ipair(1,ii,iset),iset)
18566 lstart=ifrag(1,ipair(2,ii,iset),iset)
18567 lend=ifrag(2,ipair(2,ii,iset),iset)
18568 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
18569 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
18572 ducartan(j,i)=(uzap2-uzap1)/(delta)
18575 ! Calculating numerical gradients for dU/ddx
18577 duxcartan(j,i)=0.0d0
18579 cdummy(j,i)=dc(j,i+nres)
18580 dc(j,i+nres)=dc(j,i+nres)+delta
18581 call chainbuild_cart
18584 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
18586 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
18590 kstart=ifrag(1,ipair(1,ii,iset),iset)
18591 kend=ifrag(2,ipair(1,ii,iset),iset)
18592 lstart=ifrag(1,ipair(2,ii,iset),iset)
18593 lend=ifrag(2,ipair(2,ii,iset),iset)
18594 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
18595 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
18598 dc(j,i+nres)=cdummy(j,i)
18599 call chainbuild_cart
18602 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
18603 ifrag(2,ii,iset),.true.,idummy,idummy)
18604 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
18608 kstart=ifrag(1,ipair(1,ii,iset),iset)
18609 kend=ifrag(2,ipair(1,ii,iset),iset)
18610 lstart=ifrag(1,ipair(2,ii,iset),iset)
18611 lend=ifrag(2,ipair(2,ii,iset),iset)
18612 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
18613 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
18616 duxcartan(j,i)=(uzap2-uzap1)/(delta)
18619 write(iout,*) "Numerical dUconst/ddc backbone "
18621 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
18623 ! write(iout,*) "Numerical dUconst/ddx side-chain "
18625 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
18628 end subroutine dEconstrQ_num
18629 !-----------------------------------------------------------------------------
18631 !-----------------------------------------------------------------------------
18632 subroutine check_energies
18634 ! use random, only: ran_number
18638 ! include 'DIMENSIONS'
18639 ! include 'COMMON.CHAIN'
18640 ! include 'COMMON.VAR'
18641 ! include 'COMMON.IOUNITS'
18642 ! include 'COMMON.SBRIDGE'
18643 ! include 'COMMON.LOCAL'
18644 ! include 'COMMON.GEO'
18646 ! External functions
18647 !EL double precision ran_number
18648 !EL external ran_number
18651 integer :: i,j,k,l,lmax,p,pmax
18652 real(kind=8) :: rmin,rmax
18653 real(kind=8) :: eij
18656 real(kind=8) :: wi,rij,tj,pj
18678 !t wi=ran_number(0.0D0,pi)
18679 ! wi=ran_number(0.0D0,pi/6.0D0)
18681 !t tj=ran_number(0.0D0,pi)
18682 !t pj=ran_number(0.0D0,pi)
18683 ! pj=ran_number(0.0D0,pi/6.0D0)
18687 !t rij=ran_number(rmin,rmax)
18689 c(1,j)=d*sin(pj)*cos(tj)
18690 c(2,j)=d*sin(pj)*sin(tj)
18696 c(3,i)=-rij-d*cos(wi)
18699 dc(k,nres+i)=c(k,nres+i)-c(k,i)
18700 dc_norm(k,nres+i)=dc(k,nres+i)/d
18701 dc(k,nres+j)=c(k,nres+j)-c(k,j)
18702 dc_norm(k,nres+j)=dc(k,nres+j)/d
18705 call dyn_ssbond_ene(i,j,eij)
18710 end subroutine check_energies
18711 !-----------------------------------------------------------------------------
18712 subroutine dyn_ssbond_ene(resi,resj,eij)
18717 ! include 'DIMENSIONS'
18718 ! include 'COMMON.SBRIDGE'
18719 ! include 'COMMON.CHAIN'
18720 ! include 'COMMON.DERIV'
18721 ! include 'COMMON.LOCAL'
18722 ! include 'COMMON.INTERACT'
18723 ! include 'COMMON.VAR'
18724 ! include 'COMMON.IOUNITS'
18725 ! include 'COMMON.CALC'
18729 ! include 'COMMON.MD'
18730 ! use MD, only: totT,t_bath
18733 ! External functions
18734 !EL double precision h_base
18735 !EL external h_base
18738 integer :: resi,resj
18741 real(kind=8) :: eij
18744 logical :: havebond
18745 integer itypi,itypj
18746 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
18747 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
18748 real(kind=8),dimension(3) :: dcosom1,dcosom2
18750 real(kind=8) :: pom1,pom2
18751 real(kind=8) :: ljA,ljB,ljXs
18752 real(kind=8),dimension(1:3) :: d_ljB
18753 real(kind=8) :: ssA,ssB,ssC,ssXs
18754 real(kind=8) :: ssxm,ljxm,ssm,ljm
18755 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
18756 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
18757 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
18758 !-------FIRST METHOD
18760 real(kind=8),dimension(1:3) :: d_xm
18761 !-------END FIRST METHOD
18762 !-------SECOND METHOD
18763 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
18764 !-------END SECOND METHOD
18766 !-------TESTING CODE
18767 !el logical :: checkstop,transgrad
18768 !el common /sschecks/ checkstop,transgrad
18770 integer :: icheck,nicheck,jcheck,njcheck
18771 real(kind=8),dimension(-1:1) :: echeck
18772 real(kind=8) :: deps,ssx0,ljx0
18773 !-------END TESTING CODE
18779 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
18780 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
18783 dxi=dc_norm(1,nres+i)
18784 dyi=dc_norm(2,nres+i)
18785 dzi=dc_norm(3,nres+i)
18786 dsci_inv=vbld_inv(i+nres)
18789 xj=c(1,nres+j)-c(1,nres+i)
18790 yj=c(2,nres+j)-c(2,nres+i)
18791 zj=c(3,nres+j)-c(3,nres+i)
18792 dxj=dc_norm(1,nres+j)
18793 dyj=dc_norm(2,nres+j)
18794 dzj=dc_norm(3,nres+j)
18795 dscj_inv=vbld_inv(j+nres)
18797 chi1=chi(itypi,itypj)
18798 chi2=chi(itypj,itypi)
18805 alf12=0.5D0*(alf1+alf2)
18807 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
18808 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
18809 ! The following are set in sc_angular
18813 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
18814 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
18815 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
18817 rij=1.0D0/rij ! Reset this so it makes sense
18819 sig0ij=sigma(itypi,itypj)
18820 sig=sig0ij*dsqrt(1.0D0/sigsq)
18823 ljA=eps1*eps2rt**2*eps3rt**2
18824 ljB=ljA*bb_aq(itypi,itypj)
18825 ljA=ljA*aa_aq(itypi,itypj)
18826 ljxm=ljXs+(-2.0D0*aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
18831 deltat12=om2-om1+2.0d0
18832 cosphi=om12-om1*om2
18836 +akth*(deltat1*deltat1+deltat2*deltat2) &
18837 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
18838 ssxm=ssXs-0.5D0*ssB/ssA
18840 !-------TESTING CODE
18841 !$$$c Some extra output
18842 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
18843 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
18844 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
18845 !$$$ if (ssx0.gt.0.0d0) then
18846 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
18850 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
18851 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
18852 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
18854 !-------END TESTING CODE
18856 !-------TESTING CODE
18857 ! Stop and plot energy and derivative as a function of distance
18858 if (checkstop) then
18859 ssm=ssC-0.25D0*ssB*ssB/ssA
18860 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
18861 if (ssm.lt.ljm .and. &
18862 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
18870 if (.not.checkstop) then
18875 do icheck=0,nicheck
18876 do jcheck=-1,njcheck
18877 if (checkstop) rij=(ssxm-1.0d0)+ &
18878 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
18879 !-------END TESTING CODE
18881 if (rij.gt.ljxm) then
18884 fac=(1.0D0/ljd)**expon
18885 e1=fac*fac*aa_aq(itypi,itypj)
18886 e2=fac*bb_aq(itypi,itypj)
18887 eij=eps1*eps2rt*eps3rt*(e1+e2)
18890 eij=eij*eps2rt*eps3rt
18893 e1=e1*eps1*eps2rt**2*eps3rt**2
18894 ed=-expon*(e1+eij)/ljd
18896 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
18897 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
18898 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
18899 -2.0D0*alf12*eps3der+sigder*sigsq_om12
18900 else if (rij.lt.ssxm) then
18903 eij=ssA*ssd*ssd+ssB*ssd+ssC
18905 ed=2*akcm*ssd+akct*deltat12
18907 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
18908 eom1=-2*akth*deltat1-pom1-om2*pom2
18909 eom2= 2*akth*deltat2+pom1-om1*pom2
18912 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
18914 d_ssxm(1)=0.5D0*akct/ssA
18915 d_ssxm(2)=-d_ssxm(1)
18918 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
18919 d_ljxm(2)=d_ljxm(1)*sigsq_om2
18920 d_ljxm(3)=d_ljxm(1)*sigsq_om12
18921 d_ljxm(1)=d_ljxm(1)*sigsq_om1
18923 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
18924 xm=0.5d0*(ssxm+ljxm)
18926 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
18928 if (rij.lt.xm) then
18930 ssm=ssC-0.25D0*ssB*ssB/ssA
18931 d_ssm(1)=0.5D0*akct*ssB/ssA
18932 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
18933 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
18935 f1=(rij-xm)/(ssxm-xm)
18936 f2=(rij-ssxm)/(xm-ssxm)
18940 delta_inv=1.0d0/(xm-ssxm)
18941 deltasq_inv=delta_inv*delta_inv
18943 fac1=deltasq_inv*fac*(xm-rij)
18944 fac2=deltasq_inv*fac*(rij-ssxm)
18945 ed=delta_inv*(Ht*hd2-ssm*hd1)
18946 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
18947 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
18948 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
18951 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
18952 d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
18953 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
18954 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
18956 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
18957 f1=(rij-ljxm)/(xm-ljxm)
18958 f2=(rij-xm)/(ljxm-xm)
18962 delta_inv=1.0d0/(ljxm-xm)
18963 deltasq_inv=delta_inv*delta_inv
18965 fac1=deltasq_inv*fac*(ljxm-rij)
18966 fac2=deltasq_inv*fac*(rij-xm)
18967 ed=delta_inv*(ljm*hd2-Ht*hd1)
18968 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
18969 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
18970 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
18972 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
18974 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
18980 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
18981 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
18982 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
18984 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
18985 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
18986 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
18987 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
18988 !$$$ d_ssm(3)=omega
18990 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
18992 !$$$ d_ljm(k)=ljm*d_ljB(k)
18996 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
18997 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
18998 !$$$ d_ss(2)=akct*ssd
18999 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
19000 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
19003 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
19004 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
19005 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
19007 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
19008 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
19010 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
19012 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
19013 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
19014 !$$$ h1=h_base(f1,hd1)
19015 !$$$ h2=h_base(f2,hd2)
19016 !$$$ eij=ss*h1+ljf*h2
19017 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
19018 !$$$ deltasq_inv=delta_inv*delta_inv
19019 !$$$ fac=ljf*hd2-ss*hd1
19020 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
19021 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
19022 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
19023 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
19024 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
19025 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
19026 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
19028 !$$$ havebond=.false.
19029 !$$$ if (ed.gt.0.0d0) havebond=.true.
19030 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
19037 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
19038 ! write(iout,'(a15,f12.2,f8.1,2i5)')
19039 ! & "SSBOND_E_FORM",totT,t_bath,i,j
19043 dyn_ssbond_ij(i,j)=eij
19044 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
19045 dyn_ssbond_ij(i,j)=1.0d300
19048 ! write(iout,'(a15,f12.2,f8.1,2i5)')
19049 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
19054 !-------TESTING CODE
19055 !el if (checkstop) then
19056 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
19057 "CHECKSTOP",rij,eij,ed
19061 if (checkstop) then
19062 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
19065 if (checkstop) then
19069 !-------END TESTING CODE
19072 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
19073 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
19076 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
19079 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
19080 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
19081 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
19082 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
19083 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
19084 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
19088 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
19093 gvdwc(l,i)=gvdwc(l,i)-gg(l)
19094 gvdwc(l,j)=gvdwc(l,j)+gg(l)
19098 end subroutine dyn_ssbond_ene
19099 !--------------------------------------------------------------------------
19100 subroutine triple_ssbond_ene(resi,resj,resk,eij)
19105 ! include 'DIMENSIONS'
19106 ! include 'COMMON.SBRIDGE'
19107 ! include 'COMMON.CHAIN'
19108 ! include 'COMMON.DERIV'
19109 ! include 'COMMON.LOCAL'
19110 ! include 'COMMON.INTERACT'
19111 ! include 'COMMON.VAR'
19112 ! include 'COMMON.IOUNITS'
19113 ! include 'COMMON.CALC'
19117 ! include 'COMMON.MD'
19118 ! use MD, only: totT,t_bath
19121 double precision h_base
19125 integer resi,resj,resk,m,itypi,itypj,itypk
19127 !c Output arguments
19128 double precision eij,eij1,eij2,eij3
19132 !c integer itypi,itypj,k,l
19133 double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi
19134 double precision rrik,rrjk,rik,rjk,xi,xk,yi,yk,zi,zk,xij,yij,zij
19135 double precision xik,yik,zik,xjk,yjk,zjk,dxk,dyk,dzk
19136 double precision sig0ij,ljd,sig,fac,e1,e2
19137 double precision dcosom1(3),dcosom2(3),ed
19138 double precision pom1,pom2
19139 double precision ljA,ljB,ljXs
19140 double precision d_ljB(1:3)
19141 double precision ssA,ssB,ssC,ssXs
19142 double precision ssxm,ljxm,ssm,ljm
19143 double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3)
19145 if (dtriss.eq.0) return
19149 !C write(iout,*) resi,resj,resk
19151 dxi=dc_norm(1,nres+i)
19152 dyi=dc_norm(2,nres+i)
19153 dzi=dc_norm(3,nres+i)
19154 dsci_inv=vbld_inv(i+nres)
19163 dxj=dc_norm(1,nres+j)
19164 dyj=dc_norm(2,nres+j)
19165 dzj=dc_norm(3,nres+j)
19166 dscj_inv=vbld_inv(j+nres)
19172 dxk=dc_norm(1,nres+k)
19173 dyk=dc_norm(2,nres+k)
19174 dzk=dc_norm(3,nres+k)
19175 dscj_inv=vbld_inv(k+nres)
19185 rrij=(xij*xij+yij*yij+zij*zij)
19186 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
19187 rrik=(xik*xik+yik*yik+zik*zik)
19189 rrjk=(xjk*xjk+yjk*yjk+zjk*zjk)
19191 !C there are three combination of distances for each trisulfide bonds
19192 !C The first case the ith atom is the center
19193 !C Energy function is E=d/(a*(x-y)**2+b*(x+y)**2+c) where x is first
19194 !C distance y is second distance the a,b,c,d are parameters derived for
19195 !C this problem d parameter was set as a penalty currenlty set to 1.
19196 if ((iabs(j-i).le.2).or.(iabs(i-k).le.2)) then
19199 eij1=dtriss/(atriss*(rij-rik)**2+btriss*(rij+rik)**6+ctriss)
19201 !C second case jth atom is center
19202 if ((iabs(j-i).le.2).or.(iabs(j-k).le.2)) then
19205 eij2=dtriss/(atriss*(rij-rjk)**2+btriss*(rij+rjk)**6+ctriss)
19207 !C the third case kth atom is the center
19208 if ((iabs(i-k).le.2).or.(iabs(j-k).le.2)) then
19211 eij3=dtriss/(atriss*(rik-rjk)**2+btriss*(rik+rjk)**6+ctriss)
19217 !C write(iout,*)i,j,k,eij
19218 !C The energy penalty calculated now time for the gradient part
19219 !C derivative over rij
19220 fac=-eij1**2/dtriss*(2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
19221 -eij2**2/dtriss*(2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)
19226 gvdwx(m,i)=gvdwx(m,i)-gg(m)
19227 gvdwx(m,j)=gvdwx(m,j)+gg(m)
19231 gvdwc(l,i)=gvdwc(l,i)-gg(l)
19232 gvdwc(l,j)=gvdwc(l,j)+gg(l)
19234 !C now derivative over rik
19235 fac=-eij1**2/dtriss* &
19236 (-2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
19237 -eij3**2/dtriss*(2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
19242 gvdwx(m,i)=gvdwx(m,i)-gg(m)
19243 gvdwx(m,k)=gvdwx(m,k)+gg(m)
19246 gvdwc(l,i)=gvdwc(l,i)-gg(l)
19247 gvdwc(l,k)=gvdwc(l,k)+gg(l)
19249 !C now derivative over rjk
19250 fac=-eij2**2/dtriss* &
19251 (-2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)- &
19252 eij3**2/dtriss*(-2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
19257 gvdwx(m,j)=gvdwx(m,j)-gg(m)
19258 gvdwx(m,k)=gvdwx(m,k)+gg(m)
19261 gvdwc(l,j)=gvdwc(l,j)-gg(l)
19262 gvdwc(l,k)=gvdwc(l,k)+gg(l)
19265 end subroutine triple_ssbond_ene
19269 !-----------------------------------------------------------------------------
19270 real(kind=8) function h_base(x,deriv)
19271 ! A smooth function going 0->1 in range [0,1]
19272 ! It should NOT be called outside range [0,1], it will not work there.
19279 real(kind=8) :: deriv
19282 real(kind=8) :: xsq
19285 ! Two parabolas put together. First derivative zero at extrema
19286 !$$$ if (x.lt.0.5D0) then
19287 !$$$ h_base=2.0D0*x*x
19291 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
19292 !$$$ deriv=4.0D0*deriv
19295 ! Third degree polynomial. First derivative zero at extrema
19296 h_base=x*x*(3.0d0-2.0d0*x)
19297 deriv=6.0d0*x*(1.0d0-x)
19299 ! Fifth degree polynomial. First and second derivatives zero at extrema
19301 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
19303 !$$$ deriv=deriv*deriv
19304 !$$$ deriv=30.0d0*xsq*deriv
19307 end function h_base
19308 !-----------------------------------------------------------------------------
19309 subroutine dyn_set_nss
19310 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
19312 use MD_data, only: totT,t_bath
19314 ! include 'DIMENSIONS'
19318 ! include 'COMMON.SBRIDGE'
19319 ! include 'COMMON.CHAIN'
19320 ! include 'COMMON.IOUNITS'
19321 ! include 'COMMON.SETUP'
19322 ! include 'COMMON.MD'
19324 real(kind=8) :: emin
19325 integer :: i,j,imin,ierr
19326 integer :: diff,allnss,newnss
19327 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
19330 integer,dimension(0:nfgtasks) :: i_newnss
19331 integer,dimension(0:nfgtasks) :: displ
19332 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
19333 integer :: g_newnss
19338 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
19347 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
19351 if (allflag(i).eq.0 .and. &
19352 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
19353 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
19357 if (emin.lt.1.0d300) then
19360 if (allflag(i).eq.0 .and. &
19361 (allihpb(i).eq.allihpb(imin) .or. &
19362 alljhpb(i).eq.allihpb(imin) .or. &
19363 allihpb(i).eq.alljhpb(imin) .or. &
19364 alljhpb(i).eq.alljhpb(imin))) then
19371 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
19375 if (allflag(i).eq.1) then
19377 newihpb(newnss)=allihpb(i)
19378 newjhpb(newnss)=alljhpb(i)
19383 if (nfgtasks.gt.1)then
19385 call MPI_Reduce(newnss,g_newnss,1,&
19386 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
19387 call MPI_Gather(newnss,1,MPI_INTEGER,&
19388 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
19390 do i=1,nfgtasks-1,1
19391 displ(i)=i_newnss(i-1)+displ(i-1)
19393 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
19394 g_newihpb,i_newnss,displ,MPI_INTEGER,&
19396 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
19397 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
19399 if(fg_rank.eq.0) then
19400 ! print *,'g_newnss',g_newnss
19401 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
19402 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
19405 newihpb(i)=g_newihpb(i)
19406 newjhpb(i)=g_newjhpb(i)
19414 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
19415 ! print *,newnss,nss,maxdim
19421 if (idssb(i).eq.newihpb(j) .and. &
19422 jdssb(i).eq.newjhpb(j)) found=.true.
19426 ! write(iout,*) "found",found,i,j
19427 if (.not.found.and.fg_rank.eq.0) &
19428 write(iout,'(a15,f12.2,f8.1,2i5)') &
19429 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
19438 if (newihpb(i).eq.idssb(j) .and. &
19439 newjhpb(i).eq.jdssb(j)) found=.true.
19443 ! write(iout,*) "found",found,i,j
19444 if (.not.found.and.fg_rank.eq.0) &
19445 write(iout,'(a15,f12.2,f8.1,2i5)') &
19446 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
19453 idssb(i)=newihpb(i)
19454 jdssb(i)=newjhpb(i)
19458 end subroutine dyn_set_nss
19459 ! Lipid transfer energy function
19460 subroutine Eliptransfer(eliptran)
19461 !C this is done by Adasko
19462 !C print *,"wchodze"
19463 !C structure of box:
19465 !C--bordliptop-- buffore starts
19466 !C--bufliptop--- here true lipid starts
19468 !C--buflipbot--- lipid ends buffore starts
19469 !C--bordlipbot--buffore ends
19470 real(kind=8) :: fracinbuf,eliptran,sslip,positi,ssgradlip
19473 ! print *, "I am in eliptran"
19474 do i=ilip_start,ilip_end
19476 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))&
19479 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
19480 if (positi.le.0.0) positi=positi+boxzsize
19482 !C first for peptide groups
19483 !c for each residue check if it is in lipid or lipid water border area
19484 if ((positi.gt.bordlipbot) &
19485 .and.(positi.lt.bordliptop)) then
19486 !C the energy transfer exist
19487 if (positi.lt.buflipbot) then
19488 !C what fraction I am in
19490 ((positi-bordlipbot)/lipbufthick)
19491 !C lipbufthick is thickenes of lipid buffore
19492 sslip=sscalelip(fracinbuf)
19493 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
19494 eliptran=eliptran+sslip*pepliptran
19495 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
19496 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
19497 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
19499 !C print *,"doing sccale for lower part"
19500 !C print *,i,sslip,fracinbuf,ssgradlip
19501 elseif (positi.gt.bufliptop) then
19502 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
19503 sslip=sscalelip(fracinbuf)
19504 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
19505 eliptran=eliptran+sslip*pepliptran
19506 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
19507 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
19508 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
19509 !C print *, "doing sscalefor top part"
19510 !C print *,i,sslip,fracinbuf,ssgradlip
19512 eliptran=eliptran+pepliptran
19513 !C print *,"I am in true lipid"
19516 !C eliptran=elpitran+0.0 ! I am in water
19518 if (energy_dec) write(iout,*) i,"eliptran=",eliptran,positi,sslip
19520 ! here starts the side chain transfer
19521 do i=ilip_start,ilip_end
19522 if (itype(i,1).eq.ntyp1) cycle
19523 positi=(mod(c(3,i+nres),boxzsize))
19524 if (positi.le.0) positi=positi+boxzsize
19525 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
19526 !c for each residue check if it is in lipid or lipid water border area
19527 !C respos=mod(c(3,i+nres),boxzsize)
19528 !C print *,positi,bordlipbot,buflipbot
19529 if ((positi.gt.bordlipbot) &
19530 .and.(positi.lt.bordliptop)) then
19531 !C the energy transfer exist
19532 if (positi.lt.buflipbot) then
19534 ((positi-bordlipbot)/lipbufthick)
19535 !C lipbufthick is thickenes of lipid buffore
19536 sslip=sscalelip(fracinbuf)
19537 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
19538 eliptran=eliptran+sslip*liptranene(itype(i,1))
19539 gliptranx(3,i)=gliptranx(3,i) &
19540 +ssgradlip*liptranene(itype(i,1))
19541 gliptranc(3,i-1)= gliptranc(3,i-1) &
19542 +ssgradlip*liptranene(itype(i,1))
19543 !C print *,"doing sccale for lower part"
19544 elseif (positi.gt.bufliptop) then
19546 ((bordliptop-positi)/lipbufthick)
19547 sslip=sscalelip(fracinbuf)
19548 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
19549 eliptran=eliptran+sslip*liptranene(itype(i,1))
19550 gliptranx(3,i)=gliptranx(3,i) &
19551 +ssgradlip*liptranene(itype(i,1))
19552 gliptranc(3,i-1)= gliptranc(3,i-1) &
19553 +ssgradlip*liptranene(itype(i,1))
19554 !C print *, "doing sscalefor top part",sslip,fracinbuf
19556 eliptran=eliptran+liptranene(itype(i,1))
19557 !C print *,"I am in true lipid"
19559 endif ! if in lipid or buffor
19561 !C eliptran=elpitran+0.0 ! I am in water
19562 if (energy_dec) write(iout,*) i,"eliptran=",eliptran
19565 end subroutine Eliptransfer
19566 !----------------------------------NANO FUNCTIONS
19567 !C-----------------------------------------------------------------------
19568 !C-----------------------------------------------------------
19569 !C This subroutine is to mimic the histone like structure but as well can be
19570 !C utilizet to nanostructures (infinit) small modification has to be used to
19571 !C make it finite (z gradient at the ends has to be changes as well as the x,y
19572 !C gradient has to be modified at the ends
19573 !C The energy function is Kihara potential
19574 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
19575 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
19576 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
19577 !C simple Kihara potential
19578 subroutine calctube(Etube)
19579 real(kind=8),dimension(3) :: vectube
19580 real(kind=8) :: Etube,xtemp,xminact,yminact,&
19581 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi, &
19582 sc_aa_tube,sc_bb_tube
19585 do i=itube_start,itube_end
19587 enetube(i+nres)=0.0d0
19589 !C first we calculate the distance from tube center
19591 do i=itube_start,itube_end
19592 !C lets ommit dummy atoms for now
19593 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
19594 !C now calculate distance from center of tube and direction vectors
19597 ! Find minimum distance in periodic box
19599 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19600 vectube(1)=vectube(1)+boxxsize*j
19601 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19602 vectube(2)=vectube(2)+boxysize*j
19603 xminact=abs(vectube(1)-tubecenter(1))
19604 yminact=abs(vectube(2)-tubecenter(2))
19605 if (xmin.gt.xminact) then
19609 if (ymin.gt.yminact) then
19616 vectube(1)=vectube(1)-tubecenter(1)
19617 vectube(2)=vectube(2)-tubecenter(2)
19619 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
19620 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
19622 !C as the tube is infinity we do not calculate the Z-vector use of Z
19625 !C now calculte the distance
19626 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19627 !C now normalize vector
19628 vectube(1)=vectube(1)/tub_r
19629 vectube(2)=vectube(2)/tub_r
19630 !C calculte rdiffrence between r and r0
19633 rdiff6=rdiff**6.0d0
19634 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19635 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
19636 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
19637 !C print *,rdiff,rdiff6,pep_aa_tube
19638 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19639 !C now we calculate gradient
19640 fac=(-12.0d0*pep_aa_tube/rdiff6- &
19641 6.0d0*pep_bb_tube)/rdiff6/rdiff
19642 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
19644 !C now direction of gg_tube vector
19646 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
19647 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
19650 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
19651 !C print *,gg_tube(1,0),"TU"
19654 do i=itube_start,itube_end
19655 !C Lets not jump over memory as we use many times iti
19657 !C lets ommit dummy atoms for now
19658 if ((iti.eq.ntyp1) &
19659 !C in UNRES uncomment the line below as GLY has no side-chain...
19665 vectube(1)=mod((c(1,i+nres)),boxxsize)
19666 vectube(1)=vectube(1)+boxxsize*j
19667 vectube(2)=mod((c(2,i+nres)),boxysize)
19668 vectube(2)=vectube(2)+boxysize*j
19670 xminact=abs(vectube(1)-tubecenter(1))
19671 yminact=abs(vectube(2)-tubecenter(2))
19672 if (xmin.gt.xminact) then
19676 if (ymin.gt.yminact) then
19683 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
19685 vectube(1)=vectube(1)-tubecenter(1)
19686 vectube(2)=vectube(2)-tubecenter(2)
19688 !C as the tube is infinity we do not calculate the Z-vector use of Z
19691 !C now calculte the distance
19692 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19693 !C now normalize vector
19694 vectube(1)=vectube(1)/tub_r
19695 vectube(2)=vectube(2)/tub_r
19697 !C calculte rdiffrence between r and r0
19700 rdiff6=rdiff**6.0d0
19701 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19702 sc_aa_tube=sc_aa_tube_par(iti)
19703 sc_bb_tube=sc_bb_tube_par(iti)
19704 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19705 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
19706 6.0d0*sc_bb_tube/rdiff6/rdiff
19707 !C now direction of gg_tube vector
19709 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19710 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19713 do i=itube_start,itube_end
19714 Etube=Etube+enetube(i)+enetube(i+nres)
19716 !C print *,"ETUBE", etube
19718 end subroutine calctube
19719 !C TO DO 1) add to total energy
19720 !C 2) add to gradient summation
19721 !C 3) add reading parameters (AND of course oppening of PARAM file)
19722 !C 4) add reading the center of tube
19724 !C 6) add to zerograd
19725 !C 7) allocate matrices
19728 !C-----------------------------------------------------------------------
19729 !C-----------------------------------------------------------
19730 !C This subroutine is to mimic the histone like structure but as well can be
19731 !C utilizet to nanostructures (infinit) small modification has to be used to
19732 !C make it finite (z gradient at the ends has to be changes as well as the x,y
19733 !C gradient has to be modified at the ends
19734 !C The energy function is Kihara potential
19735 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
19736 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
19737 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
19738 !C simple Kihara potential
19739 subroutine calctube2(Etube)
19740 real(kind=8),dimension(3) :: vectube
19741 real(kind=8) :: Etube,xtemp,xminact,yminact,&
19742 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi,fracinbuf,&
19743 sstube,ssgradtube,sc_aa_tube,sc_bb_tube
19746 do i=itube_start,itube_end
19748 enetube(i+nres)=0.0d0
19750 !C first we calculate the distance from tube center
19751 !C first sugare-phosphate group for NARES this would be peptide group
19753 do i=itube_start,itube_end
19754 !C lets ommit dummy atoms for now
19756 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
19757 !C now calculate distance from center of tube and direction vectors
19758 !C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19759 !C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
19760 !C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19761 !C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
19765 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19766 vectube(1)=vectube(1)+boxxsize*j
19767 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19768 vectube(2)=vectube(2)+boxysize*j
19770 xminact=abs(vectube(1)-tubecenter(1))
19771 yminact=abs(vectube(2)-tubecenter(2))
19772 if (xmin.gt.xminact) then
19776 if (ymin.gt.yminact) then
19783 vectube(1)=vectube(1)-tubecenter(1)
19784 vectube(2)=vectube(2)-tubecenter(2)
19786 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
19787 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
19789 !C as the tube is infinity we do not calculate the Z-vector use of Z
19792 !C now calculte the distance
19793 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19794 !C now normalize vector
19795 vectube(1)=vectube(1)/tub_r
19796 vectube(2)=vectube(2)/tub_r
19797 !C calculte rdiffrence between r and r0
19800 rdiff6=rdiff**6.0d0
19801 !C THIS FRAGMENT MAKES TUBE FINITE
19802 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
19803 if (positi.le.0) positi=positi+boxzsize
19804 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
19805 !c for each residue check if it is in lipid or lipid water border area
19806 !C respos=mod(c(3,i+nres),boxzsize)
19807 !C print *,positi,bordtubebot,buftubebot,bordtubetop
19808 if ((positi.gt.bordtubebot) &
19809 .and.(positi.lt.bordtubetop)) then
19810 !C the energy transfer exist
19811 if (positi.lt.buftubebot) then
19813 ((positi-bordtubebot)/tubebufthick)
19814 !C lipbufthick is thickenes of lipid buffore
19815 sstube=sscalelip(fracinbuf)
19816 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
19817 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
19818 enetube(i)=enetube(i)+sstube*tubetranenepep
19819 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19820 !C &+ssgradtube*tubetranene(itype(i,1))
19821 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19822 !C &+ssgradtube*tubetranene(itype(i,1))
19823 !C print *,"doing sccale for lower part"
19824 elseif (positi.gt.buftubetop) then
19826 ((bordtubetop-positi)/tubebufthick)
19827 sstube=sscalelip(fracinbuf)
19828 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
19829 enetube(i)=enetube(i)+sstube*tubetranenepep
19830 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19831 !C &+ssgradtube*tubetranene(itype(i,1))
19832 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19833 !C &+ssgradtube*tubetranene(itype(i,1))
19834 !C print *, "doing sscalefor top part",sslip,fracinbuf
19838 enetube(i)=enetube(i)+sstube*tubetranenepep
19839 !C print *,"I am in true lipid"
19843 !C ssgradtube=0.0d0
19845 endif ! if in lipid or buffor
19847 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19848 enetube(i)=enetube(i)+sstube* &
19849 (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
19850 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
19851 !C print *,rdiff,rdiff6,pep_aa_tube
19852 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19853 !C now we calculate gradient
19854 fac=(-12.0d0*pep_aa_tube/rdiff6- &
19855 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
19856 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
19859 !C now direction of gg_tube vector
19861 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
19862 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
19864 gg_tube(3,i)=gg_tube(3,i) &
19865 +ssgradtube*enetube(i)/sstube/2.0d0
19866 gg_tube(3,i-1)= gg_tube(3,i-1) &
19867 +ssgradtube*enetube(i)/sstube/2.0d0
19870 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
19871 !C print *,gg_tube(1,0),"TU"
19872 do i=itube_start,itube_end
19873 !C Lets not jump over memory as we use many times iti
19875 !C lets ommit dummy atoms for now
19876 if ((iti.eq.ntyp1) &
19877 !!C in UNRES uncomment the line below as GLY has no side-chain...
19880 vectube(1)=c(1,i+nres)
19881 vectube(1)=mod(vectube(1),boxxsize)
19882 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
19883 vectube(2)=c(2,i+nres)
19884 vectube(2)=mod(vectube(2),boxysize)
19885 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
19887 vectube(1)=vectube(1)-tubecenter(1)
19888 vectube(2)=vectube(2)-tubecenter(2)
19889 !C THIS FRAGMENT MAKES TUBE FINITE
19890 positi=(mod(c(3,i+nres),boxzsize))
19891 if (positi.le.0) positi=positi+boxzsize
19892 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
19893 !c for each residue check if it is in lipid or lipid water border area
19894 !C respos=mod(c(3,i+nres),boxzsize)
19895 !C print *,positi,bordtubebot,buftubebot,bordtubetop
19897 if ((positi.gt.bordtubebot) &
19898 .and.(positi.lt.bordtubetop)) then
19899 !C the energy transfer exist
19900 if (positi.lt.buftubebot) then
19902 ((positi-bordtubebot)/tubebufthick)
19903 !C lipbufthick is thickenes of lipid buffore
19904 sstube=sscalelip(fracinbuf)
19905 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
19906 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
19907 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19908 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19909 !C &+ssgradtube*tubetranene(itype(i,1))
19910 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19911 !C &+ssgradtube*tubetranene(itype(i,1))
19912 !C print *,"doing sccale for lower part"
19913 elseif (positi.gt.buftubetop) then
19915 ((bordtubetop-positi)/tubebufthick)
19917 sstube=sscalelip(fracinbuf)
19918 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
19919 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19920 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19921 !C &+ssgradtube*tubetranene(itype(i,1))
19922 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19923 !C &+ssgradtube*tubetranene(itype(i,1))
19924 !C print *, "doing sscalefor top part",sslip,fracinbuf
19928 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19929 !C print *,"I am in true lipid"
19933 !C ssgradtube=0.0d0
19935 endif ! if in lipid or buffor
19936 !CEND OF FINITE FRAGMENT
19937 !C as the tube is infinity we do not calculate the Z-vector use of Z
19940 !C now calculte the distance
19941 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19942 !C now normalize vector
19943 vectube(1)=vectube(1)/tub_r
19944 vectube(2)=vectube(2)/tub_r
19945 !C calculte rdiffrence between r and r0
19948 rdiff6=rdiff**6.0d0
19949 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19950 sc_aa_tube=sc_aa_tube_par(iti)
19951 sc_bb_tube=sc_bb_tube_par(iti)
19952 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)&
19953 *sstube+enetube(i+nres)
19954 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19955 !C now we calculate gradient
19956 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-&
19957 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
19958 !C now direction of gg_tube vector
19960 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19961 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19963 gg_tube_SC(3,i)=gg_tube_SC(3,i) &
19964 +ssgradtube*enetube(i+nres)/sstube
19965 gg_tube(3,i-1)= gg_tube(3,i-1) &
19966 +ssgradtube*enetube(i+nres)/sstube
19969 do i=itube_start,itube_end
19970 Etube=Etube+enetube(i)+enetube(i+nres)
19972 !C print *,"ETUBE", etube
19974 end subroutine calctube2
19975 !=====================================================================================================================================
19976 subroutine calcnano(Etube)
19977 real(kind=8),dimension(3) :: vectube
19979 real(kind=8) :: Etube,xtemp,xminact,yminact,&
19980 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,denominator,faccav,&
19981 sc_aa_tube,sc_bb_tube,zmin,ztemp,zminact
19982 integer:: i,j,iti,r
19985 ! print *,itube_start,itube_end,"poczatek"
19986 do i=itube_start,itube_end
19988 enetube(i+nres)=0.0d0
19990 !C first we calculate the distance from tube center
19991 !C first sugare-phosphate group for NARES this would be peptide group
19993 do i=itube_start,itube_end
19994 !C lets ommit dummy atoms for now
19995 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
19996 !C now calculate distance from center of tube and direction vectors
20002 vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
20003 vectube(1)=vectube(1)+boxxsize*j
20004 vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
20005 vectube(2)=vectube(2)+boxysize*j
20006 vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
20007 vectube(3)=vectube(3)+boxzsize*j
20010 xminact=dabs(vectube(1)-tubecenter(1))
20011 yminact=dabs(vectube(2)-tubecenter(2))
20012 zminact=dabs(vectube(3)-tubecenter(3))
20014 if (xmin.gt.xminact) then
20018 if (ymin.gt.yminact) then
20022 if (zmin.gt.zminact) then
20031 vectube(1)=vectube(1)-tubecenter(1)
20032 vectube(2)=vectube(2)-tubecenter(2)
20033 vectube(3)=vectube(3)-tubecenter(3)
20035 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
20036 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
20037 !C as the tube is infinity we do not calculate the Z-vector use of Z
20039 !C vectube(3)=0.0d0
20040 !C now calculte the distance
20041 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
20042 !C now normalize vector
20043 vectube(1)=vectube(1)/tub_r
20044 vectube(2)=vectube(2)/tub_r
20045 vectube(3)=vectube(3)/tub_r
20046 !C calculte rdiffrence between r and r0
20049 rdiff6=rdiff**6.0d0
20050 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
20051 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
20052 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
20053 !C print *,rdiff,rdiff6,pep_aa_tube
20054 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
20055 !C now we calculate gradient
20056 fac=(-12.0d0*pep_aa_tube/rdiff6- &
20057 6.0d0*pep_bb_tube)/rdiff6/rdiff
20058 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
20060 if (acavtubpep.eq.0.0d0) then
20065 denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
20067 (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
20070 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
20071 *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
20072 +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
20073 /denominator**2.0d0
20078 if (energy_dec) write(iout,*),i,rdiff,enetube(i),enecavtube(i)
20080 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
20081 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
20085 do i=itube_start,itube_end
20086 enecavtube(i)=0.0d0
20087 !C Lets not jump over memory as we use many times iti
20089 !C lets ommit dummy atoms for now
20090 if ((iti.eq.ntyp1) &
20091 !C in UNRES uncomment the line below as GLY has no side-chain...
20098 vectube(1)=dmod((c(1,i+nres)),boxxsize)
20099 vectube(1)=vectube(1)+boxxsize*j
20100 vectube(2)=dmod((c(2,i+nres)),boxysize)
20101 vectube(2)=vectube(2)+boxysize*j
20102 vectube(3)=dmod((c(3,i+nres)),boxzsize)
20103 vectube(3)=vectube(3)+boxzsize*j
20106 xminact=dabs(vectube(1)-tubecenter(1))
20107 yminact=dabs(vectube(2)-tubecenter(2))
20108 zminact=dabs(vectube(3)-tubecenter(3))
20110 if (xmin.gt.xminact) then
20114 if (ymin.gt.yminact) then
20118 if (zmin.gt.zminact) then
20127 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
20129 vectube(1)=vectube(1)-tubecenter(1)
20130 vectube(2)=vectube(2)-tubecenter(2)
20131 vectube(3)=vectube(3)-tubecenter(3)
20132 !C now calculte the distance
20133 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
20134 !C now normalize vector
20135 vectube(1)=vectube(1)/tub_r
20136 vectube(2)=vectube(2)/tub_r
20137 vectube(3)=vectube(3)/tub_r
20139 !C calculte rdiffrence between r and r0
20142 rdiff6=rdiff**6.0d0
20143 sc_aa_tube=sc_aa_tube_par(iti)
20144 sc_bb_tube=sc_bb_tube_par(iti)
20145 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
20146 !C enetube(i+nres)=0.0d0
20147 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
20148 !C now we calculate gradient
20149 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
20150 6.0d0*sc_bb_tube/rdiff6/rdiff
20152 !C now direction of gg_tube vector
20153 !C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
20154 if (acavtub(iti).eq.0.0d0) then
20156 enecavtube(i+nres)=0.0d0
20159 denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
20160 enecavtube(i+nres)= &
20161 (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
20163 !C enecavtube(i)=0.0
20164 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
20165 *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
20166 +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
20167 /denominator**2.0d0
20172 !C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
20173 !C & enecavtube(i),faccav
20174 !C print *,"licz=",
20175 !C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
20176 !C print *,"finene=",enetube(i+nres)+enecavtube(i)
20178 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
20179 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
20181 if (energy_dec) write(iout,*),i,rdiff,enetube(i+nres),enecavtube(i+nres)
20186 do i=itube_start,itube_end
20187 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) &
20188 +enecavtube(i+nres)
20191 ! print *,"begin", i,"a"
20194 ! rdiff6=rdiff**6.0d0
20195 ! sc_aa_tube=sc_aa_tube_par(i)
20196 ! sc_bb_tube=sc_bb_tube_par(i)
20197 ! enetube(i)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
20198 ! denominator=(1.0d0+dcavtub(i)*rdiff6*rdiff6)
20200 ! (bcavtub(i)*rdiff+acavtub(i)*dsqrt(rdiff)+ccavtub(i)) &
20203 ! print '(5(f10.3,1x))',rdiff,enetube(i),enecavtube(i),enecavtube(i)+enetube(i)
20205 ! print *,"end",i,"a"
20207 !C print *,"ETUBE", etube
20209 end subroutine calcnano
20211 !===============================================
20212 !--------------------------------------------------------------------------------
20213 !C first for shielding is setting of function of side-chains
20215 subroutine set_shield_fac2
20216 real(kind=8) :: div77_81=0.974996043d0, &
20217 div4_81=0.2222222222d0
20218 real (kind=8) :: dist_pep_side,dist_side_calf,dist_pept_group, &
20219 scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
20220 short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
20221 sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
20222 !C the vector between center of side_chain and peptide group
20223 real(kind=8),dimension(3) :: pep_side_long,side_calf, &
20224 pept_group,costhet_grad,cosphi_grad_long, &
20225 cosphi_grad_loc,pep_side_norm,side_calf_norm, &
20226 sh_frac_dist_grad,pep_side
20228 !C write(2,*) "ivec",ivec_start,ivec_end
20230 fac_shield(i)=0.0d0
20233 grad_shield(j,i)=0.0d0
20236 do i=ivec_start,ivec_end
20238 !C if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
20239 ! ishield_list(i)=0
20240 if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
20241 !Cif there two consequtive dummy atoms there is no peptide group between them
20242 !C the line below has to be changed for FGPROC>1
20245 if ((itype(k,1).eq.ntyp1).or.(itype(k,1).eq.10)) cycle
20249 !C first lets set vector conecting the ithe side-chain with kth side-chain
20250 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
20251 !C pep_side(j)=2.0d0
20252 !C and vector conecting the side-chain with its proper calfa
20253 side_calf(j)=c(j,k+nres)-c(j,k)
20254 !C side_calf(j)=2.0d0
20255 pept_group(j)=c(j,i)-c(j,i+1)
20256 !C lets have their lenght
20257 dist_pep_side=pep_side(j)**2+dist_pep_side
20258 dist_side_calf=dist_side_calf+side_calf(j)**2
20259 dist_pept_group=dist_pept_group+pept_group(j)**2
20261 dist_pep_side=sqrt(dist_pep_side)
20262 dist_pept_group=sqrt(dist_pept_group)
20263 dist_side_calf=sqrt(dist_side_calf)
20265 pep_side_norm(j)=pep_side(j)/dist_pep_side
20266 side_calf_norm(j)=dist_side_calf
20268 !C now sscale fraction
20269 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
20270 ! print *,buff_shield,"buff",sh_frac_dist
20272 if (sh_frac_dist.le.0.0) cycle
20273 !C print *,ishield_list(i),i
20274 !C If we reach here it means that this side chain reaches the shielding sphere
20275 !C Lets add him to the list for gradient
20276 ishield_list(i)=ishield_list(i)+1
20277 !C ishield_list is a list of non 0 side-chain that contribute to factor gradient
20278 !C this list is essential otherwise problem would be O3
20279 shield_list(ishield_list(i),i)=k
20280 !C Lets have the sscale value
20281 if (sh_frac_dist.gt.1.0) then
20282 scale_fac_dist=1.0d0
20284 sh_frac_dist_grad(j)=0.0d0
20287 scale_fac_dist=-sh_frac_dist*sh_frac_dist &
20288 *(2.0d0*sh_frac_dist-3.0d0)
20289 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
20290 /dist_pep_side/buff_shield*0.5d0
20292 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
20293 !C sh_frac_dist_grad(j)=0.0d0
20294 !C scale_fac_dist=1.0d0
20295 !C print *,"jestem",scale_fac_dist,fac_help_scale,
20296 !C & sh_frac_dist_grad(j)
20299 !C this is what is now we have the distance scaling now volume...
20300 short=short_r_sidechain(itype(k,1))
20301 long=long_r_sidechain(itype(k,1))
20302 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
20303 sinthet=short/dist_pep_side*costhet
20304 ! print *,"SORT",short,long,sinthet,costhet
20305 !C now costhet_grad
20308 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
20309 !C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
20310 !C & -short/dist_pep_side**2/costhet)
20311 !C costhet_fac=0.0d0
20313 costhet_grad(j)=costhet_fac*pep_side(j)
20315 !C remember for the final gradient multiply costhet_grad(j)
20316 !C for side_chain by factor -2 !
20317 !C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
20318 !C pep_side0pept_group is vector multiplication
20319 pep_side0pept_group=0.0d0
20321 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
20323 cosalfa=(pep_side0pept_group/ &
20324 (dist_pep_side*dist_side_calf))
20325 fac_alfa_sin=1.0d0-cosalfa**2
20326 fac_alfa_sin=dsqrt(fac_alfa_sin)
20327 rkprim=fac_alfa_sin*(long-short)+short
20330 !C now costhet_grad
20331 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
20333 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
20334 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ &
20338 cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
20339 +cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
20340 *(long-short)/fac_alfa_sin*cosalfa/ &
20341 ((dist_pep_side*dist_side_calf))* &
20342 ((side_calf(j))-cosalfa* &
20343 ((pep_side(j)/dist_pep_side)*dist_side_calf))
20344 !C cosphi_grad_long(j)=0.0d0
20345 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
20346 *(long-short)/fac_alfa_sin*cosalfa &
20347 /((dist_pep_side*dist_side_calf))* &
20349 cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
20350 !C cosphi_grad_loc(j)=0.0d0
20352 !C print *,sinphi,sinthet
20353 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) &
20356 !C now the gradient...
20358 grad_shield(j,i)=grad_shield(j,i) &
20359 !C gradient po skalowaniu
20360 +(sh_frac_dist_grad(j)*VofOverlap &
20361 !C gradient po costhet
20362 +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
20363 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
20364 sinphi/sinthet*costhet*costhet_grad(j) &
20365 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
20367 !C grad_shield_side is Cbeta sidechain gradient
20368 grad_shield_side(j,ishield_list(i),i)=&
20369 (sh_frac_dist_grad(j)*-2.0d0&
20371 -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
20372 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(&
20373 sinphi/sinthet*costhet*costhet_grad(j)&
20374 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
20376 ! print *, 1.0d0/(-dsqrt(1.0d0-sinphi*sinthet)),&
20378 ! +sinthet/sinphi,"HERE"
20379 grad_shield_loc(j,ishield_list(i),i)= &
20380 scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
20381 (1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(&
20382 sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
20385 ! print *,grad_shield_loc(j,ishield_list(i),i)
20387 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
20389 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
20391 ! write(2,*) "TOTAL VOLUME",i,itype(i,1),fac_shield(i)
20394 end subroutine set_shield_fac2
20395 !----------------------------------------------------------------------------
20396 ! SOUBROUTINE FOR AFM
20397 subroutine AFMvel(Eafmforce)
20398 use MD_data, only:totTafm
20399 real(kind=8),dimension(3) :: diffafm
20400 real(kind=8) :: afmdist,Eafmforce
20402 !C Only for check grad COMMENT if not used for checkgrad
20404 !C--------------------------------------------------------
20405 !C print *,"wchodze"
20409 diffafm(i)=c(i,afmend)-c(i,afmbeg)
20410 afmdist=afmdist+diffafm(i)**2
20412 afmdist=dsqrt(afmdist)
20414 Eafmforce=0.5d0*forceAFMconst &
20415 *(distafminit+totTafm*velAFMconst-afmdist)**2
20416 !C Eafmforce=-forceAFMconst*(dist-distafminit)
20418 gradafm(i,afmend-1)=-forceAFMconst* &
20419 (distafminit+totTafm*velAFMconst-afmdist) &
20420 *diffafm(i)/afmdist
20421 gradafm(i,afmbeg-1)=forceAFMconst* &
20422 (distafminit+totTafm*velAFMconst-afmdist) &
20423 *diffafm(i)/afmdist
20425 ! print *,'AFM',Eafmforce,totTafm*velAFMconst,afmdist
20427 end subroutine AFMvel
20428 !---------------------------------------------------------
20429 subroutine AFMforce(Eafmforce)
20431 real(kind=8),dimension(3) :: diffafm
20432 ! real(kind=8) ::afmdist
20433 real(kind=8) :: afmdist,Eafmforce
20438 diffafm(i)=c(i,afmend)-c(i,afmbeg)
20439 afmdist=afmdist+diffafm(i)**2
20441 afmdist=dsqrt(afmdist)
20442 ! print *,afmdist,distafminit
20443 Eafmforce=-forceAFMconst*(afmdist-distafminit)
20445 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/afmdist
20446 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/afmdist
20448 !C print *,'AFM',Eafmforce
20450 end subroutine AFMforce
20452 !-----------------------------------------------------------------------------
20454 subroutine read_ssHist
20457 ! include 'DIMENSIONS'
20458 ! include "DIMENSIONS.FREE"
20459 ! include 'COMMON.FREE'
20462 character(len=80) :: controlcard
20465 call card_concat(controlcard,.true.)
20466 read(controlcard,*) &
20467 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
20471 end subroutine read_ssHist
20473 !-----------------------------------------------------------------------------
20474 integer function indmat(i,j)
20476 ! get the position of the jth ijth fragment of the chain coordinate system
20477 ! in the fromto array.
20480 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
20482 end function indmat
20483 !-----------------------------------------------------------------------------
20484 real(kind=8) function sigm(x)
20490 !-----------------------------------------------------------------------------
20491 !-----------------------------------------------------------------------------
20492 subroutine alloc_ener_arrays
20493 !EL Allocation of arrays used by module energy
20494 use MD_data, only: mset
20495 !el local variables
20498 if(nres.lt.100) then
20500 elseif(nres.lt.200) then
20501 maxconts=10*nres ! Max. number of contacts per residue
20503 maxconts=10*nres ! (maxconts=maxres/4)
20505 maxcont=12*nres ! Max. number of SC contacts
20506 maxvar=6*nres ! Max. number of variables
20507 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
20508 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
20509 !----------------------
20510 ! arrays in subroutine init_int_table
20512 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
20513 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
20515 allocate(nint_gr(nres))
20516 allocate(nscp_gr(nres))
20517 allocate(ielstart(nres))
20518 allocate(ielend(nres))
20520 allocate(istart(nres,maxint_gr))
20521 allocate(iend(nres,maxint_gr))
20522 !(maxres,maxint_gr)
20523 allocate(iscpstart(nres,maxint_gr))
20524 allocate(iscpend(nres,maxint_gr))
20525 !(maxres,maxint_gr)
20526 allocate(ielstart_vdw(nres))
20527 allocate(ielend_vdw(nres))
20529 allocate(nint_gr_nucl(nres))
20530 allocate(nscp_gr_nucl(nres))
20531 allocate(ielstart_nucl(nres))
20532 allocate(ielend_nucl(nres))
20534 allocate(istart_nucl(nres,maxint_gr))
20535 allocate(iend_nucl(nres,maxint_gr))
20536 !(maxres,maxint_gr)
20537 allocate(iscpstart_nucl(nres,maxint_gr))
20538 allocate(iscpend_nucl(nres,maxint_gr))
20539 !(maxres,maxint_gr)
20540 allocate(ielstart_vdw_nucl(nres))
20541 allocate(ielend_vdw_nucl(nres))
20543 allocate(lentyp(0:nfgtasks-1))
20545 !----------------------
20547 ! common /contacts/
20548 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
20549 allocate(icont(2,maxcont))
20551 ! common /contacts1/
20552 allocate(num_cont(0:nres+4))
20554 allocate(jcont(maxconts,nres))
20556 allocate(facont(maxconts,nres))
20558 allocate(gacont(3,maxconts,nres))
20559 !(3,maxconts,maxres)
20560 ! common /contacts_hb/
20561 allocate(gacontp_hb1(3,maxconts,nres))
20562 allocate(gacontp_hb2(3,maxconts,nres))
20563 allocate(gacontp_hb3(3,maxconts,nres))
20564 allocate(gacontm_hb1(3,maxconts,nres))
20565 allocate(gacontm_hb2(3,maxconts,nres))
20566 allocate(gacontm_hb3(3,maxconts,nres))
20567 allocate(gacont_hbr(3,maxconts,nres))
20568 allocate(grij_hb_cont(3,maxconts,nres))
20569 !(3,maxconts,maxres)
20570 allocate(facont_hb(maxconts,nres))
20572 allocate(ees0p(maxconts,nres))
20573 allocate(ees0m(maxconts,nres))
20574 allocate(d_cont(maxconts,nres))
20575 allocate(ees0plist(maxconts,nres))
20578 allocate(num_cont_hb(nres))
20580 allocate(jcont_hb(maxconts,nres))
20583 allocate(Ug(2,2,nres))
20584 allocate(Ugder(2,2,nres))
20585 allocate(Ug2(2,2,nres))
20586 allocate(Ug2der(2,2,nres))
20588 allocate(obrot(2,nres))
20589 allocate(obrot2(2,nres))
20590 allocate(obrot_der(2,nres))
20591 allocate(obrot2_der(2,nres))
20593 ! common /precomp1/
20594 allocate(mu(2,nres))
20595 allocate(muder(2,nres))
20596 allocate(Ub2(2,nres))
20599 allocate(Ub2der(2,nres))
20600 allocate(Ctobr(2,nres))
20601 allocate(Ctobrder(2,nres))
20602 allocate(Dtobr2(2,nres))
20603 allocate(Dtobr2der(2,nres))
20605 allocate(EUg(2,2,nres))
20606 allocate(EUgder(2,2,nres))
20607 allocate(CUg(2,2,nres))
20608 allocate(CUgder(2,2,nres))
20609 allocate(DUg(2,2,nres))
20610 allocate(Dugder(2,2,nres))
20611 allocate(DtUg2(2,2,nres))
20612 allocate(DtUg2der(2,2,nres))
20614 ! common /precomp2/
20615 allocate(Ug2Db1t(2,nres))
20616 allocate(Ug2Db1tder(2,nres))
20617 allocate(CUgb2(2,nres))
20618 allocate(CUgb2der(2,nres))
20620 allocate(EUgC(2,2,nres))
20621 allocate(EUgCder(2,2,nres))
20622 allocate(EUgD(2,2,nres))
20623 allocate(EUgDder(2,2,nres))
20624 allocate(DtUg2EUg(2,2,nres))
20625 allocate(Ug2DtEUg(2,2,nres))
20627 allocate(Ug2DtEUgder(2,2,2,nres))
20628 allocate(DtUg2EUgder(2,2,2,nres))
20630 allocate(b1(2,nres)) !(2,-maxtor:maxtor)
20631 allocate(b2(2,nres)) !(2,-maxtor:maxtor)
20632 allocate(b1tilde(2,nres)) !(2,-maxtor:maxtor)
20633 allocate(b2tilde(2,nres)) !(2,-maxtor:maxtor)
20635 allocate(ctilde(2,2,nres))
20636 allocate(dtilde(2,2,nres)) !(2,2,-maxtor:maxtor)
20637 allocate(gtb1(2,nres))
20638 allocate(gtb2(2,nres))
20639 allocate(cc(2,2,nres))
20640 allocate(dd(2,2,nres))
20641 allocate(ee(2,2,nres))
20642 allocate(gtcc(2,2,nres))
20643 allocate(gtdd(2,2,nres))
20644 allocate(gtee(2,2,nres))
20645 allocate(gUb2(2,nres))
20646 allocate(gteUg(2,2,nres))
20648 ! common /rotat_old/
20649 allocate(costab(nres))
20650 allocate(sintab(nres))
20651 allocate(costab2(nres))
20652 allocate(sintab2(nres))
20655 allocate(a_chuj(2,2,maxconts,nres))
20656 !(2,2,maxconts,maxres)(maxconts=maxres/4)
20657 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
20658 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
20659 ! common /contdistrib/
20660 allocate(ncont_sent(nres))
20661 allocate(ncont_recv(nres))
20663 allocate(iat_sent(nres))
20665 allocate(iint_sent(4,nres,nres))
20666 allocate(iint_sent_local(4,nres,nres))
20668 allocate(iturn3_sent(4,0:nres+4))
20669 allocate(iturn4_sent(4,0:nres+4))
20670 allocate(iturn3_sent_local(4,nres))
20671 allocate(iturn4_sent_local(4,nres))
20673 allocate(itask_cont_from(0:nfgtasks-1))
20674 allocate(itask_cont_to(0:nfgtasks-1))
20675 !(0:max_fg_procs-1)
20679 !----------------------
20682 allocate(dcdv(6,maxdim))
20683 allocate(dxdv(6,maxdim))
20685 allocate(dxds(6,nres))
20687 allocate(gradx(3,-1:nres,0:2))
20688 allocate(gradc(3,-1:nres,0:2))
20690 allocate(gvdwx(3,-1:nres))
20691 allocate(gvdwc(3,-1:nres))
20692 allocate(gelc(3,-1:nres))
20693 allocate(gelc_long(3,-1:nres))
20694 allocate(gvdwpp(3,-1:nres))
20695 allocate(gvdwc_scpp(3,-1:nres))
20696 allocate(gradx_scp(3,-1:nres))
20697 allocate(gvdwc_scp(3,-1:nres))
20698 allocate(ghpbx(3,-1:nres))
20699 allocate(ghpbc(3,-1:nres))
20700 allocate(gradcorr(3,-1:nres))
20701 allocate(gradcorr_long(3,-1:nres))
20702 allocate(gradcorr5_long(3,-1:nres))
20703 allocate(gradcorr6_long(3,-1:nres))
20704 allocate(gcorr6_turn_long(3,-1:nres))
20705 allocate(gradxorr(3,-1:nres))
20706 allocate(gradcorr5(3,-1:nres))
20707 allocate(gradcorr6(3,-1:nres))
20708 allocate(gliptran(3,-1:nres))
20709 allocate(gliptranc(3,-1:nres))
20710 allocate(gliptranx(3,-1:nres))
20711 allocate(gshieldx(3,-1:nres))
20712 allocate(gshieldc(3,-1:nres))
20713 allocate(gshieldc_loc(3,-1:nres))
20714 allocate(gshieldx_ec(3,-1:nres))
20715 allocate(gshieldc_ec(3,-1:nres))
20716 allocate(gshieldc_loc_ec(3,-1:nres))
20717 allocate(gshieldx_t3(3,-1:nres))
20718 allocate(gshieldc_t3(3,-1:nres))
20719 allocate(gshieldc_loc_t3(3,-1:nres))
20720 allocate(gshieldx_t4(3,-1:nres))
20721 allocate(gshieldc_t4(3,-1:nres))
20722 allocate(gshieldc_loc_t4(3,-1:nres))
20723 allocate(gshieldx_ll(3,-1:nres))
20724 allocate(gshieldc_ll(3,-1:nres))
20725 allocate(gshieldc_loc_ll(3,-1:nres))
20726 allocate(grad_shield(3,-1:nres))
20727 allocate(gg_tube_sc(3,-1:nres))
20728 allocate(gg_tube(3,-1:nres))
20729 allocate(gradafm(3,-1:nres))
20730 allocate(gradb_nucl(3,-1:nres))
20731 allocate(gradbx_nucl(3,-1:nres))
20732 allocate(gvdwpsb1(3,-1:nres))
20733 allocate(gelpp(3,-1:nres))
20734 allocate(gvdwpsb(3,-1:nres))
20735 allocate(gelsbc(3,-1:nres))
20736 allocate(gelsbx(3,-1:nres))
20737 allocate(gvdwsbx(3,-1:nres))
20738 allocate(gvdwsbc(3,-1:nres))
20739 allocate(gsbloc(3,-1:nres))
20740 allocate(gsblocx(3,-1:nres))
20741 allocate(gradcorr_nucl(3,-1:nres))
20742 allocate(gradxorr_nucl(3,-1:nres))
20743 allocate(gradcorr3_nucl(3,-1:nres))
20744 allocate(gradxorr3_nucl(3,-1:nres))
20745 allocate(gvdwpp_nucl(3,-1:nres))
20746 allocate(gradpepcat(3,-1:nres))
20747 allocate(gradpepcatx(3,-1:nres))
20748 allocate(gradcatcat(3,-1:nres))
20750 allocate(grad_shield_side(3,maxcontsshi,-1:nres))
20751 allocate(grad_shield_loc(3,maxcontsshi,-1:nres))
20752 ! grad for shielding surroing
20753 allocate(gloc(0:maxvar,0:2))
20754 allocate(gloc_x(0:maxvar,2))
20756 allocate(gel_loc(3,-1:nres))
20757 allocate(gel_loc_long(3,-1:nres))
20758 allocate(gcorr3_turn(3,-1:nres))
20759 allocate(gcorr4_turn(3,-1:nres))
20760 allocate(gcorr6_turn(3,-1:nres))
20761 allocate(gradb(3,-1:nres))
20762 allocate(gradbx(3,-1:nres))
20764 allocate(gel_loc_loc(maxvar))
20765 allocate(gel_loc_turn3(maxvar))
20766 allocate(gel_loc_turn4(maxvar))
20767 allocate(gel_loc_turn6(maxvar))
20768 allocate(gcorr_loc(maxvar))
20769 allocate(g_corr5_loc(maxvar))
20770 allocate(g_corr6_loc(maxvar))
20772 allocate(gsccorc(3,-1:nres))
20773 allocate(gsccorx(3,-1:nres))
20775 allocate(gsccor_loc(-1:nres))
20777 allocate(gvdwx_scbase(3,-1:nres))
20778 allocate(gvdwc_scbase(3,-1:nres))
20779 allocate(gvdwx_pepbase(3,-1:nres))
20780 allocate(gvdwc_pepbase(3,-1:nres))
20781 allocate(gvdwx_scpho(3,-1:nres))
20782 allocate(gvdwc_scpho(3,-1:nres))
20783 allocate(gvdwc_peppho(3,-1:nres))
20785 allocate(dtheta(3,2,-1:nres))
20787 allocate(gscloc(3,-1:nres))
20788 allocate(gsclocx(3,-1:nres))
20790 allocate(dphi(3,3,-1:nres))
20791 allocate(dalpha(3,3,-1:nres))
20792 allocate(domega(3,3,-1:nres))
20794 ! common /deriv_scloc/
20795 allocate(dXX_C1tab(3,nres))
20796 allocate(dYY_C1tab(3,nres))
20797 allocate(dZZ_C1tab(3,nres))
20798 allocate(dXX_Ctab(3,nres))
20799 allocate(dYY_Ctab(3,nres))
20800 allocate(dZZ_Ctab(3,nres))
20801 allocate(dXX_XYZtab(3,nres))
20802 allocate(dYY_XYZtab(3,nres))
20803 allocate(dZZ_XYZtab(3,nres))
20806 allocate(jgrad_start(nres))
20807 allocate(jgrad_end(nres))
20809 !----------------------
20812 allocate(ibond_displ(0:nfgtasks-1))
20813 allocate(ibond_count(0:nfgtasks-1))
20814 allocate(ithet_displ(0:nfgtasks-1))
20815 allocate(ithet_count(0:nfgtasks-1))
20816 allocate(iphi_displ(0:nfgtasks-1))
20817 allocate(iphi_count(0:nfgtasks-1))
20818 allocate(iphi1_displ(0:nfgtasks-1))
20819 allocate(iphi1_count(0:nfgtasks-1))
20820 allocate(ivec_displ(0:nfgtasks-1))
20821 allocate(ivec_count(0:nfgtasks-1))
20822 allocate(iset_displ(0:nfgtasks-1))
20823 allocate(iset_count(0:nfgtasks-1))
20824 allocate(iint_count(0:nfgtasks-1))
20825 allocate(iint_displ(0:nfgtasks-1))
20826 !(0:max_fg_procs-1)
20827 !----------------------
20830 allocate(gcart(3,-1:nres))
20831 allocate(gxcart(3,-1:nres))
20833 allocate(gradcag(3,-1:nres))
20834 allocate(gradxag(3,-1:nres))
20836 ! common /back_constr/
20837 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
20838 allocate(dutheta(nres))
20839 allocate(dugamma(nres))
20841 allocate(duscdiff(3,nres))
20842 allocate(duscdiffx(3,nres))
20844 !el i io:read_fragments
20845 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
20846 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
20848 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
20849 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
20850 allocate(mset(0:nprocs)) !(maxprocs/20)
20852 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
20853 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
20854 allocate(dUdconst(3,0:nres))
20855 allocate(dUdxconst(3,0:nres))
20856 allocate(dqwol(3,0:nres))
20857 allocate(dxqwol(3,0:nres))
20859 !----------------------
20861 ! common /sbridge/ in io_common: read_bridge
20862 !el allocate((:),allocatable :: iss !(maxss)
20863 ! common /links/ in io_common: read_bridge
20864 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
20865 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
20866 ! common /dyn_ssbond/
20867 ! and side-chain vectors in theta or phi.
20868 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
20872 dyn_ssbond_ij(:,:)=1.0d300
20876 ! if (nss.gt.0) then
20877 allocate(idssb(maxdim),jdssb(maxdim))
20878 ! allocate(newihpb(nss),newjhpb(nss))
20881 allocate(ishield_list(-1:nres))
20882 allocate(shield_list(maxcontsshi,-1:nres))
20883 allocate(dyn_ss_mask(nres))
20884 allocate(fac_shield(-1:nres))
20885 allocate(enetube(nres*2))
20886 allocate(enecavtube(nres*2))
20889 dyn_ss_mask(:)=.false.
20890 !----------------------
20892 ! Parameters of the SCCOR term
20894 !el in io_conf: parmread
20895 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
20896 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
20897 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
20898 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
20899 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
20900 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
20901 ! allocate(vlor1sccor(maxterm_sccor,20,20))
20902 ! allocate(vlor2sccor(maxterm_sccor,20,20))
20903 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
20905 allocate(gloc_sc(3,0:2*nres,0:10))
20906 !(3,0:maxres2,10)maxres2=2*maxres
20907 allocate(dcostau(3,3,3,2*nres))
20908 allocate(dsintau(3,3,3,2*nres))
20909 allocate(dtauangle(3,3,3,2*nres))
20910 allocate(dcosomicron(3,3,3,2*nres))
20911 allocate(domicron(3,3,3,2*nres))
20912 !(3,3,3,maxres2)maxres2=2*maxres
20913 !----------------------
20916 allocate(varall(maxvar))
20917 !(maxvar)(maxvar=6*maxres)
20918 allocate(mask_theta(nres))
20919 allocate(mask_phi(nres))
20920 allocate(mask_side(nres))
20922 !----------------------
20925 allocate(uy(3,nres))
20926 allocate(uz(3,nres))
20928 allocate(uygrad(3,3,2,nres))
20929 allocate(uzgrad(3,3,2,nres))
20933 end subroutine alloc_ener_arrays
20934 !-----------------------------------------------------------------
20935 subroutine ebond_nucl(estr_nucl)
20937 !c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
20940 real(kind=8),dimension(3) :: u,ud
20941 real(kind=8) :: usum,uprod,uprod1,uprod2,usumsqder
20942 real(kind=8) :: estr_nucl,diff
20943 integer :: iti,i,j,k,nbi
20945 !C print *,"I enter ebond"
20947 write (iout,*) "ibondp_start,ibondp_end",&
20948 ibondp_nucl_start,ibondp_nucl_end
20949 do i=ibondp_nucl_start,ibondp_nucl_end
20950 if (itype(i-1,2).eq.ntyp1_molec(2) .or. &
20951 itype(i,2).eq.ntyp1_molec(2)) cycle
20952 ! estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
20954 ! gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
20955 ! & *dc(j,i-1)/vbld(i)
20957 ! if (energy_dec) write(iout,*)
20958 ! & "estr1",i,vbld(i),distchainmax,
20959 ! & gnmr1(vbld(i),-1.0d0,distchainmax)
20961 diff = vbld(i)-vbldp0_nucl
20962 if(energy_dec)write(iout,*) "estr_nucl_bb" , i,vbld(i),&
20963 vbldp0_nucl,diff,AKP_nucl*diff*diff
20964 estr_nucl=estr_nucl+diff*diff
20965 ! print *,estr_nucl
20967 gradb_nucl(j,i-1)=AKP_nucl*diff*dc(j,i-1)/vbld(i)
20969 !c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
20971 estr_nucl=0.5d0*AKP_nucl*estr_nucl
20972 ! print *,"partial sum", estr_nucl,AKP_nucl
20975 write (iout,*) "ibondp_start,ibondp_end",&
20976 ibond_nucl_start,ibond_nucl_end
20978 do i=ibond_nucl_start,ibond_nucl_end
20979 !C print *, "I am stuck",i
20981 if (iti.eq.ntyp1_molec(2)) cycle
20982 nbi=nbondterm_nucl(iti)
20985 diff=vbld(i+nres)-vbldsc0_nucl(1,iti)
20988 write (iout,*) "estr_nucl_sc", i,iti,vbld(i+nres),vbldsc0_nucl(1,iti),diff, &
20989 AKSC_nucl(1,iti),AKSC_nucl(1,iti)*diff*diff
20990 estr_nucl=estr_nucl+0.5d0*AKSC_nucl(1,iti)*diff*diff
20991 ! print *,estr_nucl
20993 gradbx_nucl(j,i)=AKSC_nucl(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
20997 diff=vbld(i+nres)-vbldsc0_nucl(j,iti)
20998 ud(j)=aksc_nucl(j,iti)*diff
20999 u(j)=abond0_nucl(j,iti)+0.5d0*ud(j)*diff
21013 uprod2=uprod2*u(k)*u(k)
21017 usumsqder=usumsqder+ud(j)*uprod2
21019 estr_nucl=estr_nucl+uprod/usum
21021 gradbx_nucl(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
21025 !C print *,"I am about to leave ebond"
21027 end subroutine ebond_nucl
21029 !-----------------------------------------------------------------------------
21030 subroutine ebend_nucl(etheta_nucl)
21031 real(kind=8),dimension(nntheterm_nucl+1) :: coskt,sinkt !mmaxtheterm
21032 real(kind=8),dimension(nsingle_nucl+1) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
21033 real(kind=8),dimension(ndouble_nucl+1,ndouble_nucl+1) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
21034 logical :: lprn=.false., lprn1=.false.
21035 !el local variables
21036 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
21037 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
21038 real(kind=8) :: aux,etheta_nucl,ccl,ssl,scl,csl,ethetacnstr
21039 ! local variables for constrains
21040 real(kind=8) :: difi,thetiii
21043 ! print *,"ithet_start",ithet_nucl_start," ithet_end",ithet_nucl_end,nres
21044 do i=ithet_nucl_start,ithet_nucl_end
21045 if ((itype(i-1,2).eq.ntyp1_molec(2)).or.&
21046 (itype(i-2,2).eq.ntyp1_molec(2)).or. &
21047 (itype(i,2).eq.ntyp1_molec(2))) cycle
21051 theti2=0.5d0*theta(i)
21052 ityp2=ithetyp_nucl(itype(i-1,2))
21053 do k=1,nntheterm_nucl
21054 coskt(k)=dcos(k*theti2)
21055 sinkt(k)=dsin(k*theti2)
21057 if (i.gt.3 .and. itype(i-2,2).ne.ntyp1_molec(2)) then
21060 if (phii.ne.phii) phii=150.0
21064 ityp1=ithetyp_nucl(itype(i-2,2))
21065 do k=1,nsingle_nucl
21066 cosph1(k)=dcos(k*phii)
21067 sinph1(k)=dsin(k*phii)
21071 ityp1=nthetyp_nucl+1
21072 do k=1,nsingle_nucl
21078 if (i.lt.nres .and. itype(i,2).ne.ntyp1_molec(2)) then
21081 if (phii1.ne.phii1) phii1=150.0
21082 phii1=pinorm(phii1)
21086 ityp3=ithetyp_nucl(itype(i,2))
21087 do k=1,nsingle_nucl
21088 cosph2(k)=dcos(k*phii1)
21089 sinph2(k)=dsin(k*phii1)
21093 ityp3=nthetyp_nucl+1
21094 do k=1,nsingle_nucl
21099 ethetai=aa0thet_nucl(ityp1,ityp2,ityp3)
21100 do k=1,ndouble_nucl
21102 ccl=cosph1(l)*cosph2(k-l)
21103 ssl=sinph1(l)*sinph2(k-l)
21104 scl=sinph1(l)*cosph2(k-l)
21105 csl=cosph1(l)*sinph2(k-l)
21106 cosph1ph2(l,k)=ccl-ssl
21107 cosph1ph2(k,l)=ccl+ssl
21108 sinph1ph2(l,k)=scl+csl
21109 sinph1ph2(k,l)=scl-csl
21113 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
21114 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
21115 write (iout,*) "coskt and sinkt",nntheterm_nucl
21116 do k=1,nntheterm_nucl
21117 write (iout,*) k,coskt(k),sinkt(k)
21120 do k=1,ntheterm_nucl
21121 ethetai=ethetai+aathet_nucl(k,ityp1,ityp2,ityp3)*sinkt(k)
21122 dethetai=dethetai+0.5d0*k*aathet_nucl(k,ityp1,ityp2,ityp3)&
21125 write (iout,*) "k",k," aathet",aathet_nucl(k,ityp1,ityp2,ityp3),&
21129 write (iout,*) "cosph and sinph"
21130 do k=1,nsingle_nucl
21131 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
21133 write (iout,*) "cosph1ph2 and sinph2ph2"
21134 do k=2,ndouble_nucl
21136 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
21137 sinph1ph2(l,k),sinph1ph2(k,l)
21140 write(iout,*) "ethetai",ethetai
21142 do m=1,ntheterm2_nucl
21143 do k=1,nsingle_nucl
21144 aux=bbthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)&
21145 +ccthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k)&
21146 +ddthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)&
21147 +eethet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k)
21148 ethetai=ethetai+sinkt(m)*aux
21149 dethetai=dethetai+0.5d0*m*aux*coskt(m)
21150 dephii=dephii+k*sinkt(m)*(&
21151 ccthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)-&
21152 bbthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k))
21153 dephii1=dephii1+k*sinkt(m)*(&
21154 eethet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)-&
21155 ddthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k))
21157 write (iout,*) "m",m," k",k," bbthet",&
21158 bbthet_nucl(k,m,ityp1,ityp2,ityp3)," ccthet",&
21159 ccthet_nucl(k,m,ityp1,ityp2,ityp3)," ddthet",&
21160 ddthet_nucl(k,m,ityp1,ityp2,ityp3)," eethet",&
21161 eethet_nucl(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
21165 write(iout,*) "ethetai",ethetai
21166 do m=1,ntheterm3_nucl
21167 do k=2,ndouble_nucl
21169 aux=ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
21170 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+&
21171 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
21172 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
21173 ethetai=ethetai+sinkt(m)*aux
21174 dethetai=dethetai+0.5d0*m*coskt(m)*aux
21175 dephii=dephii+l*sinkt(m)*(&
21176 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-&
21177 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
21178 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
21179 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
21180 dephii1=dephii1+(k-l)*sinkt(m)*( &
21181 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
21182 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
21183 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-&
21184 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
21186 write (iout,*) "m",m," k",k," l",l," ffthet", &
21187 ffthet_nucl(l,k,m,ityp1,ityp2,ityp3), &
21188 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ggthet",&
21189 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3),&
21190 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
21191 write (iout,*) cosph1ph2(l,k)*sinkt(m), &
21192 cosph1ph2(k,l)*sinkt(m),&
21193 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
21199 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
21200 i,theta(i)*rad2deg,phii*rad2deg, &
21201 phii1*rad2deg,ethetai
21202 etheta_nucl=etheta_nucl+ethetai
21203 ! print *,i,"partial sum",etheta_nucl
21204 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang_nucl*dephii
21205 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang_nucl*dephii1
21206 gloc(nphi+i-2,icg)=wang_nucl*dethetai
21209 end subroutine ebend_nucl
21210 !----------------------------------------------------
21211 subroutine etor_nucl(etors_nucl)
21212 ! implicit real*8 (a-h,o-z)
21213 ! include 'DIMENSIONS'
21214 ! include 'COMMON.VAR'
21215 ! include 'COMMON.GEO'
21216 ! include 'COMMON.LOCAL'
21217 ! include 'COMMON.TORSION'
21218 ! include 'COMMON.INTERACT'
21219 ! include 'COMMON.DERIV'
21220 ! include 'COMMON.CHAIN'
21221 ! include 'COMMON.NAMES'
21222 ! include 'COMMON.IOUNITS'
21223 ! include 'COMMON.FFIELD'
21224 ! include 'COMMON.TORCNSTR'
21225 ! include 'COMMON.CONTROL'
21226 real(kind=8) :: etors_nucl,edihcnstr
21228 !el local variables
21229 integer :: i,j,iblock,itori,itori1
21230 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
21231 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
21232 ! Set lprn=.true. for debugging
21236 ! print *,"iphi_nucl_start/end", iphi_nucl_start,iphi_nucl_end
21237 do i=iphi_nucl_start,iphi_nucl_end
21238 if (itype(i-2,2).eq.ntyp1_molec(2) .or. itype(i-1,2).eq.ntyp1_molec(2) &
21239 .or. itype(i-3,2).eq.ntyp1_molec(2) &
21240 .or. itype(i,2).eq.ntyp1_molec(2)) cycle
21242 itori=itortyp_nucl(itype(i-2,2))
21243 itori1=itortyp_nucl(itype(i-1,2))
21245 ! print *,i,itori,itori1
21247 !C Regular cosine and sine terms
21248 do j=1,nterm_nucl(itori,itori1)
21249 v1ij=v1_nucl(j,itori,itori1)
21250 v2ij=v2_nucl(j,itori,itori1)
21251 cosphi=dcos(j*phii)
21252 sinphi=dsin(j*phii)
21253 etors_nucl=etors_nucl+v1ij*cosphi+v2ij*sinphi
21254 if (energy_dec) etors_ii=etors_ii+&
21255 v1ij*cosphi+v2ij*sinphi
21256 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
21260 !C E = SUM ----------------------------------- - v1
21261 !C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
21263 cosphi=dcos(0.5d0*phii)
21264 sinphi=dsin(0.5d0*phii)
21265 do j=1,nlor_nucl(itori,itori1)
21266 vl1ij=vlor1_nucl(j,itori,itori1)
21267 vl2ij=vlor2_nucl(j,itori,itori1)
21268 vl3ij=vlor3_nucl(j,itori,itori1)
21269 pom=vl2ij*cosphi+vl3ij*sinphi
21270 pom1=1.0d0/(pom*pom+1.0d0)
21271 etors_nucl=etors_nucl+vl1ij*pom1
21272 if (energy_dec) etors_ii=etors_ii+ &
21275 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
21277 !C Subtract the constant term
21278 etors_nucl=etors_nucl-v0_nucl(itori,itori1)
21279 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
21280 'etor',i,etors_ii-v0_nucl(itori,itori1)
21282 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
21283 restyp(itype(i-2,2),2),i-2,restyp(itype(i-1,2),2),i-1,itori,itori1, &
21284 (v1_nucl(j,itori,itori1),j=1,6),(v2_nucl(j,itori,itori1),j=1,6)
21285 gloc(i-3,icg)=gloc(i-3,icg)+wtor_nucl*gloci
21286 !c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
21289 end subroutine etor_nucl
21290 !------------------------------------------------------------
21291 subroutine epp_nucl_sub(evdw1,ees)
21293 !C This subroutine calculates the average interaction energy and its gradient
21294 !C in the virtual-bond vectors between non-adjacent peptide groups, based on
21295 !C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
21296 !C The potential depends both on the distance of peptide-group centers and on
21297 !C the orientation of the CA-CA virtual bonds.
21299 integer :: i,j,k,iteli,itelj,num_conti,isubchap,ind
21300 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
21301 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
21302 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
21303 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
21304 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
21305 dist_temp, dist_init,sss_grad,fac,evdw1ij
21306 integer xshift,yshift,zshift
21307 real(kind=8),dimension(3):: ggg,gggp,gggm,erij
21308 real(kind=8) :: ees,eesij
21309 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
21310 real(kind=8) scal_el /0.5d0/
21316 !c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
21318 ! print *,"iatel_s_nucl,iatel_e_nucl",iatel_s_nucl,iatel_e_nucl
21319 do i=iatel_s_nucl,iatel_e_nucl
21320 if (itype(i,2).eq.ntyp1_molec(2) .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
21324 dx_normi=dc_norm(1,i)
21325 dy_normi=dc_norm(2,i)
21326 dz_normi=dc_norm(3,i)
21327 xmedi=c(1,i)+0.5d0*dxi
21328 ymedi=c(2,i)+0.5d0*dyi
21329 zmedi=c(3,i)+0.5d0*dzi
21330 xmedi=dmod(xmedi,boxxsize)
21331 if (xmedi.lt.0) xmedi=xmedi+boxxsize
21332 ymedi=dmod(ymedi,boxysize)
21333 if (ymedi.lt.0) ymedi=ymedi+boxysize
21334 zmedi=dmod(zmedi,boxzsize)
21335 if (zmedi.lt.0) zmedi=zmedi+boxzsize
21337 do j=ielstart_nucl(i),ielend_nucl(i)
21338 if (itype(j,2).eq.ntyp1_molec(2) .or. itype(j+1,2).eq.ntyp1_molec(2)) cycle
21343 ! xj=c(1,j)+0.5D0*dxj-xmedi
21344 ! yj=c(2,j)+0.5D0*dyj-ymedi
21345 ! zj=c(3,j)+0.5D0*dzj-zmedi
21346 xj=c(1,j)+0.5D0*dxj
21347 yj=c(2,j)+0.5D0*dyj
21348 zj=c(3,j)+0.5D0*dzj
21349 xj=mod(xj,boxxsize)
21350 if (xj.lt.0) xj=xj+boxxsize
21351 yj=mod(yj,boxysize)
21352 if (yj.lt.0) yj=yj+boxysize
21353 zj=mod(zj,boxzsize)
21354 if (zj.lt.0) zj=zj+boxzsize
21356 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
21363 xj=xj_safe+xshift*boxxsize
21364 yj=yj_safe+yshift*boxysize
21365 zj=zj_safe+zshift*boxzsize
21366 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
21367 if(dist_temp.lt.dist_init) then
21368 dist_init=dist_temp
21377 if (isubchap.eq.1) then
21388 rij=xj*xj+yj*yj+zj*zj
21389 !c write (2,*)"ij",i,j," r0pp",r0pp," rij",rij," epspp",epspp
21390 fac=(r0pp**2/rij)**3
21394 fac=(-ev1-evdw1ij)/rij
21395 ! write (2,*)"fac",fac," ev1",ev1," ev2",ev2," evdw1ij",evdw1ij
21396 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"evdw1ij",evdw1ij
21397 evdw1=evdw1+evdw1ij
21399 !C Calculate contributions to the Cartesian gradient.
21405 gvdwpp_nucl(k,i)=gvdwpp_nucl(k,i)-ggg(k)
21406 gvdwpp_nucl(k,j)=gvdwpp_nucl(k,j)+ggg(k)
21408 !c phoshate-phosphate electrostatic interactions
21411 eesij=dexp(-BEES*rij)*fac
21412 ! write (2,*)"fac",fac," eesijpp",eesij
21413 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"eesijpp",eesij
21416 fac=-(fac+BEES)*eesij*fac
21420 !c write(2,*) "ggg",i,j,ggg(1),ggg(2),ggg(3)
21421 !c write(2,*) "gelpp",i,(gelpp(k,i),k=1,3)
21422 !c write(2,*) "gelpp",j,(gelpp(k,j),k=1,3)
21424 gelpp(k,i)=gelpp(k,i)-ggg(k)
21425 gelpp(k,j)=gelpp(k,j)+ggg(k)
21432 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
21434 gvdwpp_nucl(k,i)=6*gvdwpp_nucl(k,i)
21435 !c gelpp(k,i)=332.0d0*gelpp(k,i)
21436 gelpp(k,i)=AEES*gelpp(k,i)
21438 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
21440 !c write (2,*) "total EES",ees
21442 end subroutine epp_nucl_sub
21443 !---------------------------------------------------------------------
21444 subroutine epsb(evdwpsb,eelpsb)
21447 !C This subroutine calculates the excluded-volume interaction energy between
21448 !C peptide-group centers and side chains and its gradient in virtual-bond and
21449 !C side-chain vectors.
21451 real(kind=8),dimension(3):: ggg
21452 integer :: i,iint,j,k,iteli,itypj,subchap
21453 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
21454 e1,e2,evdwij,rij,evdwpsb,eelpsb
21455 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
21456 dist_temp, dist_init
21457 integer xshift,yshift,zshift
21459 !cd print '(a)','Enter ESCP'
21460 !cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
21463 ! print *,"iatscp_s_nucl,iatscp_e_nucl",iatscp_s_nucl,iatscp_e_nucl
21464 do i=iatscp_s_nucl,iatscp_e_nucl
21465 if (itype(i,2).eq.ntyp1_molec(2) &
21466 .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
21467 xi=0.5D0*(c(1,i)+c(1,i+1))
21468 yi=0.5D0*(c(2,i)+c(2,i+1))
21469 zi=0.5D0*(c(3,i)+c(3,i+1))
21470 xi=mod(xi,boxxsize)
21471 if (xi.lt.0) xi=xi+boxxsize
21472 yi=mod(yi,boxysize)
21473 if (yi.lt.0) yi=yi+boxysize
21474 zi=mod(zi,boxzsize)
21475 if (zi.lt.0) zi=zi+boxzsize
21477 do iint=1,nscp_gr_nucl(i)
21479 do j=iscpstart_nucl(i,iint),iscpend_nucl(i,iint)
21481 if (itypj.eq.ntyp1_molec(2)) cycle
21482 !C Uncomment following three lines for SC-p interactions
21483 !c xj=c(1,nres+j)-xi
21484 !c yj=c(2,nres+j)-yi
21485 !c zj=c(3,nres+j)-zi
21486 !C Uncomment following three lines for Ca-p interactions
21493 xj=mod(xj,boxxsize)
21494 if (xj.lt.0) xj=xj+boxxsize
21495 yj=mod(yj,boxysize)
21496 if (yj.lt.0) yj=yj+boxysize
21497 zj=mod(zj,boxzsize)
21498 if (zj.lt.0) zj=zj+boxzsize
21499 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21507 xj=xj_safe+xshift*boxxsize
21508 yj=yj_safe+yshift*boxysize
21509 zj=zj_safe+zshift*boxzsize
21510 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21511 if(dist_temp.lt.dist_init) then
21512 dist_init=dist_temp
21521 if (subchap.eq.1) then
21531 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
21533 e1=fac*fac*aad_nucl(itypj)
21534 e2=fac*bad_nucl(itypj)
21535 if (iabs(j-i) .le. 2) then
21540 evdwpsb=evdwpsb+evdwij
21541 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a4)') &
21542 'evdw2',i,j,evdwij,"tu4"
21544 !C Calculate contributions to the gradient in the virtual-bond and SC vectors.
21546 fac=-(evdwij+e1)*rrij
21551 gvdwpsb1(k,i)=gvdwpsb1(k,i)-ggg(k)
21552 gvdwpsb(k,j)=gvdwpsb(k,j)+ggg(k)
21560 gvdwpsb(j,i)=expon*gvdwpsb(j,i)
21561 gvdwpsb1(j,i)=expon*gvdwpsb1(j,i)
21565 end subroutine epsb
21567 !------------------------------------------------------
21568 subroutine esb_gb(evdwsb,eelsb)
21571 integer :: iint,itypi,itypi1,itypj,subchap,num_conti2
21572 real(kind=8) :: xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
21573 real(kind=8) :: evdw,sig0iji,evdwsb,eelsb,ecorr,eelij
21574 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
21575 dist_temp, dist_init,aa,bb,faclip,sig0ij
21584 ! print *,"iastsc_nucl",iatsc_s_nucl,iatsc_e_nucl
21585 do i=iatsc_s_nucl,iatsc_e_nucl
21589 ! PRINT *,"I=",i,itypi
21590 if (itypi.eq.ntyp1_molec(2)) cycle
21591 itypi1=itype(i+1,2)
21595 xi=dmod(xi,boxxsize)
21596 if (xi.lt.0) xi=xi+boxxsize
21597 yi=dmod(yi,boxysize)
21598 if (yi.lt.0) yi=yi+boxysize
21599 zi=dmod(zi,boxzsize)
21600 if (zi.lt.0) zi=zi+boxzsize
21602 dxi=dc_norm(1,nres+i)
21603 dyi=dc_norm(2,nres+i)
21604 dzi=dc_norm(3,nres+i)
21605 dsci_inv=vbld_inv(i+nres)
21607 !C Calculate SC interaction energy.
21609 do iint=1,nint_gr_nucl(i)
21610 ! print *,"tu?",i,istart_nucl(i,iint),iend_nucl(i,iint)
21611 do j=istart_nucl(i,iint),iend_nucl(i,iint)
21615 if (itypj.eq.ntyp1_molec(2)) cycle
21616 dscj_inv=vbld_inv(j+nres)
21617 sig0ij=sigma_nucl(itypi,itypj)
21618 chi1=chi_nucl(itypi,itypj)
21619 chi2=chi_nucl(itypj,itypi)
21621 chip1=chip_nucl(itypi,itypj)
21622 chip2=chip_nucl(itypj,itypi)
21624 ! xj=c(1,nres+j)-xi
21625 ! yj=c(2,nres+j)-yi
21626 ! zj=c(3,nres+j)-zi
21630 xj=dmod(xj,boxxsize)
21631 if (xj.lt.0) xj=xj+boxxsize
21632 yj=dmod(yj,boxysize)
21633 if (yj.lt.0) yj=yj+boxysize
21634 zj=dmod(zj,boxzsize)
21635 if (zj.lt.0) zj=zj+boxzsize
21636 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21644 xj=xj_safe+xshift*boxxsize
21645 yj=yj_safe+yshift*boxysize
21646 zj=zj_safe+zshift*boxzsize
21647 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21648 if(dist_temp.lt.dist_init) then
21649 dist_init=dist_temp
21658 if (subchap.eq.1) then
21668 dxj=dc_norm(1,nres+j)
21669 dyj=dc_norm(2,nres+j)
21670 dzj=dc_norm(3,nres+j)
21671 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
21673 !C Calculate angle-dependent terms of energy and contributions to their
21678 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
21679 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
21680 om12=dxi*dxj+dyi*dyj+dzi*dzj
21681 call sc_angular_nucl
21683 sig=sig0ij*dsqrt(sigsq)
21684 rij_shift=1.0D0/rij-sig+sig0ij
21685 ! print *,rij_shift,"rij_shift"
21686 !c write (2,*) " rij",1.0D0/rij," sig",sig," sig0ij",sig0ij,
21687 !c & " rij_shift",rij_shift
21688 if (rij_shift.le.0.0D0) then
21693 !c---------------------------------------------------------------
21694 rij_shift=1.0D0/rij_shift
21695 fac=rij_shift**expon
21696 e1=fac*fac*aa_nucl(itypi,itypj)
21697 e2=fac*bb_nucl(itypi,itypj)
21698 evdwij=eps1*eps2rt*(e1+e2)
21699 !c write (2,*) "eps1",eps1," eps2rt",eps2rt,
21700 !c & " e1",e1," e2",e2," evdwij",evdwij
21702 evdwij=evdwij*eps2rt
21703 evdwsb=evdwsb+evdwij
21705 sigm=dabs(aa_nucl(itypi,itypj)/bb_nucl(itypi,itypj))**(1.0D0/6.0D0)
21706 epsi=bb_nucl(itypi,itypj)**2/aa_nucl(itypi,itypj)
21707 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
21708 restyp(itypi,2),i,restyp(itypj,2),j, &
21709 epsi,sigm,chi1,chi2,chip1,chip2, &
21710 eps1,eps2rt**2,sig,sig0ij, &
21711 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
21713 write (iout,*) "aa",aa_nucl(itypi,itypj)," bb",bb_nucl(itypi,itypj)
21716 if (energy_dec) write (iout,'(a6,2i5,e15.3,a4)') &
21717 'evdw',i,j,evdwij,"tu3"
21720 !C Calculate gradient components.
21721 e1=e1*eps1*eps2rt**2
21722 fac=-expon*(e1+evdwij)*rij_shift
21726 !C Calculate the radial part of the gradient
21730 !C Calculate angular part of the gradient.
21732 call eelsbij(eelij,num_conti2)
21733 if (energy_dec .and. &
21734 (j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2)) &
21735 write (istat,'(e14.5)') evdwij
21739 num_cont_hb(i)=num_conti2
21741 !c write (iout,*) "Number of loop steps in EGB:",ind
21742 !cccc energy_dec=.false.
21744 end subroutine esb_gb
21745 !-------------------------------------------------------------------------------
21746 subroutine eelsbij(eesij,num_conti2)
21749 real(kind=8),dimension(3) :: ggg,gggp,gggm,dcosb,dcosg
21750 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
21751 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
21752 dist_temp, dist_init,rlocshield,fracinbuf
21753 integer xshift,yshift,zshift,ilist,iresshield,num_conti2
21755 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
21756 real(kind=8) scal_el /0.5d0/
21757 integer :: iteli,itelj,kkk,kkll,m,isubchap
21758 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp,facfac
21759 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i,ael63i,ael32i
21760 real(kind=8) :: dx_normj,dy_normj,dz_normj,&
21761 r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,fac5,fac6,&
21762 el1,el2,el3,el4,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
21763 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
21764 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
21765 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
21766 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
21767 ecosgp,ecosam,ecosbm,ecosgm,ghalf,itypi,itypj
21771 ! print *,i,j,itypi,itypj,istype(i),istype(j),"????"
21772 ael6i=ael6_nucl(itypi,itypj)
21773 ael3i=ael3_nucl(itypi,itypj)
21774 ael63i=ael63_nucl(itypi,itypj)
21775 ael32i=ael32_nucl(itypi,itypj)
21776 !c write (iout,*) "eelecij",i,j,itype(i),itype(j),
21777 !c & ael6i,ael3i,ael63i,al32i,rij,rrij
21781 dx_normi=dc_norm(1,i+nres)
21782 dy_normi=dc_norm(2,i+nres)
21783 dz_normi=dc_norm(3,i+nres)
21784 dx_normj=dc_norm(1,j+nres)
21785 dy_normj=dc_norm(2,j+nres)
21786 dz_normj=dc_norm(3,j+nres)
21787 !c xj=c(1,j)+0.5D0*dxj-xmedi
21788 !c yj=c(2,j)+0.5D0*dyj-ymedi
21789 !c zj=c(3,j)+0.5D0*dzj-zmedi
21790 if (ipot_nucl.ne.2) then
21791 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
21792 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
21793 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
21801 fac=cosa-3.0D0*cosb*cosg
21803 fac1=3.0d0*(cosb*cosb+cosg*cosg)
21808 !c write (iout,*) "r3ij",r3ij," r6ij",r6ij," fac",fac," fac1",fac1,
21809 !c & " fac2",fac2," fac3",fac3," fac4",fac4," fac5",fac5," fac6",fac6
21810 el1=fac3*(4.0D0+facfac-fac1)
21812 el3=fac5*(2.0d0-2.0d0*facfac+fac1)
21814 eesij=el1+el2+el3+el4
21815 !C 12/26/95 - for the evaluation of multi-body H-bonding interactions
21816 ees0ij=4.0D0+facfac-fac1
21818 if (energy_dec) then
21819 if(j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2) &
21820 write (istat,'(2a1,i4,1x,2a1,i4,4f10.5,3e12.5,$)') &
21821 sugartyp(istype(i)),restyp(itypi,2),i,sugartyp(istype(j)),&
21822 restyp(itypj,2),j,1.0d0/rij,cosa,cosb,cosg,fac*r3ij, &
21823 (4.0D0+facfac-fac1)*r6ij,(2.0d0-2.0d0*facfac+fac1)*r6ij
21824 write (iout,'(a6,2i5,e15.3)') 'ees',i,j,eesij
21828 !C Calculate contributions to the Cartesian gradient.
21830 facel=-3.0d0*rrij*(eesij+el1+el3+el4)
21836 !* Radial derivatives. First process both termini of the fragment (i,j)
21842 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
21843 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
21844 gelsbx(k,j)=gelsbx(k,j)+ggg(k)
21845 gelsbx(k,i)=gelsbx(k,i)-ggg(k)
21850 ecosa=2.0D0*fac3*fac1+fac4+(-4.0d0*fac5+2.0d0*fac6)*fac1
21855 ecosb=fac3*(fac1*cosg+cosb)+cosg*fac4+(cosb+2*fac1*cosg)*fac5+&
21857 ecosg=fac3*(fac1*cosb+cosg)+cosb*fac4+(cosg+2*fac1*cosb)*fac5+&
21860 dcosb(k)=rij*(dc_norm(k,i+nres)-erij(k)*cosb)
21861 dcosg(k)=rij*(dc_norm(k,j+nres)-erij(k)*cosg)
21864 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
21867 gelsbx(k,i)=gelsbx(k,i)-ggg(k) &
21868 +(ecosa*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres))&
21869 + ecosb*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21870 gelsbx(k,j)=gelsbx(k,j)+ggg(k) &
21871 +(ecosa*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
21872 + ecosg*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21873 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
21874 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
21876 ! IF ( (wcorr_nucl.gt.0.0d0.or.wcorr3_nucl.gt.0.0d0) .and.
21877 IF ( j.gt.i+1 .and.&
21878 num_conti.le.maxcont) THEN
21880 !C Calculate the contact function. The ith column of the array JCONT will
21881 !C contain the numbers of atoms that make contacts with the atom I (of numbers
21882 !C greater than I). The arrays FACONT and GACONT will contain the values of
21883 !C the contact function and its derivative.
21884 r0ij=2.20D0*sigma_nucl(itypi,itypj)
21885 !c write (2,*) "ij",i,j," rij",1.0d0/rij," r0ij",r0ij
21886 call gcont(rij,r0ij,1.0D0,0.2d0/r0ij,fcont,fprimcont)
21887 !c write (2,*) "fcont",fcont
21888 if (fcont.gt.0.0D0) then
21889 num_conti=num_conti+1
21890 num_conti2=num_conti2+1
21892 if (num_conti.gt.maxconts) then
21893 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
21894 ' will skip next contacts for this conf.',maxconts
21896 jcont_hb(num_conti,i)=j
21897 !c write (iout,*) "num_conti",num_conti,
21898 !c & " jcont_hb",jcont_hb(num_conti,i)
21899 !C Calculate contact energies
21901 wij=cosa-3.0D0*cosb*cosg
21904 fac3=dsqrt(-ael6i)*r3ij
21905 !c write (2,*) "ael6i",ael6i," r3ij",r3ij," fac3",fac3
21906 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
21907 if (ees0tmp.gt.0) then
21908 ees0pij=dsqrt(ees0tmp)
21912 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
21913 if (ees0tmp.gt.0) then
21914 ees0mij=dsqrt(ees0tmp)
21918 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
21919 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
21920 !c write (iout,*) "i",i," j",j,
21921 !c & " ees0m",ees0m(num_conti,i)," ees0p",ees0p(num_conti,i)
21922 ees0pij1=fac3/ees0pij
21923 ees0mij1=fac3/ees0mij
21924 fac3p=-3.0D0*fac3*rrij
21925 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
21926 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
21927 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
21928 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
21929 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
21930 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
21931 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
21932 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
21933 ecosap=ecosa1+ecosa2
21934 ecosbp=ecosb1+ecosb2
21935 ecosgp=ecosg1+ecosg2
21936 ecosam=ecosa1-ecosa2
21937 ecosbm=ecosb1-ecosb2
21938 ecosgm=ecosg1-ecosg2
21940 facont_hb(num_conti,i)=fcont
21941 fprimcont=fprimcont/rij
21943 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
21944 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
21946 gggp(1)=gggp(1)+ees0pijp*xj
21947 gggp(2)=gggp(2)+ees0pijp*yj
21948 gggp(3)=gggp(3)+ees0pijp*zj
21949 gggm(1)=gggm(1)+ees0mijp*xj
21950 gggm(2)=gggm(2)+ees0mijp*yj
21951 gggm(3)=gggm(3)+ees0mijp*zj
21952 !C Derivatives due to the contact function
21953 gacont_hbr(1,num_conti,i)=fprimcont*xj
21954 gacont_hbr(2,num_conti,i)=fprimcont*yj
21955 gacont_hbr(3,num_conti,i)=fprimcont*zj
21958 !c Gradient of the correlation terms
21960 gacontp_hb1(k,num_conti,i)= &
21961 (ecosap*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
21962 + ecosbp*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21963 gacontp_hb2(k,num_conti,i)= &
21964 (ecosap*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres)) &
21965 + ecosgp*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21966 gacontp_hb3(k,num_conti,i)=gggp(k)
21967 gacontm_hb1(k,num_conti,i)= &
21968 (ecosam*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
21969 + ecosbm*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21970 gacontm_hb2(k,num_conti,i)= &
21971 (ecosam*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
21972 + ecosgm*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21973 gacontm_hb3(k,num_conti,i)=gggm(k)
21979 end subroutine eelsbij
21980 !------------------------------------------------------------------
21981 subroutine sc_grad_nucl
21984 real(kind=8),dimension(3) :: dcosom1,dcosom2
21985 eom1=eps2der*eps2rt_om1+sigder*sigsq_om1
21986 eom2=eps2der*eps2rt_om2+sigder*sigsq_om2
21987 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12+sigder*sigsq_om12
21989 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
21990 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
21993 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
21996 gvdwsbx(k,i)=gvdwsbx(k,i)-gg(k) &
21997 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
21998 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
21999 gvdwsbx(k,j)=gvdwsbx(k,j)+gg(k) &
22000 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
22001 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
22004 !C Calculate the components of the gradient in DC and X
22007 gvdwsbc(l,i)=gvdwsbc(l,i)-gg(l)
22008 gvdwsbc(l,j)=gvdwsbc(l,j)+gg(l)
22011 end subroutine sc_grad_nucl
22012 !-----------------------------------------------------------------------
22013 subroutine esb(esbloc)
22014 !C Calculate the local energy of a side chain and its derivatives in the
22015 !C corresponding virtual-bond valence angles THETA and the spherical angles
22016 !C ALPHA and OMEGA derived from AM1 all-atom calculations.
22017 !C added by Urszula Kozlowska. 07/11/2007
22019 real(kind=8),dimension(3):: x_prime,y_prime,z_prime
22020 real(kind=8),dimension(9):: x
22021 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1, &
22022 sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,&
22023 de_dxx,de_dyy,de_dzz,de_dt,s1_t,s1_6_t,s2_t,s2_6_t
22024 real(kind=8),dimension(3):: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,&
22025 dYY_Ci,dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
22026 real(kind=8) :: esbloc,delta,cosfac2,cosfac,sinfac2,sinfac,de_dtt,&
22027 cossc,cossc1,cosfac2xx,sinfac2yy,pom1,pom
22028 integer::it,nlobit,i,j,k
22029 ! common /sccalc/ time11,time12,time112,theti,it,nlobit
22032 do i=loc_start_nucl,loc_end_nucl
22033 if (itype(i,2).eq.ntyp1_molec(2)) cycle
22034 costtab(i+1) =dcos(theta(i+1))
22035 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
22036 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
22037 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
22038 cosfac2=0.5d0/(1.0d0+costtab(i+1))
22039 cosfac=dsqrt(cosfac2)
22040 sinfac2=0.5d0/(1.0d0-costtab(i+1))
22041 sinfac=dsqrt(sinfac2)
22043 if (it.eq.10) goto 1
22046 !C Compute the axes of tghe local cartesian coordinates system; store in
22047 !c x_prime, y_prime and z_prime
22054 !C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
22055 !C & dc_norm(3,i+nres)
22057 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
22058 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
22061 z_prime(j) = -uz(j,i-1)
22069 xx = xx + x_prime(j)*dc_norm(j,i+nres)
22070 yy = yy + y_prime(j)*dc_norm(j,i+nres)
22071 zz = zz + z_prime(j)*dc_norm(j,i+nres)
22079 x(j) = sc_parmin_nucl(j,it)
22082 !Cc diagnostics - remove later
22083 xx1 = dcos(alph(2))
22084 yy1 = dsin(alph(2))*dcos(omeg(2))
22085 zz1 = -dsin(alph(2))*dsin(omeg(2))
22086 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
22087 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
22089 !C," --- ", xx_w,yy_w,zz_w
22092 sumene = enesc_nucl(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
22093 esbloc = esbloc + sumene
22094 sumene2= enesc_nucl(x,xx,yy,0.0d0,cost2tab(i+1),sint2tab(i+1))
22095 ! print *,"enecomp",sumene,sumene2
22096 ! if (energy_dec) write(iout,*) "i",i," esbloc",sumene,esbloc,xx,yy,zz
22097 ! if (energy_dec) write(iout,*) "x",(x(k),k=1,9)
22099 write (2,*) "x",(x(k),k=1,9)
22101 !C This section to check the numerical derivatives of the energy of ith side
22102 !C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
22103 !C #define DEBUG in the code to turn it on.
22105 write (2,*) "sumene =",sumene
22109 write (2,*) xx,yy,zz
22110 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
22111 de_dxx_num=(sumenep-sumene)/aincr
22113 write (2,*) "xx+ sumene from enesc=",sumenep,sumene
22116 write (2,*) xx,yy,zz
22117 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
22118 de_dyy_num=(sumenep-sumene)/aincr
22120 write (2,*) "yy+ sumene from enesc=",sumenep,sumene
22123 write (2,*) xx,yy,zz
22124 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
22125 de_dzz_num=(sumenep-sumene)/aincr
22127 write (2,*) "zz+ sumene from enesc=",sumenep,sumene
22128 costsave=cost2tab(i+1)
22129 sintsave=sint2tab(i+1)
22130 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
22131 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
22132 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
22133 de_dt_num=(sumenep-sumene)/aincr
22134 write (2,*) " t+ sumene from enesc=",sumenep,sumene
22135 cost2tab(i+1)=costsave
22136 sint2tab(i+1)=sintsave
22137 !C End of diagnostics section.
22140 !C Compute the gradient of esc
22142 de_dxx=x(1)+2*x(4)*xx+x(7)*zz+x(8)*yy
22143 de_dyy=x(2)+2*x(5)*yy+x(8)*xx+x(9)*zz
22144 de_dzz=x(3)+2*x(6)*zz+x(7)*xx+x(9)*yy
22147 write (2,*) "x",(x(k),k=1,9)
22148 write (2,*) "xx",xx," yy",yy," zz",zz
22149 write (2,*) "de_xx ",de_xx," de_yy ",de_yy,&
22150 " de_zz ",de_zz," de_tt ",de_tt
22151 write (2,*) "de_xx_num",de_dxx_num," de_yy_num",de_dyy_num,&
22152 " de_zz_num",de_dzz_num," de_dt_num",de_dt_num
22155 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
22156 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
22157 cosfac2xx=cosfac2*xx
22158 sinfac2yy=sinfac2*yy
22160 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*&
22162 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*&
22164 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
22165 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
22166 !c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
22167 !c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
22168 !c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
22169 !c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
22170 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
22171 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
22172 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
22173 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
22177 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
22178 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
22181 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
22182 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
22183 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
22185 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
22186 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
22190 dXX_Ctab(k,i)=dXX_Ci(k)
22191 dXX_C1tab(k,i)=dXX_Ci1(k)
22192 dYY_Ctab(k,i)=dYY_Ci(k)
22193 dYY_C1tab(k,i)=dYY_Ci1(k)
22194 dZZ_Ctab(k,i)=dZZ_Ci(k)
22195 dZZ_C1tab(k,i)=dZZ_Ci1(k)
22196 dXX_XYZtab(k,i)=dXX_XYZ(k)
22197 dYY_XYZtab(k,i)=dYY_XYZ(k)
22198 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
22201 !c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
22202 !c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
22203 !c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
22204 !c & dyy_ci(k)," dzz_ci",dzz_ci(k)
22205 !c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
22207 !c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
22208 !c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
22209 gsbloc(k,i-1)=gsbloc(k,i-1)+(de_dxx*dxx_ci1(k) &
22210 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k))
22211 gsbloc(k,i)=gsbloc(k,i)+(de_dxx*dxx_Ci(k) &
22212 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k))
22213 gsblocx(k,i)= de_dxx*dxx_XYZ(k)&
22214 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
22215 ! print *,i,de_dxx*dxx_ci1(k)+de_dyy*dyy_ci1(k),de_dzz*dzz_ci1(k)*2
22217 !c write(iout,*) "ENERGY GRAD = ", (gsbloc(k,i-1),k=1,3),
22218 !c & (gsbloc(k,i),k=1,3),(gsblocx(k,i),k=1,3)
22220 !C to check gradient call subroutine check_grad
22226 !=-------------------------------------------------------
22227 real(kind=8) function enesc_nucl(x,xx,yy,zz,cost2,sint2)
22229 real(kind=8),dimension(9):: x(9)
22230 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2, &
22231 sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
22233 !c write (2,*) "enesc"
22234 !c write (2,*) "x",(x(i),i=1,9)
22235 !c write(2,*)"xx",xx," yy",yy," zz",zz," cost2",cost2," sint2",sint2
22236 sumene=x(1)*xx+x(2)*yy+x(3)*zz+x(4)*xx**2 &
22237 + x(5)*yy**2+x(6)*zz**2+x(7)*xx*zz+x(8)*xx*yy &
22241 end function enesc_nucl
22242 !-----------------------------------------------------------------------------
22243 subroutine multibody_hb_nucl(ecorr,ecorr3,n_corr,n_corr1)
22246 integer,parameter :: max_cont=2000
22247 integer,parameter:: max_dim=2*(8*3+6)
22248 integer, parameter :: msglen1=max_cont*max_dim
22249 integer,parameter :: msglen2=2*msglen1
22250 integer source,CorrelType,CorrelID,Error
22251 real(kind=8) :: buffer(max_cont,max_dim)
22252 integer status(MPI_STATUS_SIZE)
22253 integer :: ierror,nbytes
22255 real(kind=8),dimension(3):: gx(3),gx1(3)
22256 real(kind=8) :: time00
22258 integer i,j,i1,j1,jj,kk,num_conti,num_conti1,nn
22259 real(kind=8) ecorr,ecorr3
22260 integer :: n_corr,n_corr1,mm,msglen
22261 !C Set lprn=.true. for debugging
22266 if(.not.allocated(zapas2)) allocate(zapas2(3,maxconts,nres,8))
22268 if (nfgtasks.le.1) goto 30
22270 write (iout,'(a)') 'Contact function values:'
22272 write (iout,'(2i3,50(1x,i2,f5.2))') &
22273 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
22274 j=1,num_cont_hb(i))
22277 !C Caution! Following code assumes that electrostatic interactions concerning
22278 !C a given atom are split among at most two processors!
22288 !c write (*,*) 'MyRank',MyRank,' mm',mm
22291 !c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
22292 if (fg_rank.gt.0) then
22293 !C Send correlation contributions to the preceding processor
22295 nn=num_cont_hb(iatel_s_nucl)
22296 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
22297 !c write (*,*) 'The BUFFER array:'
22299 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
22301 if (ielstart_nucl(iatel_s_nucl).gt.iatel_s_nucl+ispp) then
22303 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
22304 !C Clear the contacts of the atom passed to the neighboring processor
22305 nn=num_cont_hb(iatel_s_nucl+1)
22307 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
22309 num_cont_hb(iatel_s_nucl)=0
22311 !cd write (iout,*) 'Processor ',fg_rank,MyRank,
22312 !cd & ' is sending correlation contribution to processor',fg_rank-1,
22313 !cd & ' msglen=',msglen
22314 !c write (*,*) 'Processor ',fg_rank,MyRank,
22315 !c & ' is sending correlation contribution to processor',fg_rank-1,
22316 !c & ' msglen=',msglen,' CorrelType=',CorrelType
22318 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, &
22319 CorrelType,FG_COMM,IERROR)
22320 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
22321 !cd write (iout,*) 'Processor ',fg_rank,
22322 !cd & ' has sent correlation contribution to processor',fg_rank-1,
22323 !cd & ' msglen=',msglen,' CorrelID=',CorrelID
22324 !c write (*,*) 'Processor ',fg_rank,
22325 !c & ' has sent correlation contribution to processor',fg_rank-1,
22326 !c & ' msglen=',msglen,' CorrelID=',CorrelID
22328 endif ! (fg_rank.gt.0)
22332 !c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
22333 if (fg_rank.lt.nfgtasks-1) then
22334 !C Receive correlation contributions from the next processor
22336 if (ielend_nucl(iatel_e_nucl).lt.nct_molec(2)-1) msglen=msglen2
22337 !cd write (iout,*) 'Processor',fg_rank,
22338 !cd & ' is receiving correlation contribution from processor',fg_rank+1,
22339 !cd & ' msglen=',msglen,' CorrelType=',CorrelType
22340 !c write (*,*) 'Processor',fg_rank,
22341 !c &' is receiving correlation contribution from processor',fg_rank+1,
22342 !c & ' msglen=',msglen,' CorrelType=',CorrelType
22345 do while (nbytes.le.0)
22346 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
22347 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
22349 !c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
22350 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, &
22351 fg_rank+1,CorrelType,FG_COMM,status,IERROR)
22352 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
22353 !c write (*,*) 'Processor',fg_rank,
22354 !c &' has received correlation contribution from processor',fg_rank+1,
22355 !c & ' msglen=',msglen,' nbytes=',nbytes
22356 !c write (*,*) 'The received BUFFER array:'
22358 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
22360 if (msglen.eq.msglen1) then
22361 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,0,buffer)
22362 else if (msglen.eq.msglen2) then
22363 call unpack_buffer(max_cont,max_dim,iatel_e_nucl,0,buffer)
22364 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,30,buffer)
22367 'ERROR!!!! message length changed while processing correlations.'
22369 'ERROR!!!! message length changed while processing correlations.'
22370 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
22371 endif ! msglen.eq.msglen1
22372 endif ! fg_rank.lt.nfgtasks-1
22379 write (iout,'(a)') 'Contact function values:'
22380 do i=nnt_molec(2),nct_molec(2)-1
22381 write (iout,'(2i3,50(1x,i2,f5.2))') &
22382 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
22383 j=1,num_cont_hb(i))
22388 !C Remove the loop below after debugging !!!
22389 ! do i=nnt_molec(2),nct_molec(2)
22391 ! gradcorr_nucl(j,i)=0.0D0
22392 ! gradxorr_nucl(j,i)=0.0D0
22393 ! gradcorr3_nucl(j,i)=0.0D0
22394 ! gradxorr3_nucl(j,i)=0.0D0
22397 ! print *,"iatsc_s_nucl,iatsc_e_nucl",iatsc_s_nucl,iatsc_e_nucl
22398 !C Calculate the local-electrostatic correlation terms
22399 do i=iatsc_s_nucl,iatsc_e_nucl
22401 num_conti=num_cont_hb(i)
22402 num_conti1=num_cont_hb(i+1)
22403 ! print *,i,num_conti,num_conti1
22408 !c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
22409 !c & ' jj=',jj,' kk=',kk
22410 if (j1.eq.j+1 .or. j1.eq.j-1) then
22412 !C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
22413 !C The system gains extra energy.
22414 !C Tentative expression & coefficients; assumed d(stacking)=4.5 A,
22415 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
22416 !C Need to implement full formulas 34 and 35 from Liwo et al., 1998.
22418 ecorr=ecorr+ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
22419 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
22420 'ecorrh',i,j,ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
22422 else if (j1.eq.j) then
22424 !C Contacts I-J and I-(J+1) occur simultaneously.
22425 !C The system loses extra energy.
22426 !C Tentative expression & c?oefficients; assumed d(stacking)=4.5 A,
22427 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
22428 !C Need to implement full formulas 32 from Liwo et al., 1998.
22430 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
22431 !c & ' jj=',jj,' kk=',kk
22432 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i+1,j,jj,kk,0.310D0,-0.155D0)
22437 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
22438 !c & ' jj=',jj,' kk=',kk
22439 if (j1.eq.j+1) then
22440 !C Contacts I-J and (I+1)-J occur simultaneously.
22441 !C The system loses extra energy.
22442 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i,j+1,jj,kk,0.310D0,-0.155D0)
22448 end subroutine multibody_hb_nucl
22449 !-----------------------------------------------------------
22450 real(kind=8) function ehbcorr_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
22451 ! implicit real*8 (a-h,o-z)
22452 ! include 'DIMENSIONS'
22453 ! include 'COMMON.IOUNITS'
22454 ! include 'COMMON.DERIV'
22455 ! include 'COMMON.INTERACT'
22456 ! include 'COMMON.CONTACTS'
22457 real(kind=8),dimension(3) :: gx,gx1
22459 !el local variables
22460 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
22461 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
22462 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
22463 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
22467 eij=facont_hb(jj,i)
22468 ekl=facont_hb(kk,k)
22469 ees0pij=ees0p(jj,i)
22470 ees0pkl=ees0p(kk,k)
22471 ees0mij=ees0m(jj,i)
22472 ees0mkl=ees0m(kk,k)
22474 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
22475 ! print *,"ehbcorr_nucl",ekont,ees
22476 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
22477 !C Following 4 lines for diagnostics.
22482 !cd write (iout,*)'Contacts have occurred for nucleic bases',
22483 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
22484 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
22485 !C Calculate the multi-body contribution to energy.
22486 ! ecorr_nucl=ecorr_nucl+ekont*ees
22487 !C Calculate multi-body contributions to the gradient.
22488 coeffpees0pij=coeffp*ees0pij
22489 coeffmees0mij=coeffm*ees0mij
22490 coeffpees0pkl=coeffp*ees0pkl
22491 coeffmees0mkl=coeffm*ees0mkl
22493 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i) &
22494 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
22495 coeffmees0mkl*gacontm_hb1(ll,jj,i))
22496 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j) &
22497 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+&
22498 coeffmees0mkl*gacontm_hb2(ll,jj,i))
22499 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k) &
22500 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
22501 coeffmees0mij*gacontm_hb1(ll,kk,k))
22502 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l) &
22503 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
22504 coeffmees0mij*gacontm_hb2(ll,kk,k))
22505 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
22506 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
22507 coeffmees0mkl*gacontm_hb3(ll,jj,i))
22508 gradcorr_nucl(ll,j)=gradcorr_nucl(ll,j)+gradlongij
22509 gradcorr_nucl(ll,i)=gradcorr_nucl(ll,i)-gradlongij
22510 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
22511 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
22512 coeffmees0mij*gacontm_hb3(ll,kk,k))
22513 gradcorr_nucl(ll,l)=gradcorr_nucl(ll,l)+gradlongkl
22514 gradcorr_nucl(ll,k)=gradcorr_nucl(ll,k)-gradlongkl
22515 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i)-gradlongij
22516 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j)+gradlongij
22517 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k)-gradlongkl
22518 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l)+gradlongkl
22520 ehbcorr_nucl=ekont*ees
22522 end function ehbcorr_nucl
22523 !-------------------------------------------------------------------------
22525 real(kind=8) function ehbcorr3_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
22526 ! implicit real*8 (a-h,o-z)
22527 ! include 'DIMENSIONS'
22528 ! include 'COMMON.IOUNITS'
22529 ! include 'COMMON.DERIV'
22530 ! include 'COMMON.INTERACT'
22531 ! include 'COMMON.CONTACTS'
22532 real(kind=8),dimension(3) :: gx,gx1
22534 !el local variables
22535 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
22536 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
22537 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
22538 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
22542 eij=facont_hb(jj,i)
22543 ekl=facont_hb(kk,k)
22544 ees0pij=ees0p(jj,i)
22545 ees0pkl=ees0p(kk,k)
22546 ees0mij=ees0m(jj,i)
22547 ees0mkl=ees0m(kk,k)
22549 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
22550 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
22551 !C Following 4 lines for diagnostics.
22556 !cd write (iout,*)'Contacts have occurred for nucleic bases',
22557 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
22558 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
22559 !C Calculate the multi-body contribution to energy.
22560 ! ecorr=ecorr+ekont*ees
22561 !C Calculate multi-body contributions to the gradient.
22562 coeffpees0pij=coeffp*ees0pij
22563 coeffmees0mij=coeffm*ees0mij
22564 coeffpees0pkl=coeffp*ees0pkl
22565 coeffmees0mkl=coeffm*ees0mkl
22567 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i) &
22568 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
22569 coeffmees0mkl*gacontm_hb1(ll,jj,i))
22570 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j) &
22571 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
22572 coeffmees0mkl*gacontm_hb2(ll,jj,i))
22573 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k) &
22574 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ &
22575 coeffmees0mij*gacontm_hb1(ll,kk,k))
22576 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l) &
22577 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
22578 coeffmees0mij*gacontm_hb2(ll,kk,k))
22579 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
22580 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
22581 coeffmees0mkl*gacontm_hb3(ll,jj,i))
22582 gradcorr3_nucl(ll,j)=gradcorr3_nucl(ll,j)+gradlongij
22583 gradcorr3_nucl(ll,i)=gradcorr3_nucl(ll,i)-gradlongij
22584 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
22585 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
22586 coeffmees0mij*gacontm_hb3(ll,kk,k))
22587 gradcorr3_nucl(ll,l)=gradcorr3_nucl(ll,l)+gradlongkl
22588 gradcorr3_nucl(ll,k)=gradcorr3_nucl(ll,k)-gradlongkl
22589 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i)-gradlongij
22590 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j)+gradlongij
22591 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k)-gradlongkl
22592 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l)+gradlongkl
22594 ehbcorr3_nucl=ekont*ees
22596 end function ehbcorr3_nucl
22598 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
22599 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
22600 real(kind=8):: buffer(dimen1,dimen2)
22601 num_kont=num_cont_hb(atom)
22605 buffer(i,indx+(k-1)*3+j)=zapas2(j,i,atom,k)
22608 buffer(i,indx+25)=facont_hb(i,atom)
22609 buffer(i,indx+26)=ees0p(i,atom)
22610 buffer(i,indx+27)=ees0m(i,atom)
22611 buffer(i,indx+28)=d_cont(i,atom)
22612 buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
22614 buffer(1,indx+30)=dfloat(num_kont)
22616 end subroutine pack_buffer
22617 !c------------------------------------------------------------------------------
22618 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
22619 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
22620 real(kind=8):: buffer(dimen1,dimen2)
22621 ! double precision zapas
22622 ! common /contacts_hb/ zapas(3,maxconts,maxres,8),
22623 ! & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
22624 ! & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
22625 ! & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
22626 num_kont=buffer(1,indx+30)
22627 num_kont_old=num_cont_hb(atom)
22628 num_cont_hb(atom)=num_kont+num_kont_old
22633 zapas2(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
22636 facont_hb(ii,atom)=buffer(i,indx+25)
22637 ees0p(ii,atom)=buffer(i,indx+26)
22638 ees0m(ii,atom)=buffer(i,indx+27)
22639 d_cont(i,atom)=buffer(i,indx+28)
22640 jcont_hb(ii,atom)=buffer(i,indx+29)
22643 end subroutine unpack_buffer
22644 !c------------------------------------------------------------------------------
22646 subroutine ecatcat(ecationcation)
22647 integer :: i,j,itmp,xshift,yshift,zshift,subchap,k,itypi,itypj
22648 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
22649 r7,r4,ecationcation,k0,rcal
22650 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
22651 dist_init,dist_temp,Evan1cat,Evan2cat,Eeleccat
22652 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
22655 ecationcation=0.0d0
22656 if (nres_molec(5).eq.0) return
22661 ! k0 = 332.0*(2.0*2.0)/80.0
22665 itmp=itmp+nres_molec(i)
22667 ! write(iout,*) "itmp",itmp
22668 do i=itmp+1,itmp+nres_molec(5)-1
22674 xi=mod(xi,boxxsize)
22675 if (xi.lt.0) xi=xi+boxxsize
22676 yi=mod(yi,boxysize)
22677 if (yi.lt.0) yi=yi+boxysize
22678 zi=mod(zi,boxzsize)
22679 if (zi.lt.0) zi=zi+boxzsize
22681 do j=i+1,itmp+nres_molec(5)
22683 k0 = 332.0*(ichargecat(itypi)*ichargecat(itypj))/80.0
22684 ! print *,i,j,'catcat'
22688 xj=dmod(xj,boxxsize)
22689 if (xj.lt.0) xj=xj+boxxsize
22690 yj=dmod(yj,boxysize)
22691 if (yj.lt.0) yj=yj+boxysize
22692 zj=dmod(zj,boxzsize)
22693 if (zj.lt.0) zj=zj+boxzsize
22694 ! write(iout,*) c(1,i),xi,xj,"xy",boxxsize
22695 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22703 xj=xj_safe+xshift*boxxsize
22704 yj=yj_safe+yshift*boxysize
22705 zj=zj_safe+zshift*boxzsize
22706 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22707 if(dist_temp.lt.dist_init) then
22708 dist_init=dist_temp
22717 if (subchap.eq.1) then
22726 rcal =xj**2+yj**2+zj**2
22732 ! k0 = 332*(2*2)/80
22733 Evan1cat=epscalc*(r012/rcal**6)
22734 Evan2cat=epscalc*2*(r06/rcal**3)
22742 dEvan1Cmcat(k)=-12*r(k)*epscalc*r012/r7
22743 dEvan2Cmcat(k)=-12*r(k)*epscalc*r06/r4
22744 dEeleccat(k)=-k0*r(k)/ract**3
22747 gg(k) = dEvan1Cmcat(k)+dEvan2Cmcat(k)+dEeleccat(k)
22748 gradcatcat(k,i)=gradcatcat(k,i)-gg(k)
22749 gradcatcat(k,j)=gradcatcat(k,j)+gg(k)
22752 ! write(iout,*) "ecatcat",i,j, ecationcation,xj,yj,zj
22753 ecationcation=ecationcation+Evan1cat+Evan2cat+Eeleccat
22757 end subroutine ecatcat
22758 !---------------------------------------------------------------------------
22760 subroutine ecats_prot_amber(evdw)
22761 ! subroutine ecat_prot2(ecation_prot)
22766 !el local variables
22767 integer :: iint,itypi1,subchap,isel,itmp
22768 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,e1,e2,sigm,epsi
22769 real(kind=8) :: evdw
22770 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
22771 dist_temp, dist_init,ssgradlipi,ssgradlipj, &
22772 sslipi,sslipj,faclip,alpha_sco
22774 real(kind=8) :: fracinbuf
22775 real (kind=8) :: escpho
22776 real (kind=8),dimension(4):: ener
22777 real(kind=8) :: b1,b2,egb
22778 real(kind=8) :: Fisocav,ECL,Elj,Equad,Epol,eheadtail,&
22780 Chif,ChiLambf,Fcav,dFdR,dFdOM1,&
22781 ecations_prot_amber,dFdOM2,dFdL,dFdOM12,&
22784 ! real(kind=8),dimension(3,2)::erhead_tail
22785 ! real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead,Rtail_distance
22786 real(kind=8) :: facd4, adler, Fgb, facd3
22787 integer troll,jj,istate
22788 real (kind=8) :: dcosom1(3),dcosom2(3)
22790 ecations_prot_amber=0.0D0
22791 if (nres_molec(5).eq.0) return
22793 ! sss_ele_cut=1.0d0
22797 itmp=itmp+nres_molec(i)
22799 ! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
22800 do i=ibond_start,ibond_end
22802 ! print *,"I am in EVDW",i
22803 itypi=iabs(itype(i,1))
22804 ! if (i.ne.47) cycle
22805 if (itypi.eq.ntyp1) cycle
22806 itypi1=iabs(itype(i+1,1))
22810 xi=dmod(xi,boxxsize)
22811 if (xi.lt.0) xi=xi+boxxsize
22812 yi=dmod(yi,boxysize)
22813 if (yi.lt.0) yi=yi+boxysize
22814 zi=dmod(zi,boxzsize)
22815 if (zi.lt.0) zi=zi+boxzsize
22816 dxi=dc_norm(1,nres+i)
22817 dyi=dc_norm(2,nres+i)
22818 dzi=dc_norm(3,nres+i)
22819 dsci_inv=vbld_inv(i+nres)
22820 do j=itmp+1,itmp+nres_molec(5)
22822 ! Calculate SC interaction energy.
22823 itypj=iabs(itype(j,5))
22824 if ((itypj.eq.ntyp1)) cycle
22825 CALL elgrad_init_cat(eheadtail,Egb,Ecl,Elj,Equad,Epol)
22831 xj=dmod(xj,boxxsize)
22832 if (xj.lt.0) xj=xj+boxxsize
22833 yj=dmod(yj,boxysize)
22834 if (yj.lt.0) yj=yj+boxysize
22835 zj=dmod(zj,boxzsize)
22836 if (zj.lt.0) zj=zj+boxzsize
22837 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22846 xj=xj_safe+xshift*boxxsize
22847 yj=yj_safe+yshift*boxysize
22848 zj=zj_safe+zshift*boxzsize
22849 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22850 if(dist_temp.lt.dist_init) then
22851 dist_init=dist_temp
22860 if (subchap.eq.1) then
22870 ! dxj = dc_norm( 1, nres+j )
22871 ! dyj = dc_norm( 2, nres+j )
22872 ! dzj = dc_norm( 3, nres+j )
22876 ! Parameters from fitting the analitical expressions to the PMF obtained by umbrella
22877 ! sampling performed with amber package
22881 ! a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
22882 chi1 = chicat(itypi,itypj)
22883 chis1 = chiscat(itypi,itypj)
22884 chip1 = chippcat(itypi,itypj)
22891 ! chis2 = chis(itypj,itypi)
22892 chis12 = chis1 * chis2
22893 sig1 = sigmap1cat(itypi,itypj)
22894 ! sig2 = sigmap2(itypi,itypj)
22895 ! alpha factors from Fcav/Gcav
22896 b1cav = alphasurcat(1,itypi,itypj)
22897 b2cav = alphasurcat(2,itypi,itypj)
22898 b3cav = alphasurcat(3,itypi,itypj)
22899 b4cav = alphasurcat(4,itypi,itypj)
22901 ! used to determine whether we want to do quadrupole calculations
22902 eps_in = epsintabcat(itypi,itypj)
22903 if (eps_in.eq.0.0) eps_in=1.0
22905 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
22909 ctail(k,1)=c(k,i+nres)
22912 !c! tail distances will be themselves usefull elswhere
22913 !c1 (in Gcav, for example)
22914 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
22915 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
22916 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
22918 (Rtail_distance(1)*Rtail_distance(1)) &
22919 + (Rtail_distance(2)*Rtail_distance(2)) &
22920 + (Rtail_distance(3)*Rtail_distance(3)))
22921 ! tail location and distance calculations
22923 d1 = dheadcat(1, 1, itypi, itypj)
22924 ! d2 = dhead(2, 1, itypi, itypj)
22926 ! location of polar head is computed by taking hydrophobic centre
22927 ! and moving by a d1 * dc_norm vector
22928 ! see unres publications for very informative images
22929 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
22930 chead(k,2) = c(k, j)
22932 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
22933 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
22934 Rhead_distance(k) = chead(k,2) - chead(k,1)
22936 ! pitagoras (root of sum of squares)
22938 (Rhead_distance(1)*Rhead_distance(1)) &
22939 + (Rhead_distance(2)*Rhead_distance(2)) &
22940 + (Rhead_distance(3)*Rhead_distance(3)))
22941 !-------------------------------------------------------------------
22942 ! zero everything that should be zero'ed
22960 dscj_inv = vbld_inv(j+nres)
22961 ! print *,i,j,dscj_inv,dsci_inv
22962 ! rij holds 1/(distance of Calpha atoms)
22963 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
22966 ! this should be in elgrad_init but om's are calculated by sc_angular
22967 ! which in turn is used by older potentials
22968 ! om = omega, sqom = om^2
22971 sqom12 = om12 * om12
22973 ! now we calculate EGB - Gey-Berne
22974 ! It will be summed up in evdwij and saved in evdw
22975 sigsq = 1.0D0 / sigsq
22976 sig = sig0ij * dsqrt(sigsq)
22977 ! rij_shift = 1.0D0 / rij - sig + sig0ij
22978 rij_shift = Rtail - sig + sig0ij
22979 IF (rij_shift.le.0.0D0) THEN
22983 sigder = -sig * sigsq
22984 rij_shift = 1.0D0 / rij_shift
22985 fac = rij_shift**expon
22986 c1 = fac * fac * aa_aq_cat(itypi,itypj)
22987 ! print *,"ADAM",aa_aq(itypi,itypj)
22990 c2 = fac * bb_aq_cat(itypi,itypj)
22992 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
22993 eps2der = eps3rt * evdwij
22994 eps3der = eps2rt * evdwij
22995 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
22996 evdwij = eps2rt * eps3rt * evdwij
22998 ! IF (bb_aq(itypi,itypj).gt.0) THEN
22999 ! evdw_p = evdw_p + evdwij
23001 ! evdw_m = evdw_m + evdwij
23007 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
23008 fac = -expon * (c1 + evdwij) * rij_shift
23009 sigder = fac * sigder
23010 ! Calculate distance derivative
23015 fac = chis1 * sqom1 + chis2 * sqom2 &
23016 - 2.0d0 * chis12 * om1 * om2 * om12
23017 pom = 1.0d0 - chis1 * chis2 * sqom12
23018 Lambf = (1.0d0 - (fac / pom))
23019 Lambf = dsqrt(Lambf)
23020 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
23021 Chif = Rtail * sparrow
23022 ChiLambf = Chif * Lambf
23023 eagle = dsqrt(ChiLambf)
23024 bat = ChiLambf ** 11.0d0
23025 top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
23026 bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
23030 dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
23031 dbot = 12.0d0 * b4cav * bat * Lambf
23032 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
23034 dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
23035 dbot = 12.0d0 * b4cav * bat * Chif
23036 eagle = Lambf * pom
23037 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
23038 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
23039 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
23040 * (chis2 * om2 * om12 - om1) / (eagle * pom)
23042 dFdL = ((dtop * bot - top * dbot) / botsq)
23043 dCAVdOM1 = dFdL * ( dFdOM1 )
23044 dCAVdOM2 = dFdL * ( dFdOM2 )
23045 dCAVdOM12 = dFdL * ( dFdOM12 )
23048 ertail(k) = Rtail_distance(k)/Rtail
23050 erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
23051 erdxj = scalar( ertail(1), dC_norm(1,j) )
23052 facd1 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
23053 facd2 = dtailcat(2,itypi,itypj) * vbld_inv(j+nres)
23055 pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
23056 gradpepcatx(k,i) = gradpepcatx(k,i) &
23057 - (( dFdR + gg(k) ) * pom)
23058 pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
23059 ! gvdwx(k,j) = gvdwx(k,j) &
23060 ! + (( dFdR + gg(k) ) * pom)
23061 gradpepcat(k,i) = gradpepcat(k,i) &
23062 - (( dFdR + gg(k) ) * ertail(k))
23063 gradpepcat(k,j) = gradpepcat(k,j) &
23064 + (( dFdR + gg(k) ) * ertail(k))
23067 !c! Compute head-head and head-tail energies for each state
23068 isel = iabs(Qi) + iabs(Qj)
23069 IF (isel.eq.0) THEN
23070 !c! No charges - do nothing
23073 ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
23074 !c! Nonpolar-charge interactions
23075 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
23079 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
23086 ! eheadtail = 0.0d0
23088 ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
23089 !c! Dipole-charge interactions
23090 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
23094 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
23098 CALL edq_cat(ecl, elj, epol)
23099 eheadtail = ECL + elj + epol
23100 ! eheadtail = 0.0d0
23102 ELSE IF ((isel.eq.2.and. &
23103 iabs(Qi).eq.1).and. &
23104 nstatecat(itypi,itypj).eq.1) THEN
23106 !c! Same charge-charge interaction ( +/+ or -/- )
23107 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
23111 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
23116 CALL eqq_cat(Ecl,Egb,Epol,Fisocav,Elj)
23117 eheadtail = ECL + Egb + Epol + Fisocav + Elj
23118 ! eheadtail = 0.0d0
23120 ! ELSE IF ((isel.eq.2.and. &
23121 ! iabs(Qi).eq.1).and. &
23122 ! nstate(itypi,itypj).ne.1) THEN
23123 !c! Different charge-charge interaction ( +/- or -/+ )
23124 ! if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
23128 ! if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
23133 ! CALL energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
23134 END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
23135 evdw = evdw + Fcav + eheadtail
23137 IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
23138 restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
23139 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
23140 Equad,evdwij+Fcav+eheadtail,evdw
23141 ! evdw = evdw + Fcav + eheadtail
23143 ! iF (nstate(itypi,itypj).eq.1) THEN
23146 !c!-------------------------------------------------------------------
23150 !c write (iout,*) "Number of loop steps in EGB:",ind
23151 !c energy_dec=.false.
23152 ! print *,"EVDW KURW",evdw,nres
23155 end subroutine ecats_prot_amber
23157 !---------------------------------------------------------------------------
23159 subroutine ecat_prot(ecation_prot)
23162 integer i,j,k,subchap,itmp,inum
23163 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
23164 r7,r4,ecationcation
23165 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
23166 dist_init,dist_temp,ecation_prot,rcal,rocal, &
23167 Evan1,Evan2,EC,cm1mag,DASGL,delta,r0p,Epepcat, &
23168 catl,cml,calpl, Etotal_p, Etotal_m,rtab,wdip,wmodquad,wquad1, &
23169 wquad2,wvan1,E1,E2,wconst,wvan2,rcpm,dcmag,sin2thet,sinthet, &
23170 costhet,v1m,v2m,wh2o,wc,rsecp,Ir,Irsecp,Irthrp,Irfourp,Irfiftp,&
23171 Irsistp,Irseven,Irtwelv,Irthir,dE1dr,dE2dr,dEdcos,wquad2p,opt, &
23172 rs,rthrp,rfourp,rsixp,reight,Irsixp,Ireight,Irtw,Irfourt, &
23173 opt1,opt2,opt3,opt4,opt5,opt6,opt7,opt8,opt9,opt10,opt11,opt12,&
23174 opt13,opt14,opt15,opt16,opt17,opt18,opt19, &
23175 Equad1,Equad2,dscmag,v1dpv2,dscmag3,constA,constB,Edip,&
23177 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
23178 gg,r,EtotalCat,dEtotalCm,dEtotalCalp,dEvan1Cm,dEvan2Cm, &
23179 dEtotalpep,dEtotalcat_num,dEddci,dEtotalcm_num,dEtotalcalp_num, &
23180 tab1,tab2,tab3,diff,cm1,sc,p,tcat,talp,cm,drcp,drcp_norm,vcat, &
23181 v1,v2,v3,myd_norm,dx,vcm,valpha,drdpep,dcosdpep,dcosddci,dEdpep,&
23182 dEcCat,dEdipCm,dEdipCalp,dEquad1Cat,dEquad1Cm,dEquad1Calp, &
23183 dEquad2Cat,dEquad2Cm,dEquad2Calpd,Evan1Cat,dEvan1Calp,dEvan2Cat,&
23184 dEvan2Calp,dEtotalCat,dscvec,dEcCm,dEcCalp,dEdipCat,dEquad2Calp,&
23186 real(kind=8),dimension(6) :: vcatprm
23188 ! first lets calculate interaction with peptide groups
23189 if (nres_molec(5).eq.0) return
23192 itmp=itmp+nres_molec(i)
23194 ! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
23195 do i=ibond_start,ibond_end
23197 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle ! leave dummy atoms
23198 xi=0.5d0*(c(1,i)+c(1,i+1))
23199 yi=0.5d0*(c(2,i)+c(2,i+1))
23200 zi=0.5d0*(c(3,i)+c(3,i+1))
23201 xi=mod(xi,boxxsize)
23202 if (xi.lt.0) xi=xi+boxxsize
23203 yi=mod(yi,boxysize)
23204 if (yi.lt.0) yi=yi+boxysize
23205 zi=mod(zi,boxzsize)
23206 if (zi.lt.0) zi=zi+boxzsize
23208 do j=itmp+1,itmp+nres_molec(5)
23209 ! print *,"WTF",itmp,j,i
23210 ! all parameters were for Ca2+ to approximate single charge divide by two
23212 if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
23214 wdip =1.092777950857032D2
23216 wmodquad=-2.174122713004870D4
23217 wmodquad=wmodquad/wconst
23218 wquad1 = 3.901232068562804D1
23219 wquad1=wquad1/wconst
23221 wquad2=wquad2/wconst
23229 xj=dmod(xj,boxxsize)
23230 if (xj.lt.0) xj=xj+boxxsize
23231 yj=dmod(yj,boxysize)
23232 if (yj.lt.0) yj=yj+boxysize
23233 zj=dmod(zj,boxzsize)
23234 if (zj.lt.0) zj=zj+boxzsize
23235 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23243 xj=xj_safe+xshift*boxxsize
23244 yj=yj_safe+yshift*boxysize
23245 zj=zj_safe+zshift*boxzsize
23246 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23247 if(dist_temp.lt.dist_init) then
23248 dist_init=dist_temp
23257 if (subchap.eq.1) then
23268 rcpm = sqrt(xj**2+yj**2+zj**2)
23269 drcp_norm(1)=xj/rcpm
23270 drcp_norm(2)=yj/rcpm
23271 drcp_norm(3)=zj/rcpm
23274 dcmag=dcmag+dc(k,i)**2
23278 myd_norm(k)=dc(k,i)/dcmag
23280 costhet=drcp_norm(1)*myd_norm(1)+drcp_norm(2)*myd_norm(2)+&
23281 drcp_norm(3)*myd_norm(3)
23284 Irsecp = 1.0d0/rsecp
23285 Irthrp = Irsecp/rcpm
23286 Irfourp = Irthrp/rcpm
23287 Irfiftp = Irfourp/rcpm
23288 Irsistp=Irfiftp/rcpm
23289 Irseven=Irsistp/rcpm
23290 Irtwelv=Irsistp*Irsistp
23291 Irthir=Irtwelv/rcpm
23292 sin2thet = (1-costhet*costhet)
23293 sinthet=sqrt(sin2thet)
23294 E1 = wdip*Irsecp*costhet+(wmodquad*Irfourp+wquad1*Irthrp)&
23296 E2 = -wquad1*Irthrp*wquad2+wvan1*(wvan2**12*Irtwelv-&
23297 2*wvan2**6*Irsistp)
23298 ecation_prot = ecation_prot+E1+E2
23299 ! print *,"ecatprot",i,j,ecation_prot,rcpm
23300 dE1dr = -2*costhet*wdip*Irthrp-&
23301 (4*wmodquad*Irfiftp+3*wquad1*Irfourp)*sin2thet
23302 dE2dr = 3*wquad1*wquad2*Irfourp- &
23303 12*wvan1*wvan2**6*(wvan2**6*Irthir-Irseven)
23304 dEdcos = wdip*Irsecp-2*(wmodquad*Irfourp+wquad1*Irthrp)*costhet
23306 drdpep(k) = -drcp_norm(k)
23307 dcosdpep(k) = Ir*(costhet*drcp_norm(k)-myd_norm(k))
23308 dcosddci(k) = drcp_norm(k)/dcmag-costhet*myd_norm(k)/dcmag
23309 dEdpep(k) = (dE1dr+dE2dr)*drdpep(k)+dEdcos*dcosdpep(k)
23310 dEddci(k) = dEdcos*dcosddci(k)
23313 gradpepcat(k,i)=gradpepcat(k,i)+0.5D0*dEdpep(k)-dEddci(k)
23314 gradpepcat(k,i+1)=gradpepcat(k,i+1)+0.5D0*dEdpep(k)+dEddci(k)
23315 gradpepcat(k,j)=gradpepcat(k,j)-dEdpep(k)
23319 !------------------------------------------sidechains
23320 ! do i=1,nres_molec(1)
23321 do i=ibond_start,ibond_end
23322 if ((itype(i,1).eq.ntyp1)) cycle ! leave dummy atoms
23324 ! print *,i,ecation_prot
23328 xi=mod(xi,boxxsize)
23329 if (xi.lt.0) xi=xi+boxxsize
23330 yi=mod(yi,boxysize)
23331 if (yi.lt.0) yi=yi+boxysize
23332 zi=mod(zi,boxzsize)
23333 if (zi.lt.0) zi=zi+boxzsize
23335 cm1(k)=dc(k,i+nres)
23337 cm1mag=sqrt(cm1(1)**2+cm1(2)**2+cm1(3)**2)
23338 do j=itmp+1,itmp+nres_molec(5)
23340 if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
23345 xj=dmod(xj,boxxsize)
23346 if (xj.lt.0) xj=xj+boxxsize
23347 yj=dmod(yj,boxysize)
23348 if (yj.lt.0) yj=yj+boxysize
23349 zj=dmod(zj,boxzsize)
23350 if (zj.lt.0) zj=zj+boxzsize
23351 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23359 xj=xj_safe+xshift*boxxsize
23360 yj=yj_safe+yshift*boxysize
23361 zj=zj_safe+zshift*boxzsize
23362 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23363 if(dist_temp.lt.dist_init) then
23364 dist_init=dist_temp
23373 if (subchap.eq.1) then
23385 if((itype(i,1).eq.15.or.itype(i,1).eq.16).or.&
23386 ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.&
23387 (itype(i,1).eq.25))) then
23388 if(itype(i,1).eq.16) then
23394 vcatprm(k)=catprm(k,inum)
23396 dASGL=catprm(7,inum)
23398 ! vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
23399 vcm(1)=(cm1(1)/cm1mag)*dASGL+xi
23400 vcm(2)=(cm1(2)/cm1mag)*dASGL+yi
23401 vcm(3)=(cm1(3)/cm1mag)*dASGL+zi
23405 if (subchap.eq.1) then
23414 valpha(1)=xi-c(1,i+nres)+c(1,i)
23415 valpha(2)=yi-c(2,i+nres)+c(2,i)
23416 valpha(3)=zi-c(3,i+nres)+c(3,i)
23420 dx(k) = vcat(k)-vcm(k)
23423 v1(k)=(vcm(k)-valpha(k))
23424 v2(k)=(vcat(k)-valpha(k))
23426 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
23427 v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
23428 v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
23430 ! The weights of the energy function calculated from
23431 !The quantum mechanical GAMESS simulations of calcium with ASP/GLU
23432 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
23438 if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
23447 wquad2 = vcatprm(4)
23449 wquad2p = 1.0d0-wquad2
23452 opt = dx(1)**2+dx(2)**2
23453 rsecp = opt+dx(3)**2
23457 rsixp = rfourp*rsecp
23460 Irsecp = 1.0d0/rsecp
23462 Irfourp = Irthrp/rs
23463 Irsixp = 1.0d0/rsixp
23464 Ireight=1.0d0/reight
23468 opt1 = (4*rs*dx(3)*wdip)
23469 opt2 = 6*rsecp*wquad1*opt
23470 opt3 = wquad1*wquad2p*Irsixp
23471 opt4 = (wvan1*wvan2**12)
23472 opt5 = opt4*12*Irfourt
23473 opt6 = 2*wvan1*wvan2**6
23474 opt7 = 6*opt6*Ireight
23477 opt11 = (rsecp*v2m)**2
23478 opt12 = (rsecp*v1m)**2
23479 opt14 = (v1m*v2m*rsecp)**2
23480 opt15 = -wquad1/v2m**2
23481 opt16 = (rthrp*(v1m*v2m)**2)**2
23482 opt17 = (v1m**2*rthrp)**2
23483 opt18 = -wquad1/rthrp
23484 opt19 = (v1m**2*v2m**2)**2
23487 dEcCat(k) = -(dx(k)*wc)*Irthrp
23488 dEcCm(k)=(dx(k)*wc)*Irthrp
23491 Edip=opt8*(v1dpv2)/(rsecp*v2m)
23493 dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m &
23494 *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
23495 dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m &
23496 *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
23497 dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m &
23498 *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp) &
23501 Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
23503 dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp* &
23504 (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2* &
23505 v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
23506 dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp* &
23507 (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2* &
23508 v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
23509 dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
23510 v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)* &
23513 Equad2=wquad1*wquad2p*Irthrp
23515 dEquad2Cat(k)=-3*dx(k)*rs*opt3
23516 dEquad2Cm(k)=3*dx(k)*rs*opt3
23517 dEquad2Calp(k)=0.0d0
23521 dEvan1Cat(k)=-dx(k)*opt5
23522 dEvan1Cm(k)=dx(k)*opt5
23523 dEvan1Calp(k)=0.0d0
23527 dEvan2Cat(k)=dx(k)*opt7
23528 dEvan2Cm(k)=-dx(k)*opt7
23529 dEvan2Calp(k)=0.0d0
23531 ecation_prot=ecation_prot+Ec+Edip+Equad1+Equad2+Evan1+Evan2
23532 ! print *,ecation_prot,Ec+Edip+Equad1+Equad2+Evan1+Evan2
23535 dEtotalCat(k)=dEcCat(k)+dEdipCat(k)+dEquad1Cat(k)+ &
23536 dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
23537 !c write(*,*) 'dEtotalCat inside', (dEtotalCat(l),l=1,3)
23538 dEtotalCm(k)=dEcCm(k)+dEdipCm(k)+dEquad1Cm(k)+ &
23539 dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
23540 dEtotalCalp(k)=dEcCalp(k)+dEdipCalp(k)+dEquad1Calp(k) &
23541 +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
23545 dscvec(k) = dc(k,i+nres)
23546 dscmag = dscmag+dscvec(k)*dscvec(k)
23549 dscmag = sqrt(dscmag)
23550 dscmag3 = dscmag3*dscmag
23551 constA = 1.0d0+dASGL/dscmag
23554 constB = constB+dscvec(k)*dEtotalCm(k)
23556 constB = constB*dASGL/dscmag3
23558 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
23559 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
23560 constA*dEtotalCm(k)-constB*dscvec(k)
23561 ! print *,j,constA,dEtotalCm(k),constB,dscvec(k)
23562 gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
23563 gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
23565 else if (itype(i,1).eq.13.or.itype(i,1).eq.14) then
23566 if(itype(i,1).eq.14) then
23572 vcatprm(k)=catprm(k,inum)
23574 dASGL=catprm(7,inum)
23576 ! vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
23580 vcm(1)=(cm1(1)/cm1mag)*dASGL+xi
23581 vcm(2)=(cm1(2)/cm1mag)*dASGL+yi
23582 vcm(3)=(cm1(3)/cm1mag)*dASGL+zi
23583 if (subchap.eq.1) then
23592 valpha(1)=xi-c(1,i+nres)+c(1,i)
23593 valpha(2)=yi-c(2,i+nres)+c(2,i)
23594 valpha(3)=zi-c(3,i+nres)+c(3,i)
23598 dx(k) = vcat(k)-vcm(k)
23601 v1(k)=(vcm(k)-valpha(k))
23602 v2(k)=(vcat(k)-valpha(k))
23604 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
23605 v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
23606 v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
23607 ! The weights of the energy function calculated from
23608 !The quantum mechanical GAMESS simulations of ASN/GLN with calcium
23610 if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
23617 wquad2 = vcatprm(4)
23622 opt = dx(1)**2+dx(2)**2
23623 rsecp = opt+dx(3)**2
23627 rsixp = rfourp*rsecp
23632 Irfourp = Irthrp/rs
23638 opt1 = (4*rs*dx(3)*wdip)
23639 opt2 = 6*rsecp*wquad1*opt
23640 opt3 = wquad1*wquad2p*Irsixp
23641 opt4 = (wvan1*wvan2**12)
23642 opt5 = opt4*12*Irfourt
23643 opt6 = 2*wvan1*wvan2**6
23644 opt7 = 6*opt6*Ireight
23647 opt11 = (rsecp*v2m)**2
23648 opt12 = (rsecp*v1m)**2
23649 opt14 = (v1m*v2m*rsecp)**2
23650 opt15 = -wquad1/v2m**2
23651 opt16 = (rthrp*(v1m*v2m)**2)**2
23652 opt17 = (v1m**2*rthrp)**2
23653 opt18 = -wquad1/rthrp
23654 opt19 = (v1m**2*v2m**2)**2
23655 Edip=opt8*(v1dpv2)/(rsecp*v2m)
23657 dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m&
23658 *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
23659 dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m&
23660 *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
23661 dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m&
23662 *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp)&
23665 Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
23667 dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp*&
23668 (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2*&
23669 v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
23670 dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp*&
23671 (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2*&
23672 v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
23673 dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
23674 v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)*&
23677 Equad2=wquad1*wquad2p*Irthrp
23679 dEquad2Cat(k)=-3*dx(k)*rs*opt3
23680 dEquad2Cm(k)=3*dx(k)*rs*opt3
23681 dEquad2Calp(k)=0.0d0
23685 dEvan1Cat(k)=-dx(k)*opt5
23686 dEvan1Cm(k)=dx(k)*opt5
23687 dEvan1Calp(k)=0.0d0
23691 dEvan2Cat(k)=dx(k)*opt7
23692 dEvan2Cm(k)=-dx(k)*opt7
23693 dEvan2Calp(k)=0.0d0
23695 ecation_prot = ecation_prot+Edip+Equad1+Equad2+Evan1+Evan2
23697 dEtotalCat(k)=dEdipCat(k)+dEquad1Cat(k)+ &
23698 dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
23699 dEtotalCm(k)=dEdipCm(k)+dEquad1Cm(k)+ &
23700 dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
23701 dEtotalCalp(k)=dEdipCalp(k)+dEquad1Calp(k) &
23702 +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
23706 dscvec(k) = c(k,i+nres)-c(k,i)
23712 dscmag = dscmag+dscvec(k)*dscvec(k)
23715 dscmag = sqrt(dscmag)
23716 dscmag3 = dscmag3*dscmag
23717 constA = 1+dASGL/dscmag
23720 constB = constB+dscvec(k)*dEtotalCm(k)
23722 constB = constB*dASGL/dscmag3
23724 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
23725 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
23726 constA*dEtotalCm(k)-constB*dscvec(k)
23727 gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
23728 gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
23733 ! r(k) = c(k,j)-c(k,i+nres)
23737 rcal = rcal+r(k)*r(k)
23742 r0p=0.5*(rocal+sig0(itype(i,1)))
23745 Evan1=epscalc*(r012/rcal**6)
23746 Evan2=epscalc*2*(r06/rcal**3)
23750 dEvan1Cm(k) = 12*r(k)*epscalc*r012/r7
23751 dEvan2Cm(k) = 12*r(k)*epscalc*r06/r4
23754 dEtotalCm(k)=dEvan1Cm(k)+dEvan2Cm(k)
23756 ecation_prot = ecation_prot+ Evan1+Evan2
23758 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
23760 gradpepcat(k,i)=gradpepcat(k,i)+dEtotalCm(k)
23761 gradpepcat(k,j)=gradpepcat(k,j)-dEtotalCm(k)
23763 endif ! 13-16 residues
23767 end subroutine ecat_prot
23769 !----------------------------------------------------------------------------
23770 !-----------------------------------------------------------------------------
23771 !-----------------------------------------------------------------------------
23772 subroutine eprot_sc_base(escbase)
23774 ! implicit real*8 (a-h,o-z)
23775 ! include 'DIMENSIONS'
23776 ! include 'COMMON.GEO'
23777 ! include 'COMMON.VAR'
23778 ! include 'COMMON.LOCAL'
23779 ! include 'COMMON.CHAIN'
23780 ! include 'COMMON.DERIV'
23781 ! include 'COMMON.NAMES'
23782 ! include 'COMMON.INTERACT'
23783 ! include 'COMMON.IOUNITS'
23784 ! include 'COMMON.CALC'
23785 ! include 'COMMON.CONTROL'
23786 ! include 'COMMON.SBRIDGE'
23788 !el local variables
23789 integer :: iint,itypi,itypi1,itypj,subchap
23790 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
23791 real(kind=8) :: evdw,sig0ij
23792 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
23793 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
23794 sslipi,sslipj,faclip
23796 real(kind=8) :: fracinbuf
23797 real (kind=8) :: escbase
23798 real (kind=8),dimension(4):: ener
23799 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
23800 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
23801 sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
23802 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
23803 dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
23804 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
23805 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
23806 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
23807 real(kind=8),dimension(3,2)::chead,erhead_tail
23808 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
23812 ! do i=1,nres_molec(1)
23813 do i=ibond_start,ibond_end
23814 if (itype(i,1).eq.ntyp1_molec(1)) cycle
23816 dxi = dc_norm(1,nres+i)
23817 dyi = dc_norm(2,nres+i)
23818 dzi = dc_norm(3,nres+i)
23819 dsci_inv = vbld_inv(i+nres)
23823 xi=mod(xi,boxxsize)
23824 if (xi.lt.0) xi=xi+boxxsize
23825 yi=mod(yi,boxysize)
23826 if (yi.lt.0) yi=yi+boxysize
23827 zi=mod(zi,boxzsize)
23828 if (zi.lt.0) zi=zi+boxzsize
23829 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
23831 if (itype(j,2).eq.ntyp1_molec(2))cycle
23835 xj=dmod(xj,boxxsize)
23836 if (xj.lt.0) xj=xj+boxxsize
23837 yj=dmod(yj,boxysize)
23838 if (yj.lt.0) yj=yj+boxysize
23839 zj=dmod(zj,boxzsize)
23840 if (zj.lt.0) zj=zj+boxzsize
23841 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23850 xj=xj_safe+xshift*boxxsize
23851 yj=yj_safe+yshift*boxysize
23852 zj=zj_safe+zshift*boxzsize
23853 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23854 if(dist_temp.lt.dist_init) then
23855 dist_init=dist_temp
23864 if (subchap.eq.1) then
23873 dxj = dc_norm( 1, nres+j )
23874 dyj = dc_norm( 2, nres+j )
23875 dzj = dc_norm( 3, nres+j )
23876 ! print *,i,j,itypi,itypj
23877 d1i = dhead_scbasei(itypi,itypj) !this is shift of dipole/charge
23878 d1j = dhead_scbasej(itypi,itypj) !this is shift of dipole/charge
23881 ! BetaT = 1.0d0 / (298.0d0 * Rb)
23883 sig0ij = sigma_scbase( itypi,itypj )
23884 chi1 = chi_scbase( itypi, itypj,1 )
23885 chi2 = chi_scbase( itypi, itypj,2 )
23888 chi12 = chi1 * chi2
23889 chip1 = chipp_scbase( itypi, itypj,1 )
23890 chip2 = chipp_scbase( itypi, itypj,2 )
23893 chip12 = chip1 * chip2
23894 ! not used by momo potential, but needed by sc_angular which is shared
23895 ! by all energy_potential subroutines
23899 a12sq = rborn_scbasei(itypi,itypj) * rborn_scbasej(itypi,itypj)
23900 ! a12sq = a12sq * a12sq
23901 ! charge of amino acid itypi is...
23902 chis1 = chis_scbase(itypi,itypj,1)
23903 chis2 = chis_scbase(itypi,itypj,2)
23904 chis12 = chis1 * chis2
23905 sig1 = sigmap1_scbase(itypi,itypj)
23906 sig2 = sigmap2_scbase(itypi,itypj)
23907 ! write (*,*) "sig1 = ", sig1
23908 ! write (*,*) "sig2 = ", sig2
23909 ! alpha factors from Fcav/Gcav
23910 b1 = alphasur_scbase(1,itypi,itypj)
23912 b2 = alphasur_scbase(2,itypi,itypj)
23913 b3 = alphasur_scbase(3,itypi,itypj)
23914 b4 = alphasur_scbase(4,itypi,itypj)
23915 ! used to determine whether we want to do quadrupole calculations
23917 eps_in = epsintab_scbase(itypi,itypj)
23918 if (eps_in.eq.0.0) eps_in=1.0
23919 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
23920 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
23921 !-------------------------------------------------------------------
23922 ! tail location and distance calculations
23924 ! location of polar head is computed by taking hydrophobic centre
23925 ! and moving by a d1 * dc_norm vector
23926 ! see unres publications for very informative images
23927 chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
23928 chead(k,2) = c(k, j+nres) + d1j * dc_norm(k, j+nres)
23930 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
23931 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
23932 Rhead_distance(k) = chead(k,2) - chead(k,1)
23934 ! pitagoras (root of sum of squares)
23936 (Rhead_distance(1)*Rhead_distance(1)) &
23937 + (Rhead_distance(2)*Rhead_distance(2)) &
23938 + (Rhead_distance(3)*Rhead_distance(3)))
23939 !-------------------------------------------------------------------
23940 ! zero everything that should be zero'ed
23958 dscj_inv = vbld_inv(j+nres)
23959 ! print *,i,j,dscj_inv,dsci_inv
23960 ! rij holds 1/(distance of Calpha atoms)
23961 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23963 !----------------------------
23965 ! this should be in elgrad_init but om's are calculated by sc_angular
23966 ! which in turn is used by older potentials
23967 ! om = omega, sqom = om^2
23970 sqom12 = om12 * om12
23972 ! now we calculate EGB - Gey-Berne
23973 ! It will be summed up in evdwij and saved in evdw
23974 sigsq = 1.0D0 / sigsq
23975 sig = sig0ij * dsqrt(sigsq)
23976 ! rij_shift = 1.0D0 / rij - sig + sig0ij
23977 rij_shift = 1.0/rij - sig + sig0ij
23978 IF (rij_shift.le.0.0D0) THEN
23982 sigder = -sig * sigsq
23983 rij_shift = 1.0D0 / rij_shift
23984 fac = rij_shift**expon
23985 c1 = fac * fac * aa_scbase(itypi,itypj)
23987 c2 = fac * bb_scbase(itypi,itypj)
23989 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
23990 eps2der = eps3rt * evdwij
23991 eps3der = eps2rt * evdwij
23992 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
23993 evdwij = eps2rt * eps3rt * evdwij
23994 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
23995 fac = -expon * (c1 + evdwij) * rij_shift
23996 sigder = fac * sigder
23998 ! Calculate distance derivative
24002 ! if (b2.gt.0.0) then
24003 fac = chis1 * sqom1 + chis2 * sqom2 &
24004 - 2.0d0 * chis12 * om1 * om2 * om12
24005 ! we will use pom later in Gcav, so dont mess with it!
24006 pom = 1.0d0 - chis1 * chis2 * sqom12
24007 Lambf = (1.0d0 - (fac / pom))
24008 Lambf = dsqrt(Lambf)
24009 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
24010 ! write (*,*) "sparrow = ", sparrow
24011 Chif = 1.0d0/rij * sparrow
24012 ChiLambf = Chif * Lambf
24013 eagle = dsqrt(ChiLambf)
24014 bat = ChiLambf ** 11.0d0
24015 top = b1 * ( eagle + b2 * ChiLambf - b3 )
24016 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
24020 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
24021 dbot = 12.0d0 * b4 * bat * Lambf
24022 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
24024 ! write (*,*) "dFcav/dR = ", dFdR
24025 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
24026 dbot = 12.0d0 * b4 * bat * Chif
24027 eagle = Lambf * pom
24028 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
24029 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
24030 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
24031 * (chis2 * om2 * om12 - om1) / (eagle * pom)
24033 dFdL = ((dtop * bot - top * dbot) / botsq)
24035 dCAVdOM1 = dFdL * ( dFdOM1 )
24036 dCAVdOM2 = dFdL * ( dFdOM2 )
24037 dCAVdOM12 = dFdL * ( dFdOM12 )
24042 ! eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
24043 ! eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
24044 ! eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
24045 ! -2.0D0*alf12*eps3der+sigder*sigsq_om12
24046 ! print *,"EOMY",eom1,eom2,eom12
24047 ! erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
24048 ! erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
24050 ! facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
24051 ! facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
24053 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24054 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24056 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
24057 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
24058 - (( dFdR + gg(k) ) * pom)
24059 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
24060 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
24061 ! & - ( dFdR * pom )
24063 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
24064 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
24065 + (( dFdR + gg(k) ) * pom)
24066 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
24067 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
24068 !c! & + ( dFdR * pom )
24070 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
24071 - (( dFdR + gg(k) ) * ertail(k))
24072 !c! & - ( dFdR * ertail(k))
24074 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
24075 + (( dFdR + gg(k) ) * ertail(k))
24076 !c! & + ( dFdR * ertail(k))
24079 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24080 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24087 if (wdipdip_scbase(2,itypi,itypj).gt.0.0d0) then
24088 w1 = wdipdip_scbase(1,itypi,itypj)
24089 w2 = -wdipdip_scbase(3,itypi,itypj)/2.0
24090 w3 = wdipdip_scbase(2,itypi,itypj)
24091 !c!-------------------------------------------------------------------
24093 fac = (om12 - 3.0d0 * om1 * om2)
24094 c1 = (w1 / (Rhead**3.0d0)) * fac
24095 c2 = (w2 / Rhead ** 6.0d0) &
24096 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
24097 c3= (w3/ Rhead ** 6.0d0) &
24098 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
24100 !c! write (*,*) "w1 = ", w1
24101 !c! write (*,*) "w2 = ", w2
24102 !c! write (*,*) "om1 = ", om1
24103 !c! write (*,*) "om2 = ", om2
24104 !c! write (*,*) "om12 = ", om12
24105 !c! write (*,*) "fac = ", fac
24106 !c! write (*,*) "c1 = ", c1
24107 !c! write (*,*) "c2 = ", c2
24108 !c! write (*,*) "Ecl = ", Ecl
24109 !c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
24110 !c! write (*,*) "c2_2 = ",
24111 !c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
24112 !c!-------------------------------------------------------------------
24113 !c! dervative of ECL is GCL...
24115 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
24116 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
24117 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
24118 c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
24119 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
24120 dGCLdR = c1 - c2 + c3
24122 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
24123 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
24124 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
24125 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
24126 dGCLdOM1 = c1 - c2 + c3
24128 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
24129 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
24130 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
24131 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
24132 dGCLdOM2 = c1 - c2 + c3
24134 c1 = w1 / (Rhead ** 3.0d0)
24135 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
24136 c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
24137 dGCLdOM12 = c1 - c2 + c3
24139 erhead(k) = Rhead_distance(k)/Rhead
24141 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
24142 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
24143 facd1 = d1i * vbld_inv(i+nres)
24144 facd2 = d1j * vbld_inv(j+nres)
24147 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
24148 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
24150 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
24151 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
24154 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
24155 - dGCLdR * erhead(k)
24156 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
24157 + dGCLdR * erhead(k)
24160 !now charge with dipole eg. ARG-dG
24161 if (wqdip_scbase(2,itypi,itypj).gt.0.0d0) then
24162 alphapol1 = alphapol_scbase(itypi,itypj)
24163 w1 = wqdip_scbase(1,itypi,itypj)
24164 w2 = wqdip_scbase(2,itypi,itypj)
24167 ! pis = sig0head_scbase(itypi,itypj)
24168 ! eps_head = epshead_scbase(itypi,itypj)
24169 !c!-------------------------------------------------------------------
24170 !c! R1 - distance between head of ith side chain and tail of jth sidechain
24173 !c! Calculate head-to-tail distances tail is center of side-chain
24174 R1=R1+(c(k,j+nres)-chead(k,1))**2
24179 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
24180 !c! & +dhead(1,1,itypi,itypj))**2))
24181 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
24182 !c! & +dhead(2,1,itypi,itypj))**2))
24184 !c!-------------------------------------------------------------------
24187 hawk = w2 * (1.0d0 - sqom2)
24188 Ecl = sparrow / Rhead**2.0d0 &
24189 - hawk / Rhead**4.0d0
24190 !c!-------------------------------------------------------------------
24191 !c! derivative of ecl is Gcl
24193 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
24194 + 4.0d0 * hawk / Rhead**5.0d0
24196 dGCLdOM1 = (w1) / (Rhead**2.0d0)
24198 dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
24199 !c--------------------------------------------------------------------
24200 !c Polarization energy
24202 MomoFac1 = (1.0d0 - chi1 * sqom2)
24203 RR1 = R1 * R1 / MomoFac1
24204 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
24205 fgb1 = sqrt( RR1 + a12sq * ee1)
24206 ! eps_inout_fac=0.0d0
24207 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
24208 ! derivative of Epol is Gpol...
24209 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
24211 dFGBdR1 = ( (R1 / MomoFac1) &
24212 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
24214 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
24215 * (2.0d0 - 0.5d0 * ee1) ) &
24217 dPOLdR1 = dPOLdFGB1 * dFGBdR1
24220 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
24222 erhead(k) = Rhead_distance(k)/Rhead
24223 erhead_tail(k,1) = ((c(k,j+nres)-chead(k,1))/R1)
24226 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
24227 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
24228 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
24230 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
24231 facd1 = d1i * vbld_inv(i+nres)
24232 facd2 = d1j * vbld_inv(j+nres)
24233 ! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
24236 hawk = (erhead_tail(k,1) + &
24237 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
24240 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
24241 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
24243 - dPOLdR1 * (erhead_tail(k,1))
24246 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
24247 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
24249 + dPOLdR1 * (erhead_tail(k,1))
24253 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
24254 - dGCLdR * erhead(k) &
24255 - dPOLdR1 * erhead_tail(k,1)
24256 ! & - dGLJdR * erhead(k)
24258 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
24259 + dGCLdR * erhead(k) &
24260 + dPOLdR1 * erhead_tail(k,1)
24261 ! & + dGLJdR * erhead(k)
24265 ! print *,i,j,evdwij,epol,Fcav,ECL
24266 escbase=escbase+evdwij+epol+Fcav+ECL
24267 call sc_grad_scbase
24272 end subroutine eprot_sc_base
24273 SUBROUTINE sc_grad_scbase
24276 real (kind=8) :: dcosom1(3),dcosom2(3)
24278 eps2der * eps2rt_om1 &
24279 - 2.0D0 * alf1 * eps3der &
24280 + sigder * sigsq_om1 &
24286 eps2der * eps2rt_om2 &
24287 + 2.0D0 * alf2 * eps3der &
24288 + sigder * sigsq_om2 &
24294 evdwij * eps1_om12 &
24295 + eps2der * eps2rt_om12 &
24296 - 2.0D0 * alf12 * eps3der &
24297 + sigder *sigsq_om12 &
24301 ! print *,eom1,eom2,eom12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
24302 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
24303 ! gg(1),gg(2),"rozne"
24305 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
24306 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
24307 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
24308 gvdwx_scbase(k,i)= gvdwx_scbase(k,i) - gg(k) &
24309 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
24310 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
24311 gvdwx_scbase(k,j)= gvdwx_scbase(k,j) + gg(k) &
24312 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
24313 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
24314 gvdwc_scbase(k,i)=gvdwc_scbase(k,i)-gg(k)
24315 gvdwc_scbase(k,j)=gvdwc_scbase(k,j)+gg(k)
24318 END SUBROUTINE sc_grad_scbase
24321 subroutine epep_sc_base(epepbase)
24324 !el local variables
24325 integer :: iint,itypi,itypi1,itypj,subchap
24326 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
24327 real(kind=8) :: evdw,sig0ij
24328 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
24329 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
24330 sslipi,sslipj,faclip
24332 real(kind=8) :: fracinbuf
24333 real (kind=8) :: epepbase
24334 real (kind=8),dimension(4):: ener
24335 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
24336 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
24337 sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
24338 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
24339 dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
24340 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
24341 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
24342 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
24343 real(kind=8),dimension(3,2)::chead,erhead_tail
24344 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
24348 ! do i=1,nres_molec(1)-1
24349 do i=ibond_start,ibond_end
24350 if (itype(i,1).eq.ntyp1_molec(1).or.itype(i+1,1).eq.ntyp1_molec(1)) cycle
24351 !C itypi = itype(i,1)
24355 ! print *,dxi,(-c(1,i)+c(1,i+1))*vbld_inv(i+1)
24356 dsci_inv = vbld_inv(i+1)/2.0
24357 xi=(c(1,i)+c(1,i+1))/2.0
24358 yi=(c(2,i)+c(2,i+1))/2.0
24359 zi=(c(3,i)+c(3,i+1))/2.0
24360 xi=mod(xi,boxxsize)
24361 if (xi.lt.0) xi=xi+boxxsize
24362 yi=mod(yi,boxysize)
24363 if (yi.lt.0) yi=yi+boxysize
24364 zi=mod(zi,boxzsize)
24365 if (zi.lt.0) zi=zi+boxzsize
24366 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
24368 if (itype(j,2).eq.ntyp1_molec(2))cycle
24372 xj=dmod(xj,boxxsize)
24373 if (xj.lt.0) xj=xj+boxxsize
24374 yj=dmod(yj,boxysize)
24375 if (yj.lt.0) yj=yj+boxysize
24376 zj=dmod(zj,boxzsize)
24377 if (zj.lt.0) zj=zj+boxzsize
24378 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
24387 xj=xj_safe+xshift*boxxsize
24388 yj=yj_safe+yshift*boxysize
24389 zj=zj_safe+zshift*boxzsize
24390 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
24391 if(dist_temp.lt.dist_init) then
24392 dist_init=dist_temp
24401 if (subchap.eq.1) then
24410 dxj = dc_norm( 1, nres+j )
24411 dyj = dc_norm( 2, nres+j )
24412 dzj = dc_norm( 3, nres+j )
24413 ! d1i = dhead_scbasei(itypi) !this is shift of dipole/charge
24414 ! d1j = dhead_scbasej(itypi) !this is shift of dipole/charge
24417 sig0ij = sigma_pepbase(itypj )
24418 chi1 = chi_pepbase(itypj,1 )
24419 chi2 = chi_pepbase(itypj,2 )
24422 chi12 = chi1 * chi2
24423 chip1 = chipp_pepbase(itypj,1 )
24424 chip2 = chipp_pepbase(itypj,2 )
24427 chip12 = chip1 * chip2
24428 chis1 = chis_pepbase(itypj,1)
24429 chis2 = chis_pepbase(itypj,2)
24430 chis12 = chis1 * chis2
24431 sig1 = sigmap1_pepbase(itypj)
24432 sig2 = sigmap2_pepbase(itypj)
24433 ! write (*,*) "sig1 = ", sig1
24434 ! write (*,*) "sig2 = ", sig2
24436 ! location of polar head is computed by taking hydrophobic centre
24437 ! and moving by a d1 * dc_norm vector
24438 ! see unres publications for very informative images
24439 chead(k,1) = (c(k,i)+c(k,i+1))/2.0
24440 ! + d1i * dc_norm(k, i+nres)
24441 chead(k,2) = c(k, j+nres)
24442 ! + d1j * dc_norm(k, j+nres)
24444 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
24445 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
24446 Rhead_distance(k) = chead(k,2) - chead(k,1)
24447 ! print *,gvdwc_pepbase(k,i)
24451 (Rhead_distance(1)*Rhead_distance(1)) &
24452 + (Rhead_distance(2)*Rhead_distance(2)) &
24453 + (Rhead_distance(3)*Rhead_distance(3)))
24455 ! alpha factors from Fcav/Gcav
24456 b1 = alphasur_pepbase(1,itypj)
24458 b2 = alphasur_pepbase(2,itypj)
24459 b3 = alphasur_pepbase(3,itypj)
24460 b4 = alphasur_pepbase(4,itypj)
24464 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
24467 !----------------------------
24485 dscj_inv = vbld_inv(j+nres)
24487 ! this should be in elgrad_init but om's are calculated by sc_angular
24488 ! which in turn is used by older potentials
24489 ! om = omega, sqom = om^2
24492 sqom12 = om12 * om12
24494 ! now we calculate EGB - Gey-Berne
24495 ! It will be summed up in evdwij and saved in evdw
24496 sigsq = 1.0D0 / sigsq
24497 sig = sig0ij * dsqrt(sigsq)
24498 rij_shift = 1.0/rij - sig + sig0ij
24499 IF (rij_shift.le.0.0D0) THEN
24503 sigder = -sig * sigsq
24504 rij_shift = 1.0D0 / rij_shift
24505 fac = rij_shift**expon
24506 c1 = fac * fac * aa_pepbase(itypj)
24508 c2 = fac * bb_pepbase(itypj)
24510 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
24511 eps2der = eps3rt * evdwij
24512 eps3der = eps2rt * evdwij
24513 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
24514 evdwij = eps2rt * eps3rt * evdwij
24515 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
24516 fac = -expon * (c1 + evdwij) * rij_shift
24517 sigder = fac * sigder
24519 ! Calculate distance derivative
24523 fac = chis1 * sqom1 + chis2 * sqom2 &
24524 - 2.0d0 * chis12 * om1 * om2 * om12
24525 ! we will use pom later in Gcav, so dont mess with it!
24526 pom = 1.0d0 - chis1 * chis2 * sqom12
24527 Lambf = (1.0d0 - (fac / pom))
24528 Lambf = dsqrt(Lambf)
24529 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
24530 ! write (*,*) "sparrow = ", sparrow
24531 Chif = 1.0d0/rij * sparrow
24532 ChiLambf = Chif * Lambf
24533 eagle = dsqrt(ChiLambf)
24534 bat = ChiLambf ** 11.0d0
24535 top = b1 * ( eagle + b2 * ChiLambf - b3 )
24536 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
24540 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
24541 dbot = 12.0d0 * b4 * bat * Lambf
24542 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
24544 ! write (*,*) "dFcav/dR = ", dFdR
24545 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
24546 dbot = 12.0d0 * b4 * bat * Chif
24547 eagle = Lambf * pom
24548 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
24549 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
24550 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
24551 * (chis2 * om2 * om12 - om1) / (eagle * pom)
24553 dFdL = ((dtop * bot - top * dbot) / botsq)
24555 dCAVdOM1 = dFdL * ( dFdOM1 )
24556 dCAVdOM2 = dFdL * ( dFdOM2 )
24557 dCAVdOM12 = dFdL * ( dFdOM12 )
24563 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24564 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24566 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
24567 gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
24568 - (( dFdR + gg(k) ) * pom)/2.0
24569 ! print *,gvdwc_pepbase(k,i),i,(( dFdR + gg(k) ) * pom)/2.0
24570 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
24571 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
24572 ! & - ( dFdR * pom )
24574 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
24575 gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
24576 + (( dFdR + gg(k) ) * pom)
24577 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
24578 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
24579 !c! & + ( dFdR * pom )
24581 gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
24582 - (( dFdR + gg(k) ) * ertail(k))/2.0
24583 ! print *,gvdwc_pepbase(k,i+1),i+1,(( dFdR + gg(k) ) * pom)/2.0
24585 !c! & - ( dFdR * ertail(k))
24587 gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
24588 + (( dFdR + gg(k) ) * ertail(k))
24589 !c! & + ( dFdR * ertail(k))
24592 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24593 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24597 w1 = wdipdip_pepbase(1,itypj)
24598 w2 = -wdipdip_pepbase(3,itypj)/2.0
24599 w3 = wdipdip_pepbase(2,itypj)
24602 !c!-------------------------------------------------------------------
24605 fac = (om12 - 3.0d0 * om1 * om2)
24606 c1 = (w1 / (Rhead**3.0d0)) * fac
24607 c2 = (w2 / Rhead ** 6.0d0) &
24608 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
24609 c3= (w3/ Rhead ** 6.0d0) &
24610 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
24614 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
24615 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
24616 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
24617 c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
24618 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
24620 dGCLdR = c1 - c2 + c3
24622 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
24623 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
24624 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
24625 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
24626 dGCLdOM1 = c1 - c2 + c3
24628 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
24629 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
24630 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
24631 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
24633 dGCLdOM2 = c1 - c2 + c3
24635 c1 = w1 / (Rhead ** 3.0d0)
24636 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
24637 c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
24638 dGCLdOM12 = c1 - c2 + c3
24640 erhead(k) = Rhead_distance(k)/Rhead
24642 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
24643 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
24644 ! facd1 = d1 * vbld_inv(i+nres)
24645 ! facd2 = d2 * vbld_inv(j+nres)
24649 !+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
24650 ! gvdwx_pepbase(k,i) = gvdwx_scbase(k,i) &
24653 !+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
24654 gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
24657 gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
24658 - dGCLdR * erhead(k)/2.0d0
24659 ! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
24660 gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
24661 - dGCLdR * erhead(k)/2.0d0
24662 ! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
24663 gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
24664 + dGCLdR * erhead(k)
24666 ! print *,i,j,evdwij,Fcav,ECL,"vdw,cav,ecl"
24667 epepbase=epepbase+evdwij+Fcav+ECL
24668 call sc_grad_pepbase
24671 END SUBROUTINE epep_sc_base
24672 SUBROUTINE sc_grad_pepbase
24675 real (kind=8) :: dcosom1(3),dcosom2(3)
24677 eps2der * eps2rt_om1 &
24678 - 2.0D0 * alf1 * eps3der &
24679 + sigder * sigsq_om1 &
24685 eps2der * eps2rt_om2 &
24686 + 2.0D0 * alf2 * eps3der &
24687 + sigder * sigsq_om2 &
24693 evdwij * eps1_om12 &
24694 + eps2der * eps2rt_om12 &
24695 - 2.0D0 * alf12 * eps3der &
24696 + sigder *sigsq_om12 &
24701 ! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
24702 ! if (i.eq.30) print *,gvdwc_pepbase(k,i),- gg(k),&
24703 ! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
24705 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
24706 ! gg(1),gg(2),"rozne"
24708 dcosom1(k) = rij * (dc_norm(k,i) - om1 * erij(k))
24709 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
24710 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
24711 gvdwc_pepbase(k,i)= gvdwc_pepbase(k,i) +0.5*(- gg(k)) &
24712 + (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
24714 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
24715 gvdwc_pepbase(k,i+1)= gvdwc_pepbase(k,i+1) +0.5*(- gg(k)) &
24716 - (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i))) &
24718 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
24719 ! print *,eom12,eom2,om12,om2
24720 !eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
24721 ! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
24722 gvdwx_pepbase(k,j)= gvdwx_pepbase(k,j) + gg(k) &
24723 + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
24724 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
24725 gvdwc_pepbase(k,j)=gvdwc_pepbase(k,j)+gg(k)
24728 END SUBROUTINE sc_grad_pepbase
24729 subroutine eprot_sc_phosphate(escpho)
24731 ! implicit real*8 (a-h,o-z)
24732 ! include 'DIMENSIONS'
24733 ! include 'COMMON.GEO'
24734 ! include 'COMMON.VAR'
24735 ! include 'COMMON.LOCAL'
24736 ! include 'COMMON.CHAIN'
24737 ! include 'COMMON.DERIV'
24738 ! include 'COMMON.NAMES'
24739 ! include 'COMMON.INTERACT'
24740 ! include 'COMMON.IOUNITS'
24741 ! include 'COMMON.CALC'
24742 ! include 'COMMON.CONTROL'
24743 ! include 'COMMON.SBRIDGE'
24745 !el local variables
24746 integer :: iint,itypi,itypi1,itypj,subchap
24747 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
24748 real(kind=8) :: evdw,sig0ij
24749 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
24750 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
24751 sslipi,sslipj,faclip,alpha_sco
24753 real(kind=8) :: fracinbuf
24754 real (kind=8) :: escpho
24755 real (kind=8),dimension(4):: ener
24756 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
24757 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
24758 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
24759 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
24760 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
24761 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
24762 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
24763 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
24764 real(kind=8),dimension(3,2)::chead,erhead_tail
24765 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
24769 ! do i=1,nres_molec(1)
24770 do i=ibond_start,ibond_end
24771 if (itype(i,1).eq.ntyp1_molec(1)) cycle
24773 dxi = dc_norm(1,nres+i)
24774 dyi = dc_norm(2,nres+i)
24775 dzi = dc_norm(3,nres+i)
24776 dsci_inv = vbld_inv(i+nres)
24780 xi=mod(xi,boxxsize)
24781 if (xi.lt.0) xi=xi+boxxsize
24782 yi=mod(yi,boxysize)
24783 if (yi.lt.0) yi=yi+boxysize
24784 zi=mod(zi,boxzsize)
24785 if (zi.lt.0) zi=zi+boxzsize
24786 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
24788 if ((itype(j,2).eq.ntyp1_molec(2)).or.&
24789 (itype(j+1,2).eq.ntyp1_molec(2))) cycle
24790 xj=(c(1,j)+c(1,j+1))/2.0
24791 yj=(c(2,j)+c(2,j+1))/2.0
24792 zj=(c(3,j)+c(3,j+1))/2.0
24793 xj=dmod(xj,boxxsize)
24794 if (xj.lt.0) xj=xj+boxxsize
24795 yj=dmod(yj,boxysize)
24796 if (yj.lt.0) yj=yj+boxysize
24797 zj=dmod(zj,boxzsize)
24798 if (zj.lt.0) zj=zj+boxzsize
24799 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
24807 xj=xj_safe+xshift*boxxsize
24808 yj=yj_safe+yshift*boxysize
24809 zj=zj_safe+zshift*boxzsize
24810 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
24811 if(dist_temp.lt.dist_init) then
24812 dist_init=dist_temp
24821 if (subchap.eq.1) then
24830 dxj = dc_norm( 1,j )
24831 dyj = dc_norm( 2,j )
24832 dzj = dc_norm( 3,j )
24833 dscj_inv = vbld_inv(j+1)
24836 sig0ij = sigma_scpho(itypi )
24837 chi1 = chi_scpho(itypi,1 )
24838 chi2 = chi_scpho(itypi,2 )
24841 chi12 = chi1 * chi2
24842 chip1 = chipp_scpho(itypi,1 )
24843 chip2 = chipp_scpho(itypi,2 )
24846 chip12 = chip1 * chip2
24847 chis1 = chis_scpho(itypi,1)
24848 chis2 = chis_scpho(itypi,2)
24849 chis12 = chis1 * chis2
24850 sig1 = sigmap1_scpho(itypi)
24851 sig2 = sigmap2_scpho(itypi)
24852 ! write (*,*) "sig1 = ", sig1
24853 ! write (*,*) "sig1 = ", sig1
24854 ! write (*,*) "sig2 = ", sig2
24855 ! alpha factors from Fcav/Gcav
24859 a12sq = rborn_scphoi(itypi) * rborn_scphoj(itypi)
24861 b1 = alphasur_scpho(1,itypi)
24863 b2 = alphasur_scpho(2,itypi)
24864 b3 = alphasur_scpho(3,itypi)
24865 b4 = alphasur_scpho(4,itypi)
24866 ! used to determine whether we want to do quadrupole calculations
24868 eps_in = epsintab_scpho(itypi)
24869 if (eps_in.eq.0.0) eps_in=1.0
24870 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
24871 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
24872 !-------------------------------------------------------------------
24873 ! tail location and distance calculations
24874 d1i = dhead_scphoi(itypi) !this is shift of dipole/charge
24877 ! location of polar head is computed by taking hydrophobic centre
24878 ! and moving by a d1 * dc_norm vector
24879 ! see unres publications for very informative images
24880 chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
24881 chead(k,2) = (c(k, j) + c(k, j+1))/2.0
24883 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
24884 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
24885 Rhead_distance(k) = chead(k,2) - chead(k,1)
24887 ! pitagoras (root of sum of squares)
24889 (Rhead_distance(1)*Rhead_distance(1)) &
24890 + (Rhead_distance(2)*Rhead_distance(2)) &
24891 + (Rhead_distance(3)*Rhead_distance(3)))
24892 Rhead_sq=Rhead**2.0
24893 !-------------------------------------------------------------------
24894 ! zero everything that should be zero'ed
24913 dscj_inv = vbld_inv(j+1)/2.0
24914 !dhead_scbasej(itypi,itypj)
24915 ! print *,i,j,dscj_inv,dsci_inv
24916 ! rij holds 1/(distance of Calpha atoms)
24917 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
24919 !----------------------------
24921 ! this should be in elgrad_init but om's are calculated by sc_angular
24922 ! which in turn is used by older potentials
24923 ! om = omega, sqom = om^2
24926 sqom12 = om12 * om12
24928 ! now we calculate EGB - Gey-Berne
24929 ! It will be summed up in evdwij and saved in evdw
24930 sigsq = 1.0D0 / sigsq
24931 sig = sig0ij * dsqrt(sigsq)
24932 ! rij_shift = 1.0D0 / rij - sig + sig0ij
24933 rij_shift = 1.0/rij - sig + sig0ij
24934 IF (rij_shift.le.0.0D0) THEN
24938 sigder = -sig * sigsq
24939 rij_shift = 1.0D0 / rij_shift
24940 fac = rij_shift**expon
24941 c1 = fac * fac * aa_scpho(itypi)
24943 c2 = fac * bb_scpho(itypi)
24945 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
24946 eps2der = eps3rt * evdwij
24947 eps3der = eps2rt * evdwij
24948 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
24949 evdwij = eps2rt * eps3rt * evdwij
24950 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
24951 fac = -expon * (c1 + evdwij) * rij_shift
24952 sigder = fac * sigder
24954 ! Calculate distance derivative
24958 fac = chis1 * sqom1 + chis2 * sqom2 &
24959 - 2.0d0 * chis12 * om1 * om2 * om12
24960 ! we will use pom later in Gcav, so dont mess with it!
24961 pom = 1.0d0 - chis1 * chis2 * sqom12
24962 Lambf = (1.0d0 - (fac / pom))
24963 Lambf = dsqrt(Lambf)
24964 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
24965 ! write (*,*) "sparrow = ", sparrow
24966 Chif = 1.0d0/rij * sparrow
24967 ChiLambf = Chif * Lambf
24968 eagle = dsqrt(ChiLambf)
24969 bat = ChiLambf ** 11.0d0
24970 top = b1 * ( eagle + b2 * ChiLambf - b3 )
24971 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
24974 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
24975 dbot = 12.0d0 * b4 * bat * Lambf
24976 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
24978 ! write (*,*) "dFcav/dR = ", dFdR
24979 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
24980 dbot = 12.0d0 * b4 * bat * Chif
24981 eagle = Lambf * pom
24982 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
24983 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
24984 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
24985 * (chis2 * om2 * om12 - om1) / (eagle * pom)
24987 dFdL = ((dtop * bot - top * dbot) / botsq)
24989 dCAVdOM1 = dFdL * ( dFdOM1 )
24990 dCAVdOM2 = dFdL * ( dFdOM2 )
24991 dCAVdOM12 = dFdL * ( dFdOM12 )
24997 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24998 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24999 ! if (i.eq.3) print *,'decl0',gvdwx_scpho(k,i),i
25002 ! print *,pom,gg(k),dFdR
25003 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
25004 gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
25005 - (( dFdR + gg(k) ) * pom)
25006 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
25007 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
25008 ! & - ( dFdR * pom )
25010 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
25011 ! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
25012 ! + (( dFdR + gg(k) ) * pom)
25013 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
25014 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
25015 !c! & + ( dFdR * pom )
25017 gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
25018 - (( dFdR + gg(k) ) * ertail(k))
25019 !c! & - ( dFdR * ertail(k))
25021 gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
25022 + (( dFdR + gg(k) ) * ertail(k))/2.0
25024 gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
25025 + (( dFdR + gg(k) ) * ertail(k))/2.0
25027 !c! & + ( dFdR * ertail(k))
25031 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
25032 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
25033 ! alphapol1 = alphapol_scpho(itypi)
25034 if (wqq_scpho(itypi).ne.0.0) then
25035 Qij=wqq_scpho(itypi)/eps_in
25036 alpha_sco=1.d0/alphi_scpho(itypi)
25038 Ecl = (332.0d0 * Qij*dexp(-Rhead*alpha_sco)) / Rhead
25039 !c! derivative of Ecl is Gcl...
25040 dGCLdR = (-332.0d0 * Qij*dexp(-Rhead*alpha_sco)* &
25041 (Rhead*alpha_sco+1) ) / Rhead_sq
25042 if (energy_dec) write(iout,*) "ECL",ECL,Rhead,1.0/rij
25043 else if (wqdip_scpho(2,itypi).gt.0.0d0) then
25044 w1 = wqdip_scpho(1,itypi)
25045 w2 = wqdip_scpho(2,itypi)
25048 ! pis = sig0head_scbase(itypi,itypj)
25049 ! eps_head = epshead_scbase(itypi,itypj)
25050 !c!-------------------------------------------------------------------
25052 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
25053 !c! & +dhead(1,1,itypi,itypj))**2))
25054 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
25055 !c! & +dhead(2,1,itypi,itypj))**2))
25057 !c!-------------------------------------------------------------------
25060 hawk = w2 * (1.0d0 - sqom2)
25061 Ecl = sparrow / Rhead**2.0d0 &
25062 - hawk / Rhead**4.0d0
25063 !c!-------------------------------------------------------------------
25064 if (energy_dec) write(iout,*) "ECLdipdip",ECL,Rhead,&
25067 !c! derivative of ecl is Gcl
25069 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
25070 + 4.0d0 * hawk / Rhead**5.0d0
25072 dGCLdOM1 = (w1) / (Rhead**2.0d0)
25074 dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
25077 !c--------------------------------------------------------------------
25078 !c Polarization energy
25082 !c! Calculate head-to-tail distances tail is center of side-chain
25083 R1=R1+((c(k,j)+c(k,j+1))/2.0-chead(k,1))**2
25088 alphapol1 = alphapol_scpho(itypi)
25090 MomoFac1 = (1.0d0 - chi2 * sqom1)
25091 RR1 = R1 * R1 / MomoFac1
25092 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
25093 ! print *,"ee1",ee1,a12sq,alphapol1,eps_inout_fac
25094 fgb1 = sqrt( RR1 + a12sq * ee1)
25095 ! eps_inout_fac=0.0d0
25096 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
25097 ! derivative of Epol is Gpol...
25098 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
25100 dFGBdR1 = ( (R1 / MomoFac1) &
25101 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
25103 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
25104 * (2.0d0 - 0.5d0 * ee1) ) &
25106 dPOLdR1 = dPOLdFGB1 * dFGBdR1
25109 dFGBdOM1 = (((R1 * R1 * chi2 * om1) / (MomoFac1 * MomoFac1)) &
25110 * (2.0d0 - 0.5d0 * ee1) ) &
25113 dPOLdOM1 = dPOLdFGB1 * dFGBdOM1
25116 erhead(k) = Rhead_distance(k)/Rhead
25117 erhead_tail(k,1) = (((c(k,j)+c(k,j+1))/2.0-chead(k,1))/R1)
25120 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
25121 erdxj = scalar( erhead(1), dC_norm(1,j) )
25122 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
25124 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j))
25125 facd1 = d1i * vbld_inv(i+nres)
25126 facd2 = d1j * vbld_inv(j)
25127 ! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
25130 hawk = (erhead_tail(k,1) + &
25131 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
25134 ! if (i.eq.3) print *,'decl1',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i,&
25135 ! pom,(erhead_tail(k,1))
25137 ! print *,'decl',dGCLdR,dPOLdR1,gvdwc_scpho(k,i)
25138 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
25139 gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
25141 - dPOLdR1 * (erhead_tail(k,1))
25144 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
25145 ! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
25147 ! + dPOLdR1 * (erhead_tail(k,1))
25151 gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
25152 - dGCLdR * erhead(k) &
25153 - dPOLdR1 * erhead_tail(k,1)
25154 ! & - dGLJdR * erhead(k)
25156 gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
25157 + (dGCLdR * erhead(k) &
25158 + dPOLdR1 * erhead_tail(k,1))/2.0
25159 gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
25160 + (dGCLdR * erhead(k) &
25161 + dPOLdR1 * erhead_tail(k,1))/2.0
25163 ! & + dGLJdR * erhead(k)
25164 ! if (i.eq.3) print *,'decl2',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i
25167 ! if (i.eq.3) print *,i,j,evdwij,epol,Fcav,ECL
25168 if (energy_dec) write (iout,'(a22,2i5,4f8.3,f16.3)'), &
25169 "escpho:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,escpho
25170 escpho=escpho+evdwij+epol+Fcav+ECL
25177 end subroutine eprot_sc_phosphate
25178 SUBROUTINE sc_grad_scpho
25181 real (kind=8) :: dcosom1(3),dcosom2(3)
25183 eps2der * eps2rt_om1 &
25184 - 2.0D0 * alf1 * eps3der &
25185 + sigder * sigsq_om1 &
25191 eps2der * eps2rt_om2 &
25192 + 2.0D0 * alf2 * eps3der &
25193 + sigder * sigsq_om2 &
25199 evdwij * eps1_om12 &
25200 + eps2der * eps2rt_om12 &
25201 - 2.0D0 * alf12 * eps3der &
25202 + sigder *sigsq_om12 &
25207 ! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
25208 ! if (i.eq.30) print *,gvdwc_scpho(k,i),- gg(k),&
25209 ! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
25211 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
25212 ! gg(1),gg(2),"rozne"
25214 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
25215 dcosom2(k) = rij * (dc_norm(k,j) - om2 * erij(k))
25216 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
25217 gvdwc_scpho(k,j)= gvdwc_scpho(k,j) +0.5*( gg(k)) &
25218 + (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)))&
25220 - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
25221 gvdwc_scpho(k,j+1)= gvdwc_scpho(k,j+1) +0.5*( gg(k)) &
25222 - (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j))) &
25224 + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
25225 gvdwx_scpho(k,i)= gvdwx_scpho(k,i) - gg(k) &
25226 + (eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
25227 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
25229 ! print *,eom12,eom2,om12,om2
25230 !eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
25231 ! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
25232 ! gvdwx_scpho(k,j)= gvdwx_scpho(k,j) + gg(k) &
25233 ! + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
25234 ! + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
25235 gvdwc_scpho(k,i)=gvdwc_scpho(k,i)-gg(k)
25238 END SUBROUTINE sc_grad_scpho
25239 subroutine eprot_pep_phosphate(epeppho)
25241 ! implicit real*8 (a-h,o-z)
25242 ! include 'DIMENSIONS'
25243 ! include 'COMMON.GEO'
25244 ! include 'COMMON.VAR'
25245 ! include 'COMMON.LOCAL'
25246 ! include 'COMMON.CHAIN'
25247 ! include 'COMMON.DERIV'
25248 ! include 'COMMON.NAMES'
25249 ! include 'COMMON.INTERACT'
25250 ! include 'COMMON.IOUNITS'
25251 ! include 'COMMON.CALC'
25252 ! include 'COMMON.CONTROL'
25253 ! include 'COMMON.SBRIDGE'
25255 !el local variables
25256 integer :: iint,itypi,itypi1,itypj,subchap
25257 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
25258 real(kind=8) :: evdw,sig0ij
25259 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
25260 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
25261 sslipi,sslipj,faclip
25263 real(kind=8) :: fracinbuf
25264 real (kind=8) :: epeppho
25265 real (kind=8),dimension(4):: ener
25266 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
25267 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
25268 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
25269 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
25270 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
25271 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
25272 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
25273 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
25274 real(kind=8),dimension(3,2)::chead,erhead_tail
25275 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
25277 real (kind=8) :: dcosom1(3),dcosom2(3)
25279 ! do i=1,nres_molec(1)
25280 do i=ibond_start,ibond_end
25281 if (itype(i,1).eq.ntyp1_molec(1)) cycle
25283 dsci_inv = vbld_inv(i+1)/2.0
25287 xi=(c(1,i)+c(1,i+1))/2.0
25288 yi=(c(2,i)+c(2,i+1))/2.0
25289 zi=(c(3,i)+c(3,i+1))/2.0
25290 xi=mod(xi,boxxsize)
25291 if (xi.lt.0) xi=xi+boxxsize
25292 yi=mod(yi,boxysize)
25293 if (yi.lt.0) yi=yi+boxysize
25294 zi=mod(zi,boxzsize)
25295 if (zi.lt.0) zi=zi+boxzsize
25296 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
25298 if ((itype(j,2).eq.ntyp1_molec(2)).or.&
25299 (itype(j+1,2).eq.ntyp1_molec(2))) cycle
25300 xj=(c(1,j)+c(1,j+1))/2.0
25301 yj=(c(2,j)+c(2,j+1))/2.0
25302 zj=(c(3,j)+c(3,j+1))/2.0
25303 xj=dmod(xj,boxxsize)
25304 if (xj.lt.0) xj=xj+boxxsize
25305 yj=dmod(yj,boxysize)
25306 if (yj.lt.0) yj=yj+boxysize
25307 zj=dmod(zj,boxzsize)
25308 if (zj.lt.0) zj=zj+boxzsize
25309 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
25317 xj=xj_safe+xshift*boxxsize
25318 yj=yj_safe+yshift*boxysize
25319 zj=zj_safe+zshift*boxzsize
25320 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
25321 if(dist_temp.lt.dist_init) then
25322 dist_init=dist_temp
25331 if (subchap.eq.1) then
25340 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
25342 dxj = dc_norm( 1,j )
25343 dyj = dc_norm( 2,j )
25344 dzj = dc_norm( 3,j )
25345 dscj_inv = vbld_inv(j+1)/2.0
25347 sig0ij = sigma_peppho
25350 chi12 = chi1 * chi2
25353 chip12 = chip1 * chip2
25356 chis12 = chis1 * chis2
25357 sig1 = sigmap1_peppho
25358 sig2 = sigmap2_peppho
25359 ! write (*,*) "sig1 = ", sig1
25360 ! write (*,*) "sig1 = ", sig1
25361 ! write (*,*) "sig2 = ", sig2
25362 ! alpha factors from Fcav/Gcav
25366 b1 = alphasur_peppho(1)
25368 b2 = alphasur_peppho(2)
25369 b3 = alphasur_peppho(3)
25370 b4 = alphasur_peppho(4)
25392 fac = rij_shift**expon
25393 c1 = fac * fac * aa_peppho
25395 c2 = fac * bb_peppho
25398 ! Now cavity....................
25399 eagle = dsqrt(1.0/rij_shift)
25400 top = b1 * ( eagle + b2 * 1.0/rij_shift - b3 )
25401 bot = 1.0d0 + b4 * (1.0/rij_shift ** 12.0d0)
25404 dtop = b1 * ((1.0/ (2.0d0 * eagle)) + (b2))
25405 dbot = 12.0d0 * b4 * (1.0/rij_shift) ** 11.0d0
25406 dFdR = ((dtop * bot - top * dbot) / botsq)
25407 w1 = wqdip_peppho(1)
25408 w2 = wqdip_peppho(2)
25411 ! pis = sig0head_scbase(itypi,itypj)
25412 ! eps_head = epshead_scbase(itypi,itypj)
25413 !c!-------------------------------------------------------------------
25415 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
25416 !c! & +dhead(1,1,itypi,itypj))**2))
25417 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
25418 !c! & +dhead(2,1,itypi,itypj))**2))
25420 !c!-------------------------------------------------------------------
25423 hawk = w2 * (1.0d0 - sqom1)
25424 Ecl = sparrow * rij_shift**2.0d0 &
25425 - hawk * rij_shift**4.0d0
25426 !c!-------------------------------------------------------------------
25427 !c! derivative of ecl is Gcl
25430 dGCLdR = - 2.0d0 * sparrow * rij_shift**3.0d0 &
25431 + 4.0d0 * hawk * rij_shift**5.0d0
25433 dGCLdOM1 = (w1) * (rij_shift**2.0d0)
25435 dGCLdOM2 = (2.0d0 * w2 * om1) * (rij_shift ** 4.0d0)
25436 eom1 = dGCLdOM1+dGCLdOM2
25439 fac = -expon * (c1 + evdwij) * rij_shift+dFdR+dGCLdR
25445 gvdwc_peppho(k,j) = gvdwc_peppho(k,j) +gg(k)/2.0
25446 gvdwc_peppho(k,j+1) = gvdwc_peppho(k,j+1) +gg(k)/2.0
25447 gvdwc_peppho(k,i) = gvdwc_peppho(k,i) -gg(k)/2.0
25448 gvdwc_peppho(k,i+1) = gvdwc_peppho(k,i+1) -gg(k)/2.0
25453 dcosom1(k) = rij* (dc_norm(k,i) - om1 * erij(k))
25454 dcosom2(k) = rij* (dc_norm(k,j) - om2 * erij(k))
25455 gg(k) = gg(k) + eom1 * dcosom1(k)! + eom2 * dcosom2(k)
25456 gvdwc_peppho(k,j)= gvdwc_peppho(k,j) +0.5*( gg(k)) !&
25457 ! - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
25458 gvdwc_peppho(k,j+1)= gvdwc_peppho(k,j+1) +0.5*( gg(k)) !&
25459 ! + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
25460 gvdwc_peppho(k,i)= gvdwc_peppho(k,i) -0.5*( gg(k)) &
25461 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
25462 gvdwc_peppho(k,i+1)= gvdwc_peppho(k,i+1) - 0.5*( gg(k)) &
25463 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
25465 epeppho=epeppho+evdwij+Fcav+ECL
25466 ! print *,i,j,evdwij,Fcav,ECL,rij_shift
25469 end subroutine eprot_pep_phosphate
25470 !!!!!!!!!!!!!!!!-------------------------------------------------------------
25471 subroutine emomo(evdw)
25474 ! implicit real*8 (a-h,o-z)
25475 ! include 'DIMENSIONS'
25476 ! include 'COMMON.GEO'
25477 ! include 'COMMON.VAR'
25478 ! include 'COMMON.LOCAL'
25479 ! include 'COMMON.CHAIN'
25480 ! include 'COMMON.DERIV'
25481 ! include 'COMMON.NAMES'
25482 ! include 'COMMON.INTERACT'
25483 ! include 'COMMON.IOUNITS'
25484 ! include 'COMMON.CALC'
25485 ! include 'COMMON.CONTROL'
25486 ! include 'COMMON.SBRIDGE'
25488 !el local variables
25489 integer :: iint,itypi1,subchap,isel
25490 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,e1,e2,sigm,epsi
25491 real(kind=8) :: evdw
25492 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
25493 dist_temp, dist_init,ssgradlipi,ssgradlipj, &
25494 sslipi,sslipj,faclip,alpha_sco
25496 real(kind=8) :: fracinbuf
25497 real (kind=8) :: escpho
25498 real (kind=8),dimension(4):: ener
25499 real(kind=8) :: b1,b2,egb
25500 real(kind=8) :: Fisocav,ECL,Elj,Equad,Epol,eheadtail,&
25502 Chif,ChiLambf,Fcav,dFdR,dFdOM1,&
25503 dFdOM2,dFdL,dFdOM12,&
25506 ! real(kind=8),dimension(3,2)::erhead_tail
25507 ! real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead,Rtail_distance
25508 real(kind=8) :: facd4, adler, Fgb, facd3
25509 integer troll,jj,istate
25510 real (kind=8) :: dcosom1(3),dcosom2(3)
25513 ! print *,"EVDW KURW",evdw,nres
25514 do i=iatsc_s,iatsc_e
25515 ! print *,"I am in EVDW",i
25516 itypi=iabs(itype(i,1))
25517 ! if (i.ne.47) cycle
25518 if (itypi.eq.ntyp1) cycle
25519 itypi1=iabs(itype(i+1,1))
25523 xi=dmod(xi,boxxsize)
25524 if (xi.lt.0) xi=xi+boxxsize
25525 yi=dmod(yi,boxysize)
25526 if (yi.lt.0) yi=yi+boxysize
25527 zi=dmod(zi,boxzsize)
25528 if (zi.lt.0) zi=zi+boxzsize
25530 if ((zi.gt.bordlipbot) &
25531 .and.(zi.lt.bordliptop)) then
25532 !C the energy transfer exist
25533 if (zi.lt.buflipbot) then
25534 !C what fraction I am in
25536 ((zi-bordlipbot)/lipbufthick)
25537 !C lipbufthick is thickenes of lipid buffore
25538 sslipi=sscalelip(fracinbuf)
25539 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
25540 elseif (zi.gt.bufliptop) then
25541 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
25542 sslipi=sscalelip(fracinbuf)
25543 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
25552 ! print *, sslipi,ssgradlipi
25553 dxi=dc_norm(1,nres+i)
25554 dyi=dc_norm(2,nres+i)
25555 dzi=dc_norm(3,nres+i)
25556 ! dsci_inv=dsc_inv(itypi)
25557 dsci_inv=vbld_inv(i+nres)
25558 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
25559 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
25561 ! Calculate SC interaction energy.
25563 do iint=1,nint_gr(i)
25564 do j=istart(i,iint),iend(i,iint)
25565 ! print *,"JA PIER",i,j,iint,istart(i,iint),iend(i,iint)
25566 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
25567 call dyn_ssbond_ene(i,j,evdwij)
25569 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
25570 'evdw',i,j,evdwij,' ss'
25571 ! if (energy_dec) write (iout,*) &
25572 ! 'evdw',i,j,evdwij,' ss'
25573 do k=j+1,iend(i,iint)
25574 !C search over all next residues
25575 if (dyn_ss_mask(k)) then
25576 !C check if they are cysteins
25577 !C write(iout,*) 'k=',k
25579 !c write(iout,*) "PRZED TRI", evdwij
25580 ! evdwij_przed_tri=evdwij
25581 call triple_ssbond_ene(i,j,k,evdwij)
25582 !c if(evdwij_przed_tri.ne.evdwij) then
25583 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
25586 !c write(iout,*) "PO TRI", evdwij
25587 !C call the energy function that removes the artifical triple disulfide
25588 !C bond the soubroutine is located in ssMD.F
25590 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
25591 'evdw',i,j,evdwij,'tss'
25592 endif!dyn_ss_mask(k)
25596 itypj=iabs(itype(j,1))
25597 if (itypj.eq.ntyp1) cycle
25598 CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
25600 ! if (j.ne.78) cycle
25601 ! dscj_inv=dsc_inv(itypj)
25602 dscj_inv=vbld_inv(j+nres)
25606 xj=dmod(xj,boxxsize)
25607 if (xj.lt.0) xj=xj+boxxsize
25608 yj=dmod(yj,boxysize)
25609 if (yj.lt.0) yj=yj+boxysize
25610 zj=dmod(zj,boxzsize)
25611 if (zj.lt.0) zj=zj+boxzsize
25612 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
25621 xj=xj_safe+xshift*boxxsize
25622 yj=yj_safe+yshift*boxysize
25623 zj=zj_safe+zshift*boxzsize
25624 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
25625 if(dist_temp.lt.dist_init) then
25626 dist_init=dist_temp
25635 if (subchap.eq.1) then
25644 dxj = dc_norm( 1, nres+j )
25645 dyj = dc_norm( 2, nres+j )
25646 dzj = dc_norm( 3, nres+j )
25647 ! print *,i,j,itypi,itypj
25650 ! BetaT = 1.0d0 / (298.0d0 * Rb)
25652 !1! sig0ij = sigma_scsc( itypi,itypj )
25657 ! not used by momo potential, but needed by sc_angular which is shared
25658 ! by all energy_potential subroutines
25662 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
25663 ! a12sq = a12sq * a12sq
25664 ! charge of amino acid itypi is...
25665 chis1 = chis(itypi,itypj)
25666 chis2 = chis(itypj,itypi)
25667 chis12 = chis1 * chis2
25668 sig1 = sigmap1(itypi,itypj)
25669 sig2 = sigmap2(itypi,itypj)
25670 ! write (*,*) "sig1 = ", sig1
25673 ! chis12 = chis1 * chis2
25676 ! write (*,*) "sig2 = ", sig2
25677 ! alpha factors from Fcav/Gcav
25678 b1cav = alphasur(1,itypi,itypj)
25680 b2cav = alphasur(2,itypi,itypj)
25681 b3cav = alphasur(3,itypi,itypj)
25682 b4cav = alphasur(4,itypi,itypj)
25683 ! used to determine whether we want to do quadrupole calculations
25684 eps_in = epsintab(itypi,itypj)
25685 if (eps_in.eq.0.0) eps_in=1.0
25687 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
25689 ! dtail(1,itypi,itypj)=0.0
25690 ! dtail(2,itypi,itypj)=0.0
25693 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
25694 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
25696 !c! tail distances will be themselves usefull elswhere
25697 !c1 (in Gcav, for example)
25698 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
25699 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
25700 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
25702 (Rtail_distance(1)*Rtail_distance(1)) &
25703 + (Rtail_distance(2)*Rtail_distance(2)) &
25704 + (Rtail_distance(3)*Rtail_distance(3)))
25706 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
25707 !-------------------------------------------------------------------
25708 ! tail location and distance calculations
25709 d1 = dhead(1, 1, itypi, itypj)
25710 d2 = dhead(2, 1, itypi, itypj)
25713 ! location of polar head is computed by taking hydrophobic centre
25714 ! and moving by a d1 * dc_norm vector
25715 ! see unres publications for very informative images
25716 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
25717 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
25719 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
25720 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
25721 Rhead_distance(k) = chead(k,2) - chead(k,1)
25723 ! pitagoras (root of sum of squares)
25725 (Rhead_distance(1)*Rhead_distance(1)) &
25726 + (Rhead_distance(2)*Rhead_distance(2)) &
25727 + (Rhead_distance(3)*Rhead_distance(3)))
25728 !-------------------------------------------------------------------
25729 ! zero everything that should be zero'ed
25747 dscj_inv = vbld_inv(j+nres)
25748 ! print *,i,j,dscj_inv,dsci_inv
25749 ! rij holds 1/(distance of Calpha atoms)
25750 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
25752 !----------------------------
25754 ! this should be in elgrad_init but om's are calculated by sc_angular
25755 ! which in turn is used by older potentials
25756 ! om = omega, sqom = om^2
25759 sqom12 = om12 * om12
25761 ! now we calculate EGB - Gey-Berne
25762 ! It will be summed up in evdwij and saved in evdw
25763 sigsq = 1.0D0 / sigsq
25764 sig = sig0ij * dsqrt(sigsq)
25765 ! rij_shift = 1.0D0 / rij - sig + sig0ij
25766 rij_shift = Rtail - sig + sig0ij
25767 IF (rij_shift.le.0.0D0) THEN
25771 sigder = -sig * sigsq
25772 rij_shift = 1.0D0 / rij_shift
25773 fac = rij_shift**expon
25774 c1 = fac * fac * aa_aq(itypi,itypj)
25775 ! print *,"ADAM",aa_aq(itypi,itypj)
25778 c2 = fac * bb_aq(itypi,itypj)
25780 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
25781 eps2der = eps3rt * evdwij
25782 eps3der = eps2rt * evdwij
25783 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
25784 evdwij = eps2rt * eps3rt * evdwij
25786 ! IF (bb_aq(itypi,itypj).gt.0) THEN
25787 ! evdw_p = evdw_p + evdwij
25789 ! evdw_m = evdw_m + evdwij
25796 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
25797 fac = -expon * (c1 + evdwij) * rij_shift
25798 sigder = fac * sigder
25800 ! Calculate distance derivative
25804 ! if (b2.gt.0.0) then
25805 fac = chis1 * sqom1 + chis2 * sqom2 &
25806 - 2.0d0 * chis12 * om1 * om2 * om12
25807 ! we will use pom later in Gcav, so dont mess with it!
25808 pom = 1.0d0 - chis1 * chis2 * sqom12
25809 Lambf = (1.0d0 - (fac / pom))
25810 ! print *,"fac,pom",fac,pom,Lambf
25811 Lambf = dsqrt(Lambf)
25812 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
25813 ! print *,"sig1,sig2",sig1,sig2,itypi,itypj
25814 ! write (*,*) "sparrow = ", sparrow
25815 Chif = Rtail * sparrow
25816 ! print *,"rij,sparrow",rij , sparrow
25817 ChiLambf = Chif * Lambf
25818 eagle = dsqrt(ChiLambf)
25819 bat = ChiLambf ** 11.0d0
25820 top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
25821 bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
25823 ! print *,top,bot,"bot,top",ChiLambf,Chif
25826 dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
25827 dbot = 12.0d0 * b4cav * bat * Lambf
25828 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
25830 dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
25831 dbot = 12.0d0 * b4cav * bat * Chif
25832 eagle = Lambf * pom
25833 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
25834 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
25835 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
25836 * (chis2 * om2 * om12 - om1) / (eagle * pom)
25838 dFdL = ((dtop * bot - top * dbot) / botsq)
25840 dCAVdOM1 = dFdL * ( dFdOM1 )
25841 dCAVdOM2 = dFdL * ( dFdOM2 )
25842 dCAVdOM12 = dFdL * ( dFdOM12 )
25845 ertail(k) = Rtail_distance(k)/Rtail
25847 erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
25848 erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
25849 facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
25850 facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
25852 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
25853 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
25854 pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
25855 gvdwx(k,i) = gvdwx(k,i) &
25856 - (( dFdR + gg(k) ) * pom)
25857 !c! & - ( dFdR * pom )
25858 pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
25859 gvdwx(k,j) = gvdwx(k,j) &
25860 + (( dFdR + gg(k) ) * pom)
25861 !c! & + ( dFdR * pom )
25863 gvdwc(k,i) = gvdwc(k,i) &
25864 - (( dFdR + gg(k) ) * ertail(k))
25865 !c! & - ( dFdR * ertail(k))
25867 gvdwc(k,j) = gvdwc(k,j) &
25868 + (( dFdR + gg(k) ) * ertail(k))
25869 !c! & + ( dFdR * ertail(k))
25872 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
25873 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
25877 !c! Compute head-head and head-tail energies for each state
25879 isel = iabs(Qi) + iabs(Qj)
25880 ! double charge for Phophorylated! itype - 25,27,27
25881 ! if ((itype(i).eq.27).or.(itype(i).eq.26).or.(itype(i).eq.25)) then
25885 ! if ((itype(j).eq.27).or.(itype(j).eq.26).or.(itype(j).eq.25)) then
25891 IF (isel.eq.0) THEN
25892 !c! No charges - do nothing
25895 ELSE IF (isel.eq.4) THEN
25896 !c! Calculate dipole-dipole interactions
25899 ! eheadtail = 0.0d0
25901 ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
25902 !c! Charge-nonpolar interactions
25903 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
25907 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
25914 ! eheadtail = 0.0d0
25916 ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
25917 !c! Nonpolar-charge interactions
25918 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
25922 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
25929 ! eheadtail = 0.0d0
25931 ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
25932 !c! Charge-dipole interactions
25933 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
25937 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
25942 CALL eqd(ecl, elj, epol)
25943 eheadtail = ECL + elj + epol
25944 ! eheadtail = 0.0d0
25946 ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
25947 !c! Dipole-charge interactions
25948 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
25952 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
25956 CALL edq(ecl, elj, epol)
25957 eheadtail = ECL + elj + epol
25958 ! eheadtail = 0.0d0
25960 ELSE IF ((isel.eq.2.and. &
25961 iabs(Qi).eq.1).and. &
25962 nstate(itypi,itypj).eq.1) THEN
25963 !c! Same charge-charge interaction ( +/+ or -/- )
25964 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
25968 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
25973 CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
25974 eheadtail = ECL + Egb + Epol + Fisocav + Elj
25975 ! eheadtail = 0.0d0
25977 ELSE IF ((isel.eq.2.and. &
25978 iabs(Qi).eq.1).and. &
25979 nstate(itypi,itypj).ne.1) THEN
25980 !c! Different charge-charge interaction ( +/- or -/+ )
25981 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
25985 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
25990 CALL energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
25992 END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
25993 evdw = evdw + Fcav + eheadtail
25995 IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
25996 restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
25997 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
25998 Equad,evdwij+Fcav+eheadtail,evdw
25999 ! evdw = evdw + Fcav + eheadtail
26001 iF (nstate(itypi,itypj).eq.1) THEN
26004 !c!-------------------------------------------------------------------
26009 !c write (iout,*) "Number of loop steps in EGB:",ind
26010 !c energy_dec=.false.
26011 ! print *,"EVDW KURW",evdw,nres
26014 END SUBROUTINE emomo
26015 !C------------------------------------------------------------------------------------
26016 SUBROUTINE eqq(Ecl,Egb,Epol,Fisocav,Elj)
26019 real (kind=8) :: facd3, facd4, federmaus, adler,&
26020 Ecl,Egb,Epol,Fisocav,Elj,Fgb,debkap
26022 !c! Epol and Gpol analytical parameters
26023 alphapol1 = alphapol(itypi,itypj)
26024 alphapol2 = alphapol(itypj,itypi)
26025 !c! Fisocav and Gisocav analytical parameters
26026 al1 = alphiso(1,itypi,itypj)
26027 al2 = alphiso(2,itypi,itypj)
26028 al3 = alphiso(3,itypi,itypj)
26029 al4 = alphiso(4,itypi,itypj)
26031 / dsqrt(sigiso1(itypi, itypj)**2.0d0 &
26032 + sigiso2(itypi,itypj)**2.0d0))
26034 pis = sig0head(itypi,itypj)
26035 eps_head = epshead(itypi,itypj)
26036 Rhead_sq = Rhead * Rhead
26037 !c! R1 - distance between head of ith side chain and tail of jth sidechain
26038 !c! R2 - distance between head of jth side chain and tail of ith sidechain
26042 !c! Calculate head-to-tail distances needed by Epol
26043 R1=R1+(ctail(k,2)-chead(k,1))**2
26044 R2=R2+(chead(k,2)-ctail(k,1))**2
26050 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
26051 !c! & +dhead(1,1,itypi,itypj))**2))
26052 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
26053 !c! & +dhead(2,1,itypi,itypj))**2))
26055 !c!-------------------------------------------------------------------
26056 !c! Coulomb electrostatic interaction
26057 Ecl = (332.0d0 * Qij) / Rhead
26058 !c! derivative of Ecl is Gcl...
26059 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
26063 ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
26064 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
26065 debkap=debaykap(itypi,itypj)
26066 Egb = -(332.0d0 * Qij *&
26067 (1.0/eps_in-dexp(-debkap*Fgb)/eps_out)) / Fgb
26068 ! print *,"EGB WTF",Qij,eps_inout_fac,Fgb,itypi,itypj,eps_in,eps_out
26069 !c! Derivative of Egb is Ggb...
26070 dGGBdFGB = -(-332.0d0 * Qij * &
26071 (1.0/eps_in-dexp(-debkap*Fgb)/eps_out))/(Fgb*Fgb)&
26073 (dexp(-debkap*Fgb)*debkap/eps_out))/ Fgb
26074 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )/ ( 2.0d0 * Fgb )
26075 dGGBdR = dGGBdFGB * dFGBdR
26076 !c!-------------------------------------------------------------------
26077 !c! Fisocav - isotropic cavity creation term
26078 !c! or "how much energy it costs to put charged head in water"
26080 top = al1 * (dsqrt(pom) + al2 * pom - al3)
26081 bot = (1.0d0 + al4 * pom**12.0d0)
26083 FisoCav = top / bot
26084 ! write (*,*) "Rhead = ",Rhead
26085 ! write (*,*) "csig = ",csig
26086 ! write (*,*) "pom = ",pom
26087 ! write (*,*) "al1 = ",al1
26088 ! write (*,*) "al2 = ",al2
26089 ! write (*,*) "al3 = ",al3
26090 ! write (*,*) "al4 = ",al4
26091 ! write (*,*) "top = ",top
26092 ! write (*,*) "bot = ",bot
26093 !c! Derivative of Fisocav is GCV...
26094 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
26095 dbot = 12.0d0 * al4 * pom ** 11.0d0
26096 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
26097 !c!-------------------------------------------------------------------
26099 !c! Polarization energy - charged heads polarize hydrophobic "neck"
26100 MomoFac1 = (1.0d0 - chi1 * sqom2)
26101 MomoFac2 = (1.0d0 - chi2 * sqom1)
26102 RR1 = ( R1 * R1 ) / MomoFac1
26103 RR2 = ( R2 * R2 ) / MomoFac2
26104 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
26105 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
26106 fgb1 = sqrt( RR1 + a12sq * ee1 )
26107 fgb2 = sqrt( RR2 + a12sq * ee2 )
26108 epol = 332.0d0 * eps_inout_fac * ( &
26109 (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
26111 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
26113 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
26115 dFGBdR1 = ( (R1 / MomoFac1)* ( 2.0d0 - (0.5d0 * ee1) ) )&
26117 dFGBdR2 = ( (R2 / MomoFac2)* ( 2.0d0 - (0.5d0 * ee2) ) )&
26119 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))&
26120 * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 )
26121 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))&
26122 * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 )
26123 dPOLdR1 = dPOLdFGB1 * dFGBdR1
26124 !c! dPOLdR1 = 0.0d0
26125 dPOLdR2 = dPOLdFGB2 * dFGBdR2
26126 !c! dPOLdR2 = 0.0d0
26127 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
26128 !c! dPOLdOM1 = 0.0d0
26129 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
26130 !c! dPOLdOM2 = 0.0d0
26131 !c!-------------------------------------------------------------------
26133 !c! Lennard-Jones 6-12 interaction between heads
26134 pom = (pis / Rhead)**6.0d0
26135 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
26136 !c! derivative of Elj is Glj
26137 dGLJdR = 4.0d0 * eps_head*(((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))&
26138 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
26139 !c!-------------------------------------------------------------------
26140 !c! Return the results
26141 !c! These things do the dRdX derivatives, that is
26142 !c! allow us to change what we see from function that changes with
26143 !c! distance to function that changes with LOCATION (of the interaction
26146 erhead(k) = Rhead_distance(k)/Rhead
26147 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
26148 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
26151 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
26152 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
26153 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
26154 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
26155 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
26156 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
26157 facd1 = d1 * vbld_inv(i+nres)
26158 facd2 = d2 * vbld_inv(j+nres)
26159 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
26160 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
26162 !c! Now we add appropriate partial derivatives (one in each dimension)
26164 hawk = (erhead_tail(k,1) + &
26165 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
26166 condor = (erhead_tail(k,2) + &
26167 facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
26169 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
26170 gvdwx(k,i) = gvdwx(k,i) &
26175 - dPOLdR2 * (erhead_tail(k,2)&
26176 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
26179 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
26180 gvdwx(k,j) = gvdwx(k,j)+ dGCLdR * pom&
26181 + dGGBdR * pom+ dGCVdR * pom&
26182 + dPOLdR1 * (erhead_tail(k,1)&
26183 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))&
26184 + dPOLdR2 * condor + dGLJdR * pom
26186 gvdwc(k,i) = gvdwc(k,i) &
26187 - dGCLdR * erhead(k)&
26188 - dGGBdR * erhead(k)&
26189 - dGCVdR * erhead(k)&
26190 - dPOLdR1 * erhead_tail(k,1)&
26191 - dPOLdR2 * erhead_tail(k,2)&
26192 - dGLJdR * erhead(k)
26194 gvdwc(k,j) = gvdwc(k,j) &
26195 + dGCLdR * erhead(k) &
26196 + dGGBdR * erhead(k) &
26197 + dGCVdR * erhead(k) &
26198 + dPOLdR1 * erhead_tail(k,1) &
26199 + dPOLdR2 * erhead_tail(k,2)&
26200 + dGLJdR * erhead(k)
26206 SUBROUTINE eqq_cat(Ecl,Egb,Epol,Fisocav,Elj)
26209 real (kind=8) :: facd3, facd4, federmaus, adler,&
26210 Ecl,Egb,Epol,Fisocav,Elj,Fgb,debkap
26212 !c! Epol and Gpol analytical parameters
26213 alphapol1 = alphapolcat(itypi,itypj)
26214 alphapol2 = alphapolcat(itypj,itypi)
26215 !c! Fisocav and Gisocav analytical parameters
26216 al1 = alphisocat(1,itypi,itypj)
26217 al2 = alphisocat(2,itypi,itypj)
26218 al3 = alphisocat(3,itypi,itypj)
26219 al4 = alphisocat(4,itypi,itypj)
26221 / dsqrt(sigiso1cat(itypi, itypj)**2.0d0 &
26222 + sigiso2cat(itypi,itypj)**2.0d0))
26224 pis = sig0headcat(itypi,itypj)
26225 eps_head = epsheadcat(itypi,itypj)
26226 Rhead_sq = Rhead * Rhead
26227 !c! R1 - distance between head of ith side chain and tail of jth sidechain
26228 !c! R2 - distance between head of jth side chain and tail of ith sidechain
26232 !c! Calculate head-to-tail distances needed by Epol
26233 R1=R1+(ctail(k,2)-chead(k,1))**2
26234 R2=R2+(chead(k,2)-ctail(k,1))**2
26240 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
26241 !c! & +dhead(1,1,itypi,itypj))**2))
26242 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
26243 !c! & +dhead(2,1,itypi,itypj))**2))
26245 !c!-------------------------------------------------------------------
26246 !c! Coulomb electrostatic interaction
26247 Ecl = (332.0d0 * Qij) / Rhead
26248 !c! derivative of Ecl is Gcl...
26249 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
26253 ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
26254 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
26255 debkap=debaykapcat(itypi,itypj)
26256 Egb = -(332.0d0 * Qij *&
26257 (1.0/eps_in-dexp(-debkap*Fgb)/eps_out)) / Fgb
26258 ! print *,"EGB WTF",Qij,eps_inout_fac,Fgb,itypi,itypj,eps_in,eps_out
26259 !c! Derivative of Egb is Ggb...
26260 dGGBdFGB = -(-332.0d0 * Qij * &
26261 (1.0/eps_in-dexp(-debkap*Fgb)/eps_out))/(Fgb*Fgb)&
26263 (dexp(-debkap*Fgb)*debkap/eps_out))/ Fgb
26264 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )/ ( 2.0d0 * Fgb )
26265 dGGBdR = dGGBdFGB * dFGBdR
26266 !c!-------------------------------------------------------------------
26267 !c! Fisocav - isotropic cavity creation term
26268 !c! or "how much energy it costs to put charged head in water"
26270 top = al1 * (dsqrt(pom) + al2 * pom - al3)
26271 bot = (1.0d0 + al4 * pom**12.0d0)
26273 FisoCav = top / bot
26274 ! write (*,*) "Rhead = ",Rhead
26275 ! write (*,*) "csig = ",csig
26276 ! write (*,*) "pom = ",pom
26277 ! write (*,*) "al1 = ",al1
26278 ! write (*,*) "al2 = ",al2
26279 ! write (*,*) "al3 = ",al3
26280 ! write (*,*) "al4 = ",al4
26281 ! write (*,*) "top = ",top
26282 ! write (*,*) "bot = ",bot
26283 !c! Derivative of Fisocav is GCV...
26284 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
26285 dbot = 12.0d0 * al4 * pom ** 11.0d0
26286 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
26287 !c!-------------------------------------------------------------------
26289 !c! Polarization energy - charged heads polarize hydrophobic "neck"
26290 MomoFac1 = (1.0d0 - chi1 * sqom2)
26291 MomoFac2 = (1.0d0 - chi2 * sqom1)
26292 RR1 = ( R1 * R1 ) / MomoFac1
26293 RR2 = ( R2 * R2 ) / MomoFac2
26294 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
26295 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
26296 fgb1 = sqrt( RR1 + a12sq * ee1 )
26297 fgb2 = sqrt( RR2 + a12sq * ee2 )
26298 epol = 332.0d0 * eps_inout_fac * ( &
26299 (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
26301 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
26303 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
26305 dFGBdR1 = ( (R1 / MomoFac1)* ( 2.0d0 - (0.5d0 * ee1) ) )&
26307 dFGBdR2 = ( (R2 / MomoFac2)* ( 2.0d0 - (0.5d0 * ee2) ) )&
26309 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))&
26310 * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 )
26311 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))&
26312 * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 )
26313 dPOLdR1 = dPOLdFGB1 * dFGBdR1
26314 !c! dPOLdR1 = 0.0d0
26315 dPOLdR2 = dPOLdFGB2 * dFGBdR2
26316 !c! dPOLdR2 = 0.0d0
26317 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
26318 !c! dPOLdOM1 = 0.0d0
26319 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
26320 !c! dPOLdOM2 = 0.0d0
26321 !c!-------------------------------------------------------------------
26323 !c! Lennard-Jones 6-12 interaction between heads
26324 pom = (pis / Rhead)**6.0d0
26325 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
26326 !c! derivative of Elj is Glj
26327 dGLJdR = 4.0d0 * eps_head*(((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))&
26328 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
26329 !c!-------------------------------------------------------------------
26330 !c! Return the results
26331 !c! These things do the dRdX derivatives, that is
26332 !c! allow us to change what we see from function that changes with
26333 !c! distance to function that changes with LOCATION (of the interaction
26336 erhead(k) = Rhead_distance(k)/Rhead
26337 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
26338 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
26341 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
26342 erdxj = scalar( erhead(1), dC_norm(1,j) )
26343 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
26344 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j))
26345 eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
26346 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
26347 facd1 = d1 * vbld_inv(i+nres)
26348 facd2 = d2 * vbld_inv(j)
26349 facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
26350 facd4 = dtailcat(2,itypi,itypj) * vbld_inv(j)
26352 !c! Now we add appropriate partial derivatives (one in each dimension)
26354 hawk = (erhead_tail(k,1) + &
26355 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
26356 condor = (erhead_tail(k,2) + &
26357 facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
26359 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
26360 gradpepcatx(k,i) = gradpepcatx(k,i) &
26365 - dPOLdR2 * (erhead_tail(k,2)&
26366 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
26369 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
26370 gradpepcatx(k,j) = gradpepcatx(k,j)+ dGCLdR * pom&
26371 + dGGBdR * pom+ dGCVdR * pom&
26372 + dPOLdR1 * (erhead_tail(k,1)&
26373 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j)))&
26374 + dPOLdR2 * condor + dGLJdR * pom
26376 gradpepcat(k,i) = gradpepcat(k,i) &
26377 - dGCLdR * erhead(k)&
26378 - dGGBdR * erhead(k)&
26379 - dGCVdR * erhead(k)&
26380 - dPOLdR1 * erhead_tail(k,1)&
26381 - dPOLdR2 * erhead_tail(k,2)&
26382 - dGLJdR * erhead(k)
26384 gradpepcat(k,j) = gradpepcat(k,j) &
26385 + dGCLdR * erhead(k) &
26386 + dGGBdR * erhead(k) &
26387 + dGCVdR * erhead(k) &
26388 + dPOLdR1 * erhead_tail(k,1) &
26389 + dPOLdR2 * erhead_tail(k,2)&
26390 + dGLJdR * erhead(k)
26394 END SUBROUTINE eqq_cat
26395 !c!-------------------------------------------------------------------
26396 SUBROUTINE energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
26400 double precision eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad
26401 double precision ener(4)
26402 double precision dcosom1(3),dcosom2(3)
26403 !c! used in Epol derivatives
26404 double precision facd3, facd4
26405 double precision federmaus, adler
26406 integer istate,ii,jj
26407 real (kind=8) :: Fgb
26408 ! print *,"CALLING EQUAD"
26409 !c! Epol and Gpol analytical parameters
26410 alphapol1 = alphapol(itypi,itypj)
26411 alphapol2 = alphapol(itypj,itypi)
26412 !c! Fisocav and Gisocav analytical parameters
26413 al1 = alphiso(1,itypi,itypj)
26414 al2 = alphiso(2,itypi,itypj)
26415 al3 = alphiso(3,itypi,itypj)
26416 al4 = alphiso(4,itypi,itypj)
26417 csig = (1.0d0 / dsqrt(sigiso1(itypi, itypj)**2.0d0&
26418 + sigiso2(itypi,itypj)**2.0d0))
26420 w1 = wqdip(1,itypi,itypj)
26421 w2 = wqdip(2,itypi,itypj)
26422 pis = sig0head(itypi,itypj)
26423 eps_head = epshead(itypi,itypj)
26424 !c! First things first:
26425 !c! We need to do sc_grad's job with GB and Fcav
26426 eom1 = eps2der * eps2rt_om1 &
26427 - 2.0D0 * alf1 * eps3der&
26428 + sigder * sigsq_om1&
26430 eom2 = eps2der * eps2rt_om2 &
26431 + 2.0D0 * alf2 * eps3der&
26432 + sigder * sigsq_om2&
26434 eom12 = evdwij * eps1_om12 &
26435 + eps2der * eps2rt_om12 &
26436 - 2.0D0 * alf12 * eps3der&
26437 + sigder *sigsq_om12&
26439 !c! now some magical transformations to project gradient into
26440 !c! three cartesian vectors
26442 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
26443 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
26444 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
26445 !c! this acts on hydrophobic center of interaction
26446 gvdwx(k,i)= gvdwx(k,i) - gg(k) &
26447 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
26448 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
26449 gvdwx(k,j)= gvdwx(k,j) + gg(k) &
26450 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))&
26451 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
26452 !c! this acts on Calpha
26453 gvdwc(k,i)=gvdwc(k,i)-gg(k)
26454 gvdwc(k,j)=gvdwc(k,j)+gg(k)
26456 !c! sc_grad is done, now we will compute
26461 DO istate = 1, nstate(itypi,itypj)
26462 !c*************************************************************
26463 IF (istate.ne.1) THEN
26464 IF (istate.lt.3) THEN
26470 d1 = dhead(1,ii,itypi,itypj)
26471 d2 = dhead(2,jj,itypi,itypj)
26473 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
26474 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
26475 Rhead_distance(k) = chead(k,2) - chead(k,1)
26477 !c! pitagoras (root of sum of squares)
26479 (Rhead_distance(1)*Rhead_distance(1)) &
26480 + (Rhead_distance(2)*Rhead_distance(2)) &
26481 + (Rhead_distance(3)*Rhead_distance(3)))
26483 Rhead_sq = Rhead * Rhead
26485 !c! R1 - distance between head of ith side chain and tail of jth sidechain
26486 !c! R2 - distance between head of jth side chain and tail of ith sidechain
26490 !c! Calculate head-to-tail distances
26491 R1=R1+(ctail(k,2)-chead(k,1))**2
26492 R2=R2+(chead(k,2)-ctail(k,1))**2
26497 Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
26499 !c! write (*,*) "Ecl = ", Ecl
26500 !c! derivative of Ecl is Gcl...
26501 dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
26506 !c!-------------------------------------------------------------------
26507 !c! Generalised Born Solvent Polarization
26508 ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
26509 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
26510 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
26512 !c! write (*,*) "a1*a2 = ", a12sq
26513 !c! write (*,*) "Rhead = ", Rhead
26514 !c! write (*,*) "Rhead_sq = ", Rhead_sq
26515 !c! write (*,*) "ee = ", ee
26516 !c! write (*,*) "Fgb = ", Fgb
26517 !c! write (*,*) "fac = ", eps_inout_fac
26518 !c! write (*,*) "Qij = ", Qij
26519 !c! write (*,*) "Egb = ", Egb
26520 !c! Derivative of Egb is Ggb...
26521 !c! dFGBdR is used by Quad's later...
26522 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
26523 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )&
26525 dGGBdR = dGGBdFGB * dFGBdR
26527 !c!-------------------------------------------------------------------
26528 !c! Fisocav - isotropic cavity creation term
26530 top = al1 * (dsqrt(pom) + al2 * pom - al3)
26531 bot = (1.0d0 + al4 * pom**12.0d0)
26533 FisoCav = top / bot
26534 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
26535 dbot = 12.0d0 * al4 * pom ** 11.0d0
26536 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
26538 !c!-------------------------------------------------------------------
26539 !c! Polarization energy
26541 MomoFac1 = (1.0d0 - chi1 * sqom2)
26542 MomoFac2 = (1.0d0 - chi2 * sqom1)
26543 RR1 = ( R1 * R1 ) / MomoFac1
26544 RR2 = ( R2 * R2 ) / MomoFac2
26545 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
26546 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
26547 fgb1 = sqrt( RR1 + a12sq * ee1 )
26548 fgb2 = sqrt( RR2 + a12sq * ee2 )
26549 epol = 332.0d0 * eps_inout_fac * (&
26550 (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
26552 !c! derivative of Epol is Gpol...
26553 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
26555 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
26557 dFGBdR1 = ( (R1 / MomoFac1) &
26558 * ( 2.0d0 - (0.5d0 * ee1) ) )&
26560 dFGBdR2 = ( (R2 / MomoFac2) &
26561 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
26563 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
26564 * ( 2.0d0 - 0.5d0 * ee1) ) &
26566 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
26567 * ( 2.0d0 - 0.5d0 * ee2) ) &
26569 dPOLdR1 = dPOLdFGB1 * dFGBdR1
26570 !c! dPOLdR1 = 0.0d0
26571 dPOLdR2 = dPOLdFGB2 * dFGBdR2
26572 !c! dPOLdR2 = 0.0d0
26573 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
26574 !c! dPOLdOM1 = 0.0d0
26575 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
26576 pom = (pis / Rhead)**6.0d0
26577 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
26579 !c! derivative of Elj is Glj
26580 dGLJdR = 4.0d0 * eps_head &
26581 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
26582 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
26584 !c!-------------------------------------------------------------------
26586 IF (Wqd.ne.0.0d0) THEN
26587 Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0) &
26588 - 37.5d0 * ( sqom1 + sqom2 ) &
26589 + 157.5d0 * ( sqom1 * sqom2 ) &
26590 - 45.0d0 * om1*om2*om12
26591 fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
26592 Equad = fac * Beta1
26594 !c! derivative of Equad...
26595 dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
26596 !c! dQUADdR = 0.0d0
26597 dQUADdOM1 = fac* (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
26598 !c! dQUADdOM1 = 0.0d0
26599 dQUADdOM2 = fac* (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
26600 !c! dQUADdOM2 = 0.0d0
26601 dQUADdOM12 = fac * ( 6.0d0*om12 - 45.0d0*om1*om2 )
26606 !c!-------------------------------------------------------------------
26607 !c! Return the results
26609 eom1 = dPOLdOM1 + dQUADdOM1
26610 eom2 = dPOLdOM2 + dQUADdOM2
26612 !c! now some magical transformations to project gradient into
26613 !c! three cartesian vectors
26615 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
26616 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
26617 tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
26621 erhead(k) = Rhead_distance(k)/Rhead
26622 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
26623 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
26625 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
26626 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
26627 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
26628 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
26629 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
26630 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
26631 facd1 = d1 * vbld_inv(i+nres)
26632 facd2 = d2 * vbld_inv(j+nres)
26633 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
26634 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
26636 hawk = erhead_tail(k,1) + &
26637 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
26638 condor = erhead_tail(k,2) + &
26639 facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
26641 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
26642 !c! this acts on hydrophobic center of interaction
26643 gheadtail(k,1,1) = gheadtail(k,1,1) &
26648 - dPOLdR2 * (erhead_tail(k,2) &
26649 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
26653 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
26654 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
26656 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
26657 !c! this acts on hydrophobic center of interaction
26658 gheadtail(k,2,1) = gheadtail(k,2,1) &
26662 + dPOLdR1 * (erhead_tail(k,1) &
26663 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
26664 + dPOLdR2 * condor &
26668 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
26669 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
26671 !c! this acts on Calpha
26672 gheadtail(k,3,1) = gheadtail(k,3,1) &
26673 - dGCLdR * erhead(k)&
26674 - dGGBdR * erhead(k)&
26675 - dGCVdR * erhead(k)&
26676 - dPOLdR1 * erhead_tail(k,1)&
26677 - dPOLdR2 * erhead_tail(k,2)&
26678 - dGLJdR * erhead(k) &
26679 - dQUADdR * erhead(k)&
26681 !c! this acts on Calpha
26682 gheadtail(k,4,1) = gheadtail(k,4,1) &
26683 + dGCLdR * erhead(k) &
26684 + dGGBdR * erhead(k) &
26685 + dGCVdR * erhead(k) &
26686 + dPOLdR1 * erhead_tail(k,1) &
26687 + dPOLdR2 * erhead_tail(k,2) &
26688 + dGLJdR * erhead(k) &
26689 + dQUADdR * erhead(k)&
26692 ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
26693 eheadtail = eheadtail &
26694 + wstate(istate, itypi, itypj) &
26695 * dexp(-betaT * ener(istate))
26696 !c! foreach cartesian dimension
26698 !c! foreach of two gvdwx and gvdwc
26700 gheadtail(k,l,2) = gheadtail(k,l,2) &
26701 + wstate( istate, itypi, itypj ) &
26702 * dexp(-betaT * ener(istate)) &
26704 gheadtail(k,l,1) = 0.0d0
26708 !c! Here ended the gigantic DO istate = 1, 4, which starts
26709 !c! at the beggining of the subroutine
26713 gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
26715 gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
26716 gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
26717 gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
26718 gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
26720 gheadtail(k,l,1) = 0.0d0
26721 gheadtail(k,l,2) = 0.0d0
26724 eheadtail = (-dlog(eheadtail)) / betaT
26731 END SUBROUTINE energy_quad
26732 !!-----------------------------------------------------------
26733 SUBROUTINE eqn(Epol)
26737 double precision facd4, federmaus,epol
26738 alphapol1 = alphapol(itypi,itypj)
26739 !c! R1 - distance between head of ith side chain and tail of jth sidechain
26742 !c! Calculate head-to-tail distances
26743 R1=R1+(ctail(k,2)-chead(k,1))**2
26748 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
26749 !c! & +dhead(1,1,itypi,itypj))**2))
26750 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
26751 !c! & +dhead(2,1,itypi,itypj))**2))
26752 !c--------------------------------------------------------------------
26753 !c Polarization energy
26755 MomoFac1 = (1.0d0 - chi1 * sqom2)
26756 RR1 = R1 * R1 / MomoFac1
26757 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
26758 fgb1 = sqrt( RR1 + a12sq * ee1)
26759 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
26760 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
26762 dFGBdR1 = ( (R1 / MomoFac1) &
26763 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
26765 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
26766 * (2.0d0 - 0.5d0 * ee1) ) &
26768 dPOLdR1 = dPOLdFGB1 * dFGBdR1
26769 !c! dPOLdR1 = 0.0d0
26771 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
26773 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
26775 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
26776 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
26777 facd1 = d1 * vbld_inv(i+nres)
26778 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
26781 hawk = (erhead_tail(k,1) + &
26782 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
26784 gvdwx(k,i) = gvdwx(k,i) &
26786 gvdwx(k,j) = gvdwx(k,j) &
26787 + dPOLdR1 * (erhead_tail(k,1) &
26788 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
26790 gvdwc(k,i) = gvdwc(k,i) - dPOLdR1 * erhead_tail(k,1)
26791 gvdwc(k,j) = gvdwc(k,j) + dPOLdR1 * erhead_tail(k,1)
26796 SUBROUTINE enq(Epol)
26799 double precision facd3, adler,epol
26800 alphapol2 = alphapol(itypj,itypi)
26801 !c! R2 - distance between head of jth side chain and tail of ith sidechain
26804 !c! Calculate head-to-tail distances
26805 R2=R2+(chead(k,2)-ctail(k,1))**2
26810 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
26811 !c! & +dhead(1,1,itypi,itypj))**2))
26812 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
26813 !c! & +dhead(2,1,itypi,itypj))**2))
26814 !c------------------------------------------------------------------------
26815 !c Polarization energy
26816 MomoFac2 = (1.0d0 - chi2 * sqom1)
26817 RR2 = R2 * R2 / MomoFac2
26818 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
26819 fgb2 = sqrt(RR2 + a12sq * ee2)
26820 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
26821 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
26823 dFGBdR2 = ( (R2 / MomoFac2) &
26824 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
26826 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
26827 * (2.0d0 - 0.5d0 * ee2) ) &
26829 dPOLdR2 = dPOLdFGB2 * dFGBdR2
26830 !c! dPOLdR2 = 0.0d0
26831 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
26832 !c! dPOLdOM1 = 0.0d0
26834 !c!-------------------------------------------------------------------
26835 !c! Return the results
26836 !c! (See comments in Eqq)
26838 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
26840 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
26841 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
26842 facd2 = d2 * vbld_inv(j+nres)
26843 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
26845 condor = (erhead_tail(k,2) &
26846 + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
26848 gvdwx(k,i) = gvdwx(k,i) &
26849 - dPOLdR2 * (erhead_tail(k,2) &
26850 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
26851 gvdwx(k,j) = gvdwx(k,j) &
26854 gvdwc(k,i) = gvdwc(k,i) &
26855 - dPOLdR2 * erhead_tail(k,2)
26856 gvdwc(k,j) = gvdwc(k,j) &
26857 + dPOLdR2 * erhead_tail(k,2)
26863 SUBROUTINE enq_cat(Epol)
26866 double precision facd3, adler,epol
26867 alphapol2 = alphapolcat(itypj,itypi)
26868 !c! R2 - distance between head of jth side chain and tail of ith sidechain
26871 !c! Calculate head-to-tail distances
26872 R2=R2+(chead(k,2)-ctail(k,1))**2
26877 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
26878 !c! & +dhead(1,1,itypi,itypj))**2))
26879 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
26880 !c! & +dhead(2,1,itypi,itypj))**2))
26881 !c------------------------------------------------------------------------
26882 !c Polarization energy
26883 MomoFac2 = (1.0d0 - chi2 * sqom1)
26884 RR2 = R2 * R2 / MomoFac2
26885 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
26886 fgb2 = sqrt(RR2 + a12sq * ee2)
26887 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
26888 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
26890 dFGBdR2 = ( (R2 / MomoFac2) &
26891 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
26893 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
26894 * (2.0d0 - 0.5d0 * ee2) ) &
26896 dPOLdR2 = dPOLdFGB2 * dFGBdR2
26897 !c! dPOLdR2 = 0.0d0
26898 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
26899 !c! dPOLdOM1 = 0.0d0
26902 !c!-------------------------------------------------------------------
26903 !c! Return the results
26904 !c! (See comments in Eqq)
26906 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
26908 eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
26909 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
26910 facd2 = d2 * vbld_inv(j+nres)
26911 facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
26913 condor = (erhead_tail(k,2) &
26914 + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
26916 gradpepcatx(k,i) = gradpepcatx(k,i) &
26917 - dPOLdR2 * (erhead_tail(k,2) &
26918 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
26919 gradpepcatx(k,j) = gradpepcatx(k,j) &
26922 gradpepcat(k,i) = gradpepcat(k,i) &
26923 - dPOLdR2 * erhead_tail(k,2)
26924 gradpepcat(k,j) = gradpepcat(k,j) &
26925 + dPOLdR2 * erhead_tail(k,2)
26929 END SUBROUTINE enq_cat
26931 SUBROUTINE eqd(Ecl,Elj,Epol)
26934 double precision facd4, federmaus,ecl,elj,epol
26935 alphapol1 = alphapol(itypi,itypj)
26936 w1 = wqdip(1,itypi,itypj)
26937 w2 = wqdip(2,itypi,itypj)
26938 pis = sig0head(itypi,itypj)
26939 eps_head = epshead(itypi,itypj)
26940 !c!-------------------------------------------------------------------
26941 !c! R1 - distance between head of ith side chain and tail of jth sidechain
26944 !c! Calculate head-to-tail distances
26945 R1=R1+(ctail(k,2)-chead(k,1))**2
26950 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
26951 !c! & +dhead(1,1,itypi,itypj))**2))
26952 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
26953 !c! & +dhead(2,1,itypi,itypj))**2))
26955 !c!-------------------------------------------------------------------
26957 sparrow = w1 * Qi * om1
26958 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
26959 Ecl = sparrow / Rhead**2.0d0 &
26960 - hawk / Rhead**4.0d0
26961 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
26962 + 4.0d0 * hawk / Rhead**5.0d0
26964 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
26966 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
26967 !c--------------------------------------------------------------------
26968 !c Polarization energy
26970 MomoFac1 = (1.0d0 - chi1 * sqom2)
26971 RR1 = R1 * R1 / MomoFac1
26972 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
26973 fgb1 = sqrt( RR1 + a12sq * ee1)
26974 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
26976 !c!------------------------------------------------------------------
26977 !c! derivative of Epol is Gpol...
26978 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
26980 dFGBdR1 = ( (R1 / MomoFac1) &
26981 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
26983 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
26984 * (2.0d0 - 0.5d0 * ee1) ) &
26986 dPOLdR1 = dPOLdFGB1 * dFGBdR1
26987 !c! dPOLdR1 = 0.0d0
26989 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
26990 !c! dPOLdOM2 = 0.0d0
26991 !c!-------------------------------------------------------------------
26993 pom = (pis / Rhead)**6.0d0
26994 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
26995 !c! derivative of Elj is Glj
26996 dGLJdR = 4.0d0 * eps_head &
26997 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
26998 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
27000 erhead(k) = Rhead_distance(k)/Rhead
27001 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
27004 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
27005 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
27006 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
27007 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
27008 facd1 = d1 * vbld_inv(i+nres)
27009 facd2 = d2 * vbld_inv(j+nres)
27010 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
27013 hawk = (erhead_tail(k,1) + &
27014 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
27016 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
27017 gvdwx(k,i) = gvdwx(k,i) &
27022 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
27023 gvdwx(k,j) = gvdwx(k,j) &
27025 + dPOLdR1 * (erhead_tail(k,1) &
27026 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
27030 gvdwc(k,i) = gvdwc(k,i) &
27031 - dGCLdR * erhead(k) &
27032 - dPOLdR1 * erhead_tail(k,1) &
27033 - dGLJdR * erhead(k)
27035 gvdwc(k,j) = gvdwc(k,j) &
27036 + dGCLdR * erhead(k) &
27037 + dPOLdR1 * erhead_tail(k,1) &
27038 + dGLJdR * erhead(k)
27043 SUBROUTINE edq(Ecl,Elj,Epol)
27048 double precision facd3, adler,ecl,elj,epol
27049 alphapol2 = alphapol(itypj,itypi)
27050 w1 = wqdip(1,itypi,itypj)
27051 w2 = wqdip(2,itypi,itypj)
27052 pis = sig0head(itypi,itypj)
27053 eps_head = epshead(itypi,itypj)
27054 !c!-------------------------------------------------------------------
27055 !c! R2 - distance between head of jth side chain and tail of ith sidechain
27058 !c! Calculate head-to-tail distances
27059 R2=R2+(chead(k,2)-ctail(k,1))**2
27064 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
27065 !c! & +dhead(1,1,itypi,itypj))**2))
27066 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
27067 !c! & +dhead(2,1,itypi,itypj))**2))
27070 !c!-------------------------------------------------------------------
27072 sparrow = w1 * Qi * om1
27073 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
27074 ECL = sparrow / Rhead**2.0d0 &
27075 - hawk / Rhead**4.0d0
27076 !c!-------------------------------------------------------------------
27077 !c! derivative of ecl is Gcl
27079 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
27080 + 4.0d0 * hawk / Rhead**5.0d0
27082 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
27084 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
27085 !c--------------------------------------------------------------------
27086 !c Polarization energy
27088 MomoFac2 = (1.0d0 - chi2 * sqom1)
27089 RR2 = R2 * R2 / MomoFac2
27090 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
27091 fgb2 = sqrt(RR2 + a12sq * ee2)
27092 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
27093 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
27095 dFGBdR2 = ( (R2 / MomoFac2) &
27096 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
27098 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
27099 * (2.0d0 - 0.5d0 * ee2) ) &
27101 dPOLdR2 = dPOLdFGB2 * dFGBdR2
27102 !c! dPOLdR2 = 0.0d0
27103 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
27104 !c! dPOLdOM1 = 0.0d0
27106 !c!-------------------------------------------------------------------
27108 pom = (pis / Rhead)**6.0d0
27109 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
27110 !c! derivative of Elj is Glj
27111 dGLJdR = 4.0d0 * eps_head &
27112 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
27113 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
27114 !c!-------------------------------------------------------------------
27115 !c! Return the results
27116 !c! (see comments in Eqq)
27118 erhead(k) = Rhead_distance(k)/Rhead
27119 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
27121 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
27122 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
27123 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
27124 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
27125 facd1 = d1 * vbld_inv(i+nres)
27126 facd2 = d2 * vbld_inv(j+nres)
27127 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
27129 condor = (erhead_tail(k,2) &
27130 + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
27132 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
27133 gvdwx(k,i) = gvdwx(k,i) &
27135 - dPOLdR2 * (erhead_tail(k,2) &
27136 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) &
27139 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
27140 gvdwx(k,j) = gvdwx(k,j) &
27142 + dPOLdR2 * condor &
27146 gvdwc(k,i) = gvdwc(k,i) &
27147 - dGCLdR * erhead(k) &
27148 - dPOLdR2 * erhead_tail(k,2) &
27149 - dGLJdR * erhead(k)
27151 gvdwc(k,j) = gvdwc(k,j) &
27152 + dGCLdR * erhead(k) &
27153 + dPOLdR2 * erhead_tail(k,2) &
27154 + dGLJdR * erhead(k)
27160 SUBROUTINE edq_cat(Ecl,Elj,Epol)
27164 double precision facd3, adler,ecl,elj,epol
27165 alphapol2 = alphapolcat(itypj,itypi)
27166 w1 = wqdipcat(1,itypi,itypj)
27167 w2 = wqdipcat(2,itypi,itypj)
27168 pis = sig0headcat(itypi,itypj)
27169 eps_head = epsheadcat(itypi,itypj)
27170 !c!-------------------------------------------------------------------
27171 !c! R2 - distance between head of jth side chain and tail of ith sidechain
27174 !c! Calculate head-to-tail distances
27175 R2=R2+(chead(k,2)-ctail(k,1))**2
27180 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
27181 !c! & +dhead(1,1,itypi,itypj))**2))
27182 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
27183 !c! & +dhead(2,1,itypi,itypj))**2))
27186 !c!-------------------------------------------------------------------
27188 sparrow = w1 * Qi * om1
27189 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
27190 ECL = sparrow / Rhead**2.0d0 &
27191 - hawk / Rhead**4.0d0
27192 !c!-------------------------------------------------------------------
27193 !c! derivative of ecl is Gcl
27195 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
27196 + 4.0d0 * hawk / Rhead**5.0d0
27198 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
27200 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
27201 !c--------------------------------------------------------------------
27202 !c--------------------------------------------------------------------
27203 !c Polarization energy
27205 MomoFac2 = (1.0d0 - chi2 * sqom1)
27206 RR2 = R2 * R2 / MomoFac2
27207 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
27208 fgb2 = sqrt(RR2 + a12sq * ee2)
27209 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
27210 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
27212 dFGBdR2 = ( (R2 / MomoFac2) &
27213 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
27215 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
27216 * (2.0d0 - 0.5d0 * ee2) ) &
27218 dPOLdR2 = dPOLdFGB2 * dFGBdR2
27219 !c! dPOLdR2 = 0.0d0
27220 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
27221 !c! dPOLdOM1 = 0.0d0
27223 !c!-------------------------------------------------------------------
27225 pom = (pis / Rhead)**6.0d0
27226 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
27227 !c! derivative of Elj is Glj
27228 dGLJdR = 4.0d0 * eps_head &
27229 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
27230 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
27231 !c!-------------------------------------------------------------------
27233 !c! Return the results
27234 !c! (see comments in Eqq)
27236 erhead(k) = Rhead_distance(k)/Rhead
27237 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
27239 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
27240 erdxj = scalar( erhead(1), dC_norm(1,j) )
27241 eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
27242 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
27243 facd1 = d1 * vbld_inv(i+nres)
27244 facd2 = d2 * vbld_inv(j)
27245 facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
27247 condor = (erhead_tail(k,2) &
27248 + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
27250 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
27251 gradpepcatx(k,i) = gradpepcatx(k,i) &
27253 - dPOLdR2 * (erhead_tail(k,2) &
27254 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) &
27257 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
27258 gradpepcatx(k,j) = gradpepcatx(k,j) &
27260 + dPOLdR2 * condor &
27264 gradpepcat(k,i) = gradpepcat(k,i) &
27265 - dGCLdR * erhead(k) &
27266 - dPOLdR2 * erhead_tail(k,2) &
27267 - dGLJdR * erhead(k)
27269 gradpepcat(k,j) = gradpepcat(k,j) &
27270 + dGCLdR * erhead(k) &
27271 + dPOLdR2 * erhead_tail(k,2) &
27272 + dGLJdR * erhead(k)
27276 END SUBROUTINE edq_cat
27279 SUBROUTINE edd(ECL)
27284 double precision ecl
27285 !c! csig = sigiso(itypi,itypj)
27286 w1 = wqdip(1,itypi,itypj)
27287 w2 = wqdip(2,itypi,itypj)
27288 !c!-------------------------------------------------------------------
27290 fac = (om12 - 3.0d0 * om1 * om2)
27291 c1 = (w1 / (Rhead**3.0d0)) * fac
27292 c2 = (w2 / Rhead ** 6.0d0) &
27293 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
27295 !c! write (*,*) "w1 = ", w1
27296 !c! write (*,*) "w2 = ", w2
27297 !c! write (*,*) "om1 = ", om1
27298 !c! write (*,*) "om2 = ", om2
27299 !c! write (*,*) "om12 = ", om12
27300 !c! write (*,*) "fac = ", fac
27301 !c! write (*,*) "c1 = ", c1
27302 !c! write (*,*) "c2 = ", c2
27303 !c! write (*,*) "Ecl = ", Ecl
27304 !c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
27305 !c! write (*,*) "c2_2 = ",
27306 !c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
27307 !c!-------------------------------------------------------------------
27308 !c! dervative of ECL is GCL...
27310 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
27311 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
27312 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
27315 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
27316 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
27317 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
27320 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
27321 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
27322 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
27325 c1 = w1 / (Rhead ** 3.0d0)
27326 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
27327 dGCLdOM12 = c1 - c2
27328 !c!-------------------------------------------------------------------
27329 !c! Return the results
27330 !c! (see comments in Eqq)
27332 erhead(k) = Rhead_distance(k)/Rhead
27334 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
27335 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
27336 facd1 = d1 * vbld_inv(i+nres)
27337 facd2 = d2 * vbld_inv(j+nres)
27340 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
27341 gvdwx(k,i) = gvdwx(k,i) - dGCLdR * pom
27342 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
27343 gvdwx(k,j) = gvdwx(k,j) + dGCLdR * pom
27345 gvdwc(k,i) = gvdwc(k,i) - dGCLdR * erhead(k)
27346 gvdwc(k,j) = gvdwc(k,j) + dGCLdR * erhead(k)
27350 SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
27355 real(kind=8) :: eheadtail,Egb,Ecl,Elj,Equad,Epol,Rb
27359 !c! 1/(Gas Constant * Thermostate temperature) = BetaT
27360 !c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
27362 !c! BetaT = 1.0d0 / (t_bath * Rb)i
27364 BetaT = 1.0d0 / (298.0d0 * Rb)
27365 !c! Gay-berne var's
27366 sig0ij = sigma( itypi,itypj )
27367 chi1 = chi( itypi, itypj )
27368 chi2 = chi( itypj, itypi )
27369 chi12 = chi1 * chi2
27370 chip1 = chipp( itypi, itypj )
27371 chip2 = chipp( itypj, itypi )
27372 chip12 = chip1 * chip2
27379 !c! not used by momo potential, but needed by sc_angular which is shared
27380 !c! by all energy_potential subroutines
27384 !c! location, location, location
27385 ! xj = c( 1, nres+j ) - xi
27386 ! yj = c( 2, nres+j ) - yi
27387 ! zj = c( 3, nres+j ) - zi
27388 dxj = dc_norm( 1, nres+j )
27389 dyj = dc_norm( 2, nres+j )
27390 dzj = dc_norm( 3, nres+j )
27391 !c! distance from center of chain(?) to polar/charged head
27392 !c! write (*,*) "istate = ", 1
27393 !c! write (*,*) "ii = ", 1
27394 !c! write (*,*) "jj = ", 1
27395 d1 = dhead(1, 1, itypi, itypj)
27396 d2 = dhead(2, 1, itypi, itypj)
27398 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
27399 !c! a12sq = a12sq * a12sq
27400 !c! charge of amino acid itypi is...
27401 Qi = icharge(itypi)
27402 Qj = icharge(itypj)
27405 chis1 = chis(itypi,itypj)
27406 chis2 = chis(itypj,itypi)
27407 chis12 = chis1 * chis2
27408 sig1 = sigmap1(itypi,itypj)
27409 sig2 = sigmap2(itypi,itypj)
27410 !c! write (*,*) "sig1 = ", sig1
27411 !c! write (*,*) "sig2 = ", sig2
27412 !c! alpha factors from Fcav/Gcav
27413 b1cav = alphasur(1,itypi,itypj)
27415 b2cav = alphasur(2,itypi,itypj)
27416 b3cav = alphasur(3,itypi,itypj)
27417 b4cav = alphasur(4,itypi,itypj)
27418 wqd = wquad(itypi, itypj)
27420 eps_in = epsintab(itypi,itypj)
27421 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
27422 !c! write (*,*) "eps_inout_fac = ", eps_inout_fac
27423 !c!-------------------------------------------------------------------
27424 !c! tail location and distance calculations
27427 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
27428 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
27430 !c! tail distances will be themselves usefull elswhere
27431 !c1 (in Gcav, for example)
27432 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
27433 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
27434 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
27436 (Rtail_distance(1)*Rtail_distance(1)) &
27437 + (Rtail_distance(2)*Rtail_distance(2)) &
27438 + (Rtail_distance(3)*Rtail_distance(3)))
27439 !c!-------------------------------------------------------------------
27440 !c! Calculate location and distance between polar heads
27441 !c! distance between heads
27442 !c! for each one of our three dimensional space...
27443 d1 = dhead(1, 1, itypi, itypj)
27444 d2 = dhead(2, 1, itypi, itypj)
27447 !c! location of polar head is computed by taking hydrophobic centre
27448 !c! and moving by a d1 * dc_norm vector
27449 !c! see unres publications for very informative images
27450 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
27451 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
27453 !c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
27454 !c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
27455 Rhead_distance(k) = chead(k,2) - chead(k,1)
27457 !c! pitagoras (root of sum of squares)
27459 (Rhead_distance(1)*Rhead_distance(1)) &
27460 + (Rhead_distance(2)*Rhead_distance(2)) &
27461 + (Rhead_distance(3)*Rhead_distance(3)))
27462 !c!-------------------------------------------------------------------
27463 !c! zero everything that should be zero'ed
27476 END SUBROUTINE elgrad_init
27479 SUBROUTINE elgrad_init_cat(eheadtail,Egb,Ecl,Elj,Equad,Epol)
27482 real(kind=8) :: eheadtail,Egb,Ecl,Elj,Equad,Epol,Rb
27486 !c! 1/(Gas Constant * Thermostate temperature) = BetaT
27487 !c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
27489 !c! BetaT = 1.0d0 / (t_bath * Rb)i
27491 BetaT = 1.0d0 / (298.0d0 * Rb)
27492 !c! Gay-berne var's
27493 sig0ij = sigmacat( itypi,itypj )
27494 chi1 = chicat( itypi, itypj )
27495 ! chi2 = chi( itypj, itypi )
27497 ! chi12 = chi1 * chi2
27499 chip1 = chippcat( itypi, itypj )
27500 ! chip2 = chipp( itypj, itypi )
27502 ! chip12 = chip1 * chip2
27510 !c! not used by momo potential, but needed by sc_angular which is shared
27511 !c! by all energy_potential subroutines
27515 !c! location, location, location
27516 ! xj = c( 1, nres+j ) - xi
27517 ! yj = c( 2, nres+j ) - yi
27518 ! zj = c( 3, nres+j ) - zi
27519 dxj = dc_norm( 1, nres+j )
27520 dyj = dc_norm( 2, nres+j )
27521 dzj = dc_norm( 3, nres+j )
27522 !c! distance from center of chain(?) to polar/charged head
27523 d1 = dheadcat(1, 1, itypi, itypj)
27524 d2 = dheadcat(2, 1, itypi, itypj)
27526 a12sq = rborncat(itypi,itypj) * rborncat(itypj,itypi)
27527 !c! a12sq = a12sq * a12sq
27528 !c! charge of amino acid itypi is...
27529 Qi = icharge(itypi)
27530 Qj = ichargecat(itypj)
27533 chis1 = chiscat(itypi,itypj)
27534 ! chis2 = chis(itypj,itypi)
27536 ! chis12 = chis1 * chis2
27538 sig1 = sigmap1cat(itypi,itypj)
27539 sig2 = sigmap2cat(itypi,itypj)
27540 !c! alpha factors from Fcav/Gcav
27541 b1cav = alphasurcat(1,itypi,itypj)
27543 b2cav = alphasurcat(2,itypi,itypj)
27544 b3cav = alphasurcat(3,itypi,itypj)
27545 b4cav = alphasurcat(4,itypi,itypj)
27546 wqd = wquadcat(itypi, itypj)
27548 eps_in = epsintabcat(itypi,itypj)
27549 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
27550 !c!-------------------------------------------------------------------
27551 !c! tail location and distance calculations
27554 ctail(k,1)=c(k,i+nres)-dtailcat(1,itypi,itypj)*dc_norm(k,nres+i)
27555 ctail(k,2)=c(k,j+nres)-dtailcat(2,itypi,itypj)*dc_norm(k,nres+j)
27557 !c! tail distances will be themselves usefull elswhere
27558 !c1 (in Gcav, for example)
27559 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
27560 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
27561 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
27563 (Rtail_distance(1)*Rtail_distance(1)) &
27564 + (Rtail_distance(2)*Rtail_distance(2)) &
27565 + (Rtail_distance(3)*Rtail_distance(3)))
27566 !c!-------------------------------------------------------------------
27567 !c! Calculate location and distance between polar heads
27568 !c! distance between heads
27569 !c! for each one of our three dimensional space...
27570 d1 = dheadcat(1, 1, itypi, itypj)
27571 d2 = dheadcat(2, 1, itypi, itypj)
27574 !c! location of polar head is computed by taking hydrophobic centre
27575 !c! and moving by a d1 * dc_norm vector
27576 !c! see unres publications for very informative images
27577 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
27578 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
27580 !c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
27581 !c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
27582 Rhead_distance(k) = chead(k,2) - chead(k,1)
27584 !c! pitagoras (root of sum of squares)
27586 (Rhead_distance(1)*Rhead_distance(1)) &
27587 + (Rhead_distance(2)*Rhead_distance(2)) &
27588 + (Rhead_distance(3)*Rhead_distance(3)))
27589 !c!-------------------------------------------------------------------
27590 !c! zero everything that should be zero'ed
27603 END SUBROUTINE elgrad_init_cat
27606 double precision function tschebyshev(m,n,x,y)
27609 double precision x(n),y,yy(0:maxvar),aux
27610 !c Tschebyshev polynomial. Note that the first term is omitted
27611 !c m=0: the constant term is included
27612 !c m=1: the constant term is not included
27616 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
27624 end function tschebyshev
27625 !C--------------------------------------------------------------------------
27626 double precision function gradtschebyshev(m,n,x,y)
27629 double precision x(n+1),y,yy(0:maxvar),aux
27630 !c Tschebyshev polynomial. Note that the first term is omitted
27631 !c m=0: the constant term is included
27632 !c m=1: the constant term is not included
27636 yy(i)=2*y*yy(i-1)-yy(i-2)
27640 aux=aux+x(i+1)*yy(i)*(i+1)
27641 !C print *, x(i+1),yy(i),i
27643 gradtschebyshev=aux
27645 end function gradtschebyshev