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
11900 real(kind=8), dimension(3) :: dcosom1,dcosom2
11901 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 &
11902 +dCAVdOM1+ dGCLdOM1+ dPOLdOM1
11903 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 &
11904 +dCAVdOM2+ dGCLdOM2+ dPOLdOM2
11906 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
11907 -2.0D0*alf12*eps3der+sigder*sigsq_om12&
11908 +dCAVdOM12+ dGCLdOM12
11912 ! eom12=evdwij*eps1_om12
11916 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
11917 dcosom2(k)=rij*(dc_norm(k,j)-om2*erij(k))
11920 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))
11921 !C print *,'gg',k,gg(k)
11923 ! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
11924 ! write (iout,*) "gg",(gg(k),k=1,3)
11926 gradpepcatx(k,i)=gradpepcatx(k,i)-gg(k) &
11927 +(eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
11928 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
11930 ! gradpepcatx(k,j)=gradpepcatx(k,j)+gg(k) &
11931 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)) &
11932 ! +eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv
11934 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
11935 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
11936 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
11937 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
11940 ! Calculate the components of the gradient in DC and X
11943 gradpepcat(l,i)=gradpepcat(l,i)-gg(l)
11944 gradpepcat(l,j)=gradpepcat(l,j)+gg(l)
11946 end subroutine sc_grad_cat
11948 subroutine sc_grad_cat_pep
11950 real(kind=8), dimension(3) :: dcosom1,dcosom2
11951 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 &
11952 +dCAVdOM1+ dGCLdOM1+ dPOLdOM1
11953 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 &
11954 +dCAVdOM2+ dGCLdOM2+ dPOLdOM2
11956 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
11957 -2.0D0*alf12*eps3der+sigder*sigsq_om12&
11958 +dCAVdOM12+ dGCLdOM12
11962 ! eom12=evdwij*eps1_om12
11966 dcosom1(k) = rij * (dc_norm(k,i) - om1 * erij(k))
11967 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
11968 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
11969 gvdwc_pepbase(k,i)= gvdwc_pepbase(k,i) +0.5*(- gg(k)) &
11970 + (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
11972 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
11973 gvdwc_pepbase(k,i+1)= gvdwc_pepbase(k,i+1) +0.5*(- gg(k)) &
11974 - (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i))) &
11976 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
11977 gradpepcat(k,j)=gradpepcat(k,j)+gg(k)
11979 end subroutine sc_grad_cat_pep
11982 !-----------------------------------------------------------------------------
11983 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
11986 ! implicit real*8 (a-h,o-z)
11987 ! include 'DIMENSIONS'
11988 ! include 'COMMON.LOCAL'
11989 ! include 'COMMON.IOUNITS'
11990 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
11991 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
11992 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
11993 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
11994 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
11996 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
11997 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
11998 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
11999 !el local variables
12001 delthec=thetai-thet_pred_mean
12002 delthe0=thetai-theta0i
12003 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
12004 t3 = thetai-thet_pred_mean
12008 t14 = t12+t6*sigsqtc
12010 t21 = thetai-theta0i
12016 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
12017 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
12018 *(-t12*t9-ak*sig0inv*t27)
12020 end subroutine mixder
12022 !-----------------------------------------------------------------------------
12024 !-----------------------------------------------------------------------------
12026 !-----------------------------------------------------------------------------
12027 ! This subroutine calculates the derivatives of the consecutive virtual
12028 ! bond vectors and the SC vectors in the virtual-bond angles theta and
12029 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
12030 ! in the angles alpha and omega, describing the location of a side chain
12031 ! in its local coordinate system.
12033 ! The derivatives are stored in the following arrays:
12035 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
12036 ! The structure is as follows:
12038 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
12039 ! 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)
12040 ! . . . . . . . . . . . . . . . . . .
12041 ! 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)
12045 ! 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)
12047 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
12048 ! The structure is same as above.
12050 ! DCDS - the derivatives of the side chain vectors in the local spherical
12051 ! andgles alph and omega:
12053 ! 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)
12054 ! 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)
12058 ! 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)
12060 ! Version of March '95, based on an early version of November '91.
12062 !**********************************************************************
12063 ! implicit real*8 (a-h,o-z)
12064 ! include 'DIMENSIONS'
12065 ! include 'COMMON.VAR'
12066 ! include 'COMMON.CHAIN'
12067 ! include 'COMMON.DERIV'
12068 ! include 'COMMON.GEO'
12069 ! include 'COMMON.LOCAL'
12070 ! include 'COMMON.INTERACT'
12071 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
12072 real(kind=8),dimension(3,3) :: dp,temp
12073 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
12074 real(kind=8),dimension(3) :: xx,xx1
12075 !el local variables
12076 integer :: i,k,l,j,m,ind,ind1,jjj
12077 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
12078 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
12079 sint2,xp,yp,xxp,yyp,zzp,dj
12081 ! common /przechowalnia/ fromto
12082 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
12083 ! get the position of the jth ijth fragment of the chain coordinate system
12084 ! in the fromto array.
12085 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
12087 ! maxdim=(nres-1)*(nres-2)/2
12088 ! allocate(dcdv(6,maxdim),dxds(6,nres))
12089 ! calculate the derivatives of transformation matrix elements in theta
12092 !el call flush(iout) !el
12094 rdt(1,1,i)=-rt(1,2,i)
12095 rdt(1,2,i)= rt(1,1,i)
12097 rdt(2,1,i)=-rt(2,2,i)
12098 rdt(2,2,i)= rt(2,1,i)
12100 rdt(3,1,i)=-rt(3,2,i)
12101 rdt(3,2,i)= rt(3,1,i)
12105 ! derivatives in phi
12111 drt(2,1,i)= rt(3,1,i)
12112 drt(2,2,i)= rt(3,2,i)
12113 drt(2,3,i)= rt(3,3,i)
12114 drt(3,1,i)=-rt(2,1,i)
12115 drt(3,2,i)=-rt(2,2,i)
12116 drt(3,3,i)=-rt(2,3,i)
12119 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
12125 temp(k,l)=rt(k,l,i)
12130 fromto(k,l,ind)=temp(k,l)
12139 dpkl=dpkl+temp(k,m)*rt(m,l,j)
12142 fromto(k,l,ind)=dpkl
12153 ! Calculate derivatives.
12159 ! Derivatives of DC(i+1) in theta(i+2)
12165 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
12168 prordt(j,k,i)=dp(j,k)
12171 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
12174 ! Derivatives of SC(i+1) in theta(i+2)
12176 xx1(1)=-0.5D0*xloc(2,i+1)
12177 xx1(2)= 0.5D0*xloc(1,i+1)
12181 xj=xj+r(j,k,i)*xx1(k)
12188 rj=rj+prod(j,k,i)*xx(k)
12193 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
12194 ! than the other off-diagonal derivatives.
12199 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
12201 dxdv(j,ind1+1)=dxoiij
12203 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
12205 ! Derivatives of DC(i+1) in phi(i+2)
12211 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
12214 prodrt(j,k,i)=dp(j,k)
12216 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
12219 ! Derivatives of SC(i+1) in phi(i+2)
12222 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
12223 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
12227 rj=rj+prod(j,k,i)*xx(k)
12232 ! Derivatives of SC(i+1) in phi(i+3).
12237 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
12239 dxdv(j+3,ind1+1)=dxoiij
12242 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
12243 ! theta(nres) and phi(i+3) thru phi(nres).
12247 ind=indmat(i+1,j+1)
12248 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
12253 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
12258 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
12259 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
12260 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
12261 ! Derivatives of virtual-bond vectors in theta
12263 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
12265 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
12266 ! Derivatives of SC vectors in theta
12270 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
12272 dxdv(k,ind1+1)=dxoijk
12275 !--- Calculate the derivatives in phi
12281 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
12287 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
12292 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
12294 dxdv(k+3,ind1+1)=dxoijk
12299 ! Derivatives in alpha and omega:
12302 ! dsci=dsc(itype(i,1))
12307 if(alphi.ne.alphi) alphi=100.0
12308 if(omegi.ne.omegi) omegi=-100.0
12313 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
12314 cosalphi=dcos(alphi)
12315 sinalphi=dsin(alphi)
12316 cosomegi=dcos(omegi)
12317 sinomegi=dsin(omegi)
12318 temp(1,1)=-dsci*sinalphi
12319 temp(2,1)= dsci*cosalphi*cosomegi
12320 temp(3,1)=-dsci*cosalphi*sinomegi
12322 temp(2,2)=-dsci*sinalphi*sinomegi
12323 temp(3,2)=-dsci*sinalphi*cosomegi
12324 theta2=pi-0.5D0*theta(i+1)
12328 !d print *,((temp(l,k),l=1,3),k=1,2)
12332 xxp= xp*cost2+yp*sint2
12333 yyp=-xp*sint2+yp*cost2
12336 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
12337 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
12341 dj=dj+prod(k,l,i-1)*xx(l)
12349 end subroutine cartder
12350 !-----------------------------------------------------------------------------
12352 !-----------------------------------------------------------------------------
12353 subroutine check_cartgrad
12354 ! Check the gradient of Cartesian coordinates in internal coordinates.
12355 ! implicit real*8 (a-h,o-z)
12356 ! include 'DIMENSIONS'
12357 ! include 'COMMON.IOUNITS'
12358 ! include 'COMMON.VAR'
12359 ! include 'COMMON.CHAIN'
12360 ! include 'COMMON.GEO'
12361 ! include 'COMMON.LOCAL'
12362 ! include 'COMMON.DERIV'
12363 real(kind=8),dimension(6,nres) :: temp
12364 real(kind=8),dimension(3) :: xx,gg
12365 integer :: i,k,j,ii
12366 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
12367 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
12369 ! Check the gradient of the virtual-bond and SC vectors in the internal
12375 write (iout,'(a)') '**************** dx/dalpha'
12379 alph(i)=alph(i)+aincr
12381 temp(k,i)=dc(k,nres+i)
12385 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
12386 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
12388 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
12389 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
12395 write (iout,'(a)') '**************** dx/domega'
12399 omeg(i)=omeg(i)+aincr
12401 temp(k,i)=dc(k,nres+i)
12405 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
12406 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
12407 (aincr*dabs(dxds(k+3,i))+aincr))
12409 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
12410 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
12416 write (iout,'(a)') '**************** dx/dtheta'
12420 theta(i)=theta(i)+aincr
12423 temp(k,j)=dc(k,nres+j)
12429 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
12431 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
12432 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
12433 (aincr*dabs(dxdv(k,ii))+aincr))
12435 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
12436 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
12443 write (iout,'(a)') '***************** dx/dphi'
12446 phi(i)=phi(i)+aincr
12449 temp(k,j)=dc(k,nres+j)
12457 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
12458 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
12459 (aincr*dabs(dxdv(k+3,ii))+aincr))
12461 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
12462 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
12465 phi(i)=phi(i)-aincr
12468 write (iout,'(a)') '****************** ddc/dtheta'
12471 theta(i+2)=thet+aincr
12482 gg(k)=(dc(k,j)-temp(k,j))/aincr
12483 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
12484 (aincr*dabs(dcdv(k,ii))+aincr))
12486 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
12487 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
12497 write (iout,'(a)') '******************* ddc/dphi'
12500 phi(i+3)=phii+aincr
12511 gg(k)=(dc(k,j)-temp(k,j))/aincr
12512 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
12513 (aincr*dabs(dcdv(k+3,ii))+aincr))
12515 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
12516 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
12527 end subroutine check_cartgrad
12528 !-----------------------------------------------------------------------------
12529 subroutine check_ecart
12530 ! Check the gradient of the energy in Cartesian coordinates.
12531 ! implicit real*8 (a-h,o-z)
12532 ! include 'DIMENSIONS'
12533 ! include 'COMMON.CHAIN'
12534 ! include 'COMMON.DERIV'
12535 ! include 'COMMON.IOUNITS'
12536 ! include 'COMMON.VAR'
12537 ! include 'COMMON.CONTACTS'
12539 !el integer :: icall
12540 !el common /srutu/ icall
12541 real(kind=8),dimension(6) :: ggg
12542 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
12543 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
12544 real(kind=8),dimension(6,nres) :: grad_s
12545 real(kind=8),dimension(0:n_ene) :: energia,energia1
12546 integer :: uiparm(1)
12547 real(kind=8) :: urparm(1)
12549 integer :: nf,i,j,k
12550 real(kind=8) :: aincr,etot,etot1
12556 print '(a)','CG processor',me,' calling CHECK_CART.',aincr
12559 call geom_to_var(nvar,x)
12560 call etotal(energia)
12562 !el call enerprint(energia)
12563 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
12566 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
12570 grad_s(j,i)=gradc(j,i,icg)
12571 grad_s(j+3,i)=gradx(j,i,icg)
12575 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
12580 ddx(j)=dc(j,i+nres)
12583 dc(j,i)=dc(j,i)+aincr
12585 c(j,k)=c(j,k)+aincr
12586 c(j,k+nres)=c(j,k+nres)+aincr
12589 call etotal(energia1)
12591 ggg(j)=(etot1-etot)/aincr
12594 c(j,k)=c(j,k)-aincr
12595 c(j,k+nres)=c(j,k+nres)-aincr
12599 c(j,i+nres)=c(j,i+nres)+aincr
12600 dc(j,i+nres)=dc(j,i+nres)+aincr
12602 call etotal(energia1)
12604 ggg(j+3)=(etot1-etot)/aincr
12606 dc(j,i+nres)=ddx(j)
12608 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
12609 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
12612 end subroutine check_ecart
12614 !-----------------------------------------------------------------------------
12615 subroutine check_ecartint
12616 ! Check the gradient of the energy in Cartesian coordinates.
12617 use io_base, only: intout
12618 ! implicit real*8 (a-h,o-z)
12619 ! include 'DIMENSIONS'
12620 ! include 'COMMON.CONTROL'
12621 ! include 'COMMON.CHAIN'
12622 ! include 'COMMON.DERIV'
12623 ! include 'COMMON.IOUNITS'
12624 ! include 'COMMON.VAR'
12625 ! include 'COMMON.CONTACTS'
12626 ! include 'COMMON.MD'
12627 ! include 'COMMON.LOCAL'
12628 ! include 'COMMON.SPLITELE'
12630 !el integer :: icall
12631 !el common /srutu/ icall
12632 real(kind=8),dimension(6) :: ggg,ggg1
12633 real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
12634 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
12635 real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
12636 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
12637 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
12638 real(kind=8),dimension(0:n_ene) :: energia,energia1
12639 integer :: uiparm(1)
12640 real(kind=8) :: urparm(1)
12642 integer :: i,j,k,nf
12643 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
12651 ! call intcartderiv
12652 ! call checkintcartgrad
12655 write(iout,*) 'Calling CHECK_ECARTINT.'
12658 call geom_to_var(nvar,x)
12659 write (iout,*) "split_ene ",split_ene
12661 if (.not.split_ene) then
12663 call etotal(energia)
12668 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
12671 grad_s(j,0)=gcart(j,0)
12675 grad_s(j,i)=gcart(j,i)
12676 grad_s(j+3,i)=gxcart(j,i)
12680 !- split gradient check
12682 call etotal_long(energia)
12683 !el call enerprint(energia)
12687 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12688 (gxcart(j,i),j=1,3)
12691 grad_s(j,0)=gcart(j,0)
12695 grad_s(j,i)=gcart(j,i)
12696 grad_s(j+3,i)=gxcart(j,i)
12700 call etotal_short(energia)
12701 call enerprint(energia)
12705 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12706 (gxcart(j,i),j=1,3)
12709 grad_s1(j,0)=gcart(j,0)
12713 grad_s1(j,i)=gcart(j,i)
12714 grad_s1(j+3,i)=gxcart(j,i)
12718 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
12722 if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
12723 if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
12726 dcnorm_safe1(j)=dc_norm(j,i-1)
12727 dcnorm_safe2(j)=dc_norm(j,i)
12728 dxnorm_safe(j)=dc_norm(j,i+nres)
12731 c(j,i)=ddc(j)+aincr
12732 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
12733 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
12734 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
12735 dc(j,i)=c(j,i+1)-c(j,i)
12736 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12737 call int_from_cart1(.false.)
12738 if (.not.split_ene) then
12740 call etotal(energia1)
12742 write (iout,*) "ij",i,j," etot1",etot1
12745 call etotal_long(energia1)
12747 call etotal_short(energia1)
12750 !- end split gradient
12751 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12752 c(j,i)=ddc(j)-aincr
12753 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
12754 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
12755 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
12756 dc(j,i)=c(j,i+1)-c(j,i)
12757 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12758 call int_from_cart1(.false.)
12759 if (.not.split_ene) then
12761 call etotal(energia1)
12763 write (iout,*) "ij",i,j," etot2",etot2
12764 ggg(j)=(etot1-etot2)/(2*aincr)
12767 call etotal_long(energia1)
12769 ggg(j)=(etot11-etot21)/(2*aincr)
12770 call etotal_short(energia1)
12772 ggg1(j)=(etot12-etot22)/(2*aincr)
12773 !- end split gradient
12774 ! write (iout,*) "etot21",etot21," etot22",etot22
12776 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12778 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
12779 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
12780 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
12781 dc(j,i)=c(j,i+1)-c(j,i)
12782 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12783 dc_norm(j,i-1)=dcnorm_safe1(j)
12784 dc_norm(j,i)=dcnorm_safe2(j)
12785 dc_norm(j,i+nres)=dxnorm_safe(j)
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)
12797 call etotal_long(energia1)
12799 call etotal_short(energia1)
12802 !- end split gradient
12803 c(j,i+nres)=ddx(j)-aincr
12804 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12805 call int_from_cart1(.false.)
12806 if (.not.split_ene) then
12808 call etotal(energia1)
12810 ggg(j+3)=(etot1-etot2)/(2*aincr)
12813 call etotal_long(energia1)
12815 ggg(j+3)=(etot11-etot21)/(2*aincr)
12816 call etotal_short(energia1)
12818 ggg1(j+3)=(etot12-etot22)/(2*aincr)
12819 !- end split gradient
12821 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12823 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12824 dc_norm(j,i+nres)=dxnorm_safe(j)
12825 call int_from_cart1(.false.)
12827 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12828 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
12829 if (split_ene) then
12830 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12831 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
12833 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12834 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
12835 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
12839 end subroutine check_ecartint
12841 !-----------------------------------------------------------------------------
12842 subroutine check_ecartint
12843 ! Check the gradient of the energy in Cartesian coordinates.
12844 use io_base, only: intout
12845 ! implicit real*8 (a-h,o-z)
12846 ! include 'DIMENSIONS'
12847 ! include 'COMMON.CONTROL'
12848 ! include 'COMMON.CHAIN'
12849 ! include 'COMMON.DERIV'
12850 ! include 'COMMON.IOUNITS'
12851 ! include 'COMMON.VAR'
12852 ! include 'COMMON.CONTACTS'
12853 ! include 'COMMON.MD'
12854 ! include 'COMMON.LOCAL'
12855 ! include 'COMMON.SPLITELE'
12857 !el integer :: icall
12858 !el common /srutu/ icall
12859 real(kind=8),dimension(6) :: ggg,ggg1
12860 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
12861 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
12862 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
12863 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
12864 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
12865 real(kind=8),dimension(0:n_ene) :: energia,energia1
12866 integer :: uiparm(1)
12867 real(kind=8) :: urparm(1)
12869 integer :: i,j,k,nf
12870 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
12878 ! call intcartderiv
12879 ! call checkintcartgrad
12882 write(iout,*) 'Calling CHECK_ECARTINT.',aincr
12885 call geom_to_var(nvar,x)
12886 if (.not.split_ene) then
12887 call etotal(energia)
12889 !el call enerprint(energia)
12893 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
12896 grad_s(j,0)=gcart(j,0)
12900 grad_s(j,i)=gcart(j,i)
12901 ! if (i.eq.21) print *,"PRZEKAZANIE",gcart(j,i)
12903 ! if (i.le.2) print *,"tu?!",gcart(j,i),grad_s(j,i),gxcart(j,i)
12904 grad_s(j+3,i)=gxcart(j,i)
12908 !- split gradient check
12910 call etotal_long(energia)
12911 !el call enerprint(energia)
12915 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12916 (gxcart(j,i),j=1,3)
12919 grad_s(j,0)=gcart(j,0)
12923 grad_s(j,i)=gcart(j,i)
12924 ! if (i.eq.21) print *,"PRZEKAZANIE",gcart(j,i)
12925 grad_s(j+3,i)=gxcart(j,i)
12929 call etotal_short(energia)
12930 !el call enerprint(energia)
12934 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12935 (gxcart(j,i),j=1,3)
12938 grad_s1(j,0)=gcart(j,0)
12942 grad_s1(j,i)=gcart(j,i)
12943 grad_s1(j+3,i)=gxcart(j,i)
12947 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
12952 ddx(j)=dc(j,i+nres)
12954 dcnorm_safe(k)=dc_norm(k,i)
12955 dxnorm_safe(k)=dc_norm(k,i+nres)
12959 dc(j,i)=ddc(j)+aincr
12960 call chainbuild_cart
12962 ! Broadcast the order to compute internal coordinates to the slaves.
12963 ! if (nfgtasks.gt.1)
12964 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
12966 ! call int_from_cart1(.false.)
12967 if (.not.split_ene) then
12969 call etotal(energia1)
12971 ! call enerprint(energia1)
12974 call etotal_long(energia1)
12976 call etotal_short(energia1)
12978 ! write (iout,*) "etot11",etot11," etot12",etot12
12980 !- end split gradient
12981 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12982 dc(j,i)=ddc(j)-aincr
12983 call chainbuild_cart
12984 ! call int_from_cart1(.false.)
12985 if (.not.split_ene) then
12987 call etotal(energia1)
12989 ggg(j)=(etot1-etot2)/(2*aincr)
12992 call etotal_long(energia1)
12994 ggg(j)=(etot11-etot21)/(2*aincr)
12995 call etotal_short(energia1)
12997 ggg1(j)=(etot12-etot22)/(2*aincr)
12998 !- end split gradient
12999 ! write (iout,*) "etot21",etot21," etot22",etot22
13001 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
13003 call chainbuild_cart
13006 dc(j,i+nres)=ddx(j)+aincr
13007 call chainbuild_cart
13008 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
13009 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
13010 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
13011 ! write (iout,*) "dxnormnorm",dsqrt(
13012 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
13013 ! write (iout,*) "dxnormnormsafe",dsqrt(
13014 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
13016 if (.not.split_ene) then
13018 call etotal(energia1)
13022 call etotal_long(energia1)
13024 call etotal_short(energia1)
13027 !- end split gradient
13028 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
13029 dc(j,i+nres)=ddx(j)-aincr
13030 call chainbuild_cart
13031 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
13032 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
13033 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
13035 ! write (iout,*) "dxnormnorm",dsqrt(
13036 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
13037 ! write (iout,*) "dxnormnormsafe",dsqrt(
13038 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
13039 if (.not.split_ene) then
13041 call etotal(energia1)
13043 ggg(j+3)=(etot1-etot2)/(2*aincr)
13046 call etotal_long(energia1)
13048 ggg(j+3)=(etot11-etot21)/(2*aincr)
13049 call etotal_short(energia1)
13051 ggg1(j+3)=(etot12-etot22)/(2*aincr)
13052 !- end split gradient
13054 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
13055 dc(j,i+nres)=ddx(j)
13056 call chainbuild_cart
13058 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
13059 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
13060 if (split_ene) then
13061 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
13062 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
13064 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
13065 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
13066 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
13070 end subroutine check_ecartint
13072 !-----------------------------------------------------------------------------
13073 subroutine check_eint
13074 ! Check the gradient of energy in internal coordinates.
13075 ! implicit real*8 (a-h,o-z)
13076 ! include 'DIMENSIONS'
13077 ! include 'COMMON.CHAIN'
13078 ! include 'COMMON.DERIV'
13079 ! include 'COMMON.IOUNITS'
13080 ! include 'COMMON.VAR'
13081 ! include 'COMMON.GEO'
13083 !el integer :: icall
13084 !el common /srutu/ icall
13085 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
13086 integer :: uiparm(1)
13087 real(kind=8) :: urparm(1)
13088 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
13089 character(len=6) :: key
13092 real(kind=8) :: xi,aincr,etot,etot1,etot2
13095 print '(a)','Calling CHECK_INT.'
13099 call geom_to_var(nvar,x)
13100 call var_to_geom(nvar,x)
13103 ! print *,'ICG=',ICG
13104 call etotal(energia)
13106 !el call enerprint(energia)
13107 ! print *,'ICG=',ICG
13109 if (MyID.ne.BossID) then
13110 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
13118 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
13119 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
13120 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
13124 x(i)=xi-0.5D0*aincr
13125 call var_to_geom(nvar,x)
13127 call etotal(energia1)
13129 x(i)=xi+0.5D0*aincr
13130 call var_to_geom(nvar,x)
13132 call etotal(energia2)
13134 gg(i)=(etot2-etot1)/aincr
13135 write (iout,*) i,etot1,etot2
13138 write (iout,'(/2a)')' Variable Numerical Analytical',&
13141 if (i.le.nphi) then
13144 else if (i.le.nphi+ntheta) then
13147 else if (i.le.nphi+ntheta+nside) then
13151 ii=i-(nphi+ntheta+nside)
13154 write (iout,'(i3,a,i3,3(1pd16.6))') &
13155 i,key,ii,gg(i),gana(i),&
13156 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
13159 end subroutine check_eint
13160 !-----------------------------------------------------------------------------
13162 !-----------------------------------------------------------------------------
13163 subroutine Econstr_back
13164 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
13165 ! implicit real*8 (a-h,o-z)
13166 ! include 'DIMENSIONS'
13167 ! include 'COMMON.CONTROL'
13168 ! include 'COMMON.VAR'
13169 ! include 'COMMON.MD'
13172 ! include 'COMMON.LANGEVIN'
13174 ! include 'COMMON.LANGEVIN.lang0'
13176 ! include 'COMMON.CHAIN'
13177 ! include 'COMMON.DERIV'
13178 ! include 'COMMON.GEO'
13179 ! include 'COMMON.LOCAL'
13180 ! include 'COMMON.INTERACT'
13181 ! include 'COMMON.IOUNITS'
13182 ! include 'COMMON.NAMES'
13183 ! include 'COMMON.TIME1'
13184 integer :: i,j,ii,k
13185 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
13187 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
13188 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
13189 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
13196 duscdiff(j,i)=0.0d0
13197 duscdiffx(j,i)=0.0d0
13201 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
13203 ! Deviations from theta angles
13206 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
13207 dtheta_i=theta(j)-thetaref(j)
13208 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
13209 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
13211 utheta(i)=utheta_i/(ii-1)
13213 ! Deviations from gamma angles
13216 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
13217 dgamma_i=pinorm(phi(j)-phiref(j))
13218 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
13219 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
13220 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
13221 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
13223 ugamma(i)=ugamma_i/(ii-2)
13225 ! Deviations from local SC geometry
13228 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
13229 dxx=xxtab(j)-xxref(j)
13230 dyy=yytab(j)-yyref(j)
13231 dzz=zztab(j)-zzref(j)
13232 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
13234 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
13235 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
13237 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
13238 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
13240 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
13241 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
13244 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
13245 ! & xxref(j),yyref(j),zzref(j)
13247 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
13248 ! write (iout,*) i," uscdiff",uscdiff(i)
13250 ! Put together deviations from local geometry
13252 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
13253 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
13254 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
13255 ! & " uconst_back",uconst_back
13256 utheta(i)=dsqrt(utheta(i))
13257 ugamma(i)=dsqrt(ugamma(i))
13258 uscdiff(i)=dsqrt(uscdiff(i))
13261 end subroutine Econstr_back
13262 !-----------------------------------------------------------------------------
13263 ! energy_p_new-sep_barrier.F
13264 !-----------------------------------------------------------------------------
13265 real(kind=8) function sscale(r)
13266 ! include "COMMON.SPLITELE"
13267 real(kind=8) :: r,gamm
13268 if(r.lt.r_cut-rlamb) then
13270 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
13271 gamm=(r-(r_cut-rlamb))/rlamb
13272 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
13277 end function sscale
13278 real(kind=8) function sscale_grad(r)
13279 ! include "COMMON.SPLITELE"
13280 real(kind=8) :: r,gamm
13281 if(r.lt.r_cut-rlamb) then
13283 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
13284 gamm=(r-(r_cut-rlamb))/rlamb
13285 sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
13290 end function sscale_grad
13292 !!!!!!!!!! PBCSCALE
13293 real(kind=8) function sscale_ele(r)
13294 ! include "COMMON.SPLITELE"
13295 real(kind=8) :: r,gamm
13296 if(r.lt.r_cut_ele-rlamb_ele) then
13298 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
13299 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
13300 sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
13305 end function sscale_ele
13307 real(kind=8) function sscagrad_ele(r)
13308 real(kind=8) :: r,gamm
13309 ! include "COMMON.SPLITELE"
13310 if(r.lt.r_cut_ele-rlamb_ele) then
13312 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
13313 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
13314 sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
13319 end function sscagrad_ele
13320 real(kind=8) function sscalelip(r)
13321 real(kind=8) r,gamm
13322 sscalelip=1.0d0+r*r*(2.0d0*r-3.0d0)
13324 end function sscalelip
13325 !C-----------------------------------------------------------------------
13326 real(kind=8) function sscagradlip(r)
13327 real(kind=8) r,gamm
13328 sscagradlip=r*(6.0d0*r-6.0d0)
13330 end function sscagradlip
13333 !-----------------------------------------------------------------------------
13334 subroutine elj_long(evdw)
13336 ! This subroutine calculates the interaction energy of nonbonded side chains
13337 ! assuming the LJ potential of interaction.
13339 ! implicit real*8 (a-h,o-z)
13340 ! include 'DIMENSIONS'
13341 ! include 'COMMON.GEO'
13342 ! include 'COMMON.VAR'
13343 ! include 'COMMON.LOCAL'
13344 ! include 'COMMON.CHAIN'
13345 ! include 'COMMON.DERIV'
13346 ! include 'COMMON.INTERACT'
13347 ! include 'COMMON.TORSION'
13348 ! include 'COMMON.SBRIDGE'
13349 ! include 'COMMON.NAMES'
13350 ! include 'COMMON.IOUNITS'
13351 ! include 'COMMON.CONTACTS'
13352 real(kind=8),parameter :: accur=1.0d-10
13353 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
13354 !el local variables
13355 integer :: i,iint,j,k,itypi,itypi1,itypj
13356 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
13357 real(kind=8) :: e1,e2,evdwij,evdw
13358 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
13360 do i=iatsc_s,iatsc_e
13362 if (itypi.eq.ntyp1) cycle
13363 itypi1=itype(i+1,1)
13368 ! Calculate SC interaction energy.
13370 do iint=1,nint_gr(i)
13371 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
13372 !d & 'iend=',iend(i,iint)
13373 do j=istart(i,iint),iend(i,iint)
13375 if (itypj.eq.ntyp1) cycle
13379 rij=xj*xj+yj*yj+zj*zj
13380 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
13381 if (sss.lt.1.0d0) then
13383 eps0ij=eps(itypi,itypj)
13385 e1=fac*fac*aa_aq(itypi,itypj)
13386 e2=fac*bb_aq(itypi,itypj)
13388 evdw=evdw+(1.0d0-sss)*evdwij
13390 ! Calculate the components of the gradient in DC and X
13392 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
13397 gvdwx(k,i)=gvdwx(k,i)-gg(k)
13398 gvdwx(k,j)=gvdwx(k,j)+gg(k)
13399 gvdwc(k,i)=gvdwc(k,i)-gg(k)
13400 gvdwc(k,j)=gvdwc(k,j)+gg(k)
13408 gvdwc(j,i)=expon*gvdwc(j,i)
13409 gvdwx(j,i)=expon*gvdwx(j,i)
13412 !******************************************************************************
13416 ! To save time, the factor of EXPON has been extracted from ALL components
13417 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
13420 !******************************************************************************
13422 end subroutine elj_long
13423 !-----------------------------------------------------------------------------
13424 subroutine elj_short(evdw)
13426 ! This subroutine calculates the interaction energy of nonbonded side chains
13427 ! assuming the LJ potential of interaction.
13429 ! implicit real*8 (a-h,o-z)
13430 ! include 'DIMENSIONS'
13431 ! include 'COMMON.GEO'
13432 ! include 'COMMON.VAR'
13433 ! include 'COMMON.LOCAL'
13434 ! include 'COMMON.CHAIN'
13435 ! include 'COMMON.DERIV'
13436 ! include 'COMMON.INTERACT'
13437 ! include 'COMMON.TORSION'
13438 ! include 'COMMON.SBRIDGE'
13439 ! include 'COMMON.NAMES'
13440 ! include 'COMMON.IOUNITS'
13441 ! include 'COMMON.CONTACTS'
13442 real(kind=8),parameter :: accur=1.0d-10
13443 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
13444 !el local variables
13445 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
13446 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
13447 real(kind=8) :: e1,e2,evdwij,evdw
13448 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
13450 do i=iatsc_s,iatsc_e
13452 if (itypi.eq.ntyp1) cycle
13453 itypi1=itype(i+1,1)
13460 ! Calculate SC interaction energy.
13462 do iint=1,nint_gr(i)
13463 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
13464 !d & 'iend=',iend(i,iint)
13465 do j=istart(i,iint),iend(i,iint)
13467 if (itypj.eq.ntyp1) cycle
13471 ! Change 12/1/95 to calculate four-body interactions
13472 rij=xj*xj+yj*yj+zj*zj
13473 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
13474 if (sss.gt.0.0d0) then
13476 eps0ij=eps(itypi,itypj)
13478 e1=fac*fac*aa_aq(itypi,itypj)
13479 e2=fac*bb_aq(itypi,itypj)
13481 evdw=evdw+sss*evdwij
13483 ! Calculate the components of the gradient in DC and X
13485 fac=-rrij*(e1+evdwij)*sss
13490 gvdwx(k,i)=gvdwx(k,i)-gg(k)
13491 gvdwx(k,j)=gvdwx(k,j)+gg(k)
13492 gvdwc(k,i)=gvdwc(k,i)-gg(k)
13493 gvdwc(k,j)=gvdwc(k,j)+gg(k)
13501 gvdwc(j,i)=expon*gvdwc(j,i)
13502 gvdwx(j,i)=expon*gvdwx(j,i)
13505 !******************************************************************************
13509 ! To save time, the factor of EXPON has been extracted from ALL components
13510 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
13513 !******************************************************************************
13515 end subroutine elj_short
13516 !-----------------------------------------------------------------------------
13517 subroutine eljk_long(evdw)
13519 ! This subroutine calculates the interaction energy of nonbonded side chains
13520 ! assuming the LJK potential of interaction.
13522 ! implicit real*8 (a-h,o-z)
13523 ! include 'DIMENSIONS'
13524 ! include 'COMMON.GEO'
13525 ! include 'COMMON.VAR'
13526 ! include 'COMMON.LOCAL'
13527 ! include 'COMMON.CHAIN'
13528 ! include 'COMMON.DERIV'
13529 ! include 'COMMON.INTERACT'
13530 ! include 'COMMON.IOUNITS'
13531 ! include 'COMMON.NAMES'
13532 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
13534 !el local variables
13535 integer :: i,iint,j,k,itypi,itypi1,itypj
13536 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
13537 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
13538 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
13540 do i=iatsc_s,iatsc_e
13542 if (itypi.eq.ntyp1) cycle
13543 itypi1=itype(i+1,1)
13548 ! Calculate SC interaction energy.
13550 do iint=1,nint_gr(i)
13551 do j=istart(i,iint),iend(i,iint)
13553 if (itypj.eq.ntyp1) cycle
13557 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13558 fac_augm=rrij**expon
13559 e_augm=augm(itypi,itypj)*fac_augm
13560 r_inv_ij=dsqrt(rrij)
13562 sss=sscale(rij/sigma(itypi,itypj))
13563 if (sss.lt.1.0d0) then
13564 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
13565 fac=r_shift_inv**expon
13566 e1=fac*fac*aa_aq(itypi,itypj)
13567 e2=fac*bb_aq(itypi,itypj)
13568 evdwij=e_augm+e1+e2
13569 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
13570 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
13571 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
13572 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
13573 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
13574 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
13575 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
13576 evdw=evdw+(1.0d0-sss)*evdwij
13578 ! Calculate the components of the gradient in DC and X
13580 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
13581 fac=fac*(1.0d0-sss)
13586 gvdwx(k,i)=gvdwx(k,i)-gg(k)
13587 gvdwx(k,j)=gvdwx(k,j)+gg(k)
13588 gvdwc(k,i)=gvdwc(k,i)-gg(k)
13589 gvdwc(k,j)=gvdwc(k,j)+gg(k)
13597 gvdwc(j,i)=expon*gvdwc(j,i)
13598 gvdwx(j,i)=expon*gvdwx(j,i)
13602 end subroutine eljk_long
13603 !-----------------------------------------------------------------------------
13604 subroutine eljk_short(evdw)
13606 ! This subroutine calculates the interaction energy of nonbonded side chains
13607 ! assuming the LJK potential of interaction.
13609 ! implicit real*8 (a-h,o-z)
13610 ! include 'DIMENSIONS'
13611 ! include 'COMMON.GEO'
13612 ! include 'COMMON.VAR'
13613 ! include 'COMMON.LOCAL'
13614 ! include 'COMMON.CHAIN'
13615 ! include 'COMMON.DERIV'
13616 ! include 'COMMON.INTERACT'
13617 ! include 'COMMON.IOUNITS'
13618 ! include 'COMMON.NAMES'
13619 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
13621 !el local variables
13622 integer :: i,iint,j,k,itypi,itypi1,itypj
13623 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
13624 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
13625 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
13627 do i=iatsc_s,iatsc_e
13629 if (itypi.eq.ntyp1) cycle
13630 itypi1=itype(i+1,1)
13635 ! Calculate SC interaction energy.
13637 do iint=1,nint_gr(i)
13638 do j=istart(i,iint),iend(i,iint)
13640 if (itypj.eq.ntyp1) cycle
13644 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13645 fac_augm=rrij**expon
13646 e_augm=augm(itypi,itypj)*fac_augm
13647 r_inv_ij=dsqrt(rrij)
13649 sss=sscale(rij/sigma(itypi,itypj))
13650 if (sss.gt.0.0d0) then
13651 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
13652 fac=r_shift_inv**expon
13653 e1=fac*fac*aa_aq(itypi,itypj)
13654 e2=fac*bb_aq(itypi,itypj)
13655 evdwij=e_augm+e1+e2
13656 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
13657 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
13658 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
13659 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
13660 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
13661 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
13662 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
13663 evdw=evdw+sss*evdwij
13665 ! Calculate the components of the gradient in DC and X
13667 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
13673 gvdwx(k,i)=gvdwx(k,i)-gg(k)
13674 gvdwx(k,j)=gvdwx(k,j)+gg(k)
13675 gvdwc(k,i)=gvdwc(k,i)-gg(k)
13676 gvdwc(k,j)=gvdwc(k,j)+gg(k)
13684 gvdwc(j,i)=expon*gvdwc(j,i)
13685 gvdwx(j,i)=expon*gvdwx(j,i)
13689 end subroutine eljk_short
13690 !-----------------------------------------------------------------------------
13691 subroutine ebp_long(evdw)
13693 ! This subroutine calculates the interaction energy of nonbonded side chains
13694 ! assuming the Berne-Pechukas potential of interaction.
13697 ! implicit real*8 (a-h,o-z)
13698 ! include 'DIMENSIONS'
13699 ! include 'COMMON.GEO'
13700 ! include 'COMMON.VAR'
13701 ! include 'COMMON.LOCAL'
13702 ! include 'COMMON.CHAIN'
13703 ! include 'COMMON.DERIV'
13704 ! include 'COMMON.NAMES'
13705 ! include 'COMMON.INTERACT'
13706 ! include 'COMMON.IOUNITS'
13707 ! include 'COMMON.CALC'
13709 !el integer :: icall
13710 !el common /srutu/ icall
13711 ! double precision rrsave(maxdim)
13713 !el local variables
13714 integer :: iint,itypi,itypi1,itypj
13715 real(kind=8) :: rrij,xi,yi,zi,fac
13716 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
13718 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
13720 ! if (icall.eq.0) then
13726 do i=iatsc_s,iatsc_e
13728 if (itypi.eq.ntyp1) cycle
13729 itypi1=itype(i+1,1)
13733 dxi=dc_norm(1,nres+i)
13734 dyi=dc_norm(2,nres+i)
13735 dzi=dc_norm(3,nres+i)
13736 ! dsci_inv=dsc_inv(itypi)
13737 dsci_inv=vbld_inv(i+nres)
13739 ! Calculate SC interaction energy.
13741 do iint=1,nint_gr(i)
13742 do j=istart(i,iint),iend(i,iint)
13745 if (itypj.eq.ntyp1) cycle
13746 ! dscj_inv=dsc_inv(itypj)
13747 dscj_inv=vbld_inv(j+nres)
13748 chi1=chi(itypi,itypj)
13749 chi2=chi(itypj,itypi)
13756 alf12=0.5D0*(alf1+alf2)
13760 dxj=dc_norm(1,nres+j)
13761 dyj=dc_norm(2,nres+j)
13762 dzj=dc_norm(3,nres+j)
13763 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13765 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13767 if (sss.lt.1.0d0) then
13769 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
13771 ! Calculate whole angle-dependent part of epsilon and contributions
13772 ! to its derivatives
13773 fac=(rrij*sigsq)**expon2
13774 e1=fac*fac*aa_aq(itypi,itypj)
13775 e2=fac*bb_aq(itypi,itypj)
13776 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13777 eps2der=evdwij*eps3rt
13778 eps3der=evdwij*eps2rt
13779 evdwij=evdwij*eps2rt*eps3rt
13780 evdw=evdw+evdwij*(1.0d0-sss)
13782 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13783 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13784 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
13785 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13786 !d & epsi,sigm,chi1,chi2,chip1,chip2,
13787 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
13788 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
13791 ! Calculate gradient components.
13792 e1=e1*eps1*eps2rt**2*eps3rt**2
13793 fac=-expon*(e1+evdwij)
13796 ! Calculate radial part of the gradient
13800 ! Calculate the angular part of the gradient and sum add the contributions
13801 ! to the appropriate components of the Cartesian gradient.
13802 call sc_grad_scale(1.0d0-sss)
13809 end subroutine ebp_long
13810 !-----------------------------------------------------------------------------
13811 subroutine ebp_short(evdw)
13813 ! This subroutine calculates the interaction energy of nonbonded side chains
13814 ! assuming the Berne-Pechukas potential of interaction.
13817 ! implicit real*8 (a-h,o-z)
13818 ! include 'DIMENSIONS'
13819 ! include 'COMMON.GEO'
13820 ! include 'COMMON.VAR'
13821 ! include 'COMMON.LOCAL'
13822 ! include 'COMMON.CHAIN'
13823 ! include 'COMMON.DERIV'
13824 ! include 'COMMON.NAMES'
13825 ! include 'COMMON.INTERACT'
13826 ! include 'COMMON.IOUNITS'
13827 ! include 'COMMON.CALC'
13829 !el integer :: icall
13830 !el common /srutu/ icall
13831 ! double precision rrsave(maxdim)
13833 !el local variables
13834 integer :: iint,itypi,itypi1,itypj
13835 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
13836 real(kind=8) :: sss,e1,e2,evdw
13838 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
13840 ! if (icall.eq.0) then
13846 do i=iatsc_s,iatsc_e
13848 if (itypi.eq.ntyp1) cycle
13849 itypi1=itype(i+1,1)
13853 dxi=dc_norm(1,nres+i)
13854 dyi=dc_norm(2,nres+i)
13855 dzi=dc_norm(3,nres+i)
13856 ! dsci_inv=dsc_inv(itypi)
13857 dsci_inv=vbld_inv(i+nres)
13859 ! Calculate SC interaction energy.
13861 do iint=1,nint_gr(i)
13862 do j=istart(i,iint),iend(i,iint)
13865 if (itypj.eq.ntyp1) cycle
13866 ! dscj_inv=dsc_inv(itypj)
13867 dscj_inv=vbld_inv(j+nres)
13868 chi1=chi(itypi,itypj)
13869 chi2=chi(itypj,itypi)
13876 alf12=0.5D0*(alf1+alf2)
13880 dxj=dc_norm(1,nres+j)
13881 dyj=dc_norm(2,nres+j)
13882 dzj=dc_norm(3,nres+j)
13883 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13885 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13887 if (sss.gt.0.0d0) then
13889 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
13891 ! Calculate whole angle-dependent part of epsilon and contributions
13892 ! to its derivatives
13893 fac=(rrij*sigsq)**expon2
13894 e1=fac*fac*aa_aq(itypi,itypj)
13895 e2=fac*bb_aq(itypi,itypj)
13896 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13897 eps2der=evdwij*eps3rt
13898 eps3der=evdwij*eps2rt
13899 evdwij=evdwij*eps2rt*eps3rt
13900 evdw=evdw+evdwij*sss
13902 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13903 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13904 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
13905 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13906 !d & epsi,sigm,chi1,chi2,chip1,chip2,
13907 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
13908 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
13911 ! Calculate gradient components.
13912 e1=e1*eps1*eps2rt**2*eps3rt**2
13913 fac=-expon*(e1+evdwij)
13916 ! Calculate radial part of the gradient
13920 ! Calculate the angular part of the gradient and sum add the contributions
13921 ! to the appropriate components of the Cartesian gradient.
13922 call sc_grad_scale(sss)
13929 end subroutine ebp_short
13930 !-----------------------------------------------------------------------------
13931 subroutine egb_long(evdw)
13933 ! This subroutine calculates the interaction energy of nonbonded side chains
13934 ! assuming the Gay-Berne potential of interaction.
13937 ! implicit real*8 (a-h,o-z)
13938 ! include 'DIMENSIONS'
13939 ! include 'COMMON.GEO'
13940 ! include 'COMMON.VAR'
13941 ! include 'COMMON.LOCAL'
13942 ! include 'COMMON.CHAIN'
13943 ! include 'COMMON.DERIV'
13944 ! include 'COMMON.NAMES'
13945 ! include 'COMMON.INTERACT'
13946 ! include 'COMMON.IOUNITS'
13947 ! include 'COMMON.CALC'
13948 ! include 'COMMON.CONTROL'
13950 !el local variables
13951 integer :: iint,itypi,itypi1,itypj,subchap
13952 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
13953 real(kind=8) :: sss,e1,e2,evdw,sss_grad
13954 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13955 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13956 ssgradlipi,ssgradlipj
13960 !cccc energy_dec=.false.
13961 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13964 ! if (icall.eq.0) lprn=.false.
13966 do i=iatsc_s,iatsc_e
13968 if (itypi.eq.ntyp1) cycle
13969 itypi1=itype(i+1,1)
13973 xi=mod(xi,boxxsize)
13974 if (xi.lt.0) xi=xi+boxxsize
13975 yi=mod(yi,boxysize)
13976 if (yi.lt.0) yi=yi+boxysize
13977 zi=mod(zi,boxzsize)
13978 if (zi.lt.0) zi=zi+boxzsize
13979 if ((zi.gt.bordlipbot) &
13980 .and.(zi.lt.bordliptop)) then
13981 !C the energy transfer exist
13982 if (zi.lt.buflipbot) then
13983 !C what fraction I am in
13985 ((zi-bordlipbot)/lipbufthick)
13986 !C lipbufthick is thickenes of lipid buffore
13987 sslipi=sscalelip(fracinbuf)
13988 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
13989 elseif (zi.gt.bufliptop) then
13990 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
13991 sslipi=sscalelip(fracinbuf)
13992 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
14002 dxi=dc_norm(1,nres+i)
14003 dyi=dc_norm(2,nres+i)
14004 dzi=dc_norm(3,nres+i)
14005 ! dsci_inv=dsc_inv(itypi)
14006 dsci_inv=vbld_inv(i+nres)
14007 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
14008 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
14010 ! Calculate SC interaction energy.
14012 do iint=1,nint_gr(i)
14013 do j=istart(i,iint),iend(i,iint)
14014 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
14015 ! call dyn_ssbond_ene(i,j,evdwij)
14017 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
14018 ! 'evdw',i,j,evdwij,' ss'
14019 ! if (energy_dec) write (iout,*) &
14020 ! 'evdw',i,j,evdwij,' ss'
14021 ! do k=j+1,iend(i,iint)
14022 !C search over all next residues
14023 ! if (dyn_ss_mask(k)) then
14024 !C check if they are cysteins
14025 !C write(iout,*) 'k=',k
14027 !c write(iout,*) "PRZED TRI", evdwij
14028 ! evdwij_przed_tri=evdwij
14029 ! call triple_ssbond_ene(i,j,k,evdwij)
14030 !c if(evdwij_przed_tri.ne.evdwij) then
14031 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
14034 !c write(iout,*) "PO TRI", evdwij
14035 !C call the energy function that removes the artifical triple disulfide
14036 !C bond the soubroutine is located in ssMD.F
14038 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
14039 'evdw',i,j,evdwij,'tss'
14040 ! endif!dyn_ss_mask(k)
14046 if (itypj.eq.ntyp1) cycle
14047 ! dscj_inv=dsc_inv(itypj)
14048 dscj_inv=vbld_inv(j+nres)
14049 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
14050 ! & 1.0d0/vbld(j+nres)
14051 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
14052 sig0ij=sigma(itypi,itypj)
14053 chi1=chi(itypi,itypj)
14054 chi2=chi(itypj,itypi)
14061 alf12=0.5D0*(alf1+alf2)
14065 ! Searching for nearest neighbour
14066 xj=mod(xj,boxxsize)
14067 if (xj.lt.0) xj=xj+boxxsize
14068 yj=mod(yj,boxysize)
14069 if (yj.lt.0) yj=yj+boxysize
14070 zj=mod(zj,boxzsize)
14071 if (zj.lt.0) zj=zj+boxzsize
14072 if ((zj.gt.bordlipbot) &
14073 .and.(zj.lt.bordliptop)) then
14074 !C the energy transfer exist
14075 if (zj.lt.buflipbot) then
14076 !C what fraction I am in
14078 ((zj-bordlipbot)/lipbufthick)
14079 !C lipbufthick is thickenes of lipid buffore
14080 sslipj=sscalelip(fracinbuf)
14081 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
14082 elseif (zj.gt.bufliptop) then
14083 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
14084 sslipj=sscalelip(fracinbuf)
14085 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
14094 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
14095 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
14096 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
14097 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
14099 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14107 xj=xj_safe+xshift*boxxsize
14108 yj=yj_safe+yshift*boxysize
14109 zj=zj_safe+zshift*boxzsize
14110 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14111 if(dist_temp.lt.dist_init) then
14112 dist_init=dist_temp
14121 if (subchap.eq.1) then
14131 dxj=dc_norm(1,nres+j)
14132 dyj=dc_norm(2,nres+j)
14133 dzj=dc_norm(3,nres+j)
14134 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14136 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
14137 sss_ele_cut=sscale_ele(1.0d0/(rij))
14138 sss_ele_grad=sscagrad_ele(1.0d0/(rij))
14139 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
14140 if (sss_ele_cut.le.0.0) cycle
14141 if (sss.lt.1.0d0) then
14143 ! Calculate angle-dependent terms of energy and contributions to their
14147 sig=sig0ij*dsqrt(sigsq)
14148 rij_shift=1.0D0/rij-sig+sig0ij
14149 ! for diagnostics; uncomment
14150 ! rij_shift=1.2*sig0ij
14151 ! I hate to put IF's in the loops, but here don't have another choice!!!!
14152 if (rij_shift.le.0.0D0) then
14154 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
14155 !d & restyp(itypi,1),i,restyp(itypj,1),j,
14156 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
14160 !---------------------------------------------------------------
14161 rij_shift=1.0D0/rij_shift
14162 fac=rij_shift**expon
14165 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
14166 eps2der=evdwij*eps3rt
14167 eps3der=evdwij*eps2rt
14168 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
14169 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
14170 evdwij=evdwij*eps2rt*eps3rt
14171 evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
14173 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
14174 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
14175 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
14176 restyp(itypi,1),i,restyp(itypj,1),j,&
14177 epsi,sigm,chi1,chi2,chip1,chip2,&
14178 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
14179 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
14183 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
14185 ! if (energy_dec) write (iout,*) &
14186 ! 'evdw',i,j,evdwij,"egb_long"
14188 ! Calculate gradient components.
14189 e1=e1*eps1*eps2rt**2*eps3rt**2
14190 fac=-expon*(e1+evdwij)*rij_shift
14193 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
14194 *rij-sss_grad/(1.0-sss)*rij &
14195 /sigmaii(itypi,itypj))
14197 ! Calculate the radial part of the gradient
14201 ! Calculate angular part of the gradient.
14202 call sc_grad_scale(1.0d0-sss)
14208 ! write (iout,*) "Number of loop steps in EGB:",ind
14209 !ccc energy_dec=.false.
14211 end subroutine egb_long
14212 !-----------------------------------------------------------------------------
14213 subroutine egb_short(evdw)
14215 ! This subroutine calculates the interaction energy of nonbonded side chains
14216 ! assuming the Gay-Berne potential of interaction.
14219 ! implicit real*8 (a-h,o-z)
14220 ! include 'DIMENSIONS'
14221 ! include 'COMMON.GEO'
14222 ! include 'COMMON.VAR'
14223 ! include 'COMMON.LOCAL'
14224 ! include 'COMMON.CHAIN'
14225 ! include 'COMMON.DERIV'
14226 ! include 'COMMON.NAMES'
14227 ! include 'COMMON.INTERACT'
14228 ! include 'COMMON.IOUNITS'
14229 ! include 'COMMON.CALC'
14230 ! include 'COMMON.CONTROL'
14232 !el local variables
14233 integer :: iint,itypi,itypi1,itypj,subchap
14234 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
14235 real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad
14236 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14237 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
14238 ssgradlipi,ssgradlipj
14240 !cccc energy_dec=.false.
14241 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
14244 ! if (icall.eq.0) lprn=.false.
14246 do i=iatsc_s,iatsc_e
14248 if (itypi.eq.ntyp1) cycle
14249 itypi1=itype(i+1,1)
14253 xi=mod(xi,boxxsize)
14254 if (xi.lt.0) xi=xi+boxxsize
14255 yi=mod(yi,boxysize)
14256 if (yi.lt.0) yi=yi+boxysize
14257 zi=mod(zi,boxzsize)
14258 if (zi.lt.0) zi=zi+boxzsize
14259 if ((zi.gt.bordlipbot) &
14260 .and.(zi.lt.bordliptop)) then
14261 !C the energy transfer exist
14262 if (zi.lt.buflipbot) then
14263 !C what fraction I am in
14265 ((zi-bordlipbot)/lipbufthick)
14266 !C lipbufthick is thickenes of lipid buffore
14267 sslipi=sscalelip(fracinbuf)
14268 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
14269 elseif (zi.gt.bufliptop) then
14270 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
14271 sslipi=sscalelip(fracinbuf)
14272 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
14282 dxi=dc_norm(1,nres+i)
14283 dyi=dc_norm(2,nres+i)
14284 dzi=dc_norm(3,nres+i)
14285 ! dsci_inv=dsc_inv(itypi)
14286 dsci_inv=vbld_inv(i+nres)
14288 dxi=dc_norm(1,nres+i)
14289 dyi=dc_norm(2,nres+i)
14290 dzi=dc_norm(3,nres+i)
14291 ! dsci_inv=dsc_inv(itypi)
14292 dsci_inv=vbld_inv(i+nres)
14293 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
14294 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
14296 ! Calculate SC interaction energy.
14298 do iint=1,nint_gr(i)
14299 do j=istart(i,iint),iend(i,iint)
14300 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
14301 call dyn_ssbond_ene(i,j,evdwij)
14303 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
14304 'evdw',i,j,evdwij,' ss'
14305 do k=j+1,iend(i,iint)
14306 !C search over all next residues
14307 if (dyn_ss_mask(k)) then
14308 !C check if they are cysteins
14309 !C write(iout,*) 'k=',k
14311 !c write(iout,*) "PRZED TRI", evdwij
14312 ! evdwij_przed_tri=evdwij
14313 call triple_ssbond_ene(i,j,k,evdwij)
14314 !c if(evdwij_przed_tri.ne.evdwij) then
14315 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
14318 !c write(iout,*) "PO TRI", evdwij
14319 !C call the energy function that removes the artifical triple disulfide
14320 !C bond the soubroutine is located in ssMD.F
14322 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
14323 'evdw',i,j,evdwij,'tss'
14324 endif!dyn_ss_mask(k)
14327 ! if (energy_dec) write (iout,*) &
14328 ! 'evdw',i,j,evdwij,' ss'
14332 if (itypj.eq.ntyp1) cycle
14333 ! dscj_inv=dsc_inv(itypj)
14334 dscj_inv=vbld_inv(j+nres)
14335 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
14336 ! & 1.0d0/vbld(j+nres)
14337 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
14338 sig0ij=sigma(itypi,itypj)
14339 chi1=chi(itypi,itypj)
14340 chi2=chi(itypj,itypi)
14347 alf12=0.5D0*(alf1+alf2)
14348 ! xj=c(1,nres+j)-xi
14349 ! yj=c(2,nres+j)-yi
14350 ! zj=c(3,nres+j)-zi
14354 ! Searching for nearest neighbour
14355 xj=mod(xj,boxxsize)
14356 if (xj.lt.0) xj=xj+boxxsize
14357 yj=mod(yj,boxysize)
14358 if (yj.lt.0) yj=yj+boxysize
14359 zj=mod(zj,boxzsize)
14360 if (zj.lt.0) zj=zj+boxzsize
14361 if ((zj.gt.bordlipbot) &
14362 .and.(zj.lt.bordliptop)) then
14363 !C the energy transfer exist
14364 if (zj.lt.buflipbot) then
14365 !C what fraction I am in
14367 ((zj-bordlipbot)/lipbufthick)
14368 !C lipbufthick is thickenes of lipid buffore
14369 sslipj=sscalelip(fracinbuf)
14370 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
14371 elseif (zj.gt.bufliptop) then
14372 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
14373 sslipj=sscalelip(fracinbuf)
14374 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
14383 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
14384 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
14385 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
14386 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
14388 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14397 xj=xj_safe+xshift*boxxsize
14398 yj=yj_safe+yshift*boxysize
14399 zj=zj_safe+zshift*boxzsize
14400 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14401 if(dist_temp.lt.dist_init) then
14402 dist_init=dist_temp
14411 if (subchap.eq.1) then
14421 dxj=dc_norm(1,nres+j)
14422 dyj=dc_norm(2,nres+j)
14423 dzj=dc_norm(3,nres+j)
14424 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14426 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
14427 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
14428 sss_ele_cut=sscale_ele(1.0d0/(rij))
14429 sss_ele_grad=sscagrad_ele(1.0d0/(rij))
14430 if (sss_ele_cut.le.0.0) cycle
14432 if (sss.gt.0.0d0) then
14434 ! Calculate angle-dependent terms of energy and contributions to their
14438 sig=sig0ij*dsqrt(sigsq)
14439 rij_shift=1.0D0/rij-sig+sig0ij
14440 ! for diagnostics; uncomment
14441 ! rij_shift=1.2*sig0ij
14442 ! I hate to put IF's in the loops, but here don't have another choice!!!!
14443 if (rij_shift.le.0.0D0) then
14445 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
14446 !d & restyp(itypi,1),i,restyp(itypj,1),j,
14447 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
14451 !---------------------------------------------------------------
14452 rij_shift=1.0D0/rij_shift
14453 fac=rij_shift**expon
14456 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
14457 eps2der=evdwij*eps3rt
14458 eps3der=evdwij*eps2rt
14459 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
14460 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
14461 evdwij=evdwij*eps2rt*eps3rt
14462 evdw=evdw+evdwij*sss*sss_ele_cut
14464 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
14465 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
14466 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
14467 restyp(itypi,1),i,restyp(itypj,1),j,&
14468 epsi,sigm,chi1,chi2,chip1,chip2,&
14469 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
14470 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
14474 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
14476 ! if (energy_dec) write (iout,*) &
14477 ! 'evdw',i,j,evdwij,"egb_short"
14479 ! Calculate gradient components.
14480 e1=e1*eps1*eps2rt**2*eps3rt**2
14481 fac=-expon*(e1+evdwij)*rij_shift
14484 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
14485 *rij+sss_grad/sss*rij &
14486 /sigmaii(itypi,itypj))
14489 ! Calculate the radial part of the gradient
14493 ! Calculate angular part of the gradient.
14494 call sc_grad_scale(sss)
14500 ! write (iout,*) "Number of loop steps in EGB:",ind
14501 !ccc energy_dec=.false.
14503 end subroutine egb_short
14504 !-----------------------------------------------------------------------------
14505 subroutine egbv_long(evdw)
14507 ! This subroutine calculates the interaction energy of nonbonded side chains
14508 ! assuming the Gay-Berne-Vorobjev potential of interaction.
14511 ! implicit real*8 (a-h,o-z)
14512 ! include 'DIMENSIONS'
14513 ! include 'COMMON.GEO'
14514 ! include 'COMMON.VAR'
14515 ! include 'COMMON.LOCAL'
14516 ! include 'COMMON.CHAIN'
14517 ! include 'COMMON.DERIV'
14518 ! include 'COMMON.NAMES'
14519 ! include 'COMMON.INTERACT'
14520 ! include 'COMMON.IOUNITS'
14521 ! include 'COMMON.CALC'
14523 !el integer :: icall
14524 !el common /srutu/ icall
14526 !el local variables
14527 integer :: iint,itypi,itypi1,itypj
14528 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
14529 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
14531 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
14534 ! if (icall.eq.0) lprn=.true.
14536 do i=iatsc_s,iatsc_e
14538 if (itypi.eq.ntyp1) cycle
14539 itypi1=itype(i+1,1)
14543 dxi=dc_norm(1,nres+i)
14544 dyi=dc_norm(2,nres+i)
14545 dzi=dc_norm(3,nres+i)
14546 ! dsci_inv=dsc_inv(itypi)
14547 dsci_inv=vbld_inv(i+nres)
14549 ! Calculate SC interaction energy.
14551 do iint=1,nint_gr(i)
14552 do j=istart(i,iint),iend(i,iint)
14555 if (itypj.eq.ntyp1) cycle
14556 ! dscj_inv=dsc_inv(itypj)
14557 dscj_inv=vbld_inv(j+nres)
14558 sig0ij=sigma(itypi,itypj)
14559 r0ij=r0(itypi,itypj)
14560 chi1=chi(itypi,itypj)
14561 chi2=chi(itypj,itypi)
14568 alf12=0.5D0*(alf1+alf2)
14572 dxj=dc_norm(1,nres+j)
14573 dyj=dc_norm(2,nres+j)
14574 dzj=dc_norm(3,nres+j)
14575 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14578 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
14580 if (sss.lt.1.0d0) then
14582 ! Calculate angle-dependent terms of energy and contributions to their
14586 sig=sig0ij*dsqrt(sigsq)
14587 rij_shift=1.0D0/rij-sig+r0ij
14588 ! I hate to put IF's in the loops, but here don't have another choice!!!!
14589 if (rij_shift.le.0.0D0) then
14594 !---------------------------------------------------------------
14595 rij_shift=1.0D0/rij_shift
14596 fac=rij_shift**expon
14597 e1=fac*fac*aa_aq(itypi,itypj)
14598 e2=fac*bb_aq(itypi,itypj)
14599 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
14600 eps2der=evdwij*eps3rt
14601 eps3der=evdwij*eps2rt
14602 fac_augm=rrij**expon
14603 e_augm=augm(itypi,itypj)*fac_augm
14604 evdwij=evdwij*eps2rt*eps3rt
14605 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
14607 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
14608 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
14609 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
14610 restyp(itypi,1),i,restyp(itypj,1),j,&
14611 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
14612 chi1,chi2,chip1,chip2,&
14613 eps1,eps2rt**2,eps3rt**2,&
14614 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
14617 ! Calculate gradient components.
14618 e1=e1*eps1*eps2rt**2*eps3rt**2
14619 fac=-expon*(e1+evdwij)*rij_shift
14621 fac=rij*fac-2*expon*rrij*e_augm
14622 ! Calculate the radial part of the gradient
14626 ! Calculate angular part of the gradient.
14627 call sc_grad_scale(1.0d0-sss)
14632 end subroutine egbv_long
14633 !-----------------------------------------------------------------------------
14634 subroutine egbv_short(evdw)
14636 ! This subroutine calculates the interaction energy of nonbonded side chains
14637 ! assuming the Gay-Berne-Vorobjev potential of interaction.
14640 ! implicit real*8 (a-h,o-z)
14641 ! include 'DIMENSIONS'
14642 ! include 'COMMON.GEO'
14643 ! include 'COMMON.VAR'
14644 ! include 'COMMON.LOCAL'
14645 ! include 'COMMON.CHAIN'
14646 ! include 'COMMON.DERIV'
14647 ! include 'COMMON.NAMES'
14648 ! include 'COMMON.INTERACT'
14649 ! include 'COMMON.IOUNITS'
14650 ! include 'COMMON.CALC'
14652 !el integer :: icall
14653 !el common /srutu/ icall
14655 !el local variables
14656 integer :: iint,itypi,itypi1,itypj
14657 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
14658 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
14660 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
14663 ! if (icall.eq.0) lprn=.true.
14665 do i=iatsc_s,iatsc_e
14667 if (itypi.eq.ntyp1) cycle
14668 itypi1=itype(i+1,1)
14672 dxi=dc_norm(1,nres+i)
14673 dyi=dc_norm(2,nres+i)
14674 dzi=dc_norm(3,nres+i)
14675 ! dsci_inv=dsc_inv(itypi)
14676 dsci_inv=vbld_inv(i+nres)
14678 ! Calculate SC interaction energy.
14680 do iint=1,nint_gr(i)
14681 do j=istart(i,iint),iend(i,iint)
14684 if (itypj.eq.ntyp1) cycle
14685 ! dscj_inv=dsc_inv(itypj)
14686 dscj_inv=vbld_inv(j+nres)
14687 sig0ij=sigma(itypi,itypj)
14688 r0ij=r0(itypi,itypj)
14689 chi1=chi(itypi,itypj)
14690 chi2=chi(itypj,itypi)
14697 alf12=0.5D0*(alf1+alf2)
14701 dxj=dc_norm(1,nres+j)
14702 dyj=dc_norm(2,nres+j)
14703 dzj=dc_norm(3,nres+j)
14704 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14707 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
14709 if (sss.gt.0.0d0) then
14711 ! Calculate angle-dependent terms of energy and contributions to their
14715 sig=sig0ij*dsqrt(sigsq)
14716 rij_shift=1.0D0/rij-sig+r0ij
14717 ! I hate to put IF's in the loops, but here don't have another choice!!!!
14718 if (rij_shift.le.0.0D0) then
14723 !---------------------------------------------------------------
14724 rij_shift=1.0D0/rij_shift
14725 fac=rij_shift**expon
14726 e1=fac*fac*aa_aq(itypi,itypj)
14727 e2=fac*bb_aq(itypi,itypj)
14728 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
14729 eps2der=evdwij*eps3rt
14730 eps3der=evdwij*eps2rt
14731 fac_augm=rrij**expon
14732 e_augm=augm(itypi,itypj)*fac_augm
14733 evdwij=evdwij*eps2rt*eps3rt
14734 evdw=evdw+(evdwij+e_augm)*sss
14736 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
14737 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
14738 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
14739 restyp(itypi,1),i,restyp(itypj,1),j,&
14740 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
14741 chi1,chi2,chip1,chip2,&
14742 eps1,eps2rt**2,eps3rt**2,&
14743 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
14746 ! Calculate gradient components.
14747 e1=e1*eps1*eps2rt**2*eps3rt**2
14748 fac=-expon*(e1+evdwij)*rij_shift
14750 fac=rij*fac-2*expon*rrij*e_augm
14751 ! Calculate the radial part of the gradient
14755 ! Calculate angular part of the gradient.
14756 call sc_grad_scale(sss)
14761 end subroutine egbv_short
14762 !-----------------------------------------------------------------------------
14763 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
14765 ! This subroutine calculates the average interaction energy and its gradient
14766 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
14767 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
14768 ! The potential depends both on the distance of peptide-group centers and on
14769 ! the orientation of the CA-CA virtual bonds.
14771 ! implicit real*8 (a-h,o-z)
14777 ! include 'DIMENSIONS'
14778 ! include 'COMMON.CONTROL'
14779 ! include 'COMMON.SETUP'
14780 ! include 'COMMON.IOUNITS'
14781 ! include 'COMMON.GEO'
14782 ! include 'COMMON.VAR'
14783 ! include 'COMMON.LOCAL'
14784 ! include 'COMMON.CHAIN'
14785 ! include 'COMMON.DERIV'
14786 ! include 'COMMON.INTERACT'
14787 ! include 'COMMON.CONTACTS'
14788 ! include 'COMMON.TORSION'
14789 ! include 'COMMON.VECTORS'
14790 ! include 'COMMON.FFIELD'
14791 ! include 'COMMON.TIME1'
14792 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
14793 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
14794 real(kind=8),dimension(2,2) :: acipa !el,a_temp
14795 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
14796 real(kind=8),dimension(4) :: muij
14797 !el integer :: num_conti,j1,j2
14798 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
14799 !el dz_normi,xmedi,ymedi,zmedi
14800 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
14801 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14802 !el num_conti,j1,j2
14803 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14805 real(kind=8) :: scal_el=1.0d0
14807 real(kind=8) :: scal_el=0.5d0
14810 ! 13-go grudnia roku pamietnego...
14811 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
14812 0.0d0,1.0d0,0.0d0,&
14813 0.0d0,0.0d0,1.0d0/),shape(unmat))
14814 !el local variables
14816 real(kind=8) :: fac
14817 real(kind=8) :: dxj,dyj,dzj
14818 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
14820 ! allocate(num_cont_hb(nres)) !(maxres)
14821 !d write(iout,*) 'In EELEC'
14823 !d write(iout,*) 'Type',i
14824 !d write(iout,*) 'B1',B1(:,i)
14825 !d write(iout,*) 'B2',B2(:,i)
14826 !d write(iout,*) 'CC',CC(:,:,i)
14827 !d write(iout,*) 'DD',DD(:,:,i)
14828 !d write(iout,*) 'EE',EE(:,:,i)
14830 !d call check_vecgrad
14832 if (icheckgrad.eq.1) then
14834 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
14836 dc_norm(k,i)=dc(k,i)*fac
14838 ! write (iout,*) 'i',i,' fac',fac
14841 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
14842 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
14843 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
14844 ! call vec_and_deriv
14848 ! print *, "before set matrices"
14850 ! print *,"after set martices"
14852 time_mat=time_mat+MPI_Wtime()-time01
14856 !d write (iout,*) 'i=',i
14858 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
14861 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
14862 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
14875 !d print '(a)','Enter EELEC'
14876 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
14877 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
14878 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
14880 gel_loc_loc(i)=0.0d0
14885 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
14887 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
14889 do i=iturn3_start,iturn3_end
14890 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1 &
14891 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
14895 dx_normi=dc_norm(1,i)
14896 dy_normi=dc_norm(2,i)
14897 dz_normi=dc_norm(3,i)
14898 xmedi=c(1,i)+0.5d0*dxi
14899 ymedi=c(2,i)+0.5d0*dyi
14900 zmedi=c(3,i)+0.5d0*dzi
14901 xmedi=dmod(xmedi,boxxsize)
14902 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14903 ymedi=dmod(ymedi,boxysize)
14904 if (ymedi.lt.0) ymedi=ymedi+boxysize
14905 zmedi=dmod(zmedi,boxzsize)
14906 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14908 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
14909 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
14910 num_cont_hb(i)=num_conti
14912 do i=iturn4_start,iturn4_end
14913 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
14914 .or. itype(i+3,1).eq.ntyp1 &
14915 .or. itype(i+4,1).eq.ntyp1) cycle
14919 dx_normi=dc_norm(1,i)
14920 dy_normi=dc_norm(2,i)
14921 dz_normi=dc_norm(3,i)
14922 xmedi=c(1,i)+0.5d0*dxi
14923 ymedi=c(2,i)+0.5d0*dyi
14924 zmedi=c(3,i)+0.5d0*dzi
14925 xmedi=dmod(xmedi,boxxsize)
14926 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14927 ymedi=dmod(ymedi,boxysize)
14928 if (ymedi.lt.0) ymedi=ymedi+boxysize
14929 zmedi=dmod(zmedi,boxzsize)
14930 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14931 num_conti=num_cont_hb(i)
14932 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
14933 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
14934 call eturn4(i,eello_turn4)
14935 num_cont_hb(i)=num_conti
14938 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
14940 do i=iatel_s,iatel_e
14941 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
14945 dx_normi=dc_norm(1,i)
14946 dy_normi=dc_norm(2,i)
14947 dz_normi=dc_norm(3,i)
14948 xmedi=c(1,i)+0.5d0*dxi
14949 ymedi=c(2,i)+0.5d0*dyi
14950 zmedi=c(3,i)+0.5d0*dzi
14951 xmedi=dmod(xmedi,boxxsize)
14952 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14953 ymedi=dmod(ymedi,boxysize)
14954 if (ymedi.lt.0) ymedi=ymedi+boxysize
14955 zmedi=dmod(zmedi,boxzsize)
14956 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14957 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
14958 num_conti=num_cont_hb(i)
14959 do j=ielstart(i),ielend(i)
14960 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
14961 call eelecij_scale(i,j,ees,evdw1,eel_loc)
14963 num_cont_hb(i)=num_conti
14965 ! write (iout,*) "Number of loop steps in EELEC:",ind
14967 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
14968 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
14970 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
14971 !cc eel_loc=eel_loc+eello_turn3
14972 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
14974 end subroutine eelec_scale
14975 !-----------------------------------------------------------------------------
14976 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
14977 ! implicit real*8 (a-h,o-z)
14980 ! include 'DIMENSIONS'
14984 ! include 'COMMON.CONTROL'
14985 ! include 'COMMON.IOUNITS'
14986 ! include 'COMMON.GEO'
14987 ! include 'COMMON.VAR'
14988 ! include 'COMMON.LOCAL'
14989 ! include 'COMMON.CHAIN'
14990 ! include 'COMMON.DERIV'
14991 ! include 'COMMON.INTERACT'
14992 ! include 'COMMON.CONTACTS'
14993 ! include 'COMMON.TORSION'
14994 ! include 'COMMON.VECTORS'
14995 ! include 'COMMON.FFIELD'
14996 ! include 'COMMON.TIME1'
14997 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
14998 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
14999 real(kind=8),dimension(2,2) :: acipa !el,a_temp
15000 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
15001 real(kind=8),dimension(4) :: muij
15002 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15003 dist_temp, dist_init,sss_grad
15004 integer xshift,yshift,zshift
15006 !el integer :: num_conti,j1,j2
15007 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
15008 !el dz_normi,xmedi,ymedi,zmedi
15009 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
15010 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
15011 !el num_conti,j1,j2
15012 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
15014 real(kind=8) :: scal_el=1.0d0
15016 real(kind=8) :: scal_el=0.5d0
15019 ! 13-go grudnia roku pamietnego...
15020 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
15021 0.0d0,1.0d0,0.0d0,&
15022 0.0d0,0.0d0,1.0d0/),shape(unmat))
15023 !el local variables
15024 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m,isubchap
15025 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
15026 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
15027 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
15028 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
15029 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
15030 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
15031 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
15032 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
15033 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
15034 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
15035 ecosam,ecosbm,ecosgm,ghalf,time00
15036 ! integer :: maxconts
15037 ! maxconts = nres/4
15038 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
15039 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
15040 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
15041 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
15042 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
15043 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
15044 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
15045 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
15046 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
15047 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
15048 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
15049 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
15050 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
15052 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
15053 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
15058 !d write (iout,*) "eelecij",i,j
15062 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
15063 aaa=app(iteli,itelj)
15064 bbb=bpp(iteli,itelj)
15065 ael6i=ael6(iteli,itelj)
15066 ael3i=ael3(iteli,itelj)
15070 dx_normj=dc_norm(1,j)
15071 dy_normj=dc_norm(2,j)
15072 dz_normj=dc_norm(3,j)
15073 ! xj=c(1,j)+0.5D0*dxj-xmedi
15074 ! yj=c(2,j)+0.5D0*dyj-ymedi
15075 ! zj=c(3,j)+0.5D0*dzj-zmedi
15076 xj=c(1,j)+0.5D0*dxj
15077 yj=c(2,j)+0.5D0*dyj
15078 zj=c(3,j)+0.5D0*dzj
15079 xj=mod(xj,boxxsize)
15080 if (xj.lt.0) xj=xj+boxxsize
15081 yj=mod(yj,boxysize)
15082 if (yj.lt.0) yj=yj+boxysize
15083 zj=mod(zj,boxzsize)
15084 if (zj.lt.0) zj=zj+boxzsize
15086 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15093 xj=xj_safe+xshift*boxxsize
15094 yj=yj_safe+yshift*boxysize
15095 zj=zj_safe+zshift*boxzsize
15096 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15097 if(dist_temp.lt.dist_init) then
15098 dist_init=dist_temp
15107 if (isubchap.eq.1) then
15118 rij=xj*xj+yj*yj+zj*zj
15122 ! For extracting the short-range part of Evdwpp
15123 sss=sscale(rij/rpp(iteli,itelj))
15124 sss_ele_cut=sscale_ele(rij)
15125 sss_ele_grad=sscagrad_ele(rij)
15126 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
15127 ! sss_ele_cut=1.0d0
15128 ! sss_ele_grad=0.0d0
15129 if (sss_ele_cut.le.0.0) go to 128
15133 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
15134 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
15135 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
15136 fac=cosa-3.0D0*cosb*cosg
15138 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
15139 if (j.eq.i+2) ev1=scal_el*ev1
15144 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
15147 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
15148 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
15149 ees=ees+eesij*sss_ele_cut
15150 evdw1=evdw1+evdwij*(1.0d0-sss)*sss_ele_cut
15151 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
15152 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
15153 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
15154 !d & xmedi,ymedi,zmedi,xj,yj,zj
15156 if (energy_dec) then
15157 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
15158 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
15162 ! Calculate contributions to the Cartesian gradient.
15165 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
15166 facel=-3*rrmij*(el1+eesij)*sss_ele_cut
15172 ! Radial derivatives. First process both termini of the fragment (i,j)
15174 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj
15175 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj
15176 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj
15178 ! ghalf=0.5D0*ggg(k)
15179 ! gelc(k,i)=gelc(k,i)+ghalf
15180 ! gelc(k,j)=gelc(k,j)+ghalf
15182 ! 9/28/08 AL Gradient compotents will be summed only at the end
15184 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
15185 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
15188 ! Loop over residues i+1 thru j-1.
15192 !grad gelc(l,k)=gelc(l,k)+ggg(l)
15195 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*(1.0d0-sss) &
15196 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
15197 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*(1.0d0-sss) &
15198 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
15199 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*(1.0d0-sss) &
15200 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
15202 ! ghalf=0.5D0*ggg(k)
15203 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
15204 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
15206 ! 9/28/08 AL Gradient compotents will be summed only at the end
15208 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
15209 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
15212 ! Loop over residues i+1 thru j-1.
15216 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
15220 facvdw=(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
15221 facel=(el1+eesij)*sss_ele_cut
15223 fac=-3*rrmij*(facvdw+facvdw+facel)
15228 ! Radial derivatives. First process both termini of the fragment (i,j)
15234 ! ghalf=0.5D0*ggg(k)
15235 ! gelc(k,i)=gelc(k,i)+ghalf
15236 ! gelc(k,j)=gelc(k,j)+ghalf
15238 ! 9/28/08 AL Gradient compotents will be summed only at the end
15240 gelc_long(k,j)=gelc(k,j)+ggg(k)
15241 gelc_long(k,i)=gelc(k,i)-ggg(k)
15244 ! Loop over residues i+1 thru j-1.
15248 !grad gelc(l,k)=gelc(l,k)+ggg(l)
15251 ! 9/28/08 AL Gradient compotents will be summed only at the end
15256 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
15257 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
15263 ecosa=2.0D0*fac3*fac1+fac4
15266 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
15267 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
15269 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
15270 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
15272 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
15273 !d & (dcosg(k),k=1,3)
15275 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k) )*sss_ele_cut
15278 ! ghalf=0.5D0*ggg(k)
15279 ! gelc(k,i)=gelc(k,i)+ghalf
15280 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
15281 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
15282 ! gelc(k,j)=gelc(k,j)+ghalf
15283 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
15284 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
15288 !grad gelc(l,k)=gelc(l,k)+ggg(l)
15292 gelc(k,i)=gelc(k,i) &
15293 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15294 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
15296 gelc(k,j)=gelc(k,j) &
15297 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15298 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
15300 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
15301 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
15303 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
15304 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
15305 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
15307 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
15308 ! energy of a peptide unit is assumed in the form of a second-order
15309 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
15310 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
15311 ! are computed for EVERY pair of non-contiguous peptide groups.
15313 if (j.lt.nres-1) then
15324 muij(kkk)=mu(k,i)*mu(l,j)
15327 !d write (iout,*) 'EELEC: i',i,' j',j
15328 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
15329 !d write(iout,*) 'muij',muij
15330 ury=scalar(uy(1,i),erij)
15331 urz=scalar(uz(1,i),erij)
15332 vry=scalar(uy(1,j),erij)
15333 vrz=scalar(uz(1,j),erij)
15334 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
15335 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
15336 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
15337 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
15338 fac=dsqrt(-ael6i)*r3ij
15343 !d write (iout,'(4i5,4f10.5)')
15344 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
15345 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
15346 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
15347 !d & uy(:,j),uz(:,j)
15348 !d write (iout,'(4f10.5)')
15349 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
15350 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
15351 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
15352 !d write (iout,'(9f10.5/)')
15353 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
15354 ! Derivatives of the elements of A in virtual-bond vectors
15355 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
15357 uryg(k,1)=scalar(erder(1,k),uy(1,i))
15358 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
15359 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
15360 urzg(k,1)=scalar(erder(1,k),uz(1,i))
15361 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
15362 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
15363 vryg(k,1)=scalar(erder(1,k),uy(1,j))
15364 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
15365 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
15366 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
15367 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
15368 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
15370 ! Compute radial contributions to the gradient
15388 ! Add the contributions coming from er
15391 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
15392 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
15393 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
15394 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
15397 ! Derivatives in DC(i)
15398 !grad ghalf1=0.5d0*agg(k,1)
15399 !grad ghalf2=0.5d0*agg(k,2)
15400 !grad ghalf3=0.5d0*agg(k,3)
15401 !grad ghalf4=0.5d0*agg(k,4)
15402 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
15403 -3.0d0*uryg(k,2)*vry)!+ghalf1
15404 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
15405 -3.0d0*uryg(k,2)*vrz)!+ghalf2
15406 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
15407 -3.0d0*urzg(k,2)*vry)!+ghalf3
15408 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
15409 -3.0d0*urzg(k,2)*vrz)!+ghalf4
15410 ! Derivatives in DC(i+1)
15411 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
15412 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
15413 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
15414 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
15415 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
15416 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
15417 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
15418 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
15419 ! Derivatives in DC(j)
15420 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
15421 -3.0d0*vryg(k,2)*ury)!+ghalf1
15422 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
15423 -3.0d0*vrzg(k,2)*ury)!+ghalf2
15424 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
15425 -3.0d0*vryg(k,2)*urz)!+ghalf3
15426 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
15427 -3.0d0*vrzg(k,2)*urz)!+ghalf4
15428 ! Derivatives in DC(j+1) or DC(nres-1)
15429 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
15430 -3.0d0*vryg(k,3)*ury)
15431 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
15432 -3.0d0*vrzg(k,3)*ury)
15433 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
15434 -3.0d0*vryg(k,3)*urz)
15435 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
15436 -3.0d0*vrzg(k,3)*urz)
15437 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
15439 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
15452 aggi(k,l)=-aggi(k,l)
15453 aggi1(k,l)=-aggi1(k,l)
15454 aggj(k,l)=-aggj(k,l)
15455 aggj1(k,l)=-aggj1(k,l)
15458 if (j.lt.nres-1) then
15464 aggi(k,l)=-aggi(k,l)
15465 aggi1(k,l)=-aggi1(k,l)
15466 aggj(k,l)=-aggj(k,l)
15467 aggj1(k,l)=-aggj1(k,l)
15478 aggi(k,l)=-aggi(k,l)
15479 aggi1(k,l)=-aggi1(k,l)
15480 aggj(k,l)=-aggj(k,l)
15481 aggj1(k,l)=-aggj1(k,l)
15486 IF (wel_loc.gt.0.0d0) THEN
15487 ! Contribution to the local-electrostatic energy coming from the i-j pair
15488 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
15490 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
15491 ! print *,"EELLOC",i,gel_loc_loc(i-1)
15492 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
15493 'eelloc',i,j,eel_loc_ij
15494 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
15496 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
15497 ! Partial derivatives in virtual-bond dihedral angles gamma
15499 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
15500 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
15501 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
15503 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
15504 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
15505 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
15511 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
15513 ggg(l)=(agg(l,1)*muij(1)+ &
15514 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
15516 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
15518 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
15519 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
15520 !grad ghalf=0.5d0*ggg(l)
15521 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
15522 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
15526 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
15529 ! Remaining derivatives of eello
15531 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
15532 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
15535 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
15536 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))&
15539 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
15540 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
15543 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
15544 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))&
15549 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
15550 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
15551 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
15552 .and. num_conti.le.maxconts) then
15553 ! write (iout,*) i,j," entered corr"
15555 ! Calculate the contact function. The ith column of the array JCONT will
15556 ! contain the numbers of atoms that make contacts with the atom I (of numbers
15557 ! greater than I). The arrays FACONT and GACONT will contain the values of
15558 ! the contact function and its derivative.
15559 ! r0ij=1.02D0*rpp(iteli,itelj)
15560 ! r0ij=1.11D0*rpp(iteli,itelj)
15561 r0ij=2.20D0*rpp(iteli,itelj)
15562 ! r0ij=1.55D0*rpp(iteli,itelj)
15563 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
15564 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
15565 if (fcont.gt.0.0D0) then
15566 num_conti=num_conti+1
15567 if (num_conti.gt.maxconts) then
15568 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
15569 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
15570 ' will skip next contacts for this conf.',num_conti
15572 jcont_hb(num_conti,i)=j
15573 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
15574 !d & " jcont_hb",jcont_hb(num_conti,i)
15575 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
15576 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
15577 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
15579 d_cont(num_conti,i)=rij
15580 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
15581 ! --- Electrostatic-interaction matrix ---
15582 a_chuj(1,1,num_conti,i)=a22
15583 a_chuj(1,2,num_conti,i)=a23
15584 a_chuj(2,1,num_conti,i)=a32
15585 a_chuj(2,2,num_conti,i)=a33
15586 ! --- Gradient of rij
15588 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
15595 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
15596 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
15597 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
15598 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
15599 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
15604 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
15605 ! Calculate contact energies
15607 wij=cosa-3.0D0*cosb*cosg
15610 ! fac3=dsqrt(-ael6i)/r0ij**3
15611 fac3=dsqrt(-ael6i)*r3ij
15612 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
15613 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
15614 if (ees0tmp.gt.0) then
15615 ees0pij=dsqrt(ees0tmp)
15619 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
15620 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
15621 if (ees0tmp.gt.0) then
15622 ees0mij=dsqrt(ees0tmp)
15627 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
15630 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
15633 ! Diagnostics. Comment out or remove after debugging!
15634 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
15635 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
15636 ! ees0m(num_conti,i)=0.0D0
15638 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
15639 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
15640 ! Angular derivatives of the contact function
15641 ees0pij1=fac3/ees0pij
15642 ees0mij1=fac3/ees0mij
15643 fac3p=-3.0D0*fac3*rrmij
15644 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
15645 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
15647 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
15648 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
15649 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
15650 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
15651 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
15652 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
15653 ecosap=ecosa1+ecosa2
15654 ecosbp=ecosb1+ecosb2
15655 ecosgp=ecosg1+ecosg2
15656 ecosam=ecosa1-ecosa2
15657 ecosbm=ecosb1-ecosb2
15658 ecosgm=ecosg1-ecosg2
15667 facont_hb(num_conti,i)=fcont
15668 fprimcont=fprimcont/rij
15669 !d facont_hb(num_conti,i)=1.0D0
15670 ! Following line is for diagnostics.
15673 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
15674 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
15677 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
15678 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
15680 ! gggp(1)=gggp(1)+ees0pijp*xj
15681 ! gggp(2)=gggp(2)+ees0pijp*yj
15682 ! gggp(3)=gggp(3)+ees0pijp*zj
15683 ! gggm(1)=gggm(1)+ees0mijp*xj
15684 ! gggm(2)=gggm(2)+ees0mijp*yj
15685 ! gggm(3)=gggm(3)+ees0mijp*zj
15686 gggp(1)=gggp(1)+ees0pijp*xj &
15687 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
15688 gggp(2)=gggp(2)+ees0pijp*yj &
15689 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
15690 gggp(3)=gggp(3)+ees0pijp*zj &
15691 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
15693 gggm(1)=gggm(1)+ees0mijp*xj &
15694 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
15696 gggm(2)=gggm(2)+ees0mijp*yj &
15697 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
15699 gggm(3)=gggm(3)+ees0mijp*zj &
15700 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
15702 ! Derivatives due to the contact function
15703 gacont_hbr(1,num_conti,i)=fprimcont*xj
15704 gacont_hbr(2,num_conti,i)=fprimcont*yj
15705 gacont_hbr(3,num_conti,i)=fprimcont*zj
15708 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
15709 ! following the change of gradient-summation algorithm.
15711 !grad ghalfp=0.5D0*gggp(k)
15712 !grad ghalfm=0.5D0*gggm(k)
15713 ! gacontp_hb1(k,num_conti,i)= & !ghalfp
15714 ! +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15715 ! + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
15716 ! gacontp_hb2(k,num_conti,i)= & !ghalfp
15717 ! +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15718 ! + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
15719 ! gacontp_hb3(k,num_conti,i)=gggp(k)
15720 ! gacontm_hb1(k,num_conti,i)= &!ghalfm
15721 ! +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15722 ! + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
15723 ! gacontm_hb2(k,num_conti,i)= & !ghalfm
15724 ! +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15725 ! + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
15726 ! gacontm_hb3(k,num_conti,i)=gggm(k)
15727 gacontp_hb1(k,num_conti,i)= & !ghalfp+
15728 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15729 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
15732 gacontp_hb2(k,num_conti,i)= & !ghalfp+
15733 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15734 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
15737 gacontp_hb3(k,num_conti,i)=gggp(k) &
15740 gacontm_hb1(k,num_conti,i)= & !ghalfm+
15741 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15742 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
15745 gacontm_hb2(k,num_conti,i)= & !ghalfm+
15746 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15747 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
15750 gacontm_hb3(k,num_conti,i)=gggm(k) &
15755 endif ! num_conti.le.maxconts
15758 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
15761 ghalf=0.5d0*agg(l,k)
15762 aggi(l,k)=aggi(l,k)+ghalf
15763 aggi1(l,k)=aggi1(l,k)+agg(l,k)
15764 aggj(l,k)=aggj(l,k)+ghalf
15767 if (j.eq.nres-1 .and. i.lt.j-2) then
15770 aggj1(l,k)=aggj1(l,k)+agg(l,k)
15776 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
15778 end subroutine eelecij_scale
15779 !-----------------------------------------------------------------------------
15780 subroutine evdwpp_short(evdw1)
15784 ! implicit real*8 (a-h,o-z)
15785 ! include 'DIMENSIONS'
15786 ! include 'COMMON.CONTROL'
15787 ! include 'COMMON.IOUNITS'
15788 ! include 'COMMON.GEO'
15789 ! include 'COMMON.VAR'
15790 ! include 'COMMON.LOCAL'
15791 ! include 'COMMON.CHAIN'
15792 ! include 'COMMON.DERIV'
15793 ! include 'COMMON.INTERACT'
15794 ! include 'COMMON.CONTACTS'
15795 ! include 'COMMON.TORSION'
15796 ! include 'COMMON.VECTORS'
15797 ! include 'COMMON.FFIELD'
15798 real(kind=8),dimension(3) :: ggg
15799 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
15801 real(kind=8) :: scal_el=1.0d0
15803 real(kind=8) :: scal_el=0.5d0
15805 !el local variables
15806 integer :: i,j,k,iteli,itelj,num_conti,isubchap
15807 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
15808 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
15809 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
15810 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
15811 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15812 dist_temp, dist_init,sss_grad
15813 integer xshift,yshift,zshift
15817 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
15818 ! & " iatel_e_vdw",iatel_e_vdw
15820 do i=iatel_s_vdw,iatel_e_vdw
15821 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1) cycle
15825 dx_normi=dc_norm(1,i)
15826 dy_normi=dc_norm(2,i)
15827 dz_normi=dc_norm(3,i)
15828 xmedi=c(1,i)+0.5d0*dxi
15829 ymedi=c(2,i)+0.5d0*dyi
15830 zmedi=c(3,i)+0.5d0*dzi
15831 xmedi=dmod(xmedi,boxxsize)
15832 if (xmedi.lt.0) xmedi=xmedi+boxxsize
15833 ymedi=dmod(ymedi,boxysize)
15834 if (ymedi.lt.0) ymedi=ymedi+boxysize
15835 zmedi=dmod(zmedi,boxzsize)
15836 if (zmedi.lt.0) zmedi=zmedi+boxzsize
15838 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
15839 ! & ' ielend',ielend_vdw(i)
15841 do j=ielstart_vdw(i),ielend_vdw(i)
15842 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
15846 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
15847 aaa=app(iteli,itelj)
15848 bbb=bpp(iteli,itelj)
15852 dx_normj=dc_norm(1,j)
15853 dy_normj=dc_norm(2,j)
15854 dz_normj=dc_norm(3,j)
15855 ! xj=c(1,j)+0.5D0*dxj-xmedi
15856 ! yj=c(2,j)+0.5D0*dyj-ymedi
15857 ! zj=c(3,j)+0.5D0*dzj-zmedi
15858 xj=c(1,j)+0.5D0*dxj
15859 yj=c(2,j)+0.5D0*dyj
15860 zj=c(3,j)+0.5D0*dzj
15861 xj=mod(xj,boxxsize)
15862 if (xj.lt.0) xj=xj+boxxsize
15863 yj=mod(yj,boxysize)
15864 if (yj.lt.0) yj=yj+boxysize
15865 zj=mod(zj,boxzsize)
15866 if (zj.lt.0) zj=zj+boxzsize
15868 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15875 xj=xj_safe+xshift*boxxsize
15876 yj=yj_safe+yshift*boxysize
15877 zj=zj_safe+zshift*boxzsize
15878 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15879 if(dist_temp.lt.dist_init) then
15880 dist_init=dist_temp
15889 if (isubchap.eq.1) then
15900 rij=xj*xj+yj*yj+zj*zj
15903 sss=sscale(rij/rpp(iteli,itelj))
15904 sss_ele_cut=sscale_ele(rij)
15905 sss_ele_grad=sscagrad_ele(rij)
15906 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
15907 if (sss_ele_cut.le.0.0) cycle
15908 if (sss.gt.0.0d0) then
15913 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
15914 if (j.eq.i+2) ev1=scal_el*ev1
15917 if (energy_dec) then
15918 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
15920 evdw1=evdw1+evdwij*sss*sss_ele_cut
15922 ! Calculate contributions to the Cartesian gradient.
15924 facvdw=-6*rrmij*(ev1+evdwij)*sss*sss_ele_cut
15928 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*sss &
15929 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
15930 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*sss &
15931 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
15932 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*sss &
15933 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
15936 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
15937 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
15943 end subroutine evdwpp_short
15944 !-----------------------------------------------------------------------------
15945 subroutine escp_long(evdw2,evdw2_14)
15947 ! This subroutine calculates the excluded-volume interaction energy between
15948 ! peptide-group centers and side chains and its gradient in virtual-bond and
15949 ! side-chain vectors.
15951 ! implicit real*8 (a-h,o-z)
15952 ! include 'DIMENSIONS'
15953 ! include 'COMMON.GEO'
15954 ! include 'COMMON.VAR'
15955 ! include 'COMMON.LOCAL'
15956 ! include 'COMMON.CHAIN'
15957 ! include 'COMMON.DERIV'
15958 ! include 'COMMON.INTERACT'
15959 ! include 'COMMON.FFIELD'
15960 ! include 'COMMON.IOUNITS'
15961 ! include 'COMMON.CONTROL'
15962 real(kind=8),dimension(3) :: ggg
15963 !el local variables
15964 integer :: i,iint,j,k,iteli,itypj,subchap
15965 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
15966 real(kind=8) :: evdw2,evdw2_14,evdwij
15967 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15968 dist_temp, dist_init
15972 !d print '(a)','Enter ESCP'
15973 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
15974 do i=iatscp_s,iatscp_e
15975 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
15977 xi=0.5D0*(c(1,i)+c(1,i+1))
15978 yi=0.5D0*(c(2,i)+c(2,i+1))
15979 zi=0.5D0*(c(3,i)+c(3,i+1))
15980 xi=mod(xi,boxxsize)
15981 if (xi.lt.0) xi=xi+boxxsize
15982 yi=mod(yi,boxysize)
15983 if (yi.lt.0) yi=yi+boxysize
15984 zi=mod(zi,boxzsize)
15985 if (zi.lt.0) zi=zi+boxzsize
15987 do iint=1,nscp_gr(i)
15989 do j=iscpstart(i,iint),iscpend(i,iint)
15991 if (itypj.eq.ntyp1) cycle
15992 ! Uncomment following three lines for SC-p interactions
15993 ! xj=c(1,nres+j)-xi
15994 ! yj=c(2,nres+j)-yi
15995 ! zj=c(3,nres+j)-zi
15996 ! Uncomment following three lines for Ca-p interactions
16000 xj=mod(xj,boxxsize)
16001 if (xj.lt.0) xj=xj+boxxsize
16002 yj=mod(yj,boxysize)
16003 if (yj.lt.0) yj=yj+boxysize
16004 zj=mod(zj,boxzsize)
16005 if (zj.lt.0) zj=zj+boxzsize
16006 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
16014 xj=xj_safe+xshift*boxxsize
16015 yj=yj_safe+yshift*boxysize
16016 zj=zj_safe+zshift*boxzsize
16017 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
16018 if(dist_temp.lt.dist_init) then
16019 dist_init=dist_temp
16028 if (subchap.eq.1) then
16037 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
16039 rij=dsqrt(1.0d0/rrij)
16040 sss_ele_cut=sscale_ele(rij)
16041 sss_ele_grad=sscagrad_ele(rij)
16042 ! print *,sss_ele_cut,sss_ele_grad,&
16043 ! (rij),r_cut_ele,rlamb_ele
16044 if (sss_ele_cut.le.0.0) cycle
16045 sss=sscale((rij/rscp(itypj,iteli)))
16046 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
16047 if (sss.lt.1.0d0) then
16050 e1=fac*fac*aad(itypj,iteli)
16051 e2=fac*bad(itypj,iteli)
16052 if (iabs(j-i) .le. 2) then
16055 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)*sss_ele_cut
16058 evdw2=evdw2+evdwij*(1.0d0-sss)*sss_ele_cut
16059 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
16060 'evdw2',i,j,sss,evdwij
16062 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
16064 fac=-(evdwij+e1)*rrij*(1.0d0-sss)*sss_ele_cut
16065 fac=fac+evdwij*sss_ele_grad/rij/expon*(1.0d0-sss)&
16066 -evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
16070 ! Uncomment following three lines for SC-p interactions
16072 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
16074 ! Uncomment following line for SC-p interactions
16075 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
16077 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
16078 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
16087 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
16088 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
16089 gradx_scp(j,i)=expon*gradx_scp(j,i)
16092 !******************************************************************************
16096 ! To save time the factor EXPON has been extracted from ALL components
16097 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
16100 !******************************************************************************
16102 end subroutine escp_long
16103 !-----------------------------------------------------------------------------
16104 subroutine escp_short(evdw2,evdw2_14)
16106 ! This subroutine calculates the excluded-volume interaction energy between
16107 ! peptide-group centers and side chains and its gradient in virtual-bond and
16108 ! side-chain vectors.
16110 ! implicit real*8 (a-h,o-z)
16111 ! include 'DIMENSIONS'
16112 ! include 'COMMON.GEO'
16113 ! include 'COMMON.VAR'
16114 ! include 'COMMON.LOCAL'
16115 ! include 'COMMON.CHAIN'
16116 ! include 'COMMON.DERIV'
16117 ! include 'COMMON.INTERACT'
16118 ! include 'COMMON.FFIELD'
16119 ! include 'COMMON.IOUNITS'
16120 ! include 'COMMON.CONTROL'
16121 real(kind=8),dimension(3) :: ggg
16122 !el local variables
16123 integer :: i,iint,j,k,iteli,itypj,subchap
16124 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
16125 real(kind=8) :: evdw2,evdw2_14,evdwij
16126 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
16127 dist_temp, dist_init
16131 !d print '(a)','Enter ESCP'
16132 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
16133 do i=iatscp_s,iatscp_e
16134 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
16136 xi=0.5D0*(c(1,i)+c(1,i+1))
16137 yi=0.5D0*(c(2,i)+c(2,i+1))
16138 zi=0.5D0*(c(3,i)+c(3,i+1))
16139 xi=mod(xi,boxxsize)
16140 if (xi.lt.0) xi=xi+boxxsize
16141 yi=mod(yi,boxysize)
16142 if (yi.lt.0) yi=yi+boxysize
16143 zi=mod(zi,boxzsize)
16144 if (zi.lt.0) zi=zi+boxzsize
16146 do iint=1,nscp_gr(i)
16148 do j=iscpstart(i,iint),iscpend(i,iint)
16150 if (itypj.eq.ntyp1) cycle
16151 ! Uncomment following three lines for SC-p interactions
16152 ! xj=c(1,nres+j)-xi
16153 ! yj=c(2,nres+j)-yi
16154 ! zj=c(3,nres+j)-zi
16155 ! Uncomment following three lines for Ca-p interactions
16162 xj=mod(xj,boxxsize)
16163 if (xj.lt.0) xj=xj+boxxsize
16164 yj=mod(yj,boxysize)
16165 if (yj.lt.0) yj=yj+boxysize
16166 zj=mod(zj,boxzsize)
16167 if (zj.lt.0) zj=zj+boxzsize
16168 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
16176 xj=xj_safe+xshift*boxxsize
16177 yj=yj_safe+yshift*boxysize
16178 zj=zj_safe+zshift*boxzsize
16179 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
16180 if(dist_temp.lt.dist_init) then
16181 dist_init=dist_temp
16190 if (subchap.eq.1) then
16200 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
16201 rij=dsqrt(1.0d0/rrij)
16202 sss_ele_cut=sscale_ele(rij)
16203 sss_ele_grad=sscagrad_ele(rij)
16204 ! print *,sss_ele_cut,sss_ele_grad,&
16205 ! (rij),r_cut_ele,rlamb_ele
16206 if (sss_ele_cut.le.0.0) cycle
16207 sss=sscale(rij/rscp(itypj,iteli))
16208 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
16209 if (sss.gt.0.0d0) then
16212 e1=fac*fac*aad(itypj,iteli)
16213 e2=fac*bad(itypj,iteli)
16214 if (iabs(j-i) .le. 2) then
16217 evdw2_14=evdw2_14+(e1+e2)*sss*sss_ele_cut
16220 evdw2=evdw2+evdwij*sss*sss_ele_cut
16221 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
16222 'evdw2',i,j,sss,evdwij
16224 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
16226 fac=-(evdwij+e1)*rrij*sss*sss_ele_cut
16227 fac=fac+evdwij*sss_ele_grad/rij/expon*sss &
16228 +evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
16233 ! Uncomment following three lines for SC-p interactions
16235 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
16237 ! Uncomment following line for SC-p interactions
16238 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
16240 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
16241 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
16250 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
16251 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
16252 gradx_scp(j,i)=expon*gradx_scp(j,i)
16255 !******************************************************************************
16259 ! To save time the factor EXPON has been extracted from ALL components
16260 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
16263 !******************************************************************************
16265 end subroutine escp_short
16266 !-----------------------------------------------------------------------------
16267 ! energy_p_new-sep_barrier.F
16268 !-----------------------------------------------------------------------------
16269 subroutine sc_grad_scale(scalfac)
16270 ! implicit real*8 (a-h,o-z)
16272 ! include 'DIMENSIONS'
16273 ! include 'COMMON.CHAIN'
16274 ! include 'COMMON.DERIV'
16275 ! include 'COMMON.CALC'
16276 ! include 'COMMON.IOUNITS'
16277 real(kind=8),dimension(3) :: dcosom1,dcosom2
16278 real(kind=8) :: scalfac
16279 !el local variables
16280 ! integer :: i,j,k,l
16282 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
16283 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
16284 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
16285 -2.0D0*alf12*eps3der+sigder*sigsq_om12
16289 ! eom12=evdwij*eps1_om12
16291 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
16292 ! & " sigder",sigder
16293 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
16294 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
16296 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
16297 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
16300 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac&
16303 ! write (iout,*) "gg",(gg(k),k=1,3)
16305 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
16306 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
16307 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
16309 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
16310 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
16311 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac&
16313 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
16314 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
16315 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
16316 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
16319 ! Calculate the components of the gradient in DC and X
16322 gvdwc(l,i)=gvdwc(l,i)-gg(l)
16323 gvdwc(l,j)=gvdwc(l,j)+gg(l)
16326 end subroutine sc_grad_scale
16327 !-----------------------------------------------------------------------------
16328 ! energy_split-sep.F
16329 !-----------------------------------------------------------------------------
16330 subroutine etotal_long(energia)
16332 ! Compute the long-range slow-varying contributions to the energy
16334 ! implicit real*8 (a-h,o-z)
16335 ! include 'DIMENSIONS'
16336 use MD_data, only: totT,usampl,eq_time
16340 !MS$ATTRIBUTES C :: proc_proc
16345 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
16347 ! include 'COMMON.SETUP'
16348 ! include 'COMMON.IOUNITS'
16349 ! include 'COMMON.FFIELD'
16350 ! include 'COMMON.DERIV'
16351 ! include 'COMMON.INTERACT'
16352 ! include 'COMMON.SBRIDGE'
16353 ! include 'COMMON.CHAIN'
16354 ! include 'COMMON.VAR'
16355 ! include 'COMMON.LOCAL'
16356 ! include 'COMMON.MD'
16357 real(kind=8),dimension(0:n_ene) :: energia
16358 !el local variables
16359 integer :: i,n_corr,n_corr1,ierror,ierr
16360 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
16361 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
16362 ecorr,ecorr5,ecorr6,eturn6,time00
16363 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
16364 !elwrite(iout,*)"in etotal long"
16366 if (modecalc.eq.12.or.modecalc.eq.14) then
16368 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
16370 call int_from_cart1(.false.)
16373 !elwrite(iout,*)"in etotal long"
16376 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
16377 ! & " absolute rank",myrank," nfgtasks",nfgtasks
16379 if (nfgtasks.gt.1) then
16381 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
16382 if (fg_rank.eq.0) then
16383 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
16384 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
16386 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
16387 ! FG slaves as WEIGHTS array.
16394 weights_(7)=wel_loc
16397 weights_(10)=wturn6
16399 weights_(12)=wscloc
16401 weights_(14)=wtor_d
16402 weights_(15)=wstrain
16403 weights_(16)=wvdwpp
16405 weights_(18)=scal14
16406 weights_(21)=wsccor
16407 ! FG Master broadcasts the WEIGHTS_ array
16408 call MPI_Bcast(weights_(1),n_ene,&
16409 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
16411 ! FG slaves receive the WEIGHTS array
16412 call MPI_Bcast(weights(1),n_ene,&
16413 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
16428 wstrain=weights(15)
16434 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
16436 time_Bcast=time_Bcast+MPI_Wtime()-time00
16437 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
16438 ! call chainbuild_cart
16439 ! call int_from_cart1(.false.)
16441 ! write (iout,*) 'Processor',myrank,
16442 ! & ' calling etotal_short ipot=',ipot
16444 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
16446 !d print *,'nnt=',nnt,' nct=',nct
16448 !elwrite(iout,*)"in etotal long"
16449 ! Compute the side-chain and electrostatic interaction energy
16451 goto (101,102,103,104,105,106) ipot
16452 ! Lennard-Jones potential.
16453 101 call elj_long(evdw)
16454 !d print '(a)','Exit ELJ'
16456 ! Lennard-Jones-Kihara potential (shifted).
16457 102 call eljk_long(evdw)
16459 ! Berne-Pechukas potential (dilated LJ, angular dependence).
16460 103 call ebp_long(evdw)
16462 ! Gay-Berne potential (shifted LJ, angular dependence).
16463 104 call egb_long(evdw)
16465 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
16466 105 call egbv_long(evdw)
16468 ! Soft-sphere potential
16469 106 call e_softsphere(evdw)
16471 ! Calculate electrostatic (H-bonding) energy of the main chain.
16475 if (ipot.lt.6) then
16477 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
16478 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
16479 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
16480 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
16482 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
16483 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
16484 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
16485 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
16487 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
16496 ! write (iout,*) "Soft-spheer ELEC potential"
16497 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
16501 ! Calculate excluded-volume interaction energy between peptide groups
16504 if (ipot.lt.6) then
16505 if(wscp.gt.0d0) then
16506 call escp_long(evdw2,evdw2_14)
16512 call escp_soft_sphere(evdw2,evdw2_14)
16515 ! 12/1/95 Multi-body terms
16519 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
16520 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
16521 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
16522 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
16523 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
16530 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
16531 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
16534 ! If performing constraint dynamics, call the constraint energy
16535 ! after the equilibration time
16536 if(usampl.and.totT.gt.eq_time) then
16551 energia(2)=evdw2-evdw2_14
16552 energia(18)=evdw2_14
16561 energia(3)=ees+evdw1
16568 energia(8)=eello_turn3
16569 energia(9)=eello_turn4
16571 energia(20)=Uconst+Uconst_back
16572 call sum_energy(energia,.true.)
16573 ! write (iout,*) "Exit ETOTAL_LONG"
16576 end subroutine etotal_long
16577 !-----------------------------------------------------------------------------
16578 subroutine etotal_short(energia)
16580 ! Compute the short-range fast-varying contributions to the energy
16582 ! implicit real*8 (a-h,o-z)
16583 ! include 'DIMENSIONS'
16587 !MS$ATTRIBUTES C :: proc_proc
16592 integer :: ierror,ierr
16593 real(kind=8),dimension(n_ene) :: weights_
16594 real(kind=8) :: time00
16596 ! include 'COMMON.SETUP'
16597 ! include 'COMMON.IOUNITS'
16598 ! include 'COMMON.FFIELD'
16599 ! include 'COMMON.DERIV'
16600 ! include 'COMMON.INTERACT'
16601 ! include 'COMMON.SBRIDGE'
16602 ! include 'COMMON.CHAIN'
16603 ! include 'COMMON.VAR'
16604 ! include 'COMMON.LOCAL'
16605 real(kind=8),dimension(0:n_ene) :: energia
16606 !el local variables
16608 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
16609 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr
16612 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
16614 if (modecalc.eq.12.or.modecalc.eq.14) then
16616 if (fg_rank.eq.0) call int_from_cart1(.false.)
16618 call int_from_cart1(.false.)
16622 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
16623 ! & " absolute rank",myrank," nfgtasks",nfgtasks
16625 if (nfgtasks.gt.1) then
16627 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
16628 if (fg_rank.eq.0) then
16629 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
16630 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
16632 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
16633 ! FG slaves as WEIGHTS array.
16640 weights_(7)=wel_loc
16643 weights_(10)=wturn6
16645 weights_(12)=wscloc
16647 weights_(14)=wtor_d
16648 weights_(15)=wstrain
16649 weights_(16)=wvdwpp
16651 weights_(18)=scal14
16652 weights_(21)=wsccor
16653 ! FG Master broadcasts the WEIGHTS_ array
16654 call MPI_Bcast(weights_(1),n_ene,&
16655 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
16657 ! FG slaves receive the WEIGHTS array
16658 call MPI_Bcast(weights(1),n_ene,&
16659 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
16674 wstrain=weights(15)
16680 ! write (iout,*),"Processor",myrank," BROADCAST weights"
16681 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
16683 ! write (iout,*) "Processor",myrank," BROADCAST c"
16684 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
16686 ! write (iout,*) "Processor",myrank," BROADCAST dc"
16687 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
16689 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
16690 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
16692 ! write (iout,*) "Processor",myrank," BROADCAST theta"
16693 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
16695 ! write (iout,*) "Processor",myrank," BROADCAST phi"
16696 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
16698 ! write (iout,*) "Processor",myrank," BROADCAST alph"
16699 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
16701 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
16702 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
16704 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
16705 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
16707 time_Bcast=time_Bcast+MPI_Wtime()-time00
16708 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
16710 ! write (iout,*) 'Processor',myrank,
16711 ! & ' calling etotal_short ipot=',ipot
16713 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
16715 ! call int_from_cart1(.false.)
16717 ! Compute the side-chain and electrostatic interaction energy
16719 goto (101,102,103,104,105,106) ipot
16720 ! Lennard-Jones potential.
16721 101 call elj_short(evdw)
16722 !d print '(a)','Exit ELJ'
16724 ! Lennard-Jones-Kihara potential (shifted).
16725 102 call eljk_short(evdw)
16727 ! Berne-Pechukas potential (dilated LJ, angular dependence).
16728 103 call ebp_short(evdw)
16730 ! Gay-Berne potential (shifted LJ, angular dependence).
16731 104 call egb_short(evdw)
16733 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
16734 105 call egbv_short(evdw)
16736 ! Soft-sphere potential - already dealt with in the long-range part
16738 ! 106 call e_softsphere_short(evdw)
16740 ! Calculate electrostatic (H-bonding) energy of the main chain.
16744 ! Calculate the short-range part of Evdwpp
16746 call evdwpp_short(evdw1)
16748 ! Calculate the short-range part of ESCp
16750 if (ipot.lt.6) then
16751 call escp_short(evdw2,evdw2_14)
16754 ! Calculate the bond-stretching energy
16758 ! Calculate the disulfide-bridge and other energy and the contributions
16759 ! from other distance constraints.
16762 ! Calculate the virtual-bond-angle energy.
16764 ! Calculate the SC local energy.
16769 if (wang.gt.0d0) then
16770 if (tor_mode.eq.0) then
16773 !C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
16775 call ebend_kcc(ebe)
16781 if (with_theta_constr) call etheta_constr(ethetacnstr)
16783 ! write(iout,*) "in etotal afer ebe",ipot
16785 ! print *,"Processor",myrank," computed UB"
16787 ! Calculate the SC local energy.
16790 !elwrite(iout,*) "in etotal afer esc",ipot
16791 ! print *,"Processor",myrank," computed USC"
16793 ! Calculate the virtual-bond torsional energy.
16795 !d print *,'nterm=',nterm
16796 ! if (wtor.gt.0) then
16797 ! call etor(etors,edihcnstr)
16802 if (wtor.gt.0.0d0) then
16803 if (tor_mode.eq.0) then
16806 !C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
16808 call etor_kcc(etors)
16814 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
16816 ! Calculate the virtual-bond torsional energy.
16819 ! 6/23/01 Calculate double-torsional energy
16821 if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
16822 call etor_d(etors_d)
16825 ! 21/5/07 Calculate local sicdechain correlation energy
16827 if (wsccor.gt.0.0d0) then
16828 call eback_sc_corr(esccor)
16833 ! Put energy components into an array
16840 energia(2)=evdw2-evdw2_14
16841 energia(18)=evdw2_14
16854 energia(14)=etors_d
16857 energia(19)=edihcnstr
16859 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
16861 call sum_energy(energia,.true.)
16862 ! write (iout,*) "Exit ETOTAL_SHORT"
16865 end subroutine etotal_short
16866 !-----------------------------------------------------------------------------
16868 !-----------------------------------------------------------------------------
16869 real(kind=8) function gnmr1(y,ymin,ymax)
16871 real(kind=8) :: y,ymin,ymax
16872 real(kind=8) :: wykl=4.0d0
16873 if (y.lt.ymin) then
16874 gnmr1=(ymin-y)**wykl/wykl
16875 else if (y.gt.ymax) then
16876 gnmr1=(y-ymax)**wykl/wykl
16882 !-----------------------------------------------------------------------------
16883 real(kind=8) function gnmr1prim(y,ymin,ymax)
16885 real(kind=8) :: y,ymin,ymax
16886 real(kind=8) :: wykl=4.0d0
16887 if (y.lt.ymin) then
16888 gnmr1prim=-(ymin-y)**(wykl-1)
16889 else if (y.gt.ymax) then
16890 gnmr1prim=(y-ymax)**(wykl-1)
16895 end function gnmr1prim
16896 !----------------------------------------------------------------------------
16897 real(kind=8) function rlornmr1(y,ymin,ymax,sigma)
16898 real(kind=8) y,ymin,ymax,sigma
16899 real(kind=8) wykl /4.0d0/
16900 if (y.lt.ymin) then
16901 rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl)
16902 else if (y.gt.ymax) then
16903 rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
16908 end function rlornmr1
16909 !------------------------------------------------------------------------------
16910 real(kind=8) function rlornmr1prim(y,ymin,ymax,sigma)
16911 real(kind=8) y,ymin,ymax,sigma
16912 real(kind=8) wykl /4.0d0/
16913 if (y.lt.ymin) then
16914 rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ &
16915 ((ymin-y)**wykl+sigma**wykl)**2
16916 else if (y.gt.ymax) then
16917 rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ &
16918 ((y-ymax)**wykl+sigma**wykl)**2
16923 end function rlornmr1prim
16925 real(kind=8) function harmonic(y,ymax)
16927 real(kind=8) :: y,ymax
16928 real(kind=8) :: wykl=2.0d0
16929 harmonic=(y-ymax)**wykl
16931 end function harmonic
16932 !-----------------------------------------------------------------------------
16933 real(kind=8) function harmonicprim(y,ymax)
16934 real(kind=8) :: y,ymin,ymax
16935 real(kind=8) :: wykl=2.0d0
16936 harmonicprim=(y-ymax)*wykl
16938 end function harmonicprim
16939 !-----------------------------------------------------------------------------
16941 !-----------------------------------------------------------------------------
16942 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
16944 use io_base, only:intout,briefout
16945 ! implicit real*8 (a-h,o-z)
16946 ! include 'DIMENSIONS'
16947 ! include 'COMMON.CHAIN'
16948 ! include 'COMMON.DERIV'
16949 ! include 'COMMON.VAR'
16950 ! include 'COMMON.INTERACT'
16951 ! include 'COMMON.FFIELD'
16952 ! include 'COMMON.MD'
16953 ! include 'COMMON.IOUNITS'
16954 real(kind=8),external :: ufparm
16955 integer :: uiparm(1)
16956 real(kind=8) :: urparm(1)
16957 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
16958 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
16959 integer :: n,nf,ind,ind1,i,k,j
16961 ! This subroutine calculates total internal coordinate gradient.
16962 ! Depending on the number of function evaluations, either whole energy
16963 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
16964 ! internal coordinates are reevaluated or only the cartesian-in-internal
16965 ! coordinate derivatives are evaluated. The subroutine was designed to work
16971 !d print *,'grad',nf,icg
16972 if (nf-nfl+1) 20,30,40
16973 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
16974 ! write (iout,*) 'grad 20'
16975 if (nf.eq.0) return
16977 30 call var_to_geom(n,x)
16979 ! write (iout,*) 'grad 30'
16981 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
16984 ! write (iout,*) 'grad 40'
16985 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
16987 ! Convert the Cartesian gradient into internal-coordinate gradient.
16997 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
16999 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
17002 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
17008 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
17010 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
17011 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
17014 if (i.gt.1) g(i-1)=gphii
17015 if (n.gt.nphi) g(nphi+i)=gthetai
17017 if (n.le.nphi+ntheta) goto 10
17019 if (itype(i,1).ne.10) then
17023 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
17026 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
17028 g(ialph(i,1))=galphai
17029 g(ialph(i,1)+nside)=gomegai
17033 ! Add the components corresponding to local energy terms.
17037 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
17038 g(i)=g(i)+gloc(i,icg)
17040 ! Uncomment following three lines for diagnostics.
17042 !elwrite(iout,*) "in gradient after calling intout"
17043 !d call briefout(0,0.0d0)
17044 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
17046 end subroutine gradient
17047 !-----------------------------------------------------------------------------
17048 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
17051 ! implicit real*8 (a-h,o-z)
17052 ! include 'DIMENSIONS'
17053 ! include 'COMMON.DERIV'
17054 ! include 'COMMON.IOUNITS'
17055 ! include 'COMMON.GEO'
17058 !el common /chuju/ jjj
17059 real(kind=8) :: energia(0:n_ene)
17060 integer :: uiparm(1)
17061 real(kind=8) :: urparm(1)
17063 real(kind=8),external :: ufparm
17064 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
17065 ! if (jjj.gt.0) then
17066 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
17070 !d print *,'func',nf,nfl,icg
17071 call var_to_geom(n,x)
17074 !d write (iout,*) 'ETOTAL called from FUNC'
17075 call etotal(energia)
17078 ! if (jjj.gt.0) then
17079 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
17080 ! write (iout,*) 'f=',etot
17084 end subroutine func
17085 !-----------------------------------------------------------------------------
17086 subroutine cartgrad
17087 ! implicit real*8 (a-h,o-z)
17088 ! include 'DIMENSIONS'
17090 use MD_data, only: totT,usampl,eq_time
17094 ! include 'COMMON.CHAIN'
17095 ! include 'COMMON.DERIV'
17096 ! include 'COMMON.VAR'
17097 ! include 'COMMON.INTERACT'
17098 ! include 'COMMON.FFIELD'
17099 ! include 'COMMON.MD'
17100 ! include 'COMMON.IOUNITS'
17101 ! include 'COMMON.TIME1'
17105 ! This subrouting calculates total Cartesian coordinate gradient.
17106 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
17117 !el write (iout,*) "After sum_gradient"
17119 !el write (iout,*) "After sum_gradient"
17121 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
17122 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
17126 ! If performing constraint dynamics, add the gradients of the constraint energy
17127 if(usampl.and.totT.gt.eq_time) then
17130 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
17131 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
17135 gloc(i,icg)=gloc(i,icg)+dugamma(i)
17138 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
17141 !elwrite (iout,*) "After sum_gradient"
17146 !elwrite (iout,*) "After sum_gradient"
17148 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
17150 ! call checkintcartgrad
17151 ! write(iout,*) 'calling int_to_cart'
17154 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
17158 gcart(j,i)=gradc(j,i,icg)
17159 gxcart(j,i)=gradx(j,i,icg)
17160 ! if (i.le.2) print *,"gcart_one",gcart(j,i),gradc(j,i,icg)
17163 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
17164 (gxcart(j,i),j=1,3),gloc(i,icg)
17170 ! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
17172 ! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
17175 time_inttocart=time_inttocart+MPI_Wtime()-time01
17178 write (iout,*) "gcart and gxcart after int_to_cart"
17180 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
17181 (gxcart(j,i),j=1,3)
17187 write (iout,*) "CARGRAD"
17191 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
17192 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
17194 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
17195 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
17197 ! Correction: dummy residues
17200 ! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
17201 gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
17204 if (nct.lt.nres) then
17206 ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
17207 gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
17212 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
17216 end subroutine cartgrad
17217 !-----------------------------------------------------------------------------
17218 subroutine zerograd
17219 ! implicit real*8 (a-h,o-z)
17220 ! include 'DIMENSIONS'
17221 ! include 'COMMON.DERIV'
17222 ! include 'COMMON.CHAIN'
17223 ! include 'COMMON.VAR'
17224 ! include 'COMMON.MD'
17225 ! include 'COMMON.SCCOR'
17227 !el local variables
17228 integer :: i,j,intertyp,k
17229 ! Initialize Cartesian-coordinate gradient
17231 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
17232 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
17234 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
17235 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
17236 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
17237 ! allocate(gradcorr_long(3,nres))
17238 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
17239 ! allocate(gcorr6_turn_long(3,nres))
17240 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
17242 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
17244 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
17245 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
17247 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
17248 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
17250 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
17251 ! allocate(gscloc(3,nres)) !(3,maxres)
17252 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
17256 ! common /deriv_scloc/
17257 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
17258 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
17259 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
17261 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
17265 ! gradc(j,i,icg)=0.0d0
17266 ! gradx(j,i,icg)=0.0d0
17268 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
17269 !elwrite(iout,*) "icg",icg
17273 gradx_scp(j,i)=0.0D0
17275 gvdwc_scp(j,i)=0.0D0
17276 gvdwc_scpp(j,i)=0.0d0
17278 gelc_long(j,i)=0.0D0
17283 gel_loc_long(j,i)=0.0d0
17286 gcorr3_turn(j,i)=0.0d0
17287 gcorr4_turn(j,i)=0.0d0
17288 gradcorr(j,i)=0.0d0
17289 gradcorr_long(j,i)=0.0d0
17290 gradcorr5_long(j,i)=0.0d0
17291 gradcorr6_long(j,i)=0.0d0
17292 gcorr6_turn_long(j,i)=0.0d0
17293 gradcorr5(j,i)=0.0d0
17294 gradcorr6(j,i)=0.0d0
17295 gcorr6_turn(j,i)=0.0d0
17298 gradc(j,i,icg)=0.0d0
17299 gradx(j,i,icg)=0.0d0
17302 gliptran(j,i)=0.0d0
17303 gliptranx(j,i)=0.0d0
17304 gliptranc(j,i)=0.0d0
17305 gshieldx(j,i)=0.0d0
17306 gshieldc(j,i)=0.0d0
17307 gshieldc_loc(j,i)=0.0d0
17308 gshieldx_ec(j,i)=0.0d0
17309 gshieldc_ec(j,i)=0.0d0
17310 gshieldc_loc_ec(j,i)=0.0d0
17311 gshieldx_t3(j,i)=0.0d0
17312 gshieldc_t3(j,i)=0.0d0
17313 gshieldc_loc_t3(j,i)=0.0d0
17314 gshieldx_t4(j,i)=0.0d0
17315 gshieldc_t4(j,i)=0.0d0
17316 gshieldc_loc_t4(j,i)=0.0d0
17317 gshieldx_ll(j,i)=0.0d0
17318 gshieldc_ll(j,i)=0.0d0
17319 gshieldc_loc_ll(j,i)=0.0d0
17321 gg_tube_sc(j,i)=0.0d0
17323 gradb_nucl(j,i)=0.0d0
17324 gradbx_nucl(j,i)=0.0d0
17325 gvdwpp_nucl(j,i)=0.0d0
17329 gvdwpsb1(j,i)=0.0d0
17333 gradcorr_nucl(j,i)=0.0d0
17334 gradcorr3_nucl(j,i)=0.0d0
17335 gradxorr_nucl(j,i)=0.0d0
17336 gradxorr3_nucl(j,i)=0.0d0
17340 gradpepcat(j,i)=0.0d0
17341 gradpepcatx(j,i)=0.0d0
17342 gradcatcat(j,i)=0.0d0
17343 gvdwx_scbase(j,i)=0.0d0
17344 gvdwc_scbase(j,i)=0.0d0
17345 gvdwx_pepbase(j,i)=0.0d0
17346 gvdwc_pepbase(j,i)=0.0d0
17347 gvdwx_scpho(j,i)=0.0d0
17348 gvdwc_scpho(j,i)=0.0d0
17349 gvdwc_peppho(j,i)=0.0d0
17355 gloc_sc(intertyp,i,icg)=0.0d0
17364 grad_shield_side(k,j,i)=0.0d0
17365 grad_shield_loc(k,j,i)=0.0d0
17372 ! Initialize the gradient of local energy terms.
17374 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
17375 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
17376 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
17377 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
17378 ! allocate(gel_loc_turn3(nres))
17379 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
17380 ! allocate(gsccor_loc(nres)) !(maxres)
17386 gel_loc_loc(i)=0.0d0
17388 g_corr5_loc(i)=0.0d0
17389 g_corr6_loc(i)=0.0d0
17390 gel_loc_turn3(i)=0.0d0
17391 gel_loc_turn4(i)=0.0d0
17392 gel_loc_turn6(i)=0.0d0
17393 gsccor_loc(i)=0.0d0
17395 ! initialize gcart and gxcart
17396 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
17404 end subroutine zerograd
17405 !-----------------------------------------------------------------------------
17406 real(kind=8) function fdum()
17410 !-----------------------------------------------------------------------------
17412 !-----------------------------------------------------------------------------
17413 subroutine intcartderiv
17414 ! implicit real*8 (a-h,o-z)
17415 ! include 'DIMENSIONS'
17419 ! include 'COMMON.SETUP'
17420 ! include 'COMMON.CHAIN'
17421 ! include 'COMMON.VAR'
17422 ! include 'COMMON.GEO'
17423 ! include 'COMMON.INTERACT'
17424 ! include 'COMMON.DERIV'
17425 ! include 'COMMON.IOUNITS'
17426 ! include 'COMMON.LOCAL'
17427 ! include 'COMMON.SCCOR'
17428 real(kind=8) :: pi4,pi34
17429 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
17430 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
17431 dcosomega,dsinomega !(3,3,maxres)
17432 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
17435 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
17436 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
17437 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
17438 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
17442 !el from module energy-------------
17443 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
17444 !el allocate(dsintau(3,3,3,itau_start:itau_end))
17445 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
17447 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
17448 !el allocate(dsintau(3,3,3,0:nres2))
17449 !el allocate(dtauangle(3,3,3,0:nres2))
17450 !el allocate(domicron(3,2,2,0:nres2))
17451 !el allocate(dcosomicron(3,2,2,0:nres2))
17455 #if defined(MPI) && defined(PARINTDER)
17456 if (nfgtasks.gt.1 .and. me.eq.king) &
17457 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
17462 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
17463 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
17465 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
17468 dtheta(j,1,i)=0.0d0
17469 dtheta(j,2,i)=0.0d0
17475 ! Derivatives of theta's
17476 #if defined(MPI) && defined(PARINTDER)
17477 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
17478 do i=max0(ithet_start-1,3),ithet_end
17482 cost=dcos(theta(i))
17483 sint=sqrt(1-cost*cost)
17485 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
17487 if (itype(i-1,1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
17488 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
17490 if (itype(i-1,1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
17493 #if defined(MPI) && defined(PARINTDER)
17494 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
17495 do i=max0(ithet_start-1,3),ithet_end
17499 if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1)) then
17500 cost1=dcos(omicron(1,i))
17501 sint1=sqrt(1-cost1*cost1)
17502 cost2=dcos(omicron(2,i))
17503 sint2=sqrt(1-cost2*cost2)
17505 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
17506 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
17507 cost1*dc_norm(j,i-2))/ &
17509 domicron(j,1,1,i)=-1.0/sint1*dcosomicron(j,1,1,i)
17510 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
17511 +cost1*(dc_norm(j,i-1+nres)))/ &
17513 domicron(j,1,2,i)=-1.0/sint1*dcosomicron(j,1,2,i)
17514 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
17515 !C Looks messy but better than if in loop
17516 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
17517 +cost2*dc_norm(j,i-1))/ &
17519 domicron(j,2,1,i)=-1.0/sint2*dcosomicron(j,2,1,i)
17520 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
17521 +cost2*(-dc_norm(j,i-1+nres)))/ &
17523 ! write(iout,*) "vbld", i,itype(i,1),vbld(i-1+nres)
17524 domicron(j,2,2,i)=-1.0/sint2*dcosomicron(j,2,2,i)
17528 !elwrite(iout,*) "after vbld write"
17529 ! Derivatives of phi:
17530 ! If phi is 0 or 180 degrees, then the formulas
17531 ! have to be derived by power series expansion of the
17532 ! conventional formulas around 0 and 180.
17534 do i=iphi1_start,iphi1_end
17538 ! if (itype(i-1,1).eq.21 .or. itype(i-2,1).eq.21 ) cycle
17539 ! the conventional case
17540 sint=dsin(theta(i))
17541 sint1=dsin(theta(i-1))
17543 cost=dcos(theta(i))
17544 cost1=dcos(theta(i-1))
17546 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
17547 fac0=1.0d0/(sint1*sint)
17550 fac3=cosg*cost1/(sint1*sint1)
17551 fac4=cosg*cost/(sint*sint)
17552 ! Obtaining the gamma derivatives from sine derivative
17553 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
17554 phi(i).gt.pi34.and.phi(i).le.pi.or. &
17555 phi(i).ge.-pi.and.phi(i).le.-pi34) then
17556 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
17557 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
17558 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
17562 cosg_inv=1.0d0/cosg
17563 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
17564 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
17565 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
17566 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
17568 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
17569 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17570 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
17571 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
17572 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
17573 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
17574 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
17576 ! Bug fixed 3/24/05 (AL)
17578 ! Obtaining the gamma derivatives from cosine derivative
17581 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
17582 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
17583 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
17584 dc_norm(j,i-3))/vbld(i-2)
17585 dphi(j,1,i)=-1.0/sing*dcosphi(j,1,i)
17586 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
17587 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
17589 dphi(j,2,i)=-1.0/sing*dcosphi(j,2,i)
17590 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
17591 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
17592 dc_norm(j,i-1))/vbld(i)
17593 dphi(j,3,i)=-1.0/sing*dcosphi(j,3,i)
17596 write(iout,*) "just after",dphi(j,3,i),sing,dcosphi(j,3,i)
17603 !alculate derivative of Tauangle
17605 do i=itau_start,itau_end
17608 !elwrite(iout,*) " vecpr",i,nres
17610 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
17611 ! if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10).or.
17612 ! & (itype(i-1,1).eq.ntyp1).or.(itype(i,1).eq.ntyp1)) cycle
17613 !c dtauangle(j,intertyp,dervityp,residue number)
17614 !c INTERTYP=1 SC...Ca...Ca..Ca
17615 ! the conventional case
17616 sint=dsin(theta(i))
17617 sint1=dsin(omicron(2,i-1))
17618 sing=dsin(tauangle(1,i))
17619 cost=dcos(theta(i))
17620 cost1=dcos(omicron(2,i-1))
17621 cosg=dcos(tauangle(1,i))
17622 !elwrite(iout,*) " vecpr5",i,nres
17624 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
17625 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
17626 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
17627 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
17629 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
17630 fac0=1.0d0/(sint1*sint)
17633 fac3=cosg*cost1/(sint1*sint1)
17634 fac4=cosg*cost/(sint*sint)
17635 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
17636 ! Obtaining the gamma derivatives from sine derivative
17637 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
17638 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
17639 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
17640 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
17641 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
17642 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
17646 cosg_inv=1.0d0/cosg
17647 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
17648 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
17649 *vbld_inv(i-2+nres)
17650 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
17651 dsintau(j,1,2,i)= &
17652 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
17653 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17654 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
17655 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
17656 ! Bug fixed 3/24/05 (AL)
17657 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
17658 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
17659 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
17660 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
17662 ! Obtaining the gamma derivatives from cosine derivative
17665 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
17666 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
17667 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
17668 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
17669 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
17670 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
17672 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
17673 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
17674 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
17675 dc_norm(j,i-1))/vbld(i)
17676 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
17677 ! write (iout,*) "else",i
17681 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
17684 !C Second case Ca...Ca...Ca...SC
17686 do i=itau_start,itau_end
17690 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
17691 (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle
17692 ! the conventional case
17693 sint=dsin(omicron(1,i))
17694 sint1=dsin(theta(i-1))
17695 sing=dsin(tauangle(2,i))
17696 cost=dcos(omicron(1,i))
17697 cost1=dcos(theta(i-1))
17698 cosg=dcos(tauangle(2,i))
17700 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
17702 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
17703 fac0=1.0d0/(sint1*sint)
17706 fac3=cosg*cost1/(sint1*sint1)
17707 fac4=cosg*cost/(sint*sint)
17708 ! Obtaining the gamma derivatives from sine derivative
17709 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
17710 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
17711 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
17712 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
17713 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
17714 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
17718 cosg_inv=1.0d0/cosg
17719 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
17720 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
17721 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
17722 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
17723 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
17724 dsintau(j,2,2,i)= &
17725 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
17726 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17727 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
17728 ! & sing*ctgt*domicron(j,1,2,i),
17729 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17730 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
17731 ! Bug fixed 3/24/05 (AL)
17732 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
17733 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
17734 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
17735 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
17737 ! Obtaining the gamma derivatives from cosine derivative
17740 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
17741 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
17742 dc_norm(j,i-3))/vbld(i-2)
17743 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
17744 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
17745 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
17746 dcosomicron(j,1,1,i)
17747 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
17748 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
17749 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
17750 dc_norm(j,i-1+nres))/vbld(i-1+nres)
17751 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
17752 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
17757 !CC third case SC...Ca...Ca...SC
17760 do i=itau_start,itau_end
17764 ! the conventional case
17765 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
17766 (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
17767 sint=dsin(omicron(1,i))
17768 sint1=dsin(omicron(2,i-1))
17769 sing=dsin(tauangle(3,i))
17770 cost=dcos(omicron(1,i))
17771 cost1=dcos(omicron(2,i-1))
17772 cosg=dcos(tauangle(3,i))
17774 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
17775 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
17777 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
17778 fac0=1.0d0/(sint1*sint)
17781 fac3=cosg*cost1/(sint1*sint1)
17782 fac4=cosg*cost/(sint*sint)
17783 ! Obtaining the gamma derivatives from sine derivative
17784 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
17785 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
17786 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
17787 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
17788 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
17789 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
17793 cosg_inv=1.0d0/cosg
17794 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
17795 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
17796 *vbld_inv(i-2+nres)
17797 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
17798 dsintau(j,3,2,i)= &
17799 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
17800 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17801 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
17802 ! Bug fixed 3/24/05 (AL)
17803 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
17804 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
17805 *vbld_inv(i-1+nres)
17806 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
17807 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
17809 ! Obtaining the gamma derivatives from cosine derivative
17812 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
17813 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
17814 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
17815 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
17816 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
17817 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
17818 dcosomicron(j,1,1,i)
17819 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
17820 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
17821 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
17822 dc_norm(j,i-1+nres))/vbld(i-1+nres)
17823 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
17824 ! write(iout,*) "else",i
17830 ! Derivatives of side-chain angles alpha and omega
17831 #if defined(MPI) && defined(PARINTDER)
17832 do i=ibond_start,ibond_end
17836 if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
17837 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
17840 fac8=fac5/vbld(i+1)
17841 fac9=fac5/vbld(i+nres)
17842 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
17843 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
17844 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
17845 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
17846 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
17847 sina=sqrt(1-cosa*cosa)
17849 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
17851 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
17852 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
17853 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
17854 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
17855 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
17856 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
17857 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
17858 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
17860 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
17862 ! obtaining the derivatives of omega from sines
17863 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
17864 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
17865 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
17866 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
17868 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
17869 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
17870 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
17871 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
17872 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
17873 coso_inv=1.0d0/dcos(omeg(i))
17875 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
17876 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
17877 (sino*dc_norm(j,i-1))/vbld(i)
17878 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
17879 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
17880 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
17881 -sino*dc_norm(j,i)/vbld(i+1)
17882 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
17883 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
17884 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
17886 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
17889 ! obtaining the derivatives of omega from cosines
17890 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
17891 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
17896 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
17897 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
17898 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
17899 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
17900 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
17901 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
17902 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
17903 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
17904 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
17905 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
17906 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
17907 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
17908 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
17909 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
17910 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
17916 dalpha(k,j,i)=0.0d0
17917 domega(k,j,i)=0.0d0
17923 #if defined(MPI) && defined(PARINTDER)
17924 if (nfgtasks.gt.1) then
17926 !d write (iout,*) "Gather dtheta"
17927 !d call flush(iout)
17928 write (iout,*) "dtheta before gather"
17930 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
17933 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
17934 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
17935 king,FG_COMM,IERROR)
17938 !d write (iout,*) "Gather dphi"
17939 !d call flush(iout)
17940 write (iout,*) "dphi before gather"
17942 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
17946 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
17947 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
17948 king,FG_COMM,IERROR)
17949 !d write (iout,*) "Gather dalpha"
17950 !d call flush(iout)
17952 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
17953 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
17954 king,FG_COMM,IERROR)
17955 !d write (iout,*) "Gather domega"
17956 !d call flush(iout)
17957 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
17958 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
17959 king,FG_COMM,IERROR)
17965 write (iout,*) "dtheta after gather"
17967 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
17969 write (iout,*) "dphi after gather"
17971 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
17973 write (iout,*) "dalpha after gather"
17975 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
17977 write (iout,*) "domega after gather"
17979 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
17984 end subroutine intcartderiv
17985 !-----------------------------------------------------------------------------
17986 subroutine checkintcartgrad
17987 ! implicit real*8 (a-h,o-z)
17988 ! include 'DIMENSIONS'
17992 ! include 'COMMON.CHAIN'
17993 ! include 'COMMON.VAR'
17994 ! include 'COMMON.GEO'
17995 ! include 'COMMON.INTERACT'
17996 ! include 'COMMON.DERIV'
17997 ! include 'COMMON.IOUNITS'
17998 ! include 'COMMON.SETUP'
17999 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
18000 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
18001 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
18002 real(kind=8),dimension(3) :: dc_norm_s
18003 real(kind=8) :: aincr=1.0d-5
18005 real(kind=8) :: dcji
18008 theta_s(i)=theta(i)
18012 ! Check theta gradient
18014 "Analytical (upper) and numerical (lower) gradient of theta"
18019 dc(j,i-2)=dcji+aincr
18020 call chainbuild_cart
18021 call int_from_cart1(.false.)
18022 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
18025 dc(j,i-1)=dc(j,i-1)+aincr
18026 call chainbuild_cart
18027 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
18030 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
18031 !el (dtheta(j,2,i),j=1,3)
18032 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
18033 !el (dthetanum(j,2,i),j=1,3)
18034 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
18035 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
18036 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
18039 ! Check gamma gradient
18041 "Analytical (upper) and numerical (lower) gradient of gamma"
18045 dc(j,i-3)=dcji+aincr
18046 call chainbuild_cart
18047 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
18050 dc(j,i-2)=dcji+aincr
18051 call chainbuild_cart
18052 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
18055 dc(j,i-1)=dc(j,i-1)+aincr
18056 call chainbuild_cart
18057 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
18060 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
18061 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
18062 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
18063 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
18064 !el write (iout,'(5x,3(3f10.5,5x))') &
18065 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
18066 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
18067 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
18070 ! Check alpha gradient
18072 "Analytical (upper) and numerical (lower) gradient of alpha"
18074 if(itype(i,1).ne.10) then
18077 dc(j,i-1)=dcji+aincr
18078 call chainbuild_cart
18079 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
18084 call chainbuild_cart
18085 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
18089 dc(j,i+nres)=dc(j,i+nres)+aincr
18090 call chainbuild_cart
18091 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
18096 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
18097 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
18098 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
18099 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
18100 !el write (iout,'(5x,3(3f10.5,5x))') &
18101 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
18102 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
18103 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
18106 ! Check omega gradient
18108 "Analytical (upper) and numerical (lower) gradient of omega"
18110 if(itype(i,1).ne.10) then
18113 dc(j,i-1)=dcji+aincr
18114 call chainbuild_cart
18115 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
18120 call chainbuild_cart
18121 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
18125 dc(j,i+nres)=dc(j,i+nres)+aincr
18126 call chainbuild_cart
18127 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
18132 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
18133 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
18134 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
18135 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
18136 !el write (iout,'(5x,3(3f10.5,5x))') &
18137 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
18138 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
18139 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
18143 end subroutine checkintcartgrad
18144 !-----------------------------------------------------------------------------
18146 !-----------------------------------------------------------------------------
18147 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
18148 ! implicit real*8 (a-h,o-z)
18149 ! include 'DIMENSIONS'
18150 ! include 'COMMON.IOUNITS'
18151 ! include 'COMMON.CHAIN'
18152 ! include 'COMMON.INTERACT'
18153 ! include 'COMMON.VAR'
18154 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
18155 integer :: kkk,nsep=3
18156 real(kind=8) :: qm !dist,
18157 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
18158 logical :: lprn=.false.
18160 ! real(kind=8) :: sigm,x
18162 !el sigm(x)=0.25d0*x ! local function
18168 do il=seg1+nsep,seg2
18171 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
18172 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
18173 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
18175 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
18176 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
18179 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
18180 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
18181 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
18182 dijCM=dist(il+nres,jl+nres)
18183 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
18185 qq = qq+qqij+qqijCM
18191 if((seg3-il).lt.3) then
18198 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
18199 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
18200 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
18202 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
18203 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
18206 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
18207 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
18208 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
18209 dijCM=dist(il+nres,jl+nres)
18210 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
18212 qq = qq+qqij+qqijCM
18217 if (qqmax.le.qq) qqmax=qq
18219 qwolynes=1.0d0-qqmax
18221 end function qwolynes
18222 !-----------------------------------------------------------------------------
18223 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
18224 ! implicit real*8 (a-h,o-z)
18225 ! include 'DIMENSIONS'
18226 ! include 'COMMON.IOUNITS'
18227 ! include 'COMMON.CHAIN'
18228 ! include 'COMMON.INTERACT'
18229 ! include 'COMMON.VAR'
18230 ! include 'COMMON.MD'
18231 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
18232 integer :: nsep=3, kkk
18233 !el real(kind=8) :: dist
18234 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
18235 logical :: lprn=.false.
18237 real(kind=8) :: sim,dd0,fac,ddqij
18238 !el sigm(x)=0.25d0*x ! local function
18248 do il=seg1+nsep,seg2
18251 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
18252 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
18253 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
18255 sim = 1.0d0/sigm(d0ij)
18258 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
18260 ddqij = (c(k,il)-c(k,jl))*fac
18261 dqwol(k,il)=dqwol(k,il)+ddqij
18262 dqwol(k,jl)=dqwol(k,jl)-ddqij
18265 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
18268 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
18269 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
18270 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
18271 dijCM=dist(il+nres,jl+nres)
18272 sim = 1.0d0/sigm(d0ijCM)
18275 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
18277 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
18278 dxqwol(k,il)=dxqwol(k,il)+ddqij
18279 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
18286 if((seg3-il).lt.3) then
18293 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
18294 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
18295 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
18297 sim = 1.0d0/sigm(d0ij)
18300 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
18302 ddqij = (c(k,il)-c(k,jl))*fac
18303 dqwol(k,il)=dqwol(k,il)+ddqij
18304 dqwol(k,jl)=dqwol(k,jl)-ddqij
18306 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
18309 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
18310 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
18311 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
18312 dijCM=dist(il+nres,jl+nres)
18313 sim = 1.0d0/sigm(d0ijCM)
18316 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
18318 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
18319 dxqwol(k,il)=dxqwol(k,il)+ddqij
18320 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
18329 dqwol(j,i)=dqwol(j,i)/nl
18330 dxqwol(j,i)=dxqwol(j,i)/nl
18334 end subroutine qwolynes_prim
18335 !-----------------------------------------------------------------------------
18336 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
18337 ! implicit real*8 (a-h,o-z)
18338 ! include 'DIMENSIONS'
18339 ! include 'COMMON.IOUNITS'
18340 ! include 'COMMON.CHAIN'
18341 ! include 'COMMON.INTERACT'
18342 ! include 'COMMON.VAR'
18343 integer :: seg1,seg2,seg3,seg4
18345 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
18346 real(kind=8),dimension(3,0:2*nres) :: cdummy
18347 real(kind=8) :: q1,q2
18348 real(kind=8) :: delta=1.0d-10
18353 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
18355 c(j,i)=c(j,i)+delta
18356 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
18357 qwolan(j,i)=(q2-q1)/delta
18363 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
18364 cdummy(j,i+nres)=c(j,i+nres)
18365 c(j,i+nres)=c(j,i+nres)+delta
18366 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
18367 qwolxan(j,i)=(q2-q1)/delta
18368 c(j,i+nres)=cdummy(j,i+nres)
18371 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
18373 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
18375 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
18377 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
18380 end subroutine qwol_num
18381 !-----------------------------------------------------------------------------
18382 subroutine EconstrQ
18383 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
18384 ! implicit real*8 (a-h,o-z)
18385 ! include 'DIMENSIONS'
18386 ! include 'COMMON.CONTROL'
18387 ! include 'COMMON.VAR'
18388 ! include 'COMMON.MD'
18391 ! include 'COMMON.LANGEVIN'
18393 ! include 'COMMON.LANGEVIN.lang0'
18395 ! include 'COMMON.CHAIN'
18396 ! include 'COMMON.DERIV'
18397 ! include 'COMMON.GEO'
18398 ! include 'COMMON.LOCAL'
18399 ! include 'COMMON.INTERACT'
18400 ! include 'COMMON.IOUNITS'
18401 ! include 'COMMON.NAMES'
18402 ! include 'COMMON.TIME1'
18403 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
18404 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
18406 integer :: kstart,kend,lstart,lend,idummy
18407 real(kind=8) :: delta=1.0d-7
18408 integer :: i,j,k,ii
18412 dudconst(j,i)=0.0d0
18413 duxconst(j,i)=0.0d0
18414 dudxconst(j,i)=0.0d0
18419 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
18421 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
18422 ! Calculating the derivatives of Constraint energy with respect to Q
18423 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
18425 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
18426 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
18427 ! hmnum=(hm2-hm1)/delta
18428 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
18429 ! & qinfrag(i,iset))
18430 ! write(iout,*) "harmonicnum frag", hmnum
18431 ! Calculating the derivatives of Q with respect to cartesian coordinates
18432 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
18434 ! write(iout,*) "dqwol "
18436 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
18438 ! write(iout,*) "dxqwol "
18440 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
18442 ! Calculating numerical gradients of dU/dQi and dQi/dxi
18443 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
18444 ! & ,idummy,idummy)
18445 ! The gradients of Uconst in Cs
18448 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
18449 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
18454 kstart=ifrag(1,ipair(1,i,iset),iset)
18455 kend=ifrag(2,ipair(1,i,iset),iset)
18456 lstart=ifrag(1,ipair(2,i,iset),iset)
18457 lend=ifrag(2,ipair(2,i,iset),iset)
18458 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
18459 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
18460 ! Calculating dU/dQ
18461 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
18462 ! hm1=harmonic(qpair(i),qinpair(i,iset))
18463 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
18464 ! hmnum=(hm2-hm1)/delta
18465 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
18466 ! & qinpair(i,iset))
18467 ! write(iout,*) "harmonicnum pair ", hmnum
18468 ! Calculating dQ/dXi
18469 call qwolynes_prim(kstart,kend,.false.,&
18471 ! write(iout,*) "dqwol "
18473 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
18475 ! write(iout,*) "dxqwol "
18477 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
18479 ! Calculating numerical gradients
18480 ! call qwol_num(kstart,kend,.false.
18482 ! The gradients of Uconst in Cs
18485 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
18486 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
18490 ! write(iout,*) "Uconst inside subroutine ", Uconst
18491 ! Transforming the gradients from Cs to dCs for the backbone
18495 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
18499 ! Transforming the gradients from Cs to dCs for the side chains
18502 dudxconst(j,i)=duxconst(j,i)
18505 ! write(iout,*) "dU/ddc backbone "
18507 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
18509 ! write(iout,*) "dU/ddX side chain "
18511 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
18513 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
18514 ! call dEconstrQ_num
18516 end subroutine EconstrQ
18517 !-----------------------------------------------------------------------------
18518 subroutine dEconstrQ_num
18519 ! Calculating numerical dUconst/ddc and dUconst/ddx
18520 ! implicit real*8 (a-h,o-z)
18521 ! include 'DIMENSIONS'
18522 ! include 'COMMON.CONTROL'
18523 ! include 'COMMON.VAR'
18524 ! include 'COMMON.MD'
18527 ! include 'COMMON.LANGEVIN'
18529 ! include 'COMMON.LANGEVIN.lang0'
18531 ! include 'COMMON.CHAIN'
18532 ! include 'COMMON.DERIV'
18533 ! include 'COMMON.GEO'
18534 ! include 'COMMON.LOCAL'
18535 ! include 'COMMON.INTERACT'
18536 ! include 'COMMON.IOUNITS'
18537 ! include 'COMMON.NAMES'
18538 ! include 'COMMON.TIME1'
18539 real(kind=8) :: uzap1,uzap2
18540 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
18541 integer :: kstart,kend,lstart,lend,idummy
18542 real(kind=8) :: delta=1.0d-7
18543 !el local variables
18549 dUcartan(j,i)=0.0d0
18550 cdummy(j,i)=dc(j,i)
18551 dc(j,i)=dc(j,i)+delta
18552 call chainbuild_cart
18555 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
18557 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
18561 kstart=ifrag(1,ipair(1,ii,iset),iset)
18562 kend=ifrag(2,ipair(1,ii,iset),iset)
18563 lstart=ifrag(1,ipair(2,ii,iset),iset)
18564 lend=ifrag(2,ipair(2,ii,iset),iset)
18565 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
18566 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
18569 dc(j,i)=cdummy(j,i)
18570 call chainbuild_cart
18573 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
18575 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
18579 kstart=ifrag(1,ipair(1,ii,iset),iset)
18580 kend=ifrag(2,ipair(1,ii,iset),iset)
18581 lstart=ifrag(1,ipair(2,ii,iset),iset)
18582 lend=ifrag(2,ipair(2,ii,iset),iset)
18583 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
18584 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
18587 ducartan(j,i)=(uzap2-uzap1)/(delta)
18590 ! Calculating numerical gradients for dU/ddx
18592 duxcartan(j,i)=0.0d0
18594 cdummy(j,i)=dc(j,i+nres)
18595 dc(j,i+nres)=dc(j,i+nres)+delta
18596 call chainbuild_cart
18599 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
18601 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
18605 kstart=ifrag(1,ipair(1,ii,iset),iset)
18606 kend=ifrag(2,ipair(1,ii,iset),iset)
18607 lstart=ifrag(1,ipair(2,ii,iset),iset)
18608 lend=ifrag(2,ipair(2,ii,iset),iset)
18609 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
18610 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
18613 dc(j,i+nres)=cdummy(j,i)
18614 call chainbuild_cart
18617 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
18618 ifrag(2,ii,iset),.true.,idummy,idummy)
18619 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
18623 kstart=ifrag(1,ipair(1,ii,iset),iset)
18624 kend=ifrag(2,ipair(1,ii,iset),iset)
18625 lstart=ifrag(1,ipair(2,ii,iset),iset)
18626 lend=ifrag(2,ipair(2,ii,iset),iset)
18627 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
18628 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
18631 duxcartan(j,i)=(uzap2-uzap1)/(delta)
18634 write(iout,*) "Numerical dUconst/ddc backbone "
18636 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
18638 ! write(iout,*) "Numerical dUconst/ddx side-chain "
18640 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
18643 end subroutine dEconstrQ_num
18644 !-----------------------------------------------------------------------------
18646 !-----------------------------------------------------------------------------
18647 subroutine check_energies
18649 ! use random, only: ran_number
18653 ! include 'DIMENSIONS'
18654 ! include 'COMMON.CHAIN'
18655 ! include 'COMMON.VAR'
18656 ! include 'COMMON.IOUNITS'
18657 ! include 'COMMON.SBRIDGE'
18658 ! include 'COMMON.LOCAL'
18659 ! include 'COMMON.GEO'
18661 ! External functions
18662 !EL double precision ran_number
18663 !EL external ran_number
18666 integer :: i,j,k,l,lmax,p,pmax
18667 real(kind=8) :: rmin,rmax
18668 real(kind=8) :: eij
18671 real(kind=8) :: wi,rij,tj,pj
18693 !t wi=ran_number(0.0D0,pi)
18694 ! wi=ran_number(0.0D0,pi/6.0D0)
18696 !t tj=ran_number(0.0D0,pi)
18697 !t pj=ran_number(0.0D0,pi)
18698 ! pj=ran_number(0.0D0,pi/6.0D0)
18702 !t rij=ran_number(rmin,rmax)
18704 c(1,j)=d*sin(pj)*cos(tj)
18705 c(2,j)=d*sin(pj)*sin(tj)
18711 c(3,i)=-rij-d*cos(wi)
18714 dc(k,nres+i)=c(k,nres+i)-c(k,i)
18715 dc_norm(k,nres+i)=dc(k,nres+i)/d
18716 dc(k,nres+j)=c(k,nres+j)-c(k,j)
18717 dc_norm(k,nres+j)=dc(k,nres+j)/d
18720 call dyn_ssbond_ene(i,j,eij)
18725 end subroutine check_energies
18726 !-----------------------------------------------------------------------------
18727 subroutine dyn_ssbond_ene(resi,resj,eij)
18732 ! include 'DIMENSIONS'
18733 ! include 'COMMON.SBRIDGE'
18734 ! include 'COMMON.CHAIN'
18735 ! include 'COMMON.DERIV'
18736 ! include 'COMMON.LOCAL'
18737 ! include 'COMMON.INTERACT'
18738 ! include 'COMMON.VAR'
18739 ! include 'COMMON.IOUNITS'
18740 ! include 'COMMON.CALC'
18744 ! include 'COMMON.MD'
18745 ! use MD, only: totT,t_bath
18748 ! External functions
18749 !EL double precision h_base
18750 !EL external h_base
18753 integer :: resi,resj
18756 real(kind=8) :: eij
18759 logical :: havebond
18760 integer itypi,itypj
18761 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
18762 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
18763 real(kind=8),dimension(3) :: dcosom1,dcosom2
18765 real(kind=8) :: pom1,pom2
18766 real(kind=8) :: ljA,ljB,ljXs
18767 real(kind=8),dimension(1:3) :: d_ljB
18768 real(kind=8) :: ssA,ssB,ssC,ssXs
18769 real(kind=8) :: ssxm,ljxm,ssm,ljm
18770 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
18771 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
18772 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
18773 !-------FIRST METHOD
18775 real(kind=8),dimension(1:3) :: d_xm
18776 !-------END FIRST METHOD
18777 !-------SECOND METHOD
18778 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
18779 !-------END SECOND METHOD
18781 !-------TESTING CODE
18782 !el logical :: checkstop,transgrad
18783 !el common /sschecks/ checkstop,transgrad
18785 integer :: icheck,nicheck,jcheck,njcheck
18786 real(kind=8),dimension(-1:1) :: echeck
18787 real(kind=8) :: deps,ssx0,ljx0
18788 !-------END TESTING CODE
18794 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
18795 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
18798 dxi=dc_norm(1,nres+i)
18799 dyi=dc_norm(2,nres+i)
18800 dzi=dc_norm(3,nres+i)
18801 dsci_inv=vbld_inv(i+nres)
18804 xj=c(1,nres+j)-c(1,nres+i)
18805 yj=c(2,nres+j)-c(2,nres+i)
18806 zj=c(3,nres+j)-c(3,nres+i)
18807 dxj=dc_norm(1,nres+j)
18808 dyj=dc_norm(2,nres+j)
18809 dzj=dc_norm(3,nres+j)
18810 dscj_inv=vbld_inv(j+nres)
18812 chi1=chi(itypi,itypj)
18813 chi2=chi(itypj,itypi)
18820 alf12=0.5D0*(alf1+alf2)
18822 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
18823 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
18824 ! The following are set in sc_angular
18828 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
18829 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
18830 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
18832 rij=1.0D0/rij ! Reset this so it makes sense
18834 sig0ij=sigma(itypi,itypj)
18835 sig=sig0ij*dsqrt(1.0D0/sigsq)
18838 ljA=eps1*eps2rt**2*eps3rt**2
18839 ljB=ljA*bb_aq(itypi,itypj)
18840 ljA=ljA*aa_aq(itypi,itypj)
18841 ljxm=ljXs+(-2.0D0*aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
18846 deltat12=om2-om1+2.0d0
18847 cosphi=om12-om1*om2
18851 +akth*(deltat1*deltat1+deltat2*deltat2) &
18852 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
18853 ssxm=ssXs-0.5D0*ssB/ssA
18855 !-------TESTING CODE
18856 !$$$c Some extra output
18857 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
18858 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
18859 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
18860 !$$$ if (ssx0.gt.0.0d0) then
18861 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
18865 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
18866 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
18867 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
18869 !-------END TESTING CODE
18871 !-------TESTING CODE
18872 ! Stop and plot energy and derivative as a function of distance
18873 if (checkstop) then
18874 ssm=ssC-0.25D0*ssB*ssB/ssA
18875 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
18876 if (ssm.lt.ljm .and. &
18877 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
18885 if (.not.checkstop) then
18890 do icheck=0,nicheck
18891 do jcheck=-1,njcheck
18892 if (checkstop) rij=(ssxm-1.0d0)+ &
18893 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
18894 !-------END TESTING CODE
18896 if (rij.gt.ljxm) then
18899 fac=(1.0D0/ljd)**expon
18900 e1=fac*fac*aa_aq(itypi,itypj)
18901 e2=fac*bb_aq(itypi,itypj)
18902 eij=eps1*eps2rt*eps3rt*(e1+e2)
18905 eij=eij*eps2rt*eps3rt
18908 e1=e1*eps1*eps2rt**2*eps3rt**2
18909 ed=-expon*(e1+eij)/ljd
18911 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
18912 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
18913 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
18914 -2.0D0*alf12*eps3der+sigder*sigsq_om12
18915 else if (rij.lt.ssxm) then
18918 eij=ssA*ssd*ssd+ssB*ssd+ssC
18920 ed=2*akcm*ssd+akct*deltat12
18922 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
18923 eom1=-2*akth*deltat1-pom1-om2*pom2
18924 eom2= 2*akth*deltat2+pom1-om1*pom2
18927 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
18929 d_ssxm(1)=0.5D0*akct/ssA
18930 d_ssxm(2)=-d_ssxm(1)
18933 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
18934 d_ljxm(2)=d_ljxm(1)*sigsq_om2
18935 d_ljxm(3)=d_ljxm(1)*sigsq_om12
18936 d_ljxm(1)=d_ljxm(1)*sigsq_om1
18938 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
18939 xm=0.5d0*(ssxm+ljxm)
18941 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
18943 if (rij.lt.xm) then
18945 ssm=ssC-0.25D0*ssB*ssB/ssA
18946 d_ssm(1)=0.5D0*akct*ssB/ssA
18947 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
18948 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
18950 f1=(rij-xm)/(ssxm-xm)
18951 f2=(rij-ssxm)/(xm-ssxm)
18955 delta_inv=1.0d0/(xm-ssxm)
18956 deltasq_inv=delta_inv*delta_inv
18958 fac1=deltasq_inv*fac*(xm-rij)
18959 fac2=deltasq_inv*fac*(rij-ssxm)
18960 ed=delta_inv*(Ht*hd2-ssm*hd1)
18961 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
18962 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
18963 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
18966 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
18967 d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
18968 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
18969 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
18971 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
18972 f1=(rij-ljxm)/(xm-ljxm)
18973 f2=(rij-xm)/(ljxm-xm)
18977 delta_inv=1.0d0/(ljxm-xm)
18978 deltasq_inv=delta_inv*delta_inv
18980 fac1=deltasq_inv*fac*(ljxm-rij)
18981 fac2=deltasq_inv*fac*(rij-xm)
18982 ed=delta_inv*(ljm*hd2-Ht*hd1)
18983 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
18984 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
18985 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
18987 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
18989 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
18995 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
18996 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
18997 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
18999 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
19000 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
19001 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
19002 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
19003 !$$$ d_ssm(3)=omega
19005 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
19007 !$$$ d_ljm(k)=ljm*d_ljB(k)
19011 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
19012 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
19013 !$$$ d_ss(2)=akct*ssd
19014 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
19015 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
19018 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
19019 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
19020 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
19022 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
19023 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
19025 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
19027 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
19028 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
19029 !$$$ h1=h_base(f1,hd1)
19030 !$$$ h2=h_base(f2,hd2)
19031 !$$$ eij=ss*h1+ljf*h2
19032 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
19033 !$$$ deltasq_inv=delta_inv*delta_inv
19034 !$$$ fac=ljf*hd2-ss*hd1
19035 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
19036 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
19037 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
19038 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
19039 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
19040 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
19041 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
19043 !$$$ havebond=.false.
19044 !$$$ if (ed.gt.0.0d0) havebond=.true.
19045 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
19052 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
19053 ! write(iout,'(a15,f12.2,f8.1,2i5)')
19054 ! & "SSBOND_E_FORM",totT,t_bath,i,j
19058 dyn_ssbond_ij(i,j)=eij
19059 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
19060 dyn_ssbond_ij(i,j)=1.0d300
19063 ! write(iout,'(a15,f12.2,f8.1,2i5)')
19064 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
19069 !-------TESTING CODE
19070 !el if (checkstop) then
19071 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
19072 "CHECKSTOP",rij,eij,ed
19076 if (checkstop) then
19077 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
19080 if (checkstop) then
19084 !-------END TESTING CODE
19087 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
19088 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
19091 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
19094 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
19095 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
19096 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
19097 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
19098 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
19099 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
19103 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
19108 gvdwc(l,i)=gvdwc(l,i)-gg(l)
19109 gvdwc(l,j)=gvdwc(l,j)+gg(l)
19113 end subroutine dyn_ssbond_ene
19114 !--------------------------------------------------------------------------
19115 subroutine triple_ssbond_ene(resi,resj,resk,eij)
19120 ! include 'DIMENSIONS'
19121 ! include 'COMMON.SBRIDGE'
19122 ! include 'COMMON.CHAIN'
19123 ! include 'COMMON.DERIV'
19124 ! include 'COMMON.LOCAL'
19125 ! include 'COMMON.INTERACT'
19126 ! include 'COMMON.VAR'
19127 ! include 'COMMON.IOUNITS'
19128 ! include 'COMMON.CALC'
19132 ! include 'COMMON.MD'
19133 ! use MD, only: totT,t_bath
19136 double precision h_base
19140 integer resi,resj,resk,m,itypi,itypj,itypk
19142 !c Output arguments
19143 double precision eij,eij1,eij2,eij3
19147 !c integer itypi,itypj,k,l
19148 double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi
19149 double precision rrik,rrjk,rik,rjk,xi,xk,yi,yk,zi,zk,xij,yij,zij
19150 double precision xik,yik,zik,xjk,yjk,zjk,dxk,dyk,dzk
19151 double precision sig0ij,ljd,sig,fac,e1,e2
19152 double precision dcosom1(3),dcosom2(3),ed
19153 double precision pom1,pom2
19154 double precision ljA,ljB,ljXs
19155 double precision d_ljB(1:3)
19156 double precision ssA,ssB,ssC,ssXs
19157 double precision ssxm,ljxm,ssm,ljm
19158 double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3)
19160 if (dtriss.eq.0) return
19164 !C write(iout,*) resi,resj,resk
19166 dxi=dc_norm(1,nres+i)
19167 dyi=dc_norm(2,nres+i)
19168 dzi=dc_norm(3,nres+i)
19169 dsci_inv=vbld_inv(i+nres)
19178 dxj=dc_norm(1,nres+j)
19179 dyj=dc_norm(2,nres+j)
19180 dzj=dc_norm(3,nres+j)
19181 dscj_inv=vbld_inv(j+nres)
19187 dxk=dc_norm(1,nres+k)
19188 dyk=dc_norm(2,nres+k)
19189 dzk=dc_norm(3,nres+k)
19190 dscj_inv=vbld_inv(k+nres)
19200 rrij=(xij*xij+yij*yij+zij*zij)
19201 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
19202 rrik=(xik*xik+yik*yik+zik*zik)
19204 rrjk=(xjk*xjk+yjk*yjk+zjk*zjk)
19206 !C there are three combination of distances for each trisulfide bonds
19207 !C The first case the ith atom is the center
19208 !C Energy function is E=d/(a*(x-y)**2+b*(x+y)**2+c) where x is first
19209 !C distance y is second distance the a,b,c,d are parameters derived for
19210 !C this problem d parameter was set as a penalty currenlty set to 1.
19211 if ((iabs(j-i).le.2).or.(iabs(i-k).le.2)) then
19214 eij1=dtriss/(atriss*(rij-rik)**2+btriss*(rij+rik)**6+ctriss)
19216 !C second case jth atom is center
19217 if ((iabs(j-i).le.2).or.(iabs(j-k).le.2)) then
19220 eij2=dtriss/(atriss*(rij-rjk)**2+btriss*(rij+rjk)**6+ctriss)
19222 !C the third case kth atom is the center
19223 if ((iabs(i-k).le.2).or.(iabs(j-k).le.2)) then
19226 eij3=dtriss/(atriss*(rik-rjk)**2+btriss*(rik+rjk)**6+ctriss)
19232 !C write(iout,*)i,j,k,eij
19233 !C The energy penalty calculated now time for the gradient part
19234 !C derivative over rij
19235 fac=-eij1**2/dtriss*(2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
19236 -eij2**2/dtriss*(2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)
19241 gvdwx(m,i)=gvdwx(m,i)-gg(m)
19242 gvdwx(m,j)=gvdwx(m,j)+gg(m)
19246 gvdwc(l,i)=gvdwc(l,i)-gg(l)
19247 gvdwc(l,j)=gvdwc(l,j)+gg(l)
19249 !C now derivative over rik
19250 fac=-eij1**2/dtriss* &
19251 (-2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
19252 -eij3**2/dtriss*(2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
19257 gvdwx(m,i)=gvdwx(m,i)-gg(m)
19258 gvdwx(m,k)=gvdwx(m,k)+gg(m)
19261 gvdwc(l,i)=gvdwc(l,i)-gg(l)
19262 gvdwc(l,k)=gvdwc(l,k)+gg(l)
19264 !C now derivative over rjk
19265 fac=-eij2**2/dtriss* &
19266 (-2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)- &
19267 eij3**2/dtriss*(-2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
19272 gvdwx(m,j)=gvdwx(m,j)-gg(m)
19273 gvdwx(m,k)=gvdwx(m,k)+gg(m)
19276 gvdwc(l,j)=gvdwc(l,j)-gg(l)
19277 gvdwc(l,k)=gvdwc(l,k)+gg(l)
19280 end subroutine triple_ssbond_ene
19284 !-----------------------------------------------------------------------------
19285 real(kind=8) function h_base(x,deriv)
19286 ! A smooth function going 0->1 in range [0,1]
19287 ! It should NOT be called outside range [0,1], it will not work there.
19294 real(kind=8) :: deriv
19297 real(kind=8) :: xsq
19300 ! Two parabolas put together. First derivative zero at extrema
19301 !$$$ if (x.lt.0.5D0) then
19302 !$$$ h_base=2.0D0*x*x
19306 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
19307 !$$$ deriv=4.0D0*deriv
19310 ! Third degree polynomial. First derivative zero at extrema
19311 h_base=x*x*(3.0d0-2.0d0*x)
19312 deriv=6.0d0*x*(1.0d0-x)
19314 ! Fifth degree polynomial. First and second derivatives zero at extrema
19316 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
19318 !$$$ deriv=deriv*deriv
19319 !$$$ deriv=30.0d0*xsq*deriv
19322 end function h_base
19323 !-----------------------------------------------------------------------------
19324 subroutine dyn_set_nss
19325 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
19327 use MD_data, only: totT,t_bath
19329 ! include 'DIMENSIONS'
19333 ! include 'COMMON.SBRIDGE'
19334 ! include 'COMMON.CHAIN'
19335 ! include 'COMMON.IOUNITS'
19336 ! include 'COMMON.SETUP'
19337 ! include 'COMMON.MD'
19339 real(kind=8) :: emin
19340 integer :: i,j,imin,ierr
19341 integer :: diff,allnss,newnss
19342 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
19345 integer,dimension(0:nfgtasks) :: i_newnss
19346 integer,dimension(0:nfgtasks) :: displ
19347 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
19348 integer :: g_newnss
19353 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
19362 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
19366 if (allflag(i).eq.0 .and. &
19367 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
19368 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
19372 if (emin.lt.1.0d300) then
19375 if (allflag(i).eq.0 .and. &
19376 (allihpb(i).eq.allihpb(imin) .or. &
19377 alljhpb(i).eq.allihpb(imin) .or. &
19378 allihpb(i).eq.alljhpb(imin) .or. &
19379 alljhpb(i).eq.alljhpb(imin))) then
19386 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
19390 if (allflag(i).eq.1) then
19392 newihpb(newnss)=allihpb(i)
19393 newjhpb(newnss)=alljhpb(i)
19398 if (nfgtasks.gt.1)then
19400 call MPI_Reduce(newnss,g_newnss,1,&
19401 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
19402 call MPI_Gather(newnss,1,MPI_INTEGER,&
19403 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
19405 do i=1,nfgtasks-1,1
19406 displ(i)=i_newnss(i-1)+displ(i-1)
19408 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
19409 g_newihpb,i_newnss,displ,MPI_INTEGER,&
19411 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
19412 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
19414 if(fg_rank.eq.0) then
19415 ! print *,'g_newnss',g_newnss
19416 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
19417 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
19420 newihpb(i)=g_newihpb(i)
19421 newjhpb(i)=g_newjhpb(i)
19429 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
19430 ! print *,newnss,nss,maxdim
19436 if (idssb(i).eq.newihpb(j) .and. &
19437 jdssb(i).eq.newjhpb(j)) found=.true.
19441 ! write(iout,*) "found",found,i,j
19442 if (.not.found.and.fg_rank.eq.0) &
19443 write(iout,'(a15,f12.2,f8.1,2i5)') &
19444 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
19453 if (newihpb(i).eq.idssb(j) .and. &
19454 newjhpb(i).eq.jdssb(j)) found=.true.
19458 ! write(iout,*) "found",found,i,j
19459 if (.not.found.and.fg_rank.eq.0) &
19460 write(iout,'(a15,f12.2,f8.1,2i5)') &
19461 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
19468 idssb(i)=newihpb(i)
19469 jdssb(i)=newjhpb(i)
19473 end subroutine dyn_set_nss
19474 ! Lipid transfer energy function
19475 subroutine Eliptransfer(eliptran)
19476 !C this is done by Adasko
19477 !C print *,"wchodze"
19478 !C structure of box:
19480 !C--bordliptop-- buffore starts
19481 !C--bufliptop--- here true lipid starts
19483 !C--buflipbot--- lipid ends buffore starts
19484 !C--bordlipbot--buffore ends
19485 real(kind=8) :: fracinbuf,eliptran,sslip,positi,ssgradlip
19488 ! print *, "I am in eliptran"
19489 do i=ilip_start,ilip_end
19491 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))&
19494 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
19495 if (positi.le.0.0) positi=positi+boxzsize
19497 !C first for peptide groups
19498 !c for each residue check if it is in lipid or lipid water border area
19499 if ((positi.gt.bordlipbot) &
19500 .and.(positi.lt.bordliptop)) then
19501 !C the energy transfer exist
19502 if (positi.lt.buflipbot) then
19503 !C what fraction I am in
19505 ((positi-bordlipbot)/lipbufthick)
19506 !C lipbufthick is thickenes of lipid buffore
19507 sslip=sscalelip(fracinbuf)
19508 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
19509 eliptran=eliptran+sslip*pepliptran
19510 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
19511 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
19512 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
19514 !C print *,"doing sccale for lower part"
19515 !C print *,i,sslip,fracinbuf,ssgradlip
19516 elseif (positi.gt.bufliptop) then
19517 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
19518 sslip=sscalelip(fracinbuf)
19519 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
19520 eliptran=eliptran+sslip*pepliptran
19521 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
19522 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
19523 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
19524 !C print *, "doing sscalefor top part"
19525 !C print *,i,sslip,fracinbuf,ssgradlip
19527 eliptran=eliptran+pepliptran
19528 !C print *,"I am in true lipid"
19531 !C eliptran=elpitran+0.0 ! I am in water
19533 if (energy_dec) write(iout,*) i,"eliptran=",eliptran,positi,sslip
19535 ! here starts the side chain transfer
19536 do i=ilip_start,ilip_end
19537 if (itype(i,1).eq.ntyp1) cycle
19538 positi=(mod(c(3,i+nres),boxzsize))
19539 if (positi.le.0) positi=positi+boxzsize
19540 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
19541 !c for each residue check if it is in lipid or lipid water border area
19542 !C respos=mod(c(3,i+nres),boxzsize)
19543 !C print *,positi,bordlipbot,buflipbot
19544 if ((positi.gt.bordlipbot) &
19545 .and.(positi.lt.bordliptop)) then
19546 !C the energy transfer exist
19547 if (positi.lt.buflipbot) then
19549 ((positi-bordlipbot)/lipbufthick)
19550 !C lipbufthick is thickenes of lipid buffore
19551 sslip=sscalelip(fracinbuf)
19552 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
19553 eliptran=eliptran+sslip*liptranene(itype(i,1))
19554 gliptranx(3,i)=gliptranx(3,i) &
19555 +ssgradlip*liptranene(itype(i,1))
19556 gliptranc(3,i-1)= gliptranc(3,i-1) &
19557 +ssgradlip*liptranene(itype(i,1))
19558 !C print *,"doing sccale for lower part"
19559 elseif (positi.gt.bufliptop) then
19561 ((bordliptop-positi)/lipbufthick)
19562 sslip=sscalelip(fracinbuf)
19563 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
19564 eliptran=eliptran+sslip*liptranene(itype(i,1))
19565 gliptranx(3,i)=gliptranx(3,i) &
19566 +ssgradlip*liptranene(itype(i,1))
19567 gliptranc(3,i-1)= gliptranc(3,i-1) &
19568 +ssgradlip*liptranene(itype(i,1))
19569 !C print *, "doing sscalefor top part",sslip,fracinbuf
19571 eliptran=eliptran+liptranene(itype(i,1))
19572 !C print *,"I am in true lipid"
19574 endif ! if in lipid or buffor
19576 !C eliptran=elpitran+0.0 ! I am in water
19577 if (energy_dec) write(iout,*) i,"eliptran=",eliptran
19580 end subroutine Eliptransfer
19581 !----------------------------------NANO FUNCTIONS
19582 !C-----------------------------------------------------------------------
19583 !C-----------------------------------------------------------
19584 !C This subroutine is to mimic the histone like structure but as well can be
19585 !C utilizet to nanostructures (infinit) small modification has to be used to
19586 !C make it finite (z gradient at the ends has to be changes as well as the x,y
19587 !C gradient has to be modified at the ends
19588 !C The energy function is Kihara potential
19589 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
19590 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
19591 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
19592 !C simple Kihara potential
19593 subroutine calctube(Etube)
19594 real(kind=8),dimension(3) :: vectube
19595 real(kind=8) :: Etube,xtemp,xminact,yminact,&
19596 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi, &
19597 sc_aa_tube,sc_bb_tube
19600 do i=itube_start,itube_end
19602 enetube(i+nres)=0.0d0
19604 !C first we calculate the distance from tube center
19606 do i=itube_start,itube_end
19607 !C lets ommit dummy atoms for now
19608 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
19609 !C now calculate distance from center of tube and direction vectors
19612 ! Find minimum distance in periodic box
19614 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19615 vectube(1)=vectube(1)+boxxsize*j
19616 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19617 vectube(2)=vectube(2)+boxysize*j
19618 xminact=abs(vectube(1)-tubecenter(1))
19619 yminact=abs(vectube(2)-tubecenter(2))
19620 if (xmin.gt.xminact) then
19624 if (ymin.gt.yminact) then
19631 vectube(1)=vectube(1)-tubecenter(1)
19632 vectube(2)=vectube(2)-tubecenter(2)
19634 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
19635 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
19637 !C as the tube is infinity we do not calculate the Z-vector use of Z
19640 !C now calculte the distance
19641 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19642 !C now normalize vector
19643 vectube(1)=vectube(1)/tub_r
19644 vectube(2)=vectube(2)/tub_r
19645 !C calculte rdiffrence between r and r0
19648 rdiff6=rdiff**6.0d0
19649 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19650 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
19651 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
19652 !C print *,rdiff,rdiff6,pep_aa_tube
19653 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19654 !C now we calculate gradient
19655 fac=(-12.0d0*pep_aa_tube/rdiff6- &
19656 6.0d0*pep_bb_tube)/rdiff6/rdiff
19657 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
19659 !C now direction of gg_tube vector
19661 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
19662 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
19665 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
19666 !C print *,gg_tube(1,0),"TU"
19669 do i=itube_start,itube_end
19670 !C Lets not jump over memory as we use many times iti
19672 !C lets ommit dummy atoms for now
19673 if ((iti.eq.ntyp1) &
19674 !C in UNRES uncomment the line below as GLY has no side-chain...
19680 vectube(1)=mod((c(1,i+nres)),boxxsize)
19681 vectube(1)=vectube(1)+boxxsize*j
19682 vectube(2)=mod((c(2,i+nres)),boxysize)
19683 vectube(2)=vectube(2)+boxysize*j
19685 xminact=abs(vectube(1)-tubecenter(1))
19686 yminact=abs(vectube(2)-tubecenter(2))
19687 if (xmin.gt.xminact) then
19691 if (ymin.gt.yminact) then
19698 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
19700 vectube(1)=vectube(1)-tubecenter(1)
19701 vectube(2)=vectube(2)-tubecenter(2)
19703 !C as the tube is infinity we do not calculate the Z-vector use of Z
19706 !C now calculte the distance
19707 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19708 !C now normalize vector
19709 vectube(1)=vectube(1)/tub_r
19710 vectube(2)=vectube(2)/tub_r
19712 !C calculte rdiffrence between r and r0
19715 rdiff6=rdiff**6.0d0
19716 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19717 sc_aa_tube=sc_aa_tube_par(iti)
19718 sc_bb_tube=sc_bb_tube_par(iti)
19719 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19720 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
19721 6.0d0*sc_bb_tube/rdiff6/rdiff
19722 !C now direction of gg_tube vector
19724 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19725 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19728 do i=itube_start,itube_end
19729 Etube=Etube+enetube(i)+enetube(i+nres)
19731 !C print *,"ETUBE", etube
19733 end subroutine calctube
19734 !C TO DO 1) add to total energy
19735 !C 2) add to gradient summation
19736 !C 3) add reading parameters (AND of course oppening of PARAM file)
19737 !C 4) add reading the center of tube
19739 !C 6) add to zerograd
19740 !C 7) allocate matrices
19743 !C-----------------------------------------------------------------------
19744 !C-----------------------------------------------------------
19745 !C This subroutine is to mimic the histone like structure but as well can be
19746 !C utilizet to nanostructures (infinit) small modification has to be used to
19747 !C make it finite (z gradient at the ends has to be changes as well as the x,y
19748 !C gradient has to be modified at the ends
19749 !C The energy function is Kihara potential
19750 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
19751 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
19752 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
19753 !C simple Kihara potential
19754 subroutine calctube2(Etube)
19755 real(kind=8),dimension(3) :: vectube
19756 real(kind=8) :: Etube,xtemp,xminact,yminact,&
19757 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi,fracinbuf,&
19758 sstube,ssgradtube,sc_aa_tube,sc_bb_tube
19761 do i=itube_start,itube_end
19763 enetube(i+nres)=0.0d0
19765 !C first we calculate the distance from tube center
19766 !C first sugare-phosphate group for NARES this would be peptide group
19768 do i=itube_start,itube_end
19769 !C lets ommit dummy atoms for now
19771 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
19772 !C now calculate distance from center of tube and direction vectors
19773 !C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19774 !C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
19775 !C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19776 !C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
19780 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19781 vectube(1)=vectube(1)+boxxsize*j
19782 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19783 vectube(2)=vectube(2)+boxysize*j
19785 xminact=abs(vectube(1)-tubecenter(1))
19786 yminact=abs(vectube(2)-tubecenter(2))
19787 if (xmin.gt.xminact) then
19791 if (ymin.gt.yminact) then
19798 vectube(1)=vectube(1)-tubecenter(1)
19799 vectube(2)=vectube(2)-tubecenter(2)
19801 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
19802 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
19804 !C as the tube is infinity we do not calculate the Z-vector use of Z
19807 !C now calculte the distance
19808 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19809 !C now normalize vector
19810 vectube(1)=vectube(1)/tub_r
19811 vectube(2)=vectube(2)/tub_r
19812 !C calculte rdiffrence between r and r0
19815 rdiff6=rdiff**6.0d0
19816 !C THIS FRAGMENT MAKES TUBE FINITE
19817 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
19818 if (positi.le.0) positi=positi+boxzsize
19819 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
19820 !c for each residue check if it is in lipid or lipid water border area
19821 !C respos=mod(c(3,i+nres),boxzsize)
19822 !C print *,positi,bordtubebot,buftubebot,bordtubetop
19823 if ((positi.gt.bordtubebot) &
19824 .and.(positi.lt.bordtubetop)) then
19825 !C the energy transfer exist
19826 if (positi.lt.buftubebot) then
19828 ((positi-bordtubebot)/tubebufthick)
19829 !C lipbufthick is thickenes of lipid buffore
19830 sstube=sscalelip(fracinbuf)
19831 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
19832 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
19833 enetube(i)=enetube(i)+sstube*tubetranenepep
19834 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19835 !C &+ssgradtube*tubetranene(itype(i,1))
19836 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19837 !C &+ssgradtube*tubetranene(itype(i,1))
19838 !C print *,"doing sccale for lower part"
19839 elseif (positi.gt.buftubetop) then
19841 ((bordtubetop-positi)/tubebufthick)
19842 sstube=sscalelip(fracinbuf)
19843 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
19844 enetube(i)=enetube(i)+sstube*tubetranenepep
19845 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19846 !C &+ssgradtube*tubetranene(itype(i,1))
19847 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19848 !C &+ssgradtube*tubetranene(itype(i,1))
19849 !C print *, "doing sscalefor top part",sslip,fracinbuf
19853 enetube(i)=enetube(i)+sstube*tubetranenepep
19854 !C print *,"I am in true lipid"
19858 !C ssgradtube=0.0d0
19860 endif ! if in lipid or buffor
19862 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19863 enetube(i)=enetube(i)+sstube* &
19864 (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
19865 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
19866 !C print *,rdiff,rdiff6,pep_aa_tube
19867 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19868 !C now we calculate gradient
19869 fac=(-12.0d0*pep_aa_tube/rdiff6- &
19870 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
19871 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
19874 !C now direction of gg_tube vector
19876 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
19877 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
19879 gg_tube(3,i)=gg_tube(3,i) &
19880 +ssgradtube*enetube(i)/sstube/2.0d0
19881 gg_tube(3,i-1)= gg_tube(3,i-1) &
19882 +ssgradtube*enetube(i)/sstube/2.0d0
19885 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
19886 !C print *,gg_tube(1,0),"TU"
19887 do i=itube_start,itube_end
19888 !C Lets not jump over memory as we use many times iti
19890 !C lets ommit dummy atoms for now
19891 if ((iti.eq.ntyp1) &
19892 !!C in UNRES uncomment the line below as GLY has no side-chain...
19895 vectube(1)=c(1,i+nres)
19896 vectube(1)=mod(vectube(1),boxxsize)
19897 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
19898 vectube(2)=c(2,i+nres)
19899 vectube(2)=mod(vectube(2),boxysize)
19900 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
19902 vectube(1)=vectube(1)-tubecenter(1)
19903 vectube(2)=vectube(2)-tubecenter(2)
19904 !C THIS FRAGMENT MAKES TUBE FINITE
19905 positi=(mod(c(3,i+nres),boxzsize))
19906 if (positi.le.0) positi=positi+boxzsize
19907 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
19908 !c for each residue check if it is in lipid or lipid water border area
19909 !C respos=mod(c(3,i+nres),boxzsize)
19910 !C print *,positi,bordtubebot,buftubebot,bordtubetop
19912 if ((positi.gt.bordtubebot) &
19913 .and.(positi.lt.bordtubetop)) then
19914 !C the energy transfer exist
19915 if (positi.lt.buftubebot) then
19917 ((positi-bordtubebot)/tubebufthick)
19918 !C lipbufthick is thickenes of lipid buffore
19919 sstube=sscalelip(fracinbuf)
19920 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
19921 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
19922 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19923 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19924 !C &+ssgradtube*tubetranene(itype(i,1))
19925 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19926 !C &+ssgradtube*tubetranene(itype(i,1))
19927 !C print *,"doing sccale for lower part"
19928 elseif (positi.gt.buftubetop) then
19930 ((bordtubetop-positi)/tubebufthick)
19932 sstube=sscalelip(fracinbuf)
19933 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
19934 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19935 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19936 !C &+ssgradtube*tubetranene(itype(i,1))
19937 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19938 !C &+ssgradtube*tubetranene(itype(i,1))
19939 !C print *, "doing sscalefor top part",sslip,fracinbuf
19943 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19944 !C print *,"I am in true lipid"
19948 !C ssgradtube=0.0d0
19950 endif ! if in lipid or buffor
19951 !CEND OF FINITE FRAGMENT
19952 !C as the tube is infinity we do not calculate the Z-vector use of Z
19955 !C now calculte the distance
19956 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19957 !C now normalize vector
19958 vectube(1)=vectube(1)/tub_r
19959 vectube(2)=vectube(2)/tub_r
19960 !C calculte rdiffrence between r and r0
19963 rdiff6=rdiff**6.0d0
19964 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19965 sc_aa_tube=sc_aa_tube_par(iti)
19966 sc_bb_tube=sc_bb_tube_par(iti)
19967 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)&
19968 *sstube+enetube(i+nres)
19969 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19970 !C now we calculate gradient
19971 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-&
19972 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
19973 !C now direction of gg_tube vector
19975 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19976 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19978 gg_tube_SC(3,i)=gg_tube_SC(3,i) &
19979 +ssgradtube*enetube(i+nres)/sstube
19980 gg_tube(3,i-1)= gg_tube(3,i-1) &
19981 +ssgradtube*enetube(i+nres)/sstube
19984 do i=itube_start,itube_end
19985 Etube=Etube+enetube(i)+enetube(i+nres)
19987 !C print *,"ETUBE", etube
19989 end subroutine calctube2
19990 !=====================================================================================================================================
19991 subroutine calcnano(Etube)
19992 real(kind=8),dimension(3) :: vectube
19994 real(kind=8) :: Etube,xtemp,xminact,yminact,&
19995 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,denominator,faccav,&
19996 sc_aa_tube,sc_bb_tube,zmin,ztemp,zminact
19997 integer:: i,j,iti,r
20000 ! print *,itube_start,itube_end,"poczatek"
20001 do i=itube_start,itube_end
20003 enetube(i+nres)=0.0d0
20005 !C first we calculate the distance from tube center
20006 !C first sugare-phosphate group for NARES this would be peptide group
20008 do i=itube_start,itube_end
20009 !C lets ommit dummy atoms for now
20010 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
20011 !C now calculate distance from center of tube and direction vectors
20017 vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
20018 vectube(1)=vectube(1)+boxxsize*j
20019 vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
20020 vectube(2)=vectube(2)+boxysize*j
20021 vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
20022 vectube(3)=vectube(3)+boxzsize*j
20025 xminact=dabs(vectube(1)-tubecenter(1))
20026 yminact=dabs(vectube(2)-tubecenter(2))
20027 zminact=dabs(vectube(3)-tubecenter(3))
20029 if (xmin.gt.xminact) then
20033 if (ymin.gt.yminact) then
20037 if (zmin.gt.zminact) then
20046 vectube(1)=vectube(1)-tubecenter(1)
20047 vectube(2)=vectube(2)-tubecenter(2)
20048 vectube(3)=vectube(3)-tubecenter(3)
20050 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
20051 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
20052 !C as the tube is infinity we do not calculate the Z-vector use of Z
20054 !C vectube(3)=0.0d0
20055 !C now calculte the distance
20056 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
20057 !C now normalize vector
20058 vectube(1)=vectube(1)/tub_r
20059 vectube(2)=vectube(2)/tub_r
20060 vectube(3)=vectube(3)/tub_r
20061 !C calculte rdiffrence between r and r0
20064 rdiff6=rdiff**6.0d0
20065 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
20066 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
20067 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
20068 !C print *,rdiff,rdiff6,pep_aa_tube
20069 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
20070 !C now we calculate gradient
20071 fac=(-12.0d0*pep_aa_tube/rdiff6- &
20072 6.0d0*pep_bb_tube)/rdiff6/rdiff
20073 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
20075 if (acavtubpep.eq.0.0d0) then
20080 denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
20082 (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
20085 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
20086 *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
20087 +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
20088 /denominator**2.0d0
20093 if (energy_dec) write(iout,*),i,rdiff,enetube(i),enecavtube(i)
20095 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
20096 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
20100 do i=itube_start,itube_end
20101 enecavtube(i)=0.0d0
20102 !C Lets not jump over memory as we use many times iti
20104 !C lets ommit dummy atoms for now
20105 if ((iti.eq.ntyp1) &
20106 !C in UNRES uncomment the line below as GLY has no side-chain...
20113 vectube(1)=dmod((c(1,i+nres)),boxxsize)
20114 vectube(1)=vectube(1)+boxxsize*j
20115 vectube(2)=dmod((c(2,i+nres)),boxysize)
20116 vectube(2)=vectube(2)+boxysize*j
20117 vectube(3)=dmod((c(3,i+nres)),boxzsize)
20118 vectube(3)=vectube(3)+boxzsize*j
20121 xminact=dabs(vectube(1)-tubecenter(1))
20122 yminact=dabs(vectube(2)-tubecenter(2))
20123 zminact=dabs(vectube(3)-tubecenter(3))
20125 if (xmin.gt.xminact) then
20129 if (ymin.gt.yminact) then
20133 if (zmin.gt.zminact) then
20142 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
20144 vectube(1)=vectube(1)-tubecenter(1)
20145 vectube(2)=vectube(2)-tubecenter(2)
20146 vectube(3)=vectube(3)-tubecenter(3)
20147 !C now calculte the distance
20148 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
20149 !C now normalize vector
20150 vectube(1)=vectube(1)/tub_r
20151 vectube(2)=vectube(2)/tub_r
20152 vectube(3)=vectube(3)/tub_r
20154 !C calculte rdiffrence between r and r0
20157 rdiff6=rdiff**6.0d0
20158 sc_aa_tube=sc_aa_tube_par(iti)
20159 sc_bb_tube=sc_bb_tube_par(iti)
20160 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
20161 !C enetube(i+nres)=0.0d0
20162 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
20163 !C now we calculate gradient
20164 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
20165 6.0d0*sc_bb_tube/rdiff6/rdiff
20167 !C now direction of gg_tube vector
20168 !C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
20169 if (acavtub(iti).eq.0.0d0) then
20171 enecavtube(i+nres)=0.0d0
20174 denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
20175 enecavtube(i+nres)= &
20176 (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
20178 !C enecavtube(i)=0.0
20179 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
20180 *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
20181 +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
20182 /denominator**2.0d0
20187 !C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
20188 !C & enecavtube(i),faccav
20189 !C print *,"licz=",
20190 !C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
20191 !C print *,"finene=",enetube(i+nres)+enecavtube(i)
20193 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
20194 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
20196 if (energy_dec) write(iout,*),i,rdiff,enetube(i+nres),enecavtube(i+nres)
20201 do i=itube_start,itube_end
20202 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) &
20203 +enecavtube(i+nres)
20206 ! print *,"begin", i,"a"
20209 ! rdiff6=rdiff**6.0d0
20210 ! sc_aa_tube=sc_aa_tube_par(i)
20211 ! sc_bb_tube=sc_bb_tube_par(i)
20212 ! enetube(i)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
20213 ! denominator=(1.0d0+dcavtub(i)*rdiff6*rdiff6)
20215 ! (bcavtub(i)*rdiff+acavtub(i)*dsqrt(rdiff)+ccavtub(i)) &
20218 ! print '(5(f10.3,1x))',rdiff,enetube(i),enecavtube(i),enecavtube(i)+enetube(i)
20220 ! print *,"end",i,"a"
20222 !C print *,"ETUBE", etube
20224 end subroutine calcnano
20226 !===============================================
20227 !--------------------------------------------------------------------------------
20228 !C first for shielding is setting of function of side-chains
20230 subroutine set_shield_fac2
20231 real(kind=8) :: div77_81=0.974996043d0, &
20232 div4_81=0.2222222222d0
20233 real (kind=8) :: dist_pep_side,dist_side_calf,dist_pept_group, &
20234 scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
20235 short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
20236 sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
20237 !C the vector between center of side_chain and peptide group
20238 real(kind=8),dimension(3) :: pep_side_long,side_calf, &
20239 pept_group,costhet_grad,cosphi_grad_long, &
20240 cosphi_grad_loc,pep_side_norm,side_calf_norm, &
20241 sh_frac_dist_grad,pep_side
20243 !C write(2,*) "ivec",ivec_start,ivec_end
20245 fac_shield(i)=0.0d0
20248 grad_shield(j,i)=0.0d0
20251 do i=ivec_start,ivec_end
20253 !C if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
20254 ! ishield_list(i)=0
20255 if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
20256 !Cif there two consequtive dummy atoms there is no peptide group between them
20257 !C the line below has to be changed for FGPROC>1
20260 if ((itype(k,1).eq.ntyp1).or.(itype(k,1).eq.10)) cycle
20264 !C first lets set vector conecting the ithe side-chain with kth side-chain
20265 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
20266 !C pep_side(j)=2.0d0
20267 !C and vector conecting the side-chain with its proper calfa
20268 side_calf(j)=c(j,k+nres)-c(j,k)
20269 !C side_calf(j)=2.0d0
20270 pept_group(j)=c(j,i)-c(j,i+1)
20271 !C lets have their lenght
20272 dist_pep_side=pep_side(j)**2+dist_pep_side
20273 dist_side_calf=dist_side_calf+side_calf(j)**2
20274 dist_pept_group=dist_pept_group+pept_group(j)**2
20276 dist_pep_side=sqrt(dist_pep_side)
20277 dist_pept_group=sqrt(dist_pept_group)
20278 dist_side_calf=sqrt(dist_side_calf)
20280 pep_side_norm(j)=pep_side(j)/dist_pep_side
20281 side_calf_norm(j)=dist_side_calf
20283 !C now sscale fraction
20284 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
20285 ! print *,buff_shield,"buff",sh_frac_dist
20287 if (sh_frac_dist.le.0.0) cycle
20288 !C print *,ishield_list(i),i
20289 !C If we reach here it means that this side chain reaches the shielding sphere
20290 !C Lets add him to the list for gradient
20291 ishield_list(i)=ishield_list(i)+1
20292 !C ishield_list is a list of non 0 side-chain that contribute to factor gradient
20293 !C this list is essential otherwise problem would be O3
20294 shield_list(ishield_list(i),i)=k
20295 !C Lets have the sscale value
20296 if (sh_frac_dist.gt.1.0) then
20297 scale_fac_dist=1.0d0
20299 sh_frac_dist_grad(j)=0.0d0
20302 scale_fac_dist=-sh_frac_dist*sh_frac_dist &
20303 *(2.0d0*sh_frac_dist-3.0d0)
20304 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
20305 /dist_pep_side/buff_shield*0.5d0
20307 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
20308 !C sh_frac_dist_grad(j)=0.0d0
20309 !C scale_fac_dist=1.0d0
20310 !C print *,"jestem",scale_fac_dist,fac_help_scale,
20311 !C & sh_frac_dist_grad(j)
20314 !C this is what is now we have the distance scaling now volume...
20315 short=short_r_sidechain(itype(k,1))
20316 long=long_r_sidechain(itype(k,1))
20317 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
20318 sinthet=short/dist_pep_side*costhet
20319 ! print *,"SORT",short,long,sinthet,costhet
20320 !C now costhet_grad
20323 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
20324 !C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
20325 !C & -short/dist_pep_side**2/costhet)
20326 !C costhet_fac=0.0d0
20328 costhet_grad(j)=costhet_fac*pep_side(j)
20330 !C remember for the final gradient multiply costhet_grad(j)
20331 !C for side_chain by factor -2 !
20332 !C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
20333 !C pep_side0pept_group is vector multiplication
20334 pep_side0pept_group=0.0d0
20336 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
20338 cosalfa=(pep_side0pept_group/ &
20339 (dist_pep_side*dist_side_calf))
20340 fac_alfa_sin=1.0d0-cosalfa**2
20341 fac_alfa_sin=dsqrt(fac_alfa_sin)
20342 rkprim=fac_alfa_sin*(long-short)+short
20345 !C now costhet_grad
20346 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
20348 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
20349 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ &
20353 cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
20354 +cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
20355 *(long-short)/fac_alfa_sin*cosalfa/ &
20356 ((dist_pep_side*dist_side_calf))* &
20357 ((side_calf(j))-cosalfa* &
20358 ((pep_side(j)/dist_pep_side)*dist_side_calf))
20359 !C cosphi_grad_long(j)=0.0d0
20360 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
20361 *(long-short)/fac_alfa_sin*cosalfa &
20362 /((dist_pep_side*dist_side_calf))* &
20364 cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
20365 !C cosphi_grad_loc(j)=0.0d0
20367 !C print *,sinphi,sinthet
20368 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) &
20371 !C now the gradient...
20373 grad_shield(j,i)=grad_shield(j,i) &
20374 !C gradient po skalowaniu
20375 +(sh_frac_dist_grad(j)*VofOverlap &
20376 !C gradient po costhet
20377 +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
20378 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
20379 sinphi/sinthet*costhet*costhet_grad(j) &
20380 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
20382 !C grad_shield_side is Cbeta sidechain gradient
20383 grad_shield_side(j,ishield_list(i),i)=&
20384 (sh_frac_dist_grad(j)*-2.0d0&
20386 -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
20387 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(&
20388 sinphi/sinthet*costhet*costhet_grad(j)&
20389 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
20391 ! print *, 1.0d0/(-dsqrt(1.0d0-sinphi*sinthet)),&
20393 ! +sinthet/sinphi,"HERE"
20394 grad_shield_loc(j,ishield_list(i),i)= &
20395 scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
20396 (1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(&
20397 sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
20400 ! print *,grad_shield_loc(j,ishield_list(i),i)
20402 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
20404 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
20406 ! write(2,*) "TOTAL VOLUME",i,itype(i,1),fac_shield(i)
20409 end subroutine set_shield_fac2
20410 !----------------------------------------------------------------------------
20411 ! SOUBROUTINE FOR AFM
20412 subroutine AFMvel(Eafmforce)
20413 use MD_data, only:totTafm
20414 real(kind=8),dimension(3) :: diffafm
20415 real(kind=8) :: afmdist,Eafmforce
20417 !C Only for check grad COMMENT if not used for checkgrad
20419 !C--------------------------------------------------------
20420 !C print *,"wchodze"
20424 diffafm(i)=c(i,afmend)-c(i,afmbeg)
20425 afmdist=afmdist+diffafm(i)**2
20427 afmdist=dsqrt(afmdist)
20429 Eafmforce=0.5d0*forceAFMconst &
20430 *(distafminit+totTafm*velAFMconst-afmdist)**2
20431 !C Eafmforce=-forceAFMconst*(dist-distafminit)
20433 gradafm(i,afmend-1)=-forceAFMconst* &
20434 (distafminit+totTafm*velAFMconst-afmdist) &
20435 *diffafm(i)/afmdist
20436 gradafm(i,afmbeg-1)=forceAFMconst* &
20437 (distafminit+totTafm*velAFMconst-afmdist) &
20438 *diffafm(i)/afmdist
20440 ! print *,'AFM',Eafmforce,totTafm*velAFMconst,afmdist
20442 end subroutine AFMvel
20443 !---------------------------------------------------------
20444 subroutine AFMforce(Eafmforce)
20446 real(kind=8),dimension(3) :: diffafm
20447 ! real(kind=8) ::afmdist
20448 real(kind=8) :: afmdist,Eafmforce
20453 diffafm(i)=c(i,afmend)-c(i,afmbeg)
20454 afmdist=afmdist+diffafm(i)**2
20456 afmdist=dsqrt(afmdist)
20457 ! print *,afmdist,distafminit
20458 Eafmforce=-forceAFMconst*(afmdist-distafminit)
20460 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/afmdist
20461 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/afmdist
20463 !C print *,'AFM',Eafmforce
20465 end subroutine AFMforce
20467 !-----------------------------------------------------------------------------
20469 subroutine read_ssHist
20472 ! include 'DIMENSIONS'
20473 ! include "DIMENSIONS.FREE"
20474 ! include 'COMMON.FREE'
20477 character(len=80) :: controlcard
20480 call card_concat(controlcard,.true.)
20481 read(controlcard,*) &
20482 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
20486 end subroutine read_ssHist
20488 !-----------------------------------------------------------------------------
20489 integer function indmat(i,j)
20491 ! get the position of the jth ijth fragment of the chain coordinate system
20492 ! in the fromto array.
20495 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
20497 end function indmat
20498 !-----------------------------------------------------------------------------
20499 real(kind=8) function sigm(x)
20505 !-----------------------------------------------------------------------------
20506 !-----------------------------------------------------------------------------
20507 subroutine alloc_ener_arrays
20508 !EL Allocation of arrays used by module energy
20509 use MD_data, only: mset
20510 !el local variables
20513 if(nres.lt.100) then
20515 elseif(nres.lt.200) then
20516 maxconts=10*nres ! Max. number of contacts per residue
20518 maxconts=10*nres ! (maxconts=maxres/4)
20520 maxcont=12*nres ! Max. number of SC contacts
20521 maxvar=6*nres ! Max. number of variables
20522 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
20523 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
20524 !----------------------
20525 ! arrays in subroutine init_int_table
20527 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
20528 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
20530 allocate(nint_gr(nres))
20531 allocate(nscp_gr(nres))
20532 allocate(ielstart(nres))
20533 allocate(ielend(nres))
20535 allocate(istart(nres,maxint_gr))
20536 allocate(iend(nres,maxint_gr))
20537 !(maxres,maxint_gr)
20538 allocate(iscpstart(nres,maxint_gr))
20539 allocate(iscpend(nres,maxint_gr))
20540 !(maxres,maxint_gr)
20541 allocate(ielstart_vdw(nres))
20542 allocate(ielend_vdw(nres))
20544 allocate(nint_gr_nucl(nres))
20545 allocate(nscp_gr_nucl(nres))
20546 allocate(ielstart_nucl(nres))
20547 allocate(ielend_nucl(nres))
20549 allocate(istart_nucl(nres,maxint_gr))
20550 allocate(iend_nucl(nres,maxint_gr))
20551 !(maxres,maxint_gr)
20552 allocate(iscpstart_nucl(nres,maxint_gr))
20553 allocate(iscpend_nucl(nres,maxint_gr))
20554 !(maxres,maxint_gr)
20555 allocate(ielstart_vdw_nucl(nres))
20556 allocate(ielend_vdw_nucl(nres))
20558 allocate(lentyp(0:nfgtasks-1))
20560 !----------------------
20562 ! common /contacts/
20563 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
20564 allocate(icont(2,maxcont))
20566 ! common /contacts1/
20567 allocate(num_cont(0:nres+4))
20569 allocate(jcont(maxconts,nres))
20571 allocate(facont(maxconts,nres))
20573 allocate(gacont(3,maxconts,nres))
20574 !(3,maxconts,maxres)
20575 ! common /contacts_hb/
20576 allocate(gacontp_hb1(3,maxconts,nres))
20577 allocate(gacontp_hb2(3,maxconts,nres))
20578 allocate(gacontp_hb3(3,maxconts,nres))
20579 allocate(gacontm_hb1(3,maxconts,nres))
20580 allocate(gacontm_hb2(3,maxconts,nres))
20581 allocate(gacontm_hb3(3,maxconts,nres))
20582 allocate(gacont_hbr(3,maxconts,nres))
20583 allocate(grij_hb_cont(3,maxconts,nres))
20584 !(3,maxconts,maxres)
20585 allocate(facont_hb(maxconts,nres))
20587 allocate(ees0p(maxconts,nres))
20588 allocate(ees0m(maxconts,nres))
20589 allocate(d_cont(maxconts,nres))
20590 allocate(ees0plist(maxconts,nres))
20593 allocate(num_cont_hb(nres))
20595 allocate(jcont_hb(maxconts,nres))
20598 allocate(Ug(2,2,nres))
20599 allocate(Ugder(2,2,nres))
20600 allocate(Ug2(2,2,nres))
20601 allocate(Ug2der(2,2,nres))
20603 allocate(obrot(2,nres))
20604 allocate(obrot2(2,nres))
20605 allocate(obrot_der(2,nres))
20606 allocate(obrot2_der(2,nres))
20608 ! common /precomp1/
20609 allocate(mu(2,nres))
20610 allocate(muder(2,nres))
20611 allocate(Ub2(2,nres))
20614 allocate(Ub2der(2,nres))
20615 allocate(Ctobr(2,nres))
20616 allocate(Ctobrder(2,nres))
20617 allocate(Dtobr2(2,nres))
20618 allocate(Dtobr2der(2,nres))
20620 allocate(EUg(2,2,nres))
20621 allocate(EUgder(2,2,nres))
20622 allocate(CUg(2,2,nres))
20623 allocate(CUgder(2,2,nres))
20624 allocate(DUg(2,2,nres))
20625 allocate(Dugder(2,2,nres))
20626 allocate(DtUg2(2,2,nres))
20627 allocate(DtUg2der(2,2,nres))
20629 ! common /precomp2/
20630 allocate(Ug2Db1t(2,nres))
20631 allocate(Ug2Db1tder(2,nres))
20632 allocate(CUgb2(2,nres))
20633 allocate(CUgb2der(2,nres))
20635 allocate(EUgC(2,2,nres))
20636 allocate(EUgCder(2,2,nres))
20637 allocate(EUgD(2,2,nres))
20638 allocate(EUgDder(2,2,nres))
20639 allocate(DtUg2EUg(2,2,nres))
20640 allocate(Ug2DtEUg(2,2,nres))
20642 allocate(Ug2DtEUgder(2,2,2,nres))
20643 allocate(DtUg2EUgder(2,2,2,nres))
20645 allocate(b1(2,nres)) !(2,-maxtor:maxtor)
20646 allocate(b2(2,nres)) !(2,-maxtor:maxtor)
20647 allocate(b1tilde(2,nres)) !(2,-maxtor:maxtor)
20648 allocate(b2tilde(2,nres)) !(2,-maxtor:maxtor)
20650 allocate(ctilde(2,2,nres))
20651 allocate(dtilde(2,2,nres)) !(2,2,-maxtor:maxtor)
20652 allocate(gtb1(2,nres))
20653 allocate(gtb2(2,nres))
20654 allocate(cc(2,2,nres))
20655 allocate(dd(2,2,nres))
20656 allocate(ee(2,2,nres))
20657 allocate(gtcc(2,2,nres))
20658 allocate(gtdd(2,2,nres))
20659 allocate(gtee(2,2,nres))
20660 allocate(gUb2(2,nres))
20661 allocate(gteUg(2,2,nres))
20663 ! common /rotat_old/
20664 allocate(costab(nres))
20665 allocate(sintab(nres))
20666 allocate(costab2(nres))
20667 allocate(sintab2(nres))
20670 allocate(a_chuj(2,2,maxconts,nres))
20671 !(2,2,maxconts,maxres)(maxconts=maxres/4)
20672 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
20673 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
20674 ! common /contdistrib/
20675 allocate(ncont_sent(nres))
20676 allocate(ncont_recv(nres))
20678 allocate(iat_sent(nres))
20680 allocate(iint_sent(4,nres,nres))
20681 allocate(iint_sent_local(4,nres,nres))
20683 allocate(iturn3_sent(4,0:nres+4))
20684 allocate(iturn4_sent(4,0:nres+4))
20685 allocate(iturn3_sent_local(4,nres))
20686 allocate(iturn4_sent_local(4,nres))
20688 allocate(itask_cont_from(0:nfgtasks-1))
20689 allocate(itask_cont_to(0:nfgtasks-1))
20690 !(0:max_fg_procs-1)
20694 !----------------------
20697 allocate(dcdv(6,maxdim))
20698 allocate(dxdv(6,maxdim))
20700 allocate(dxds(6,nres))
20702 allocate(gradx(3,-1:nres,0:2))
20703 allocate(gradc(3,-1:nres,0:2))
20705 allocate(gvdwx(3,-1:nres))
20706 allocate(gvdwc(3,-1:nres))
20707 allocate(gelc(3,-1:nres))
20708 allocate(gelc_long(3,-1:nres))
20709 allocate(gvdwpp(3,-1:nres))
20710 allocate(gvdwc_scpp(3,-1:nres))
20711 allocate(gradx_scp(3,-1:nres))
20712 allocate(gvdwc_scp(3,-1:nres))
20713 allocate(ghpbx(3,-1:nres))
20714 allocate(ghpbc(3,-1:nres))
20715 allocate(gradcorr(3,-1:nres))
20716 allocate(gradcorr_long(3,-1:nres))
20717 allocate(gradcorr5_long(3,-1:nres))
20718 allocate(gradcorr6_long(3,-1:nres))
20719 allocate(gcorr6_turn_long(3,-1:nres))
20720 allocate(gradxorr(3,-1:nres))
20721 allocate(gradcorr5(3,-1:nres))
20722 allocate(gradcorr6(3,-1:nres))
20723 allocate(gliptran(3,-1:nres))
20724 allocate(gliptranc(3,-1:nres))
20725 allocate(gliptranx(3,-1:nres))
20726 allocate(gshieldx(3,-1:nres))
20727 allocate(gshieldc(3,-1:nres))
20728 allocate(gshieldc_loc(3,-1:nres))
20729 allocate(gshieldx_ec(3,-1:nres))
20730 allocate(gshieldc_ec(3,-1:nres))
20731 allocate(gshieldc_loc_ec(3,-1:nres))
20732 allocate(gshieldx_t3(3,-1:nres))
20733 allocate(gshieldc_t3(3,-1:nres))
20734 allocate(gshieldc_loc_t3(3,-1:nres))
20735 allocate(gshieldx_t4(3,-1:nres))
20736 allocate(gshieldc_t4(3,-1:nres))
20737 allocate(gshieldc_loc_t4(3,-1:nres))
20738 allocate(gshieldx_ll(3,-1:nres))
20739 allocate(gshieldc_ll(3,-1:nres))
20740 allocate(gshieldc_loc_ll(3,-1:nres))
20741 allocate(grad_shield(3,-1:nres))
20742 allocate(gg_tube_sc(3,-1:nres))
20743 allocate(gg_tube(3,-1:nres))
20744 allocate(gradafm(3,-1:nres))
20745 allocate(gradb_nucl(3,-1:nres))
20746 allocate(gradbx_nucl(3,-1:nres))
20747 allocate(gvdwpsb1(3,-1:nres))
20748 allocate(gelpp(3,-1:nres))
20749 allocate(gvdwpsb(3,-1:nres))
20750 allocate(gelsbc(3,-1:nres))
20751 allocate(gelsbx(3,-1:nres))
20752 allocate(gvdwsbx(3,-1:nres))
20753 allocate(gvdwsbc(3,-1:nres))
20754 allocate(gsbloc(3,-1:nres))
20755 allocate(gsblocx(3,-1:nres))
20756 allocate(gradcorr_nucl(3,-1:nres))
20757 allocate(gradxorr_nucl(3,-1:nres))
20758 allocate(gradcorr3_nucl(3,-1:nres))
20759 allocate(gradxorr3_nucl(3,-1:nres))
20760 allocate(gvdwpp_nucl(3,-1:nres))
20761 allocate(gradpepcat(3,-1:nres))
20762 allocate(gradpepcatx(3,-1:nres))
20763 allocate(gradcatcat(3,-1:nres))
20765 allocate(grad_shield_side(3,maxcontsshi,-1:nres))
20766 allocate(grad_shield_loc(3,maxcontsshi,-1:nres))
20767 ! grad for shielding surroing
20768 allocate(gloc(0:maxvar,0:2))
20769 allocate(gloc_x(0:maxvar,2))
20771 allocate(gel_loc(3,-1:nres))
20772 allocate(gel_loc_long(3,-1:nres))
20773 allocate(gcorr3_turn(3,-1:nres))
20774 allocate(gcorr4_turn(3,-1:nres))
20775 allocate(gcorr6_turn(3,-1:nres))
20776 allocate(gradb(3,-1:nres))
20777 allocate(gradbx(3,-1:nres))
20779 allocate(gel_loc_loc(maxvar))
20780 allocate(gel_loc_turn3(maxvar))
20781 allocate(gel_loc_turn4(maxvar))
20782 allocate(gel_loc_turn6(maxvar))
20783 allocate(gcorr_loc(maxvar))
20784 allocate(g_corr5_loc(maxvar))
20785 allocate(g_corr6_loc(maxvar))
20787 allocate(gsccorc(3,-1:nres))
20788 allocate(gsccorx(3,-1:nres))
20790 allocate(gsccor_loc(-1:nres))
20792 allocate(gvdwx_scbase(3,-1:nres))
20793 allocate(gvdwc_scbase(3,-1:nres))
20794 allocate(gvdwx_pepbase(3,-1:nres))
20795 allocate(gvdwc_pepbase(3,-1:nres))
20796 allocate(gvdwx_scpho(3,-1:nres))
20797 allocate(gvdwc_scpho(3,-1:nres))
20798 allocate(gvdwc_peppho(3,-1:nres))
20800 allocate(dtheta(3,2,-1:nres))
20802 allocate(gscloc(3,-1:nres))
20803 allocate(gsclocx(3,-1:nres))
20805 allocate(dphi(3,3,-1:nres))
20806 allocate(dalpha(3,3,-1:nres))
20807 allocate(domega(3,3,-1:nres))
20809 ! common /deriv_scloc/
20810 allocate(dXX_C1tab(3,nres))
20811 allocate(dYY_C1tab(3,nres))
20812 allocate(dZZ_C1tab(3,nres))
20813 allocate(dXX_Ctab(3,nres))
20814 allocate(dYY_Ctab(3,nres))
20815 allocate(dZZ_Ctab(3,nres))
20816 allocate(dXX_XYZtab(3,nres))
20817 allocate(dYY_XYZtab(3,nres))
20818 allocate(dZZ_XYZtab(3,nres))
20821 allocate(jgrad_start(nres))
20822 allocate(jgrad_end(nres))
20824 !----------------------
20827 allocate(ibond_displ(0:nfgtasks-1))
20828 allocate(ibond_count(0:nfgtasks-1))
20829 allocate(ithet_displ(0:nfgtasks-1))
20830 allocate(ithet_count(0:nfgtasks-1))
20831 allocate(iphi_displ(0:nfgtasks-1))
20832 allocate(iphi_count(0:nfgtasks-1))
20833 allocate(iphi1_displ(0:nfgtasks-1))
20834 allocate(iphi1_count(0:nfgtasks-1))
20835 allocate(ivec_displ(0:nfgtasks-1))
20836 allocate(ivec_count(0:nfgtasks-1))
20837 allocate(iset_displ(0:nfgtasks-1))
20838 allocate(iset_count(0:nfgtasks-1))
20839 allocate(iint_count(0:nfgtasks-1))
20840 allocate(iint_displ(0:nfgtasks-1))
20841 !(0:max_fg_procs-1)
20842 !----------------------
20845 allocate(gcart(3,-1:nres))
20846 allocate(gxcart(3,-1:nres))
20848 allocate(gradcag(3,-1:nres))
20849 allocate(gradxag(3,-1:nres))
20851 ! common /back_constr/
20852 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
20853 allocate(dutheta(nres))
20854 allocate(dugamma(nres))
20856 allocate(duscdiff(3,nres))
20857 allocate(duscdiffx(3,nres))
20859 !el i io:read_fragments
20860 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
20861 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
20863 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
20864 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
20865 allocate(mset(0:nprocs)) !(maxprocs/20)
20867 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
20868 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
20869 allocate(dUdconst(3,0:nres))
20870 allocate(dUdxconst(3,0:nres))
20871 allocate(dqwol(3,0:nres))
20872 allocate(dxqwol(3,0:nres))
20874 !----------------------
20876 ! common /sbridge/ in io_common: read_bridge
20877 !el allocate((:),allocatable :: iss !(maxss)
20878 ! common /links/ in io_common: read_bridge
20879 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
20880 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
20881 ! common /dyn_ssbond/
20882 ! and side-chain vectors in theta or phi.
20883 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
20887 dyn_ssbond_ij(:,:)=1.0d300
20891 ! if (nss.gt.0) then
20892 allocate(idssb(maxdim),jdssb(maxdim))
20893 ! allocate(newihpb(nss),newjhpb(nss))
20896 allocate(ishield_list(-1:nres))
20897 allocate(shield_list(maxcontsshi,-1:nres))
20898 allocate(dyn_ss_mask(nres))
20899 allocate(fac_shield(-1:nres))
20900 allocate(enetube(nres*2))
20901 allocate(enecavtube(nres*2))
20904 dyn_ss_mask(:)=.false.
20905 !----------------------
20907 ! Parameters of the SCCOR term
20909 !el in io_conf: parmread
20910 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
20911 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
20912 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
20913 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
20914 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
20915 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
20916 ! allocate(vlor1sccor(maxterm_sccor,20,20))
20917 ! allocate(vlor2sccor(maxterm_sccor,20,20))
20918 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
20920 allocate(gloc_sc(3,0:2*nres,0:10))
20921 !(3,0:maxres2,10)maxres2=2*maxres
20922 allocate(dcostau(3,3,3,2*nres))
20923 allocate(dsintau(3,3,3,2*nres))
20924 allocate(dtauangle(3,3,3,2*nres))
20925 allocate(dcosomicron(3,3,3,2*nres))
20926 allocate(domicron(3,3,3,2*nres))
20927 !(3,3,3,maxres2)maxres2=2*maxres
20928 !----------------------
20931 allocate(varall(maxvar))
20932 !(maxvar)(maxvar=6*maxres)
20933 allocate(mask_theta(nres))
20934 allocate(mask_phi(nres))
20935 allocate(mask_side(nres))
20937 !----------------------
20940 allocate(uy(3,nres))
20941 allocate(uz(3,nres))
20943 allocate(uygrad(3,3,2,nres))
20944 allocate(uzgrad(3,3,2,nres))
20948 end subroutine alloc_ener_arrays
20949 !-----------------------------------------------------------------
20950 subroutine ebond_nucl(estr_nucl)
20952 !c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
20955 real(kind=8),dimension(3) :: u,ud
20956 real(kind=8) :: usum,uprod,uprod1,uprod2,usumsqder
20957 real(kind=8) :: estr_nucl,diff
20958 integer :: iti,i,j,k,nbi
20960 !C print *,"I enter ebond"
20962 write (iout,*) "ibondp_start,ibondp_end",&
20963 ibondp_nucl_start,ibondp_nucl_end
20964 do i=ibondp_nucl_start,ibondp_nucl_end
20965 if (itype(i-1,2).eq.ntyp1_molec(2) .or. &
20966 itype(i,2).eq.ntyp1_molec(2)) cycle
20967 ! estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
20969 ! gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
20970 ! & *dc(j,i-1)/vbld(i)
20972 ! if (energy_dec) write(iout,*)
20973 ! & "estr1",i,vbld(i),distchainmax,
20974 ! & gnmr1(vbld(i),-1.0d0,distchainmax)
20976 diff = vbld(i)-vbldp0_nucl
20977 if(energy_dec)write(iout,*) "estr_nucl_bb" , i,vbld(i),&
20978 vbldp0_nucl,diff,AKP_nucl*diff*diff
20979 estr_nucl=estr_nucl+diff*diff
20980 ! print *,estr_nucl
20982 gradb_nucl(j,i-1)=AKP_nucl*diff*dc(j,i-1)/vbld(i)
20984 !c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
20986 estr_nucl=0.5d0*AKP_nucl*estr_nucl
20987 ! print *,"partial sum", estr_nucl,AKP_nucl
20990 write (iout,*) "ibondp_start,ibondp_end",&
20991 ibond_nucl_start,ibond_nucl_end
20993 do i=ibond_nucl_start,ibond_nucl_end
20994 !C print *, "I am stuck",i
20996 if (iti.eq.ntyp1_molec(2)) cycle
20997 nbi=nbondterm_nucl(iti)
21000 diff=vbld(i+nres)-vbldsc0_nucl(1,iti)
21003 write (iout,*) "estr_nucl_sc", i,iti,vbld(i+nres),vbldsc0_nucl(1,iti),diff, &
21004 AKSC_nucl(1,iti),AKSC_nucl(1,iti)*diff*diff
21005 estr_nucl=estr_nucl+0.5d0*AKSC_nucl(1,iti)*diff*diff
21006 ! print *,estr_nucl
21008 gradbx_nucl(j,i)=AKSC_nucl(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
21012 diff=vbld(i+nres)-vbldsc0_nucl(j,iti)
21013 ud(j)=aksc_nucl(j,iti)*diff
21014 u(j)=abond0_nucl(j,iti)+0.5d0*ud(j)*diff
21028 uprod2=uprod2*u(k)*u(k)
21032 usumsqder=usumsqder+ud(j)*uprod2
21034 estr_nucl=estr_nucl+uprod/usum
21036 gradbx_nucl(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
21040 !C print *,"I am about to leave ebond"
21042 end subroutine ebond_nucl
21044 !-----------------------------------------------------------------------------
21045 subroutine ebend_nucl(etheta_nucl)
21046 real(kind=8),dimension(nntheterm_nucl+1) :: coskt,sinkt !mmaxtheterm
21047 real(kind=8),dimension(nsingle_nucl+1) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
21048 real(kind=8),dimension(ndouble_nucl+1,ndouble_nucl+1) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
21049 logical :: lprn=.false., lprn1=.false.
21050 !el local variables
21051 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
21052 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
21053 real(kind=8) :: aux,etheta_nucl,ccl,ssl,scl,csl,ethetacnstr
21054 ! local variables for constrains
21055 real(kind=8) :: difi,thetiii
21058 ! print *,"ithet_start",ithet_nucl_start," ithet_end",ithet_nucl_end,nres
21059 do i=ithet_nucl_start,ithet_nucl_end
21060 if ((itype(i-1,2).eq.ntyp1_molec(2)).or.&
21061 (itype(i-2,2).eq.ntyp1_molec(2)).or. &
21062 (itype(i,2).eq.ntyp1_molec(2))) cycle
21066 theti2=0.5d0*theta(i)
21067 ityp2=ithetyp_nucl(itype(i-1,2))
21068 do k=1,nntheterm_nucl
21069 coskt(k)=dcos(k*theti2)
21070 sinkt(k)=dsin(k*theti2)
21072 if (i.gt.3 .and. itype(i-2,2).ne.ntyp1_molec(2)) then
21075 if (phii.ne.phii) phii=150.0
21079 ityp1=ithetyp_nucl(itype(i-2,2))
21080 do k=1,nsingle_nucl
21081 cosph1(k)=dcos(k*phii)
21082 sinph1(k)=dsin(k*phii)
21086 ityp1=nthetyp_nucl+1
21087 do k=1,nsingle_nucl
21093 if (i.lt.nres .and. itype(i,2).ne.ntyp1_molec(2)) then
21096 if (phii1.ne.phii1) phii1=150.0
21097 phii1=pinorm(phii1)
21101 ityp3=ithetyp_nucl(itype(i,2))
21102 do k=1,nsingle_nucl
21103 cosph2(k)=dcos(k*phii1)
21104 sinph2(k)=dsin(k*phii1)
21108 ityp3=nthetyp_nucl+1
21109 do k=1,nsingle_nucl
21114 ethetai=aa0thet_nucl(ityp1,ityp2,ityp3)
21115 do k=1,ndouble_nucl
21117 ccl=cosph1(l)*cosph2(k-l)
21118 ssl=sinph1(l)*sinph2(k-l)
21119 scl=sinph1(l)*cosph2(k-l)
21120 csl=cosph1(l)*sinph2(k-l)
21121 cosph1ph2(l,k)=ccl-ssl
21122 cosph1ph2(k,l)=ccl+ssl
21123 sinph1ph2(l,k)=scl+csl
21124 sinph1ph2(k,l)=scl-csl
21128 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
21129 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
21130 write (iout,*) "coskt and sinkt",nntheterm_nucl
21131 do k=1,nntheterm_nucl
21132 write (iout,*) k,coskt(k),sinkt(k)
21135 do k=1,ntheterm_nucl
21136 ethetai=ethetai+aathet_nucl(k,ityp1,ityp2,ityp3)*sinkt(k)
21137 dethetai=dethetai+0.5d0*k*aathet_nucl(k,ityp1,ityp2,ityp3)&
21140 write (iout,*) "k",k," aathet",aathet_nucl(k,ityp1,ityp2,ityp3),&
21144 write (iout,*) "cosph and sinph"
21145 do k=1,nsingle_nucl
21146 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
21148 write (iout,*) "cosph1ph2 and sinph2ph2"
21149 do k=2,ndouble_nucl
21151 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
21152 sinph1ph2(l,k),sinph1ph2(k,l)
21155 write(iout,*) "ethetai",ethetai
21157 do m=1,ntheterm2_nucl
21158 do k=1,nsingle_nucl
21159 aux=bbthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)&
21160 +ccthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k)&
21161 +ddthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)&
21162 +eethet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k)
21163 ethetai=ethetai+sinkt(m)*aux
21164 dethetai=dethetai+0.5d0*m*aux*coskt(m)
21165 dephii=dephii+k*sinkt(m)*(&
21166 ccthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)-&
21167 bbthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k))
21168 dephii1=dephii1+k*sinkt(m)*(&
21169 eethet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)-&
21170 ddthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k))
21172 write (iout,*) "m",m," k",k," bbthet",&
21173 bbthet_nucl(k,m,ityp1,ityp2,ityp3)," ccthet",&
21174 ccthet_nucl(k,m,ityp1,ityp2,ityp3)," ddthet",&
21175 ddthet_nucl(k,m,ityp1,ityp2,ityp3)," eethet",&
21176 eethet_nucl(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
21180 write(iout,*) "ethetai",ethetai
21181 do m=1,ntheterm3_nucl
21182 do k=2,ndouble_nucl
21184 aux=ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
21185 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+&
21186 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
21187 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
21188 ethetai=ethetai+sinkt(m)*aux
21189 dethetai=dethetai+0.5d0*m*coskt(m)*aux
21190 dephii=dephii+l*sinkt(m)*(&
21191 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-&
21192 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
21193 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
21194 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
21195 dephii1=dephii1+(k-l)*sinkt(m)*( &
21196 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
21197 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
21198 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-&
21199 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
21201 write (iout,*) "m",m," k",k," l",l," ffthet", &
21202 ffthet_nucl(l,k,m,ityp1,ityp2,ityp3), &
21203 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ggthet",&
21204 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3),&
21205 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
21206 write (iout,*) cosph1ph2(l,k)*sinkt(m), &
21207 cosph1ph2(k,l)*sinkt(m),&
21208 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
21214 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
21215 i,theta(i)*rad2deg,phii*rad2deg, &
21216 phii1*rad2deg,ethetai
21217 etheta_nucl=etheta_nucl+ethetai
21218 ! print *,i,"partial sum",etheta_nucl
21219 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang_nucl*dephii
21220 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang_nucl*dephii1
21221 gloc(nphi+i-2,icg)=wang_nucl*dethetai
21224 end subroutine ebend_nucl
21225 !----------------------------------------------------
21226 subroutine etor_nucl(etors_nucl)
21227 ! implicit real*8 (a-h,o-z)
21228 ! include 'DIMENSIONS'
21229 ! include 'COMMON.VAR'
21230 ! include 'COMMON.GEO'
21231 ! include 'COMMON.LOCAL'
21232 ! include 'COMMON.TORSION'
21233 ! include 'COMMON.INTERACT'
21234 ! include 'COMMON.DERIV'
21235 ! include 'COMMON.CHAIN'
21236 ! include 'COMMON.NAMES'
21237 ! include 'COMMON.IOUNITS'
21238 ! include 'COMMON.FFIELD'
21239 ! include 'COMMON.TORCNSTR'
21240 ! include 'COMMON.CONTROL'
21241 real(kind=8) :: etors_nucl,edihcnstr
21243 !el local variables
21244 integer :: i,j,iblock,itori,itori1
21245 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
21246 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
21247 ! Set lprn=.true. for debugging
21251 ! print *,"iphi_nucl_start/end", iphi_nucl_start,iphi_nucl_end
21252 do i=iphi_nucl_start,iphi_nucl_end
21253 if (itype(i-2,2).eq.ntyp1_molec(2) .or. itype(i-1,2).eq.ntyp1_molec(2) &
21254 .or. itype(i-3,2).eq.ntyp1_molec(2) &
21255 .or. itype(i,2).eq.ntyp1_molec(2)) cycle
21257 itori=itortyp_nucl(itype(i-2,2))
21258 itori1=itortyp_nucl(itype(i-1,2))
21260 ! print *,i,itori,itori1
21262 !C Regular cosine and sine terms
21263 do j=1,nterm_nucl(itori,itori1)
21264 v1ij=v1_nucl(j,itori,itori1)
21265 v2ij=v2_nucl(j,itori,itori1)
21266 cosphi=dcos(j*phii)
21267 sinphi=dsin(j*phii)
21268 etors_nucl=etors_nucl+v1ij*cosphi+v2ij*sinphi
21269 if (energy_dec) etors_ii=etors_ii+&
21270 v1ij*cosphi+v2ij*sinphi
21271 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
21275 !C E = SUM ----------------------------------- - v1
21276 !C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
21278 cosphi=dcos(0.5d0*phii)
21279 sinphi=dsin(0.5d0*phii)
21280 do j=1,nlor_nucl(itori,itori1)
21281 vl1ij=vlor1_nucl(j,itori,itori1)
21282 vl2ij=vlor2_nucl(j,itori,itori1)
21283 vl3ij=vlor3_nucl(j,itori,itori1)
21284 pom=vl2ij*cosphi+vl3ij*sinphi
21285 pom1=1.0d0/(pom*pom+1.0d0)
21286 etors_nucl=etors_nucl+vl1ij*pom1
21287 if (energy_dec) etors_ii=etors_ii+ &
21290 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
21292 !C Subtract the constant term
21293 etors_nucl=etors_nucl-v0_nucl(itori,itori1)
21294 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
21295 'etor',i,etors_ii-v0_nucl(itori,itori1)
21297 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
21298 restyp(itype(i-2,2),2),i-2,restyp(itype(i-1,2),2),i-1,itori,itori1, &
21299 (v1_nucl(j,itori,itori1),j=1,6),(v2_nucl(j,itori,itori1),j=1,6)
21300 gloc(i-3,icg)=gloc(i-3,icg)+wtor_nucl*gloci
21301 !c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
21304 end subroutine etor_nucl
21305 !------------------------------------------------------------
21306 subroutine epp_nucl_sub(evdw1,ees)
21308 !C This subroutine calculates the average interaction energy and its gradient
21309 !C in the virtual-bond vectors between non-adjacent peptide groups, based on
21310 !C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
21311 !C The potential depends both on the distance of peptide-group centers and on
21312 !C the orientation of the CA-CA virtual bonds.
21314 integer :: i,j,k,iteli,itelj,num_conti,isubchap,ind
21315 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
21316 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
21317 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
21318 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
21319 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
21320 dist_temp, dist_init,sss_grad,fac,evdw1ij
21321 integer xshift,yshift,zshift
21322 real(kind=8),dimension(3):: ggg,gggp,gggm,erij
21323 real(kind=8) :: ees,eesij
21324 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
21325 real(kind=8) scal_el /0.5d0/
21331 !c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
21333 ! print *,"iatel_s_nucl,iatel_e_nucl",iatel_s_nucl,iatel_e_nucl
21334 do i=iatel_s_nucl,iatel_e_nucl
21335 if (itype(i,2).eq.ntyp1_molec(2) .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
21339 dx_normi=dc_norm(1,i)
21340 dy_normi=dc_norm(2,i)
21341 dz_normi=dc_norm(3,i)
21342 xmedi=c(1,i)+0.5d0*dxi
21343 ymedi=c(2,i)+0.5d0*dyi
21344 zmedi=c(3,i)+0.5d0*dzi
21345 xmedi=dmod(xmedi,boxxsize)
21346 if (xmedi.lt.0) xmedi=xmedi+boxxsize
21347 ymedi=dmod(ymedi,boxysize)
21348 if (ymedi.lt.0) ymedi=ymedi+boxysize
21349 zmedi=dmod(zmedi,boxzsize)
21350 if (zmedi.lt.0) zmedi=zmedi+boxzsize
21352 do j=ielstart_nucl(i),ielend_nucl(i)
21353 if (itype(j,2).eq.ntyp1_molec(2) .or. itype(j+1,2).eq.ntyp1_molec(2)) cycle
21358 ! xj=c(1,j)+0.5D0*dxj-xmedi
21359 ! yj=c(2,j)+0.5D0*dyj-ymedi
21360 ! zj=c(3,j)+0.5D0*dzj-zmedi
21361 xj=c(1,j)+0.5D0*dxj
21362 yj=c(2,j)+0.5D0*dyj
21363 zj=c(3,j)+0.5D0*dzj
21364 xj=mod(xj,boxxsize)
21365 if (xj.lt.0) xj=xj+boxxsize
21366 yj=mod(yj,boxysize)
21367 if (yj.lt.0) yj=yj+boxysize
21368 zj=mod(zj,boxzsize)
21369 if (zj.lt.0) zj=zj+boxzsize
21371 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
21378 xj=xj_safe+xshift*boxxsize
21379 yj=yj_safe+yshift*boxysize
21380 zj=zj_safe+zshift*boxzsize
21381 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
21382 if(dist_temp.lt.dist_init) then
21383 dist_init=dist_temp
21392 if (isubchap.eq.1) then
21403 rij=xj*xj+yj*yj+zj*zj
21404 !c write (2,*)"ij",i,j," r0pp",r0pp," rij",rij," epspp",epspp
21405 fac=(r0pp**2/rij)**3
21409 fac=(-ev1-evdw1ij)/rij
21410 ! write (2,*)"fac",fac," ev1",ev1," ev2",ev2," evdw1ij",evdw1ij
21411 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"evdw1ij",evdw1ij
21412 evdw1=evdw1+evdw1ij
21414 !C Calculate contributions to the Cartesian gradient.
21420 gvdwpp_nucl(k,i)=gvdwpp_nucl(k,i)-ggg(k)
21421 gvdwpp_nucl(k,j)=gvdwpp_nucl(k,j)+ggg(k)
21423 !c phoshate-phosphate electrostatic interactions
21426 eesij=dexp(-BEES*rij)*fac
21427 ! write (2,*)"fac",fac," eesijpp",eesij
21428 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"eesijpp",eesij
21431 fac=-(fac+BEES)*eesij*fac
21435 !c write(2,*) "ggg",i,j,ggg(1),ggg(2),ggg(3)
21436 !c write(2,*) "gelpp",i,(gelpp(k,i),k=1,3)
21437 !c write(2,*) "gelpp",j,(gelpp(k,j),k=1,3)
21439 gelpp(k,i)=gelpp(k,i)-ggg(k)
21440 gelpp(k,j)=gelpp(k,j)+ggg(k)
21447 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
21449 gvdwpp_nucl(k,i)=6*gvdwpp_nucl(k,i)
21450 !c gelpp(k,i)=332.0d0*gelpp(k,i)
21451 gelpp(k,i)=AEES*gelpp(k,i)
21453 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
21455 !c write (2,*) "total EES",ees
21457 end subroutine epp_nucl_sub
21458 !---------------------------------------------------------------------
21459 subroutine epsb(evdwpsb,eelpsb)
21462 !C This subroutine calculates the excluded-volume interaction energy between
21463 !C peptide-group centers and side chains and its gradient in virtual-bond and
21464 !C side-chain vectors.
21466 real(kind=8),dimension(3):: ggg
21467 integer :: i,iint,j,k,iteli,itypj,subchap
21468 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
21469 e1,e2,evdwij,rij,evdwpsb,eelpsb
21470 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
21471 dist_temp, dist_init
21472 integer xshift,yshift,zshift
21474 !cd print '(a)','Enter ESCP'
21475 !cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
21478 ! print *,"iatscp_s_nucl,iatscp_e_nucl",iatscp_s_nucl,iatscp_e_nucl
21479 do i=iatscp_s_nucl,iatscp_e_nucl
21480 if (itype(i,2).eq.ntyp1_molec(2) &
21481 .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
21482 xi=0.5D0*(c(1,i)+c(1,i+1))
21483 yi=0.5D0*(c(2,i)+c(2,i+1))
21484 zi=0.5D0*(c(3,i)+c(3,i+1))
21485 xi=mod(xi,boxxsize)
21486 if (xi.lt.0) xi=xi+boxxsize
21487 yi=mod(yi,boxysize)
21488 if (yi.lt.0) yi=yi+boxysize
21489 zi=mod(zi,boxzsize)
21490 if (zi.lt.0) zi=zi+boxzsize
21492 do iint=1,nscp_gr_nucl(i)
21494 do j=iscpstart_nucl(i,iint),iscpend_nucl(i,iint)
21496 if (itypj.eq.ntyp1_molec(2)) cycle
21497 !C Uncomment following three lines for SC-p interactions
21498 !c xj=c(1,nres+j)-xi
21499 !c yj=c(2,nres+j)-yi
21500 !c zj=c(3,nres+j)-zi
21501 !C Uncomment following three lines for Ca-p interactions
21508 xj=mod(xj,boxxsize)
21509 if (xj.lt.0) xj=xj+boxxsize
21510 yj=mod(yj,boxysize)
21511 if (yj.lt.0) yj=yj+boxysize
21512 zj=mod(zj,boxzsize)
21513 if (zj.lt.0) zj=zj+boxzsize
21514 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21522 xj=xj_safe+xshift*boxxsize
21523 yj=yj_safe+yshift*boxysize
21524 zj=zj_safe+zshift*boxzsize
21525 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21526 if(dist_temp.lt.dist_init) then
21527 dist_init=dist_temp
21536 if (subchap.eq.1) then
21546 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
21548 e1=fac*fac*aad_nucl(itypj)
21549 e2=fac*bad_nucl(itypj)
21550 if (iabs(j-i) .le. 2) then
21555 evdwpsb=evdwpsb+evdwij
21556 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a4)') &
21557 'evdw2',i,j,evdwij,"tu4"
21559 !C Calculate contributions to the gradient in the virtual-bond and SC vectors.
21561 fac=-(evdwij+e1)*rrij
21566 gvdwpsb1(k,i)=gvdwpsb1(k,i)-ggg(k)
21567 gvdwpsb(k,j)=gvdwpsb(k,j)+ggg(k)
21575 gvdwpsb(j,i)=expon*gvdwpsb(j,i)
21576 gvdwpsb1(j,i)=expon*gvdwpsb1(j,i)
21580 end subroutine epsb
21582 !------------------------------------------------------
21583 subroutine esb_gb(evdwsb,eelsb)
21586 integer :: iint,itypi,itypi1,itypj,subchap,num_conti2
21587 real(kind=8) :: xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
21588 real(kind=8) :: evdw,sig0iji,evdwsb,eelsb,ecorr,eelij
21589 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
21590 dist_temp, dist_init,aa,bb,faclip,sig0ij
21599 ! print *,"iastsc_nucl",iatsc_s_nucl,iatsc_e_nucl
21600 do i=iatsc_s_nucl,iatsc_e_nucl
21604 ! PRINT *,"I=",i,itypi
21605 if (itypi.eq.ntyp1_molec(2)) cycle
21606 itypi1=itype(i+1,2)
21610 xi=dmod(xi,boxxsize)
21611 if (xi.lt.0) xi=xi+boxxsize
21612 yi=dmod(yi,boxysize)
21613 if (yi.lt.0) yi=yi+boxysize
21614 zi=dmod(zi,boxzsize)
21615 if (zi.lt.0) zi=zi+boxzsize
21617 dxi=dc_norm(1,nres+i)
21618 dyi=dc_norm(2,nres+i)
21619 dzi=dc_norm(3,nres+i)
21620 dsci_inv=vbld_inv(i+nres)
21622 !C Calculate SC interaction energy.
21624 do iint=1,nint_gr_nucl(i)
21625 ! print *,"tu?",i,istart_nucl(i,iint),iend_nucl(i,iint)
21626 do j=istart_nucl(i,iint),iend_nucl(i,iint)
21630 if (itypj.eq.ntyp1_molec(2)) cycle
21631 dscj_inv=vbld_inv(j+nres)
21632 sig0ij=sigma_nucl(itypi,itypj)
21633 chi1=chi_nucl(itypi,itypj)
21634 chi2=chi_nucl(itypj,itypi)
21636 chip1=chip_nucl(itypi,itypj)
21637 chip2=chip_nucl(itypj,itypi)
21639 ! xj=c(1,nres+j)-xi
21640 ! yj=c(2,nres+j)-yi
21641 ! zj=c(3,nres+j)-zi
21645 xj=dmod(xj,boxxsize)
21646 if (xj.lt.0) xj=xj+boxxsize
21647 yj=dmod(yj,boxysize)
21648 if (yj.lt.0) yj=yj+boxysize
21649 zj=dmod(zj,boxzsize)
21650 if (zj.lt.0) zj=zj+boxzsize
21651 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21659 xj=xj_safe+xshift*boxxsize
21660 yj=yj_safe+yshift*boxysize
21661 zj=zj_safe+zshift*boxzsize
21662 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21663 if(dist_temp.lt.dist_init) then
21664 dist_init=dist_temp
21673 if (subchap.eq.1) then
21683 dxj=dc_norm(1,nres+j)
21684 dyj=dc_norm(2,nres+j)
21685 dzj=dc_norm(3,nres+j)
21686 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
21688 !C Calculate angle-dependent terms of energy and contributions to their
21693 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
21694 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
21695 om12=dxi*dxj+dyi*dyj+dzi*dzj
21696 call sc_angular_nucl
21698 sig=sig0ij*dsqrt(sigsq)
21699 rij_shift=1.0D0/rij-sig+sig0ij
21700 ! print *,rij_shift,"rij_shift"
21701 !c write (2,*) " rij",1.0D0/rij," sig",sig," sig0ij",sig0ij,
21702 !c & " rij_shift",rij_shift
21703 if (rij_shift.le.0.0D0) then
21708 !c---------------------------------------------------------------
21709 rij_shift=1.0D0/rij_shift
21710 fac=rij_shift**expon
21711 e1=fac*fac*aa_nucl(itypi,itypj)
21712 e2=fac*bb_nucl(itypi,itypj)
21713 evdwij=eps1*eps2rt*(e1+e2)
21714 !c write (2,*) "eps1",eps1," eps2rt",eps2rt,
21715 !c & " e1",e1," e2",e2," evdwij",evdwij
21717 evdwij=evdwij*eps2rt
21718 evdwsb=evdwsb+evdwij
21720 sigm=dabs(aa_nucl(itypi,itypj)/bb_nucl(itypi,itypj))**(1.0D0/6.0D0)
21721 epsi=bb_nucl(itypi,itypj)**2/aa_nucl(itypi,itypj)
21722 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
21723 restyp(itypi,2),i,restyp(itypj,2),j, &
21724 epsi,sigm,chi1,chi2,chip1,chip2, &
21725 eps1,eps2rt**2,sig,sig0ij, &
21726 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
21728 write (iout,*) "aa",aa_nucl(itypi,itypj)," bb",bb_nucl(itypi,itypj)
21731 if (energy_dec) write (iout,'(a6,2i5,e15.3,a4)') &
21732 'evdw',i,j,evdwij,"tu3"
21735 !C Calculate gradient components.
21736 e1=e1*eps1*eps2rt**2
21737 fac=-expon*(e1+evdwij)*rij_shift
21741 !C Calculate the radial part of the gradient
21745 !C Calculate angular part of the gradient.
21747 call eelsbij(eelij,num_conti2)
21748 if (energy_dec .and. &
21749 (j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2)) &
21750 write (istat,'(e14.5)') evdwij
21754 num_cont_hb(i)=num_conti2
21756 !c write (iout,*) "Number of loop steps in EGB:",ind
21757 !cccc energy_dec=.false.
21759 end subroutine esb_gb
21760 !-------------------------------------------------------------------------------
21761 subroutine eelsbij(eesij,num_conti2)
21764 real(kind=8),dimension(3) :: ggg,gggp,gggm,dcosb,dcosg
21765 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
21766 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
21767 dist_temp, dist_init,rlocshield,fracinbuf
21768 integer xshift,yshift,zshift,ilist,iresshield,num_conti2
21770 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
21771 real(kind=8) scal_el /0.5d0/
21772 integer :: iteli,itelj,kkk,kkll,m,isubchap
21773 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp,facfac
21774 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i,ael63i,ael32i
21775 real(kind=8) :: dx_normj,dy_normj,dz_normj,&
21776 r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,fac5,fac6,&
21777 el1,el2,el3,el4,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
21778 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
21779 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
21780 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
21781 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
21782 ecosgp,ecosam,ecosbm,ecosgm,ghalf,itypi,itypj
21786 ! print *,i,j,itypi,itypj,istype(i),istype(j),"????"
21787 ael6i=ael6_nucl(itypi,itypj)
21788 ael3i=ael3_nucl(itypi,itypj)
21789 ael63i=ael63_nucl(itypi,itypj)
21790 ael32i=ael32_nucl(itypi,itypj)
21791 !c write (iout,*) "eelecij",i,j,itype(i),itype(j),
21792 !c & ael6i,ael3i,ael63i,al32i,rij,rrij
21796 dx_normi=dc_norm(1,i+nres)
21797 dy_normi=dc_norm(2,i+nres)
21798 dz_normi=dc_norm(3,i+nres)
21799 dx_normj=dc_norm(1,j+nres)
21800 dy_normj=dc_norm(2,j+nres)
21801 dz_normj=dc_norm(3,j+nres)
21802 !c xj=c(1,j)+0.5D0*dxj-xmedi
21803 !c yj=c(2,j)+0.5D0*dyj-ymedi
21804 !c zj=c(3,j)+0.5D0*dzj-zmedi
21805 if (ipot_nucl.ne.2) then
21806 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
21807 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
21808 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
21816 fac=cosa-3.0D0*cosb*cosg
21818 fac1=3.0d0*(cosb*cosb+cosg*cosg)
21823 !c write (iout,*) "r3ij",r3ij," r6ij",r6ij," fac",fac," fac1",fac1,
21824 !c & " fac2",fac2," fac3",fac3," fac4",fac4," fac5",fac5," fac6",fac6
21825 el1=fac3*(4.0D0+facfac-fac1)
21827 el3=fac5*(2.0d0-2.0d0*facfac+fac1)
21829 eesij=el1+el2+el3+el4
21830 !C 12/26/95 - for the evaluation of multi-body H-bonding interactions
21831 ees0ij=4.0D0+facfac-fac1
21833 if (energy_dec) then
21834 if(j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2) &
21835 write (istat,'(2a1,i4,1x,2a1,i4,4f10.5,3e12.5,$)') &
21836 sugartyp(istype(i)),restyp(itypi,2),i,sugartyp(istype(j)),&
21837 restyp(itypj,2),j,1.0d0/rij,cosa,cosb,cosg,fac*r3ij, &
21838 (4.0D0+facfac-fac1)*r6ij,(2.0d0-2.0d0*facfac+fac1)*r6ij
21839 write (iout,'(a6,2i5,e15.3)') 'ees',i,j,eesij
21843 !C Calculate contributions to the Cartesian gradient.
21845 facel=-3.0d0*rrij*(eesij+el1+el3+el4)
21851 !* Radial derivatives. First process both termini of the fragment (i,j)
21857 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
21858 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
21859 gelsbx(k,j)=gelsbx(k,j)+ggg(k)
21860 gelsbx(k,i)=gelsbx(k,i)-ggg(k)
21865 ecosa=2.0D0*fac3*fac1+fac4+(-4.0d0*fac5+2.0d0*fac6)*fac1
21870 ecosb=fac3*(fac1*cosg+cosb)+cosg*fac4+(cosb+2*fac1*cosg)*fac5+&
21872 ecosg=fac3*(fac1*cosb+cosg)+cosb*fac4+(cosg+2*fac1*cosb)*fac5+&
21875 dcosb(k)=rij*(dc_norm(k,i+nres)-erij(k)*cosb)
21876 dcosg(k)=rij*(dc_norm(k,j+nres)-erij(k)*cosg)
21879 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
21882 gelsbx(k,i)=gelsbx(k,i)-ggg(k) &
21883 +(ecosa*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres))&
21884 + ecosb*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21885 gelsbx(k,j)=gelsbx(k,j)+ggg(k) &
21886 +(ecosa*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
21887 + ecosg*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21888 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
21889 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
21891 ! IF ( (wcorr_nucl.gt.0.0d0.or.wcorr3_nucl.gt.0.0d0) .and.
21892 IF ( j.gt.i+1 .and.&
21893 num_conti.le.maxcont) THEN
21895 !C Calculate the contact function. The ith column of the array JCONT will
21896 !C contain the numbers of atoms that make contacts with the atom I (of numbers
21897 !C greater than I). The arrays FACONT and GACONT will contain the values of
21898 !C the contact function and its derivative.
21899 r0ij=2.20D0*sigma_nucl(itypi,itypj)
21900 !c write (2,*) "ij",i,j," rij",1.0d0/rij," r0ij",r0ij
21901 call gcont(rij,r0ij,1.0D0,0.2d0/r0ij,fcont,fprimcont)
21902 !c write (2,*) "fcont",fcont
21903 if (fcont.gt.0.0D0) then
21904 num_conti=num_conti+1
21905 num_conti2=num_conti2+1
21907 if (num_conti.gt.maxconts) then
21908 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
21909 ' will skip next contacts for this conf.',maxconts
21911 jcont_hb(num_conti,i)=j
21912 !c write (iout,*) "num_conti",num_conti,
21913 !c & " jcont_hb",jcont_hb(num_conti,i)
21914 !C Calculate contact energies
21916 wij=cosa-3.0D0*cosb*cosg
21919 fac3=dsqrt(-ael6i)*r3ij
21920 !c write (2,*) "ael6i",ael6i," r3ij",r3ij," fac3",fac3
21921 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
21922 if (ees0tmp.gt.0) then
21923 ees0pij=dsqrt(ees0tmp)
21927 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
21928 if (ees0tmp.gt.0) then
21929 ees0mij=dsqrt(ees0tmp)
21933 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
21934 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
21935 !c write (iout,*) "i",i," j",j,
21936 !c & " ees0m",ees0m(num_conti,i)," ees0p",ees0p(num_conti,i)
21937 ees0pij1=fac3/ees0pij
21938 ees0mij1=fac3/ees0mij
21939 fac3p=-3.0D0*fac3*rrij
21940 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
21941 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
21942 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
21943 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
21944 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
21945 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
21946 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
21947 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
21948 ecosap=ecosa1+ecosa2
21949 ecosbp=ecosb1+ecosb2
21950 ecosgp=ecosg1+ecosg2
21951 ecosam=ecosa1-ecosa2
21952 ecosbm=ecosb1-ecosb2
21953 ecosgm=ecosg1-ecosg2
21955 facont_hb(num_conti,i)=fcont
21956 fprimcont=fprimcont/rij
21958 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
21959 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
21961 gggp(1)=gggp(1)+ees0pijp*xj
21962 gggp(2)=gggp(2)+ees0pijp*yj
21963 gggp(3)=gggp(3)+ees0pijp*zj
21964 gggm(1)=gggm(1)+ees0mijp*xj
21965 gggm(2)=gggm(2)+ees0mijp*yj
21966 gggm(3)=gggm(3)+ees0mijp*zj
21967 !C Derivatives due to the contact function
21968 gacont_hbr(1,num_conti,i)=fprimcont*xj
21969 gacont_hbr(2,num_conti,i)=fprimcont*yj
21970 gacont_hbr(3,num_conti,i)=fprimcont*zj
21973 !c Gradient of the correlation terms
21975 gacontp_hb1(k,num_conti,i)= &
21976 (ecosap*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
21977 + ecosbp*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21978 gacontp_hb2(k,num_conti,i)= &
21979 (ecosap*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres)) &
21980 + ecosgp*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21981 gacontp_hb3(k,num_conti,i)=gggp(k)
21982 gacontm_hb1(k,num_conti,i)= &
21983 (ecosam*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
21984 + ecosbm*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21985 gacontm_hb2(k,num_conti,i)= &
21986 (ecosam*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
21987 + ecosgm*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21988 gacontm_hb3(k,num_conti,i)=gggm(k)
21994 end subroutine eelsbij
21995 !------------------------------------------------------------------
21996 subroutine sc_grad_nucl
21999 real(kind=8),dimension(3) :: dcosom1,dcosom2
22000 eom1=eps2der*eps2rt_om1+sigder*sigsq_om1
22001 eom2=eps2der*eps2rt_om2+sigder*sigsq_om2
22002 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12+sigder*sigsq_om12
22004 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
22005 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
22008 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
22011 gvdwsbx(k,i)=gvdwsbx(k,i)-gg(k) &
22012 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
22013 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
22014 gvdwsbx(k,j)=gvdwsbx(k,j)+gg(k) &
22015 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
22016 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
22019 !C Calculate the components of the gradient in DC and X
22022 gvdwsbc(l,i)=gvdwsbc(l,i)-gg(l)
22023 gvdwsbc(l,j)=gvdwsbc(l,j)+gg(l)
22026 end subroutine sc_grad_nucl
22027 !-----------------------------------------------------------------------
22028 subroutine esb(esbloc)
22029 !C Calculate the local energy of a side chain and its derivatives in the
22030 !C corresponding virtual-bond valence angles THETA and the spherical angles
22031 !C ALPHA and OMEGA derived from AM1 all-atom calculations.
22032 !C added by Urszula Kozlowska. 07/11/2007
22034 real(kind=8),dimension(3):: x_prime,y_prime,z_prime
22035 real(kind=8),dimension(9):: x
22036 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1, &
22037 sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,&
22038 de_dxx,de_dyy,de_dzz,de_dt,s1_t,s1_6_t,s2_t,s2_6_t
22039 real(kind=8),dimension(3):: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,&
22040 dYY_Ci,dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
22041 real(kind=8) :: esbloc,delta,cosfac2,cosfac,sinfac2,sinfac,de_dtt,&
22042 cossc,cossc1,cosfac2xx,sinfac2yy,pom1,pom
22043 integer::it,nlobit,i,j,k
22044 ! common /sccalc/ time11,time12,time112,theti,it,nlobit
22047 do i=loc_start_nucl,loc_end_nucl
22048 if (itype(i,2).eq.ntyp1_molec(2)) cycle
22049 costtab(i+1) =dcos(theta(i+1))
22050 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
22051 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
22052 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
22053 cosfac2=0.5d0/(1.0d0+costtab(i+1))
22054 cosfac=dsqrt(cosfac2)
22055 sinfac2=0.5d0/(1.0d0-costtab(i+1))
22056 sinfac=dsqrt(sinfac2)
22058 if (it.eq.10) goto 1
22061 !C Compute the axes of tghe local cartesian coordinates system; store in
22062 !c x_prime, y_prime and z_prime
22069 !C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
22070 !C & dc_norm(3,i+nres)
22072 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
22073 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
22076 z_prime(j) = -uz(j,i-1)
22084 xx = xx + x_prime(j)*dc_norm(j,i+nres)
22085 yy = yy + y_prime(j)*dc_norm(j,i+nres)
22086 zz = zz + z_prime(j)*dc_norm(j,i+nres)
22094 x(j) = sc_parmin_nucl(j,it)
22097 !Cc diagnostics - remove later
22098 xx1 = dcos(alph(2))
22099 yy1 = dsin(alph(2))*dcos(omeg(2))
22100 zz1 = -dsin(alph(2))*dsin(omeg(2))
22101 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
22102 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
22104 !C," --- ", xx_w,yy_w,zz_w
22107 sumene = enesc_nucl(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
22108 esbloc = esbloc + sumene
22109 sumene2= enesc_nucl(x,xx,yy,0.0d0,cost2tab(i+1),sint2tab(i+1))
22110 ! print *,"enecomp",sumene,sumene2
22111 ! if (energy_dec) write(iout,*) "i",i," esbloc",sumene,esbloc,xx,yy,zz
22112 ! if (energy_dec) write(iout,*) "x",(x(k),k=1,9)
22114 write (2,*) "x",(x(k),k=1,9)
22116 !C This section to check the numerical derivatives of the energy of ith side
22117 !C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
22118 !C #define DEBUG in the code to turn it on.
22120 write (2,*) "sumene =",sumene
22124 write (2,*) xx,yy,zz
22125 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
22126 de_dxx_num=(sumenep-sumene)/aincr
22128 write (2,*) "xx+ sumene from enesc=",sumenep,sumene
22131 write (2,*) xx,yy,zz
22132 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
22133 de_dyy_num=(sumenep-sumene)/aincr
22135 write (2,*) "yy+ sumene from enesc=",sumenep,sumene
22138 write (2,*) xx,yy,zz
22139 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
22140 de_dzz_num=(sumenep-sumene)/aincr
22142 write (2,*) "zz+ sumene from enesc=",sumenep,sumene
22143 costsave=cost2tab(i+1)
22144 sintsave=sint2tab(i+1)
22145 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
22146 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
22147 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
22148 de_dt_num=(sumenep-sumene)/aincr
22149 write (2,*) " t+ sumene from enesc=",sumenep,sumene
22150 cost2tab(i+1)=costsave
22151 sint2tab(i+1)=sintsave
22152 !C End of diagnostics section.
22155 !C Compute the gradient of esc
22157 de_dxx=x(1)+2*x(4)*xx+x(7)*zz+x(8)*yy
22158 de_dyy=x(2)+2*x(5)*yy+x(8)*xx+x(9)*zz
22159 de_dzz=x(3)+2*x(6)*zz+x(7)*xx+x(9)*yy
22162 write (2,*) "x",(x(k),k=1,9)
22163 write (2,*) "xx",xx," yy",yy," zz",zz
22164 write (2,*) "de_xx ",de_xx," de_yy ",de_yy,&
22165 " de_zz ",de_zz," de_tt ",de_tt
22166 write (2,*) "de_xx_num",de_dxx_num," de_yy_num",de_dyy_num,&
22167 " de_zz_num",de_dzz_num," de_dt_num",de_dt_num
22170 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
22171 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
22172 cosfac2xx=cosfac2*xx
22173 sinfac2yy=sinfac2*yy
22175 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*&
22177 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*&
22179 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
22180 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
22181 !c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
22182 !c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
22183 !c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
22184 !c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
22185 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
22186 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
22187 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
22188 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
22192 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
22193 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
22196 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
22197 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
22198 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
22200 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
22201 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
22205 dXX_Ctab(k,i)=dXX_Ci(k)
22206 dXX_C1tab(k,i)=dXX_Ci1(k)
22207 dYY_Ctab(k,i)=dYY_Ci(k)
22208 dYY_C1tab(k,i)=dYY_Ci1(k)
22209 dZZ_Ctab(k,i)=dZZ_Ci(k)
22210 dZZ_C1tab(k,i)=dZZ_Ci1(k)
22211 dXX_XYZtab(k,i)=dXX_XYZ(k)
22212 dYY_XYZtab(k,i)=dYY_XYZ(k)
22213 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
22216 !c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
22217 !c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
22218 !c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
22219 !c & dyy_ci(k)," dzz_ci",dzz_ci(k)
22220 !c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
22222 !c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
22223 !c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
22224 gsbloc(k,i-1)=gsbloc(k,i-1)+(de_dxx*dxx_ci1(k) &
22225 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k))
22226 gsbloc(k,i)=gsbloc(k,i)+(de_dxx*dxx_Ci(k) &
22227 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k))
22228 gsblocx(k,i)= de_dxx*dxx_XYZ(k)&
22229 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
22230 ! print *,i,de_dxx*dxx_ci1(k)+de_dyy*dyy_ci1(k),de_dzz*dzz_ci1(k)*2
22232 !c write(iout,*) "ENERGY GRAD = ", (gsbloc(k,i-1),k=1,3),
22233 !c & (gsbloc(k,i),k=1,3),(gsblocx(k,i),k=1,3)
22235 !C to check gradient call subroutine check_grad
22241 !=-------------------------------------------------------
22242 real(kind=8) function enesc_nucl(x,xx,yy,zz,cost2,sint2)
22244 real(kind=8),dimension(9):: x(9)
22245 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2, &
22246 sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
22248 !c write (2,*) "enesc"
22249 !c write (2,*) "x",(x(i),i=1,9)
22250 !c write(2,*)"xx",xx," yy",yy," zz",zz," cost2",cost2," sint2",sint2
22251 sumene=x(1)*xx+x(2)*yy+x(3)*zz+x(4)*xx**2 &
22252 + x(5)*yy**2+x(6)*zz**2+x(7)*xx*zz+x(8)*xx*yy &
22256 end function enesc_nucl
22257 !-----------------------------------------------------------------------------
22258 subroutine multibody_hb_nucl(ecorr,ecorr3,n_corr,n_corr1)
22261 integer,parameter :: max_cont=2000
22262 integer,parameter:: max_dim=2*(8*3+6)
22263 integer, parameter :: msglen1=max_cont*max_dim
22264 integer,parameter :: msglen2=2*msglen1
22265 integer source,CorrelType,CorrelID,Error
22266 real(kind=8) :: buffer(max_cont,max_dim)
22267 integer status(MPI_STATUS_SIZE)
22268 integer :: ierror,nbytes
22270 real(kind=8),dimension(3):: gx(3),gx1(3)
22271 real(kind=8) :: time00
22273 integer i,j,i1,j1,jj,kk,num_conti,num_conti1,nn
22274 real(kind=8) ecorr,ecorr3
22275 integer :: n_corr,n_corr1,mm,msglen
22276 !C Set lprn=.true. for debugging
22281 if(.not.allocated(zapas2)) allocate(zapas2(3,maxconts,nres,8))
22283 if (nfgtasks.le.1) goto 30
22285 write (iout,'(a)') 'Contact function values:'
22287 write (iout,'(2i3,50(1x,i2,f5.2))') &
22288 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
22289 j=1,num_cont_hb(i))
22292 !C Caution! Following code assumes that electrostatic interactions concerning
22293 !C a given atom are split among at most two processors!
22303 !c write (*,*) 'MyRank',MyRank,' mm',mm
22306 !c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
22307 if (fg_rank.gt.0) then
22308 !C Send correlation contributions to the preceding processor
22310 nn=num_cont_hb(iatel_s_nucl)
22311 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
22312 !c write (*,*) 'The BUFFER array:'
22314 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
22316 if (ielstart_nucl(iatel_s_nucl).gt.iatel_s_nucl+ispp) then
22318 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
22319 !C Clear the contacts of the atom passed to the neighboring processor
22320 nn=num_cont_hb(iatel_s_nucl+1)
22322 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
22324 num_cont_hb(iatel_s_nucl)=0
22326 !cd write (iout,*) 'Processor ',fg_rank,MyRank,
22327 !cd & ' is sending correlation contribution to processor',fg_rank-1,
22328 !cd & ' msglen=',msglen
22329 !c write (*,*) 'Processor ',fg_rank,MyRank,
22330 !c & ' is sending correlation contribution to processor',fg_rank-1,
22331 !c & ' msglen=',msglen,' CorrelType=',CorrelType
22333 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, &
22334 CorrelType,FG_COMM,IERROR)
22335 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
22336 !cd write (iout,*) 'Processor ',fg_rank,
22337 !cd & ' has sent correlation contribution to processor',fg_rank-1,
22338 !cd & ' msglen=',msglen,' CorrelID=',CorrelID
22339 !c write (*,*) 'Processor ',fg_rank,
22340 !c & ' has sent correlation contribution to processor',fg_rank-1,
22341 !c & ' msglen=',msglen,' CorrelID=',CorrelID
22343 endif ! (fg_rank.gt.0)
22347 !c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
22348 if (fg_rank.lt.nfgtasks-1) then
22349 !C Receive correlation contributions from the next processor
22351 if (ielend_nucl(iatel_e_nucl).lt.nct_molec(2)-1) msglen=msglen2
22352 !cd write (iout,*) 'Processor',fg_rank,
22353 !cd & ' is receiving correlation contribution from processor',fg_rank+1,
22354 !cd & ' msglen=',msglen,' CorrelType=',CorrelType
22355 !c write (*,*) 'Processor',fg_rank,
22356 !c &' is receiving correlation contribution from processor',fg_rank+1,
22357 !c & ' msglen=',msglen,' CorrelType=',CorrelType
22360 do while (nbytes.le.0)
22361 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
22362 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
22364 !c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
22365 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, &
22366 fg_rank+1,CorrelType,FG_COMM,status,IERROR)
22367 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
22368 !c write (*,*) 'Processor',fg_rank,
22369 !c &' has received correlation contribution from processor',fg_rank+1,
22370 !c & ' msglen=',msglen,' nbytes=',nbytes
22371 !c write (*,*) 'The received BUFFER array:'
22373 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
22375 if (msglen.eq.msglen1) then
22376 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,0,buffer)
22377 else if (msglen.eq.msglen2) then
22378 call unpack_buffer(max_cont,max_dim,iatel_e_nucl,0,buffer)
22379 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,30,buffer)
22382 'ERROR!!!! message length changed while processing correlations.'
22384 'ERROR!!!! message length changed while processing correlations.'
22385 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
22386 endif ! msglen.eq.msglen1
22387 endif ! fg_rank.lt.nfgtasks-1
22394 write (iout,'(a)') 'Contact function values:'
22395 do i=nnt_molec(2),nct_molec(2)-1
22396 write (iout,'(2i3,50(1x,i2,f5.2))') &
22397 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
22398 j=1,num_cont_hb(i))
22403 !C Remove the loop below after debugging !!!
22404 ! do i=nnt_molec(2),nct_molec(2)
22406 ! gradcorr_nucl(j,i)=0.0D0
22407 ! gradxorr_nucl(j,i)=0.0D0
22408 ! gradcorr3_nucl(j,i)=0.0D0
22409 ! gradxorr3_nucl(j,i)=0.0D0
22412 ! print *,"iatsc_s_nucl,iatsc_e_nucl",iatsc_s_nucl,iatsc_e_nucl
22413 !C Calculate the local-electrostatic correlation terms
22414 do i=iatsc_s_nucl,iatsc_e_nucl
22416 num_conti=num_cont_hb(i)
22417 num_conti1=num_cont_hb(i+1)
22418 ! print *,i,num_conti,num_conti1
22423 !c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
22424 !c & ' jj=',jj,' kk=',kk
22425 if (j1.eq.j+1 .or. j1.eq.j-1) then
22427 !C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
22428 !C The system gains extra energy.
22429 !C Tentative expression & coefficients; assumed d(stacking)=4.5 A,
22430 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
22431 !C Need to implement full formulas 34 and 35 from Liwo et al., 1998.
22433 ecorr=ecorr+ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
22434 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
22435 'ecorrh',i,j,ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
22437 else if (j1.eq.j) then
22439 !C Contacts I-J and I-(J+1) occur simultaneously.
22440 !C The system loses extra energy.
22441 !C Tentative expression & c?oefficients; assumed d(stacking)=4.5 A,
22442 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
22443 !C Need to implement full formulas 32 from Liwo et al., 1998.
22445 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
22446 !c & ' jj=',jj,' kk=',kk
22447 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i+1,j,jj,kk,0.310D0,-0.155D0)
22452 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
22453 !c & ' jj=',jj,' kk=',kk
22454 if (j1.eq.j+1) then
22455 !C Contacts I-J and (I+1)-J occur simultaneously.
22456 !C The system loses extra energy.
22457 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i,j+1,jj,kk,0.310D0,-0.155D0)
22463 end subroutine multibody_hb_nucl
22464 !-----------------------------------------------------------
22465 real(kind=8) function ehbcorr_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
22466 ! implicit real*8 (a-h,o-z)
22467 ! include 'DIMENSIONS'
22468 ! include 'COMMON.IOUNITS'
22469 ! include 'COMMON.DERIV'
22470 ! include 'COMMON.INTERACT'
22471 ! include 'COMMON.CONTACTS'
22472 real(kind=8),dimension(3) :: gx,gx1
22474 !el local variables
22475 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
22476 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
22477 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
22478 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
22482 eij=facont_hb(jj,i)
22483 ekl=facont_hb(kk,k)
22484 ees0pij=ees0p(jj,i)
22485 ees0pkl=ees0p(kk,k)
22486 ees0mij=ees0m(jj,i)
22487 ees0mkl=ees0m(kk,k)
22489 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
22490 ! print *,"ehbcorr_nucl",ekont,ees
22491 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
22492 !C Following 4 lines for diagnostics.
22497 !cd write (iout,*)'Contacts have occurred for nucleic bases',
22498 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
22499 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
22500 !C Calculate the multi-body contribution to energy.
22501 ! ecorr_nucl=ecorr_nucl+ekont*ees
22502 !C Calculate multi-body contributions to the gradient.
22503 coeffpees0pij=coeffp*ees0pij
22504 coeffmees0mij=coeffm*ees0mij
22505 coeffpees0pkl=coeffp*ees0pkl
22506 coeffmees0mkl=coeffm*ees0mkl
22508 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i) &
22509 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
22510 coeffmees0mkl*gacontm_hb1(ll,jj,i))
22511 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j) &
22512 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+&
22513 coeffmees0mkl*gacontm_hb2(ll,jj,i))
22514 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k) &
22515 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
22516 coeffmees0mij*gacontm_hb1(ll,kk,k))
22517 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l) &
22518 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
22519 coeffmees0mij*gacontm_hb2(ll,kk,k))
22520 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
22521 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
22522 coeffmees0mkl*gacontm_hb3(ll,jj,i))
22523 gradcorr_nucl(ll,j)=gradcorr_nucl(ll,j)+gradlongij
22524 gradcorr_nucl(ll,i)=gradcorr_nucl(ll,i)-gradlongij
22525 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
22526 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
22527 coeffmees0mij*gacontm_hb3(ll,kk,k))
22528 gradcorr_nucl(ll,l)=gradcorr_nucl(ll,l)+gradlongkl
22529 gradcorr_nucl(ll,k)=gradcorr_nucl(ll,k)-gradlongkl
22530 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i)-gradlongij
22531 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j)+gradlongij
22532 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k)-gradlongkl
22533 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l)+gradlongkl
22535 ehbcorr_nucl=ekont*ees
22537 end function ehbcorr_nucl
22538 !-------------------------------------------------------------------------
22540 real(kind=8) function ehbcorr3_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
22541 ! implicit real*8 (a-h,o-z)
22542 ! include 'DIMENSIONS'
22543 ! include 'COMMON.IOUNITS'
22544 ! include 'COMMON.DERIV'
22545 ! include 'COMMON.INTERACT'
22546 ! include 'COMMON.CONTACTS'
22547 real(kind=8),dimension(3) :: gx,gx1
22549 !el local variables
22550 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
22551 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
22552 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
22553 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
22557 eij=facont_hb(jj,i)
22558 ekl=facont_hb(kk,k)
22559 ees0pij=ees0p(jj,i)
22560 ees0pkl=ees0p(kk,k)
22561 ees0mij=ees0m(jj,i)
22562 ees0mkl=ees0m(kk,k)
22564 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
22565 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
22566 !C Following 4 lines for diagnostics.
22571 !cd write (iout,*)'Contacts have occurred for nucleic bases',
22572 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
22573 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
22574 !C Calculate the multi-body contribution to energy.
22575 ! ecorr=ecorr+ekont*ees
22576 !C Calculate multi-body contributions to the gradient.
22577 coeffpees0pij=coeffp*ees0pij
22578 coeffmees0mij=coeffm*ees0mij
22579 coeffpees0pkl=coeffp*ees0pkl
22580 coeffmees0mkl=coeffm*ees0mkl
22582 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i) &
22583 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
22584 coeffmees0mkl*gacontm_hb1(ll,jj,i))
22585 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j) &
22586 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
22587 coeffmees0mkl*gacontm_hb2(ll,jj,i))
22588 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k) &
22589 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ &
22590 coeffmees0mij*gacontm_hb1(ll,kk,k))
22591 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l) &
22592 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
22593 coeffmees0mij*gacontm_hb2(ll,kk,k))
22594 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
22595 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
22596 coeffmees0mkl*gacontm_hb3(ll,jj,i))
22597 gradcorr3_nucl(ll,j)=gradcorr3_nucl(ll,j)+gradlongij
22598 gradcorr3_nucl(ll,i)=gradcorr3_nucl(ll,i)-gradlongij
22599 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
22600 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
22601 coeffmees0mij*gacontm_hb3(ll,kk,k))
22602 gradcorr3_nucl(ll,l)=gradcorr3_nucl(ll,l)+gradlongkl
22603 gradcorr3_nucl(ll,k)=gradcorr3_nucl(ll,k)-gradlongkl
22604 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i)-gradlongij
22605 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j)+gradlongij
22606 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k)-gradlongkl
22607 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l)+gradlongkl
22609 ehbcorr3_nucl=ekont*ees
22611 end function ehbcorr3_nucl
22613 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
22614 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
22615 real(kind=8):: buffer(dimen1,dimen2)
22616 num_kont=num_cont_hb(atom)
22620 buffer(i,indx+(k-1)*3+j)=zapas2(j,i,atom,k)
22623 buffer(i,indx+25)=facont_hb(i,atom)
22624 buffer(i,indx+26)=ees0p(i,atom)
22625 buffer(i,indx+27)=ees0m(i,atom)
22626 buffer(i,indx+28)=d_cont(i,atom)
22627 buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
22629 buffer(1,indx+30)=dfloat(num_kont)
22631 end subroutine pack_buffer
22632 !c------------------------------------------------------------------------------
22633 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
22634 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
22635 real(kind=8):: buffer(dimen1,dimen2)
22636 ! double precision zapas
22637 ! common /contacts_hb/ zapas(3,maxconts,maxres,8),
22638 ! & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
22639 ! & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
22640 ! & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
22641 num_kont=buffer(1,indx+30)
22642 num_kont_old=num_cont_hb(atom)
22643 num_cont_hb(atom)=num_kont+num_kont_old
22648 zapas2(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
22651 facont_hb(ii,atom)=buffer(i,indx+25)
22652 ees0p(ii,atom)=buffer(i,indx+26)
22653 ees0m(ii,atom)=buffer(i,indx+27)
22654 d_cont(i,atom)=buffer(i,indx+28)
22655 jcont_hb(ii,atom)=buffer(i,indx+29)
22658 end subroutine unpack_buffer
22659 !c------------------------------------------------------------------------------
22661 subroutine ecatcat(ecationcation)
22662 integer :: i,j,itmp,xshift,yshift,zshift,subchap,k,itypi,itypj
22663 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
22664 r7,r4,ecationcation,k0,rcal
22665 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
22666 dist_init,dist_temp,Evan1cat,Evan2cat,Eeleccat
22667 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
22670 ecationcation=0.0d0
22671 if (nres_molec(5).eq.0) return
22676 ! k0 = 332.0*(2.0*2.0)/80.0
22680 itmp=itmp+nres_molec(i)
22682 ! write(iout,*) "itmp",itmp
22683 do i=itmp+1,itmp+nres_molec(5)-1
22689 xi=mod(xi,boxxsize)
22690 if (xi.lt.0) xi=xi+boxxsize
22691 yi=mod(yi,boxysize)
22692 if (yi.lt.0) yi=yi+boxysize
22693 zi=mod(zi,boxzsize)
22694 if (zi.lt.0) zi=zi+boxzsize
22696 do j=i+1,itmp+nres_molec(5)
22698 k0 = 332.0*(ichargecat(itypi)*ichargecat(itypj))/80.0
22699 ! print *,i,j,'catcat'
22703 xj=dmod(xj,boxxsize)
22704 if (xj.lt.0) xj=xj+boxxsize
22705 yj=dmod(yj,boxysize)
22706 if (yj.lt.0) yj=yj+boxysize
22707 zj=dmod(zj,boxzsize)
22708 if (zj.lt.0) zj=zj+boxzsize
22709 ! write(iout,*) c(1,i),xi,xj,"xy",boxxsize
22710 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22718 xj=xj_safe+xshift*boxxsize
22719 yj=yj_safe+yshift*boxysize
22720 zj=zj_safe+zshift*boxzsize
22721 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22722 if(dist_temp.lt.dist_init) then
22723 dist_init=dist_temp
22732 if (subchap.eq.1) then
22741 rcal =xj**2+yj**2+zj**2
22747 ! k0 = 332*(2*2)/80
22748 Evan1cat=epscalc*(r012/rcal**6)
22749 Evan2cat=epscalc*2*(r06/rcal**3)
22757 dEvan1Cmcat(k)=-12*r(k)*epscalc*r012/r7
22758 dEvan2Cmcat(k)=-12*r(k)*epscalc*r06/r4
22759 dEeleccat(k)=-k0*r(k)/ract**3
22762 gg(k) = dEvan1Cmcat(k)+dEvan2Cmcat(k)+dEeleccat(k)
22763 gradcatcat(k,i)=gradcatcat(k,i)-gg(k)
22764 gradcatcat(k,j)=gradcatcat(k,j)+gg(k)
22767 ! write(iout,*) "ecatcat",i,j, ecationcation,xj,yj,zj
22768 ecationcation=ecationcation+Evan1cat+Evan2cat+Eeleccat
22772 end subroutine ecatcat
22773 !---------------------------------------------------------------------------
22775 subroutine ecats_prot_amber(evdw)
22776 ! subroutine ecat_prot2(ecation_prot)
22781 !el local variables
22782 integer :: iint,itypi1,subchap,isel,itmp
22783 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,e1,e2,sigm,epsi
22784 real(kind=8) :: evdw
22785 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
22786 dist_temp, dist_init,ssgradlipi,ssgradlipj, &
22787 sslipi,sslipj,faclip,alpha_sco
22789 real(kind=8) :: fracinbuf
22790 real (kind=8) :: escpho
22791 real (kind=8),dimension(4):: ener
22792 real(kind=8) :: b1,b2,egb
22793 real(kind=8) :: Fisocav,ECL,Elj,Equad,Epol,eheadtail,&
22795 Chif,ChiLambf,Fcav,dFdR,dFdOM1,&
22796 ecations_prot_amber,dFdOM2,dFdL,dFdOM12,&
22799 ! real(kind=8),dimension(3,2)::erhead_tail
22800 ! real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead,Rtail_distance
22801 real(kind=8) :: facd4, adler, Fgb, facd3
22802 integer troll,jj,istate
22803 real (kind=8) :: dcosom1(3),dcosom2(3)
22806 if (nres_molec(5).eq.0) return
22808 ! sss_ele_cut=1.0d0
22812 itmp=itmp+nres_molec(i)
22815 ! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
22816 do i=ibond_start,ibond_end
22818 ! print *,"I am in EVDW",i
22819 itypi=iabs(itype(i,1))
22821 ! if (i.ne.47) cycle
22822 if ((itypi.eq.ntyp1).or.(itypi.eq.10)) cycle
22823 itypi1=iabs(itype(i+1,1))
22827 xi=dmod(xi,boxxsize)
22828 if (xi.lt.0) xi=xi+boxxsize
22829 yi=dmod(yi,boxysize)
22830 if (yi.lt.0) yi=yi+boxysize
22831 zi=dmod(zi,boxzsize)
22832 if (zi.lt.0) zi=zi+boxzsize
22833 dxi=dc_norm(1,nres+i)
22834 dyi=dc_norm(2,nres+i)
22835 dzi=dc_norm(3,nres+i)
22836 dsci_inv=vbld_inv(i+nres)
22837 do j=itmp+1,itmp+nres_molec(5)
22839 ! Calculate SC interaction energy.
22840 itypj=iabs(itype(j,5))
22841 if ((itypj.eq.ntyp1)) cycle
22842 CALL elgrad_init_cat(eheadtail,Egb,Ecl,Elj,Equad,Epol)
22848 xj=dmod(xj,boxxsize)
22849 if (xj.lt.0) xj=xj+boxxsize
22850 yj=dmod(yj,boxysize)
22851 if (yj.lt.0) yj=yj+boxysize
22852 zj=dmod(zj,boxzsize)
22853 if (zj.lt.0) zj=zj+boxzsize
22854 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22863 xj=xj_safe+xshift*boxxsize
22864 yj=yj_safe+yshift*boxysize
22865 zj=zj_safe+zshift*boxzsize
22866 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22867 if(dist_temp.lt.dist_init) then
22868 dist_init=dist_temp
22877 if (subchap.eq.1) then
22887 ! dxj = dc_norm( 1, nres+j )
22888 ! dyj = dc_norm( 2, nres+j )
22889 ! dzj = dc_norm( 3, nres+j )
22893 ! Parameters from fitting the analitical expressions to the PMF obtained by umbrella
22894 ! sampling performed with amber package
22898 ! a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
22899 chi1 = chi1cat(itypi,itypj)
22900 chis1 = chis1cat(itypi,itypj)
22901 chip1 = chipp1cat(itypi,itypj)
22908 ! chis2 = chis(itypj,itypi)
22909 chis12 = chis1 * chis2
22910 sig1 = sigmap1cat(itypi,itypj)
22911 ! sig2 = sigmap2(itypi,itypj)
22912 ! alpha factors from Fcav/Gcav
22913 b1cav = alphasurcat(1,itypi,itypj)
22914 b2cav = alphasurcat(2,itypi,itypj)
22915 b3cav = alphasurcat(3,itypi,itypj)
22916 b4cav = alphasurcat(4,itypi,itypj)
22918 ! used to determine whether we want to do quadrupole calculations
22919 eps_in = epsintabcat(itypi,itypj)
22920 if (eps_in.eq.0.0) eps_in=1.0
22922 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
22926 ctail(k,1)=c(k,i+nres)
22929 !c! tail distances will be themselves usefull elswhere
22930 !c1 (in Gcav, for example)
22931 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
22932 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
22933 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
22935 (Rtail_distance(1)*Rtail_distance(1)) &
22936 + (Rtail_distance(2)*Rtail_distance(2)) &
22937 + (Rtail_distance(3)*Rtail_distance(3)))
22938 ! tail location and distance calculations
22940 d1 = dheadcat(1, 1, itypi, itypj)
22941 ! d2 = dhead(2, 1, itypi, itypj)
22943 ! location of polar head is computed by taking hydrophobic centre
22944 ! and moving by a d1 * dc_norm vector
22945 ! see unres publications for very informative images
22946 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
22947 chead(k,2) = c(k, j)
22949 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
22950 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
22951 Rhead_distance(k) = chead(k,2) - chead(k,1)
22953 ! pitagoras (root of sum of squares)
22955 (Rhead_distance(1)*Rhead_distance(1)) &
22956 + (Rhead_distance(2)*Rhead_distance(2)) &
22957 + (Rhead_distance(3)*Rhead_distance(3)))
22958 !-------------------------------------------------------------------
22959 ! zero everything that should be zero'ed
22977 dscj_inv = vbld_inv(j+nres)
22978 ! print *,i,j,dscj_inv,dsci_inv
22979 ! rij holds 1/(distance of Calpha atoms)
22980 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
22983 ! this should be in elgrad_init but om's are calculated by sc_angular
22984 ! which in turn is used by older potentials
22985 ! om = omega, sqom = om^2
22988 sqom12 = om12 * om12
22990 ! now we calculate EGB - Gey-Berne
22991 ! It will be summed up in evdwij and saved in evdw
22992 sigsq = 1.0D0 / sigsq
22993 sig = sig0ij * dsqrt(sigsq)
22994 ! rij_shift = 1.0D0 / rij - sig + sig0ij
22995 rij_shift = Rtail - sig + sig0ij
22996 IF (rij_shift.le.0.0D0) THEN
23000 sigder = -sig * sigsq
23001 rij_shift = 1.0D0 / rij_shift
23002 fac = rij_shift**expon
23003 c1 = fac * fac * aa_aq_cat(itypi,itypj)
23004 ! print *,"ADAM",aa_aq(itypi,itypj)
23007 c2 = fac * bb_aq_cat(itypi,itypj)
23009 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
23010 eps2der = eps3rt * evdwij
23011 eps3der = eps2rt * evdwij
23012 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
23013 evdwij = eps2rt * eps3rt * evdwij
23015 ! IF (bb_aq(itypi,itypj).gt.0) THEN
23016 ! evdw_p = evdw_p + evdwij
23018 ! evdw_m = evdw_m + evdwij
23024 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
23025 fac = -expon * (c1 + evdwij) * rij_shift
23026 sigder = fac * sigder
23027 ! Calculate distance derivative
23032 fac = chis1 * sqom1 + chis2 * sqom2 &
23033 - 2.0d0 * chis12 * om1 * om2 * om12
23034 pom = 1.0d0 - chis1 * chis2 * sqom12
23035 Lambf = (1.0d0 - (fac / pom))
23036 Lambf = dsqrt(Lambf)
23037 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
23038 Chif = Rtail * sparrow
23039 ChiLambf = Chif * Lambf
23040 eagle = dsqrt(ChiLambf)
23041 bat = ChiLambf ** 11.0d0
23042 top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
23043 bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
23047 dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
23048 dbot = 12.0d0 * b4cav * bat * Lambf
23049 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
23051 dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
23052 dbot = 12.0d0 * b4cav * bat * Chif
23053 eagle = Lambf * pom
23054 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
23055 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
23056 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
23057 * (chis2 * om2 * om12 - om1) / (eagle * pom)
23059 dFdL = ((dtop * bot - top * dbot) / botsq)
23060 dCAVdOM1 = dFdL * ( dFdOM1 )
23061 dCAVdOM2 = dFdL * ( dFdOM2 )
23062 dCAVdOM12 = dFdL * ( dFdOM12 )
23065 ertail(k) = Rtail_distance(k)/Rtail
23067 erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
23068 erdxj = scalar( ertail(1), dC_norm(1,j) )
23069 facd1 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
23070 facd2 = dtailcat(2,itypi,itypj) * vbld_inv(j+nres)
23072 pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
23073 gradpepcatx(k,i) = gradpepcatx(k,i) &
23074 - (( dFdR + gg(k) ) * pom)
23075 pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
23076 ! gvdwx(k,j) = gvdwx(k,j) &
23077 ! + (( dFdR + gg(k) ) * pom)
23078 gradpepcat(k,i) = gradpepcat(k,i) &
23079 - (( dFdR + gg(k) ) * ertail(k))
23080 gradpepcat(k,j) = gradpepcat(k,j) &
23081 + (( dFdR + gg(k) ) * ertail(k))
23084 !c! Compute head-head and head-tail energies for each state
23085 isel = iabs(Qi) + 1 ! ion is always charged so iabs(Qj)
23086 IF (isel.eq.0) THEN
23087 !c! No charges - do nothing
23090 ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
23091 !c! Nonpolar-charge interactions
23092 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
23096 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
23103 ! eheadtail = 0.0d0
23105 ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
23106 !c! Dipole-charge interactions
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
23115 CALL edq_cat(ecl, elj, epol)
23116 eheadtail = ECL + elj + epol
23117 ! eheadtail = 0.0d0
23119 ELSE IF ((isel.eq.2.and. &
23120 iabs(Qi).eq.1).and. &
23121 nstatecat(itypi,itypj).eq.1) THEN
23123 !c! Same 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 eqq_cat(Ecl,Egb,Epol,Fisocav,Elj)
23134 eheadtail = ECL + Egb + Epol + Fisocav + Elj
23135 ! eheadtail = 0.0d0
23137 ! ELSE IF ((isel.eq.2.and. &
23138 ! iabs(Qi).eq.1).and. &
23139 ! nstate(itypi,itypj).ne.1) THEN
23140 !c! Different charge-charge interaction ( +/- or -/+ )
23141 ! if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
23145 ! if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
23150 ! CALL energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
23151 END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
23152 evdw = evdw + Fcav + eheadtail
23154 IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
23155 restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
23156 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
23157 Equad,evdwij+Fcav+eheadtail,evdw
23158 ! evdw = evdw + Fcav + eheadtail
23160 ! iF (nstate(itypi,itypj).eq.1) THEN
23163 !c!-------------------------------------------------------------------
23167 !c write (iout,*) "Number of loop steps in EGB:",ind
23168 !c energy_dec=.false.
23169 ! print *,"EVDW KURW",evdw,nres
23172 do i=ibond_start,ibond_end
23174 ! print *,"I am in EVDW",i
23175 itypi=10 ! the peptide group parameters are for glicine
23177 ! if (i.ne.47) cycle
23178 if ((itype(i,1).eq.ntyp1).or.itype(i+1,1).eq.ntyp1) cycle
23179 itypi1=iabs(itype(i+1,1))
23180 xi=(c(1,i)+c(1,i+1))/2.0
23181 yi=(c(2,i)+c(2,i+1))/2.0
23182 zi=(c(3,i)+c(3,i+1))/2.0
23183 xi=dmod(xi,boxxsize)
23184 if (xi.lt.0) xi=xi+boxxsize
23185 yi=dmod(yi,boxysize)
23186 if (yi.lt.0) yi=yi+boxysize
23187 zi=dmod(zi,boxzsize)
23188 if (zi.lt.0) zi=zi+boxzsize
23192 dsci_inv=vbld_inv(i+1)/2.0
23193 do j=itmp+1,itmp+nres_molec(5)
23195 ! Calculate SC interaction energy.
23196 itypj=iabs(itype(j,5))
23197 if ((itypj.eq.ntyp1)) cycle
23198 CALL elgrad_init_cat_pep(eheadtail,Egb,Ecl,Elj,Equad,Epol)
23204 xj=dmod(xj,boxxsize)
23205 if (xj.lt.0) xj=xj+boxxsize
23206 yj=dmod(yj,boxysize)
23207 if (yj.lt.0) yj=yj+boxysize
23208 zj=dmod(zj,boxzsize)
23209 if (zj.lt.0) zj=zj+boxzsize
23210 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23219 xj=xj_safe+xshift*boxxsize
23220 yj=yj_safe+yshift*boxysize
23221 zj=zj_safe+zshift*boxzsize
23222 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23223 if(dist_temp.lt.dist_init) then
23224 dist_init=dist_temp
23233 if (subchap.eq.1) then
23243 dxj = 0.0d0! dc_norm( 1, nres+j )
23244 dyj = 0.0d0!dc_norm( 2, nres+j )
23245 dzj = 0.0d0! dc_norm( 3, nres+j )
23249 ! Parameters from fitting the analitical expressions to the PMF obtained by umbrella
23250 ! sampling performed with amber package
23254 ! a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
23255 chi1 = chi1cat(itypi,itypj)
23256 chis1 = chis1cat(itypi,itypj)
23257 chip1 = chipp1cat(itypi,itypj)
23264 ! chis2 = chis(itypj,itypi)
23265 chis12 = chis1 * chis2
23266 sig1 = sigmap1cat(itypi,itypj)
23267 ! sig2 = sigmap2(itypi,itypj)
23268 ! alpha factors from Fcav/Gcav
23269 b1cav = alphasurcat(1,itypi,itypj)
23270 b2cav = alphasurcat(2,itypi,itypj)
23271 b3cav = alphasurcat(3,itypi,itypj)
23272 b4cav = alphasurcat(4,itypi,itypj)
23274 ! used to determine whether we want to do quadrupole calculations
23275 eps_in = epsintabcat(itypi,itypj)
23276 if (eps_in.eq.0.0) eps_in=1.0
23278 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
23282 ctail(k,1)=(c(k,i)+c(k,i+1))/2.0
23285 !c! tail distances will be themselves usefull elswhere
23286 !c1 (in Gcav, for example)
23287 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
23288 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
23289 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
23291 (Rtail_distance(1)*Rtail_distance(1)) &
23292 + (Rtail_distance(2)*Rtail_distance(2)) &
23293 + (Rtail_distance(3)*Rtail_distance(3)))
23294 ! tail location and distance calculations
23296 d1 = dheadcat(1, 1, itypi, itypj)
23297 ! d2 = dhead(2, 1, itypi, itypj)
23299 ! location of polar head is computed by taking hydrophobic centre
23300 ! and moving by a d1 * dc_norm vector
23301 ! see unres publications for very informative images
23302 chead(k,1) = (c(k, i)+c(k,i+1))/2.0 + d1 * dc_norm(k, i)
23303 chead(k,2) = c(k, j)
23305 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
23306 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
23307 Rhead_distance(k) = chead(k,2) - chead(k,1)
23309 ! pitagoras (root of sum of squares)
23311 (Rhead_distance(1)*Rhead_distance(1)) &
23312 + (Rhead_distance(2)*Rhead_distance(2)) &
23313 + (Rhead_distance(3)*Rhead_distance(3)))
23314 !-------------------------------------------------------------------
23315 ! zero everything that should be zero'ed
23333 dscj_inv = vbld_inv(j+nres)
23334 ! print *,i,j,dscj_inv,dsci_inv
23335 ! rij holds 1/(distance of Calpha atoms)
23336 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23339 ! this should be in elgrad_init but om's are calculated by sc_angular
23340 ! which in turn is used by older potentials
23341 ! om = omega, sqom = om^2
23344 sqom12 = om12 * om12
23346 ! now we calculate EGB - Gey-Berne
23347 ! It will be summed up in evdwij and saved in evdw
23348 sigsq = 1.0D0 / sigsq
23349 sig = sig0ij * dsqrt(sigsq)
23350 ! rij_shift = 1.0D0 / rij - sig + sig0ij
23351 rij_shift = Rtail - sig + sig0ij
23352 IF (rij_shift.le.0.0D0) THEN
23356 sigder = -sig * sigsq
23357 rij_shift = 1.0D0 / rij_shift
23358 fac = rij_shift**expon
23359 c1 = fac * fac * aa_aq_cat(itypi,itypj)
23360 ! print *,"ADAM",aa_aq(itypi,itypj)
23363 c2 = fac * bb_aq_cat(itypi,itypj)
23365 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
23366 eps2der = eps3rt * evdwij
23367 eps3der = eps2rt * evdwij
23368 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
23369 evdwij = eps2rt * eps3rt * evdwij
23371 ! IF (bb_aq(itypi,itypj).gt.0) THEN
23372 ! evdw_p = evdw_p + evdwij
23374 ! evdw_m = evdw_m + evdwij
23380 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
23381 fac = -expon * (c1 + evdwij) * rij_shift
23382 sigder = fac * sigder
23383 ! Calculate distance derivative
23388 fac = chis1 * sqom1 + chis2 * sqom2 &
23389 - 2.0d0 * chis12 * om1 * om2 * om12
23391 pom = 1.0d0 - chis1 * chis2 * sqom12
23392 print *,"TUT2",fac,chis1,sqom1,pom
23393 Lambf = (1.0d0 - (fac / pom))
23394 Lambf = dsqrt(Lambf)
23395 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
23396 Chif = Rtail * sparrow
23397 ChiLambf = Chif * Lambf
23398 eagle = dsqrt(ChiLambf)
23399 bat = ChiLambf ** 11.0d0
23400 top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
23401 bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
23405 dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
23406 dbot = 12.0d0 * b4cav * bat * Lambf
23407 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
23409 dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
23410 dbot = 12.0d0 * b4cav * bat * Chif
23411 eagle = Lambf * pom
23412 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
23413 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
23414 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
23415 * (chis2 * om2 * om12 - om1) / (eagle * pom)
23417 dFdL = ((dtop * bot - top * dbot) / botsq)
23418 dCAVdOM1 = dFdL * ( dFdOM1 )
23419 dCAVdOM2 = dFdL * ( dFdOM2 )
23420 dCAVdOM12 = dFdL * ( dFdOM12 )
23423 ertail(k) = Rtail_distance(k)/Rtail
23425 erdxi = scalar( ertail(1), dC_norm(1,i) )
23426 erdxj = scalar( ertail(1), dC_norm(1,j) )
23427 facd1 = dtailcat(1,itypi,itypj) * vbld_inv(i)
23428 facd2 = dtailcat(2,itypi,itypj) * vbld_inv(j+nres)
23430 pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i))
23431 ! gradpepcatx(k,i) = gradpepcatx(k,i) &
23432 ! - (( dFdR + gg(k) ) * pom)
23433 pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
23434 ! gvdwx(k,j) = gvdwx(k,j) &
23435 ! + (( dFdR + gg(k) ) * pom)
23436 gradpepcat(k,i) = gradpepcat(k,i) &
23437 - (( dFdR + gg(k) ) * ertail(k))/2.0d0
23438 gradpepcat(k,i+1) = gradpepcat(k,i+1) &
23439 - (( dFdR + gg(k) ) * ertail(k))/2.0d0
23441 gradpepcat(k,j) = gradpepcat(k,j) &
23442 + (( dFdR + gg(k) ) * ertail(k))
23445 !c! Compute head-head and head-tail energies for each state
23447 !c! Dipole-charge interactions
23448 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
23452 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
23456 CALL edq_cat_pep(ecl, elj, epol)
23457 eheadtail = ECL + elj + epol
23458 ! print *,"i,",i,eheadtail
23461 evdw = evdw + Fcav + eheadtail
23463 IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
23464 restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
23465 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
23466 Equad,evdwij+Fcav+eheadtail,evdw
23467 ! evdw = evdw + Fcav + eheadtail
23469 ! iF (nstate(itypi,itypj).eq.1) THEN
23470 CALL sc_grad_cat_pep
23472 !c!-------------------------------------------------------------------
23476 !c write (iout,*) "Number of loop steps in EGB:",ind
23477 !c energy_dec=.false.
23478 ! print *,"EVDW KURW",evdw,nres
23482 end subroutine ecats_prot_amber
23484 !---------------------------------------------------------------------------
23486 subroutine ecat_prot(ecation_prot)
23489 integer i,j,k,subchap,itmp,inum
23490 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
23491 r7,r4,ecationcation
23492 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
23493 dist_init,dist_temp,ecation_prot,rcal,rocal, &
23494 Evan1,Evan2,EC,cm1mag,DASGL,delta,r0p,Epepcat, &
23495 catl,cml,calpl, Etotal_p, Etotal_m,rtab,wdip,wmodquad,wquad1, &
23496 wquad2,wvan1,E1,E2,wconst,wvan2,rcpm,dcmag,sin2thet,sinthet, &
23497 costhet,v1m,v2m,wh2o,wc,rsecp,Ir,Irsecp,Irthrp,Irfourp,Irfiftp,&
23498 Irsistp,Irseven,Irtwelv,Irthir,dE1dr,dE2dr,dEdcos,wquad2p,opt, &
23499 rs,rthrp,rfourp,rsixp,reight,Irsixp,Ireight,Irtw,Irfourt, &
23500 opt1,opt2,opt3,opt4,opt5,opt6,opt7,opt8,opt9,opt10,opt11,opt12,&
23501 opt13,opt14,opt15,opt16,opt17,opt18,opt19, &
23502 Equad1,Equad2,dscmag,v1dpv2,dscmag3,constA,constB,Edip,&
23504 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
23505 gg,r,EtotalCat,dEtotalCm,dEtotalCalp,dEvan1Cm,dEvan2Cm, &
23506 dEtotalpep,dEtotalcat_num,dEddci,dEtotalcm_num,dEtotalcalp_num, &
23507 tab1,tab2,tab3,diff,cm1,sc,p,tcat,talp,cm,drcp,drcp_norm,vcat, &
23508 v1,v2,v3,myd_norm,dx,vcm,valpha,drdpep,dcosdpep,dcosddci,dEdpep,&
23509 dEcCat,dEdipCm,dEdipCalp,dEquad1Cat,dEquad1Cm,dEquad1Calp, &
23510 dEquad2Cat,dEquad2Cm,dEquad2Calpd,Evan1Cat,dEvan1Calp,dEvan2Cat,&
23511 dEvan2Calp,dEtotalCat,dscvec,dEcCm,dEcCalp,dEdipCat,dEquad2Calp,&
23513 real(kind=8),dimension(6) :: vcatprm
23515 ! first lets calculate interaction with peptide groups
23516 if (nres_molec(5).eq.0) return
23519 itmp=itmp+nres_molec(i)
23521 ! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
23522 do i=ibond_start,ibond_end
23524 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle ! leave dummy atoms
23525 xi=0.5d0*(c(1,i)+c(1,i+1))
23526 yi=0.5d0*(c(2,i)+c(2,i+1))
23527 zi=0.5d0*(c(3,i)+c(3,i+1))
23528 xi=mod(xi,boxxsize)
23529 if (xi.lt.0) xi=xi+boxxsize
23530 yi=mod(yi,boxysize)
23531 if (yi.lt.0) yi=yi+boxysize
23532 zi=mod(zi,boxzsize)
23533 if (zi.lt.0) zi=zi+boxzsize
23535 do j=itmp+1,itmp+nres_molec(5)
23536 ! print *,"WTF",itmp,j,i
23537 ! all parameters were for Ca2+ to approximate single charge divide by two
23539 if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
23541 wdip =1.092777950857032D2
23543 wmodquad=-2.174122713004870D4
23544 wmodquad=wmodquad/wconst
23545 wquad1 = 3.901232068562804D1
23546 wquad1=wquad1/wconst
23548 wquad2=wquad2/wconst
23556 xj=dmod(xj,boxxsize)
23557 if (xj.lt.0) xj=xj+boxxsize
23558 yj=dmod(yj,boxysize)
23559 if (yj.lt.0) yj=yj+boxysize
23560 zj=dmod(zj,boxzsize)
23561 if (zj.lt.0) zj=zj+boxzsize
23562 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23570 xj=xj_safe+xshift*boxxsize
23571 yj=yj_safe+yshift*boxysize
23572 zj=zj_safe+zshift*boxzsize
23573 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23574 if(dist_temp.lt.dist_init) then
23575 dist_init=dist_temp
23584 if (subchap.eq.1) then
23595 rcpm = sqrt(xj**2+yj**2+zj**2)
23596 drcp_norm(1)=xj/rcpm
23597 drcp_norm(2)=yj/rcpm
23598 drcp_norm(3)=zj/rcpm
23601 dcmag=dcmag+dc(k,i)**2
23605 myd_norm(k)=dc(k,i)/dcmag
23607 costhet=drcp_norm(1)*myd_norm(1)+drcp_norm(2)*myd_norm(2)+&
23608 drcp_norm(3)*myd_norm(3)
23611 Irsecp = 1.0d0/rsecp
23612 Irthrp = Irsecp/rcpm
23613 Irfourp = Irthrp/rcpm
23614 Irfiftp = Irfourp/rcpm
23615 Irsistp=Irfiftp/rcpm
23616 Irseven=Irsistp/rcpm
23617 Irtwelv=Irsistp*Irsistp
23618 Irthir=Irtwelv/rcpm
23619 sin2thet = (1-costhet*costhet)
23620 sinthet=sqrt(sin2thet)
23621 E1 = wdip*Irsecp*costhet+(wmodquad*Irfourp+wquad1*Irthrp)&
23623 E2 = -wquad1*Irthrp*wquad2+wvan1*(wvan2**12*Irtwelv-&
23624 2*wvan2**6*Irsistp)
23625 ecation_prot = ecation_prot+E1+E2
23626 ! print *,"ecatprot",i,j,ecation_prot,rcpm
23627 dE1dr = -2*costhet*wdip*Irthrp-&
23628 (4*wmodquad*Irfiftp+3*wquad1*Irfourp)*sin2thet
23629 dE2dr = 3*wquad1*wquad2*Irfourp- &
23630 12*wvan1*wvan2**6*(wvan2**6*Irthir-Irseven)
23631 dEdcos = wdip*Irsecp-2*(wmodquad*Irfourp+wquad1*Irthrp)*costhet
23633 drdpep(k) = -drcp_norm(k)
23634 dcosdpep(k) = Ir*(costhet*drcp_norm(k)-myd_norm(k))
23635 dcosddci(k) = drcp_norm(k)/dcmag-costhet*myd_norm(k)/dcmag
23636 dEdpep(k) = (dE1dr+dE2dr)*drdpep(k)+dEdcos*dcosdpep(k)
23637 dEddci(k) = dEdcos*dcosddci(k)
23640 gradpepcat(k,i)=gradpepcat(k,i)+0.5D0*dEdpep(k)-dEddci(k)
23641 gradpepcat(k,i+1)=gradpepcat(k,i+1)+0.5D0*dEdpep(k)+dEddci(k)
23642 gradpepcat(k,j)=gradpepcat(k,j)-dEdpep(k)
23646 !------------------------------------------sidechains
23647 ! do i=1,nres_molec(1)
23648 do i=ibond_start,ibond_end
23649 if ((itype(i,1).eq.ntyp1)) cycle ! leave dummy atoms
23651 ! print *,i,ecation_prot
23655 xi=mod(xi,boxxsize)
23656 if (xi.lt.0) xi=xi+boxxsize
23657 yi=mod(yi,boxysize)
23658 if (yi.lt.0) yi=yi+boxysize
23659 zi=mod(zi,boxzsize)
23660 if (zi.lt.0) zi=zi+boxzsize
23662 cm1(k)=dc(k,i+nres)
23664 cm1mag=sqrt(cm1(1)**2+cm1(2)**2+cm1(3)**2)
23665 do j=itmp+1,itmp+nres_molec(5)
23667 if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
23672 xj=dmod(xj,boxxsize)
23673 if (xj.lt.0) xj=xj+boxxsize
23674 yj=dmod(yj,boxysize)
23675 if (yj.lt.0) yj=yj+boxysize
23676 zj=dmod(zj,boxzsize)
23677 if (zj.lt.0) zj=zj+boxzsize
23678 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23686 xj=xj_safe+xshift*boxxsize
23687 yj=yj_safe+yshift*boxysize
23688 zj=zj_safe+zshift*boxzsize
23689 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23690 if(dist_temp.lt.dist_init) then
23691 dist_init=dist_temp
23700 if (subchap.eq.1) then
23712 if((itype(i,1).eq.15.or.itype(i,1).eq.16).or.&
23713 ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.&
23714 (itype(i,1).eq.25))) then
23715 if(itype(i,1).eq.16) then
23721 vcatprm(k)=catprm(k,inum)
23723 dASGL=catprm(7,inum)
23725 ! vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
23726 vcm(1)=(cm1(1)/cm1mag)*dASGL+xi
23727 vcm(2)=(cm1(2)/cm1mag)*dASGL+yi
23728 vcm(3)=(cm1(3)/cm1mag)*dASGL+zi
23732 if (subchap.eq.1) then
23741 valpha(1)=xi-c(1,i+nres)+c(1,i)
23742 valpha(2)=yi-c(2,i+nres)+c(2,i)
23743 valpha(3)=zi-c(3,i+nres)+c(3,i)
23747 dx(k) = vcat(k)-vcm(k)
23750 v1(k)=(vcm(k)-valpha(k))
23751 v2(k)=(vcat(k)-valpha(k))
23753 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
23754 v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
23755 v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
23757 ! The weights of the energy function calculated from
23758 !The quantum mechanical GAMESS simulations of calcium with ASP/GLU
23759 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
23765 if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
23774 wquad2 = vcatprm(4)
23776 wquad2p = 1.0d0-wquad2
23779 opt = dx(1)**2+dx(2)**2
23780 rsecp = opt+dx(3)**2
23784 rsixp = rfourp*rsecp
23787 Irsecp = 1.0d0/rsecp
23789 Irfourp = Irthrp/rs
23790 Irsixp = 1.0d0/rsixp
23791 Ireight=1.0d0/reight
23795 opt1 = (4*rs*dx(3)*wdip)
23796 opt2 = 6*rsecp*wquad1*opt
23797 opt3 = wquad1*wquad2p*Irsixp
23798 opt4 = (wvan1*wvan2**12)
23799 opt5 = opt4*12*Irfourt
23800 opt6 = 2*wvan1*wvan2**6
23801 opt7 = 6*opt6*Ireight
23804 opt11 = (rsecp*v2m)**2
23805 opt12 = (rsecp*v1m)**2
23806 opt14 = (v1m*v2m*rsecp)**2
23807 opt15 = -wquad1/v2m**2
23808 opt16 = (rthrp*(v1m*v2m)**2)**2
23809 opt17 = (v1m**2*rthrp)**2
23810 opt18 = -wquad1/rthrp
23811 opt19 = (v1m**2*v2m**2)**2
23814 dEcCat(k) = -(dx(k)*wc)*Irthrp
23815 dEcCm(k)=(dx(k)*wc)*Irthrp
23818 Edip=opt8*(v1dpv2)/(rsecp*v2m)
23820 dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m &
23821 *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
23822 dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m &
23823 *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
23824 dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m &
23825 *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp) &
23828 Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
23830 dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp* &
23831 (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2* &
23832 v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
23833 dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp* &
23834 (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2* &
23835 v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
23836 dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
23837 v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)* &
23840 Equad2=wquad1*wquad2p*Irthrp
23842 dEquad2Cat(k)=-3*dx(k)*rs*opt3
23843 dEquad2Cm(k)=3*dx(k)*rs*opt3
23844 dEquad2Calp(k)=0.0d0
23848 dEvan1Cat(k)=-dx(k)*opt5
23849 dEvan1Cm(k)=dx(k)*opt5
23850 dEvan1Calp(k)=0.0d0
23854 dEvan2Cat(k)=dx(k)*opt7
23855 dEvan2Cm(k)=-dx(k)*opt7
23856 dEvan2Calp(k)=0.0d0
23858 ecation_prot=ecation_prot+Ec+Edip+Equad1+Equad2+Evan1+Evan2
23859 ! print *,ecation_prot,Ec+Edip+Equad1+Equad2+Evan1+Evan2
23862 dEtotalCat(k)=dEcCat(k)+dEdipCat(k)+dEquad1Cat(k)+ &
23863 dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
23864 !c write(*,*) 'dEtotalCat inside', (dEtotalCat(l),l=1,3)
23865 dEtotalCm(k)=dEcCm(k)+dEdipCm(k)+dEquad1Cm(k)+ &
23866 dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
23867 dEtotalCalp(k)=dEcCalp(k)+dEdipCalp(k)+dEquad1Calp(k) &
23868 +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
23872 dscvec(k) = dc(k,i+nres)
23873 dscmag = dscmag+dscvec(k)*dscvec(k)
23876 dscmag = sqrt(dscmag)
23877 dscmag3 = dscmag3*dscmag
23878 constA = 1.0d0+dASGL/dscmag
23881 constB = constB+dscvec(k)*dEtotalCm(k)
23883 constB = constB*dASGL/dscmag3
23885 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
23886 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
23887 constA*dEtotalCm(k)-constB*dscvec(k)
23888 ! print *,j,constA,dEtotalCm(k),constB,dscvec(k)
23889 gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
23890 gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
23892 else if (itype(i,1).eq.13.or.itype(i,1).eq.14) then
23893 if(itype(i,1).eq.14) then
23899 vcatprm(k)=catprm(k,inum)
23901 dASGL=catprm(7,inum)
23903 ! vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
23907 vcm(1)=(cm1(1)/cm1mag)*dASGL+xi
23908 vcm(2)=(cm1(2)/cm1mag)*dASGL+yi
23909 vcm(3)=(cm1(3)/cm1mag)*dASGL+zi
23910 if (subchap.eq.1) then
23919 valpha(1)=xi-c(1,i+nres)+c(1,i)
23920 valpha(2)=yi-c(2,i+nres)+c(2,i)
23921 valpha(3)=zi-c(3,i+nres)+c(3,i)
23925 dx(k) = vcat(k)-vcm(k)
23928 v1(k)=(vcm(k)-valpha(k))
23929 v2(k)=(vcat(k)-valpha(k))
23931 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
23932 v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
23933 v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
23934 ! The weights of the energy function calculated from
23935 !The quantum mechanical GAMESS simulations of ASN/GLN with calcium
23937 if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
23944 wquad2 = vcatprm(4)
23949 opt = dx(1)**2+dx(2)**2
23950 rsecp = opt+dx(3)**2
23954 rsixp = rfourp*rsecp
23959 Irfourp = Irthrp/rs
23965 opt1 = (4*rs*dx(3)*wdip)
23966 opt2 = 6*rsecp*wquad1*opt
23967 opt3 = wquad1*wquad2p*Irsixp
23968 opt4 = (wvan1*wvan2**12)
23969 opt5 = opt4*12*Irfourt
23970 opt6 = 2*wvan1*wvan2**6
23971 opt7 = 6*opt6*Ireight
23974 opt11 = (rsecp*v2m)**2
23975 opt12 = (rsecp*v1m)**2
23976 opt14 = (v1m*v2m*rsecp)**2
23977 opt15 = -wquad1/v2m**2
23978 opt16 = (rthrp*(v1m*v2m)**2)**2
23979 opt17 = (v1m**2*rthrp)**2
23980 opt18 = -wquad1/rthrp
23981 opt19 = (v1m**2*v2m**2)**2
23982 Edip=opt8*(v1dpv2)/(rsecp*v2m)
23984 dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m&
23985 *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
23986 dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m&
23987 *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
23988 dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m&
23989 *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp)&
23992 Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
23994 dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp*&
23995 (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2*&
23996 v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
23997 dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp*&
23998 (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2*&
23999 v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
24000 dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
24001 v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)*&
24004 Equad2=wquad1*wquad2p*Irthrp
24006 dEquad2Cat(k)=-3*dx(k)*rs*opt3
24007 dEquad2Cm(k)=3*dx(k)*rs*opt3
24008 dEquad2Calp(k)=0.0d0
24012 dEvan1Cat(k)=-dx(k)*opt5
24013 dEvan1Cm(k)=dx(k)*opt5
24014 dEvan1Calp(k)=0.0d0
24018 dEvan2Cat(k)=dx(k)*opt7
24019 dEvan2Cm(k)=-dx(k)*opt7
24020 dEvan2Calp(k)=0.0d0
24022 ecation_prot = ecation_prot+Edip+Equad1+Equad2+Evan1+Evan2
24024 dEtotalCat(k)=dEdipCat(k)+dEquad1Cat(k)+ &
24025 dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
24026 dEtotalCm(k)=dEdipCm(k)+dEquad1Cm(k)+ &
24027 dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
24028 dEtotalCalp(k)=dEdipCalp(k)+dEquad1Calp(k) &
24029 +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
24033 dscvec(k) = c(k,i+nres)-c(k,i)
24039 dscmag = dscmag+dscvec(k)*dscvec(k)
24042 dscmag = sqrt(dscmag)
24043 dscmag3 = dscmag3*dscmag
24044 constA = 1+dASGL/dscmag
24047 constB = constB+dscvec(k)*dEtotalCm(k)
24049 constB = constB*dASGL/dscmag3
24051 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
24052 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
24053 constA*dEtotalCm(k)-constB*dscvec(k)
24054 gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
24055 gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
24060 ! r(k) = c(k,j)-c(k,i+nres)
24064 rcal = rcal+r(k)*r(k)
24069 r0p=0.5*(rocal+sig0(itype(i,1)))
24072 Evan1=epscalc*(r012/rcal**6)
24073 Evan2=epscalc*2*(r06/rcal**3)
24077 dEvan1Cm(k) = 12*r(k)*epscalc*r012/r7
24078 dEvan2Cm(k) = 12*r(k)*epscalc*r06/r4
24081 dEtotalCm(k)=dEvan1Cm(k)+dEvan2Cm(k)
24083 ecation_prot = ecation_prot+ Evan1+Evan2
24085 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
24087 gradpepcat(k,i)=gradpepcat(k,i)+dEtotalCm(k)
24088 gradpepcat(k,j)=gradpepcat(k,j)-dEtotalCm(k)
24090 endif ! 13-16 residues
24094 end subroutine ecat_prot
24096 !----------------------------------------------------------------------------
24097 !-----------------------------------------------------------------------------
24098 !-----------------------------------------------------------------------------
24099 subroutine eprot_sc_base(escbase)
24101 ! implicit real*8 (a-h,o-z)
24102 ! include 'DIMENSIONS'
24103 ! include 'COMMON.GEO'
24104 ! include 'COMMON.VAR'
24105 ! include 'COMMON.LOCAL'
24106 ! include 'COMMON.CHAIN'
24107 ! include 'COMMON.DERIV'
24108 ! include 'COMMON.NAMES'
24109 ! include 'COMMON.INTERACT'
24110 ! include 'COMMON.IOUNITS'
24111 ! include 'COMMON.CALC'
24112 ! include 'COMMON.CONTROL'
24113 ! include 'COMMON.SBRIDGE'
24115 !el local variables
24116 integer :: iint,itypi,itypi1,itypj,subchap
24117 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
24118 real(kind=8) :: evdw,sig0ij
24119 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
24120 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
24121 sslipi,sslipj,faclip
24123 real(kind=8) :: fracinbuf
24124 real (kind=8) :: escbase
24125 real (kind=8),dimension(4):: ener
24126 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
24127 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
24128 sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
24129 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
24130 dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
24131 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
24132 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
24133 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
24134 real(kind=8),dimension(3,2)::chead,erhead_tail
24135 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
24139 ! do i=1,nres_molec(1)
24140 do i=ibond_start,ibond_end
24141 if (itype(i,1).eq.ntyp1_molec(1)) cycle
24143 dxi = dc_norm(1,nres+i)
24144 dyi = dc_norm(2,nres+i)
24145 dzi = dc_norm(3,nres+i)
24146 dsci_inv = vbld_inv(i+nres)
24150 xi=mod(xi,boxxsize)
24151 if (xi.lt.0) xi=xi+boxxsize
24152 yi=mod(yi,boxysize)
24153 if (yi.lt.0) yi=yi+boxysize
24154 zi=mod(zi,boxzsize)
24155 if (zi.lt.0) zi=zi+boxzsize
24156 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
24158 if (itype(j,2).eq.ntyp1_molec(2))cycle
24162 xj=dmod(xj,boxxsize)
24163 if (xj.lt.0) xj=xj+boxxsize
24164 yj=dmod(yj,boxysize)
24165 if (yj.lt.0) yj=yj+boxysize
24166 zj=dmod(zj,boxzsize)
24167 if (zj.lt.0) zj=zj+boxzsize
24168 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
24177 xj=xj_safe+xshift*boxxsize
24178 yj=yj_safe+yshift*boxysize
24179 zj=zj_safe+zshift*boxzsize
24180 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
24181 if(dist_temp.lt.dist_init) then
24182 dist_init=dist_temp
24191 if (subchap.eq.1) then
24200 dxj = dc_norm( 1, nres+j )
24201 dyj = dc_norm( 2, nres+j )
24202 dzj = dc_norm( 3, nres+j )
24203 ! print *,i,j,itypi,itypj
24204 d1i = dhead_scbasei(itypi,itypj) !this is shift of dipole/charge
24205 d1j = dhead_scbasej(itypi,itypj) !this is shift of dipole/charge
24208 ! BetaT = 1.0d0 / (298.0d0 * Rb)
24210 sig0ij = sigma_scbase( itypi,itypj )
24211 chi1 = chi_scbase( itypi, itypj,1 )
24212 chi2 = chi_scbase( itypi, itypj,2 )
24215 chi12 = chi1 * chi2
24216 chip1 = chipp_scbase( itypi, itypj,1 )
24217 chip2 = chipp_scbase( itypi, itypj,2 )
24220 chip12 = chip1 * chip2
24221 ! not used by momo potential, but needed by sc_angular which is shared
24222 ! by all energy_potential subroutines
24226 a12sq = rborn_scbasei(itypi,itypj) * rborn_scbasej(itypi,itypj)
24227 ! a12sq = a12sq * a12sq
24228 ! charge of amino acid itypi is...
24229 chis1 = chis_scbase(itypi,itypj,1)
24230 chis2 = chis_scbase(itypi,itypj,2)
24231 chis12 = chis1 * chis2
24232 sig1 = sigmap1_scbase(itypi,itypj)
24233 sig2 = sigmap2_scbase(itypi,itypj)
24234 ! write (*,*) "sig1 = ", sig1
24235 ! write (*,*) "sig2 = ", sig2
24236 ! alpha factors from Fcav/Gcav
24237 b1 = alphasur_scbase(1,itypi,itypj)
24239 b2 = alphasur_scbase(2,itypi,itypj)
24240 b3 = alphasur_scbase(3,itypi,itypj)
24241 b4 = alphasur_scbase(4,itypi,itypj)
24242 ! used to determine whether we want to do quadrupole calculations
24244 eps_in = epsintab_scbase(itypi,itypj)
24245 if (eps_in.eq.0.0) eps_in=1.0
24246 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
24247 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
24248 !-------------------------------------------------------------------
24249 ! tail location and distance calculations
24251 ! location of polar head is computed by taking hydrophobic centre
24252 ! and moving by a d1 * dc_norm vector
24253 ! see unres publications for very informative images
24254 chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
24255 chead(k,2) = c(k, j+nres) + d1j * dc_norm(k, j+nres)
24257 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
24258 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
24259 Rhead_distance(k) = chead(k,2) - chead(k,1)
24261 ! pitagoras (root of sum of squares)
24263 (Rhead_distance(1)*Rhead_distance(1)) &
24264 + (Rhead_distance(2)*Rhead_distance(2)) &
24265 + (Rhead_distance(3)*Rhead_distance(3)))
24266 !-------------------------------------------------------------------
24267 ! zero everything that should be zero'ed
24285 dscj_inv = vbld_inv(j+nres)
24286 ! print *,i,j,dscj_inv,dsci_inv
24287 ! rij holds 1/(distance of Calpha atoms)
24288 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
24290 !----------------------------
24292 ! this should be in elgrad_init but om's are calculated by sc_angular
24293 ! which in turn is used by older potentials
24294 ! om = omega, sqom = om^2
24297 sqom12 = om12 * om12
24299 ! now we calculate EGB - Gey-Berne
24300 ! It will be summed up in evdwij and saved in evdw
24301 sigsq = 1.0D0 / sigsq
24302 sig = sig0ij * dsqrt(sigsq)
24303 ! rij_shift = 1.0D0 / rij - sig + sig0ij
24304 rij_shift = 1.0/rij - sig + sig0ij
24305 IF (rij_shift.le.0.0D0) THEN
24309 sigder = -sig * sigsq
24310 rij_shift = 1.0D0 / rij_shift
24311 fac = rij_shift**expon
24312 c1 = fac * fac * aa_scbase(itypi,itypj)
24314 c2 = fac * bb_scbase(itypi,itypj)
24316 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
24317 eps2der = eps3rt * evdwij
24318 eps3der = eps2rt * evdwij
24319 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
24320 evdwij = eps2rt * eps3rt * evdwij
24321 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
24322 fac = -expon * (c1 + evdwij) * rij_shift
24323 sigder = fac * sigder
24325 ! Calculate distance derivative
24329 ! if (b2.gt.0.0) then
24330 fac = chis1 * sqom1 + chis2 * sqom2 &
24331 - 2.0d0 * chis12 * om1 * om2 * om12
24332 ! we will use pom later in Gcav, so dont mess with it!
24333 pom = 1.0d0 - chis1 * chis2 * sqom12
24334 Lambf = (1.0d0 - (fac / pom))
24335 Lambf = dsqrt(Lambf)
24336 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
24337 ! write (*,*) "sparrow = ", sparrow
24338 Chif = 1.0d0/rij * sparrow
24339 ChiLambf = Chif * Lambf
24340 eagle = dsqrt(ChiLambf)
24341 bat = ChiLambf ** 11.0d0
24342 top = b1 * ( eagle + b2 * ChiLambf - b3 )
24343 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
24347 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
24348 dbot = 12.0d0 * b4 * bat * Lambf
24349 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
24351 ! write (*,*) "dFcav/dR = ", dFdR
24352 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
24353 dbot = 12.0d0 * b4 * bat * Chif
24354 eagle = Lambf * pom
24355 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
24356 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
24357 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
24358 * (chis2 * om2 * om12 - om1) / (eagle * pom)
24360 dFdL = ((dtop * bot - top * dbot) / botsq)
24362 dCAVdOM1 = dFdL * ( dFdOM1 )
24363 dCAVdOM2 = dFdL * ( dFdOM2 )
24364 dCAVdOM12 = dFdL * ( dFdOM12 )
24369 ! eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
24370 ! eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
24371 ! eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
24372 ! -2.0D0*alf12*eps3der+sigder*sigsq_om12
24373 ! print *,"EOMY",eom1,eom2,eom12
24374 ! erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
24375 ! erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
24377 ! facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
24378 ! facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
24380 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24381 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24383 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
24384 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
24385 - (( dFdR + gg(k) ) * pom)
24386 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
24387 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
24388 ! & - ( dFdR * pom )
24390 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
24391 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
24392 + (( dFdR + gg(k) ) * pom)
24393 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
24394 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
24395 !c! & + ( dFdR * pom )
24397 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
24398 - (( dFdR + gg(k) ) * ertail(k))
24399 !c! & - ( dFdR * ertail(k))
24401 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
24402 + (( dFdR + gg(k) ) * ertail(k))
24403 !c! & + ( dFdR * ertail(k))
24406 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24407 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24414 if (wdipdip_scbase(2,itypi,itypj).gt.0.0d0) then
24415 w1 = wdipdip_scbase(1,itypi,itypj)
24416 w2 = -wdipdip_scbase(3,itypi,itypj)/2.0
24417 w3 = wdipdip_scbase(2,itypi,itypj)
24418 !c!-------------------------------------------------------------------
24420 fac = (om12 - 3.0d0 * om1 * om2)
24421 c1 = (w1 / (Rhead**3.0d0)) * fac
24422 c2 = (w2 / Rhead ** 6.0d0) &
24423 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
24424 c3= (w3/ Rhead ** 6.0d0) &
24425 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
24427 !c! write (*,*) "w1 = ", w1
24428 !c! write (*,*) "w2 = ", w2
24429 !c! write (*,*) "om1 = ", om1
24430 !c! write (*,*) "om2 = ", om2
24431 !c! write (*,*) "om12 = ", om12
24432 !c! write (*,*) "fac = ", fac
24433 !c! write (*,*) "c1 = ", c1
24434 !c! write (*,*) "c2 = ", c2
24435 !c! write (*,*) "Ecl = ", Ecl
24436 !c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
24437 !c! write (*,*) "c2_2 = ",
24438 !c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
24439 !c!-------------------------------------------------------------------
24440 !c! dervative of ECL is GCL...
24442 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
24443 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
24444 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
24445 c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
24446 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
24447 dGCLdR = c1 - c2 + c3
24449 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
24450 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
24451 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
24452 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
24453 dGCLdOM1 = c1 - c2 + c3
24455 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
24456 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
24457 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
24458 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
24459 dGCLdOM2 = c1 - c2 + c3
24461 c1 = w1 / (Rhead ** 3.0d0)
24462 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
24463 c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
24464 dGCLdOM12 = c1 - c2 + c3
24466 erhead(k) = Rhead_distance(k)/Rhead
24468 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
24469 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
24470 facd1 = d1i * vbld_inv(i+nres)
24471 facd2 = d1j * vbld_inv(j+nres)
24474 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
24475 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
24477 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
24478 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
24481 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
24482 - dGCLdR * erhead(k)
24483 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
24484 + dGCLdR * erhead(k)
24487 !now charge with dipole eg. ARG-dG
24488 if (wqdip_scbase(2,itypi,itypj).gt.0.0d0) then
24489 alphapol1 = alphapol_scbase(itypi,itypj)
24490 w1 = wqdip_scbase(1,itypi,itypj)
24491 w2 = wqdip_scbase(2,itypi,itypj)
24494 ! pis = sig0head_scbase(itypi,itypj)
24495 ! eps_head = epshead_scbase(itypi,itypj)
24496 !c!-------------------------------------------------------------------
24497 !c! R1 - distance between head of ith side chain and tail of jth sidechain
24500 !c! Calculate head-to-tail distances tail is center of side-chain
24501 R1=R1+(c(k,j+nres)-chead(k,1))**2
24506 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
24507 !c! & +dhead(1,1,itypi,itypj))**2))
24508 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
24509 !c! & +dhead(2,1,itypi,itypj))**2))
24511 !c!-------------------------------------------------------------------
24514 hawk = w2 * (1.0d0 - sqom2)
24515 Ecl = sparrow / Rhead**2.0d0 &
24516 - hawk / Rhead**4.0d0
24517 !c!-------------------------------------------------------------------
24518 !c! derivative of ecl is Gcl
24520 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
24521 + 4.0d0 * hawk / Rhead**5.0d0
24523 dGCLdOM1 = (w1) / (Rhead**2.0d0)
24525 dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
24526 !c--------------------------------------------------------------------
24527 !c Polarization energy
24529 MomoFac1 = (1.0d0 - chi1 * sqom2)
24530 RR1 = R1 * R1 / MomoFac1
24531 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
24532 fgb1 = sqrt( RR1 + a12sq * ee1)
24533 ! eps_inout_fac=0.0d0
24534 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
24535 ! derivative of Epol is Gpol...
24536 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
24538 dFGBdR1 = ( (R1 / MomoFac1) &
24539 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
24541 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
24542 * (2.0d0 - 0.5d0 * ee1) ) &
24544 dPOLdR1 = dPOLdFGB1 * dFGBdR1
24547 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
24549 erhead(k) = Rhead_distance(k)/Rhead
24550 erhead_tail(k,1) = ((c(k,j+nres)-chead(k,1))/R1)
24553 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
24554 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
24555 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
24557 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
24558 facd1 = d1i * vbld_inv(i+nres)
24559 facd2 = d1j * vbld_inv(j+nres)
24560 ! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
24563 hawk = (erhead_tail(k,1) + &
24564 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
24567 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
24568 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
24570 - dPOLdR1 * (erhead_tail(k,1))
24573 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
24574 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
24576 + dPOLdR1 * (erhead_tail(k,1))
24580 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
24581 - dGCLdR * erhead(k) &
24582 - dPOLdR1 * erhead_tail(k,1)
24583 ! & - dGLJdR * erhead(k)
24585 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
24586 + dGCLdR * erhead(k) &
24587 + dPOLdR1 * erhead_tail(k,1)
24588 ! & + dGLJdR * erhead(k)
24592 ! print *,i,j,evdwij,epol,Fcav,ECL
24593 escbase=escbase+evdwij+epol+Fcav+ECL
24594 call sc_grad_scbase
24599 end subroutine eprot_sc_base
24600 SUBROUTINE sc_grad_scbase
24603 real (kind=8) :: dcosom1(3),dcosom2(3)
24605 eps2der * eps2rt_om1 &
24606 - 2.0D0 * alf1 * eps3der &
24607 + sigder * sigsq_om1 &
24613 eps2der * eps2rt_om2 &
24614 + 2.0D0 * alf2 * eps3der &
24615 + sigder * sigsq_om2 &
24621 evdwij * eps1_om12 &
24622 + eps2der * eps2rt_om12 &
24623 - 2.0D0 * alf12 * eps3der &
24624 + sigder *sigsq_om12 &
24628 ! print *,eom1,eom2,eom12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
24629 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
24630 ! gg(1),gg(2),"rozne"
24632 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
24633 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
24634 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
24635 gvdwx_scbase(k,i)= gvdwx_scbase(k,i) - gg(k) &
24636 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
24637 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
24638 gvdwx_scbase(k,j)= gvdwx_scbase(k,j) + gg(k) &
24639 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
24640 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
24641 gvdwc_scbase(k,i)=gvdwc_scbase(k,i)-gg(k)
24642 gvdwc_scbase(k,j)=gvdwc_scbase(k,j)+gg(k)
24645 END SUBROUTINE sc_grad_scbase
24648 subroutine epep_sc_base(epepbase)
24651 !el local variables
24652 integer :: iint,itypi,itypi1,itypj,subchap
24653 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
24654 real(kind=8) :: evdw,sig0ij
24655 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
24656 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
24657 sslipi,sslipj,faclip
24659 real(kind=8) :: fracinbuf
24660 real (kind=8) :: epepbase
24661 real (kind=8),dimension(4):: ener
24662 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
24663 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
24664 sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
24665 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
24666 dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
24667 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
24668 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
24669 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
24670 real(kind=8),dimension(3,2)::chead,erhead_tail
24671 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
24675 ! do i=1,nres_molec(1)-1
24676 do i=ibond_start,ibond_end
24677 if (itype(i,1).eq.ntyp1_molec(1).or.itype(i+1,1).eq.ntyp1_molec(1)) cycle
24678 !C itypi = itype(i,1)
24682 ! print *,dxi,(-c(1,i)+c(1,i+1))*vbld_inv(i+1)
24683 dsci_inv = vbld_inv(i+1)/2.0
24684 xi=(c(1,i)+c(1,i+1))/2.0
24685 yi=(c(2,i)+c(2,i+1))/2.0
24686 zi=(c(3,i)+c(3,i+1))/2.0
24687 xi=mod(xi,boxxsize)
24688 if (xi.lt.0) xi=xi+boxxsize
24689 yi=mod(yi,boxysize)
24690 if (yi.lt.0) yi=yi+boxysize
24691 zi=mod(zi,boxzsize)
24692 if (zi.lt.0) zi=zi+boxzsize
24693 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
24695 if (itype(j,2).eq.ntyp1_molec(2))cycle
24699 xj=dmod(xj,boxxsize)
24700 if (xj.lt.0) xj=xj+boxxsize
24701 yj=dmod(yj,boxysize)
24702 if (yj.lt.0) yj=yj+boxysize
24703 zj=dmod(zj,boxzsize)
24704 if (zj.lt.0) zj=zj+boxzsize
24705 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
24714 xj=xj_safe+xshift*boxxsize
24715 yj=yj_safe+yshift*boxysize
24716 zj=zj_safe+zshift*boxzsize
24717 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
24718 if(dist_temp.lt.dist_init) then
24719 dist_init=dist_temp
24728 if (subchap.eq.1) then
24737 dxj = dc_norm( 1, nres+j )
24738 dyj = dc_norm( 2, nres+j )
24739 dzj = dc_norm( 3, nres+j )
24740 ! d1i = dhead_scbasei(itypi) !this is shift of dipole/charge
24741 ! d1j = dhead_scbasej(itypi) !this is shift of dipole/charge
24744 sig0ij = sigma_pepbase(itypj )
24745 chi1 = chi_pepbase(itypj,1 )
24746 chi2 = chi_pepbase(itypj,2 )
24749 chi12 = chi1 * chi2
24750 chip1 = chipp_pepbase(itypj,1 )
24751 chip2 = chipp_pepbase(itypj,2 )
24754 chip12 = chip1 * chip2
24755 chis1 = chis_pepbase(itypj,1)
24756 chis2 = chis_pepbase(itypj,2)
24757 chis12 = chis1 * chis2
24758 sig1 = sigmap1_pepbase(itypj)
24759 sig2 = sigmap2_pepbase(itypj)
24760 ! write (*,*) "sig1 = ", sig1
24761 ! write (*,*) "sig2 = ", sig2
24763 ! location of polar head is computed by taking hydrophobic centre
24764 ! and moving by a d1 * dc_norm vector
24765 ! see unres publications for very informative images
24766 chead(k,1) = (c(k,i)+c(k,i+1))/2.0
24767 ! + d1i * dc_norm(k, i+nres)
24768 chead(k,2) = c(k, j+nres)
24769 ! + d1j * dc_norm(k, j+nres)
24771 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
24772 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
24773 Rhead_distance(k) = chead(k,2) - chead(k,1)
24774 ! print *,gvdwc_pepbase(k,i)
24778 (Rhead_distance(1)*Rhead_distance(1)) &
24779 + (Rhead_distance(2)*Rhead_distance(2)) &
24780 + (Rhead_distance(3)*Rhead_distance(3)))
24782 ! alpha factors from Fcav/Gcav
24783 b1 = alphasur_pepbase(1,itypj)
24785 b2 = alphasur_pepbase(2,itypj)
24786 b3 = alphasur_pepbase(3,itypj)
24787 b4 = alphasur_pepbase(4,itypj)
24791 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
24794 !----------------------------
24812 dscj_inv = vbld_inv(j+nres)
24814 ! this should be in elgrad_init but om's are calculated by sc_angular
24815 ! which in turn is used by older potentials
24816 ! om = omega, sqom = om^2
24819 sqom12 = om12 * om12
24821 ! now we calculate EGB - Gey-Berne
24822 ! It will be summed up in evdwij and saved in evdw
24823 sigsq = 1.0D0 / sigsq
24824 sig = sig0ij * dsqrt(sigsq)
24825 rij_shift = 1.0/rij - sig + sig0ij
24826 IF (rij_shift.le.0.0D0) THEN
24830 sigder = -sig * sigsq
24831 rij_shift = 1.0D0 / rij_shift
24832 fac = rij_shift**expon
24833 c1 = fac * fac * aa_pepbase(itypj)
24835 c2 = fac * bb_pepbase(itypj)
24837 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
24838 eps2der = eps3rt * evdwij
24839 eps3der = eps2rt * evdwij
24840 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
24841 evdwij = eps2rt * eps3rt * evdwij
24842 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
24843 fac = -expon * (c1 + evdwij) * rij_shift
24844 sigder = fac * sigder
24846 ! Calculate distance derivative
24850 fac = chis1 * sqom1 + chis2 * sqom2 &
24851 - 2.0d0 * chis12 * om1 * om2 * om12
24852 ! we will use pom later in Gcav, so dont mess with it!
24853 pom = 1.0d0 - chis1 * chis2 * sqom12
24854 Lambf = (1.0d0 - (fac / pom))
24855 Lambf = dsqrt(Lambf)
24856 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
24857 ! write (*,*) "sparrow = ", sparrow
24858 Chif = 1.0d0/rij * sparrow
24859 ChiLambf = Chif * Lambf
24860 eagle = dsqrt(ChiLambf)
24861 bat = ChiLambf ** 11.0d0
24862 top = b1 * ( eagle + b2 * ChiLambf - b3 )
24863 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
24867 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
24868 dbot = 12.0d0 * b4 * bat * Lambf
24869 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
24871 ! write (*,*) "dFcav/dR = ", dFdR
24872 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
24873 dbot = 12.0d0 * b4 * bat * Chif
24874 eagle = Lambf * pom
24875 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
24876 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
24877 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
24878 * (chis2 * om2 * om12 - om1) / (eagle * pom)
24880 dFdL = ((dtop * bot - top * dbot) / botsq)
24882 dCAVdOM1 = dFdL * ( dFdOM1 )
24883 dCAVdOM2 = dFdL * ( dFdOM2 )
24884 dCAVdOM12 = dFdL * ( dFdOM12 )
24890 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24891 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24893 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
24894 gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
24895 - (( dFdR + gg(k) ) * pom)/2.0
24896 ! print *,gvdwc_pepbase(k,i),i,(( dFdR + gg(k) ) * pom)/2.0
24897 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
24898 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
24899 ! & - ( dFdR * pom )
24901 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
24902 gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
24903 + (( dFdR + gg(k) ) * pom)
24904 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
24905 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
24906 !c! & + ( dFdR * pom )
24908 gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
24909 - (( dFdR + gg(k) ) * ertail(k))/2.0
24910 ! print *,gvdwc_pepbase(k,i+1),i+1,(( dFdR + gg(k) ) * pom)/2.0
24912 !c! & - ( dFdR * ertail(k))
24914 gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
24915 + (( dFdR + gg(k) ) * ertail(k))
24916 !c! & + ( dFdR * ertail(k))
24919 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24920 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24924 w1 = wdipdip_pepbase(1,itypj)
24925 w2 = -wdipdip_pepbase(3,itypj)/2.0
24926 w3 = wdipdip_pepbase(2,itypj)
24929 !c!-------------------------------------------------------------------
24932 fac = (om12 - 3.0d0 * om1 * om2)
24933 c1 = (w1 / (Rhead**3.0d0)) * fac
24934 c2 = (w2 / Rhead ** 6.0d0) &
24935 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
24936 c3= (w3/ Rhead ** 6.0d0) &
24937 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
24941 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
24942 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
24943 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
24944 c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
24945 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
24947 dGCLdR = c1 - c2 + c3
24949 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
24950 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
24951 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
24952 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
24953 dGCLdOM1 = c1 - c2 + c3
24955 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
24956 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
24957 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
24958 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
24960 dGCLdOM2 = c1 - c2 + c3
24962 c1 = w1 / (Rhead ** 3.0d0)
24963 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
24964 c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
24965 dGCLdOM12 = c1 - c2 + c3
24967 erhead(k) = Rhead_distance(k)/Rhead
24969 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
24970 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
24971 ! facd1 = d1 * vbld_inv(i+nres)
24972 ! facd2 = d2 * vbld_inv(j+nres)
24976 !+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
24977 ! gvdwx_pepbase(k,i) = gvdwx_scbase(k,i) &
24980 !+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
24981 gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
24984 gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
24985 - dGCLdR * erhead(k)/2.0d0
24986 ! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
24987 gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
24988 - dGCLdR * erhead(k)/2.0d0
24989 ! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
24990 gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
24991 + dGCLdR * erhead(k)
24993 ! print *,i,j,evdwij,Fcav,ECL,"vdw,cav,ecl"
24994 epepbase=epepbase+evdwij+Fcav+ECL
24995 call sc_grad_pepbase
24998 END SUBROUTINE epep_sc_base
24999 SUBROUTINE sc_grad_pepbase
25002 real (kind=8) :: dcosom1(3),dcosom2(3)
25004 eps2der * eps2rt_om1 &
25005 - 2.0D0 * alf1 * eps3der &
25006 + sigder * sigsq_om1 &
25012 eps2der * eps2rt_om2 &
25013 + 2.0D0 * alf2 * eps3der &
25014 + sigder * sigsq_om2 &
25020 evdwij * eps1_om12 &
25021 + eps2der * eps2rt_om12 &
25022 - 2.0D0 * alf12 * eps3der &
25023 + sigder *sigsq_om12 &
25028 ! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
25029 ! if (i.eq.30) print *,gvdwc_pepbase(k,i),- gg(k),&
25030 ! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
25032 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
25033 ! gg(1),gg(2),"rozne"
25035 dcosom1(k) = rij * (dc_norm(k,i) - om1 * erij(k))
25036 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
25037 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
25038 gvdwc_pepbase(k,i)= gvdwc_pepbase(k,i) +0.5*(- gg(k)) &
25039 + (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
25041 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
25042 gvdwc_pepbase(k,i+1)= gvdwc_pepbase(k,i+1) +0.5*(- gg(k)) &
25043 - (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i))) &
25045 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
25046 ! print *,eom12,eom2,om12,om2
25047 !eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
25048 ! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
25049 gvdwx_pepbase(k,j)= gvdwx_pepbase(k,j) + gg(k) &
25050 + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
25051 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
25052 gvdwc_pepbase(k,j)=gvdwc_pepbase(k,j)+gg(k)
25055 END SUBROUTINE sc_grad_pepbase
25056 subroutine eprot_sc_phosphate(escpho)
25058 ! implicit real*8 (a-h,o-z)
25059 ! include 'DIMENSIONS'
25060 ! include 'COMMON.GEO'
25061 ! include 'COMMON.VAR'
25062 ! include 'COMMON.LOCAL'
25063 ! include 'COMMON.CHAIN'
25064 ! include 'COMMON.DERIV'
25065 ! include 'COMMON.NAMES'
25066 ! include 'COMMON.INTERACT'
25067 ! include 'COMMON.IOUNITS'
25068 ! include 'COMMON.CALC'
25069 ! include 'COMMON.CONTROL'
25070 ! include 'COMMON.SBRIDGE'
25072 !el local variables
25073 integer :: iint,itypi,itypi1,itypj,subchap
25074 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
25075 real(kind=8) :: evdw,sig0ij
25076 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
25077 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
25078 sslipi,sslipj,faclip,alpha_sco
25080 real(kind=8) :: fracinbuf
25081 real (kind=8) :: escpho
25082 real (kind=8),dimension(4):: ener
25083 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
25084 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
25085 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
25086 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
25087 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
25088 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
25089 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
25090 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
25091 real(kind=8),dimension(3,2)::chead,erhead_tail
25092 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
25096 ! do i=1,nres_molec(1)
25097 do i=ibond_start,ibond_end
25098 if (itype(i,1).eq.ntyp1_molec(1)) cycle
25100 dxi = dc_norm(1,nres+i)
25101 dyi = dc_norm(2,nres+i)
25102 dzi = dc_norm(3,nres+i)
25103 dsci_inv = vbld_inv(i+nres)
25107 xi=mod(xi,boxxsize)
25108 if (xi.lt.0) xi=xi+boxxsize
25109 yi=mod(yi,boxysize)
25110 if (yi.lt.0) yi=yi+boxysize
25111 zi=mod(zi,boxzsize)
25112 if (zi.lt.0) zi=zi+boxzsize
25113 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
25115 if ((itype(j,2).eq.ntyp1_molec(2)).or.&
25116 (itype(j+1,2).eq.ntyp1_molec(2))) cycle
25117 xj=(c(1,j)+c(1,j+1))/2.0
25118 yj=(c(2,j)+c(2,j+1))/2.0
25119 zj=(c(3,j)+c(3,j+1))/2.0
25120 xj=dmod(xj,boxxsize)
25121 if (xj.lt.0) xj=xj+boxxsize
25122 yj=dmod(yj,boxysize)
25123 if (yj.lt.0) yj=yj+boxysize
25124 zj=dmod(zj,boxzsize)
25125 if (zj.lt.0) zj=zj+boxzsize
25126 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
25134 xj=xj_safe+xshift*boxxsize
25135 yj=yj_safe+yshift*boxysize
25136 zj=zj_safe+zshift*boxzsize
25137 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
25138 if(dist_temp.lt.dist_init) then
25139 dist_init=dist_temp
25148 if (subchap.eq.1) then
25157 dxj = dc_norm( 1,j )
25158 dyj = dc_norm( 2,j )
25159 dzj = dc_norm( 3,j )
25160 dscj_inv = vbld_inv(j+1)
25163 sig0ij = sigma_scpho(itypi )
25164 chi1 = chi_scpho(itypi,1 )
25165 chi2 = chi_scpho(itypi,2 )
25168 chi12 = chi1 * chi2
25169 chip1 = chipp_scpho(itypi,1 )
25170 chip2 = chipp_scpho(itypi,2 )
25173 chip12 = chip1 * chip2
25174 chis1 = chis_scpho(itypi,1)
25175 chis2 = chis_scpho(itypi,2)
25176 chis12 = chis1 * chis2
25177 sig1 = sigmap1_scpho(itypi)
25178 sig2 = sigmap2_scpho(itypi)
25179 ! write (*,*) "sig1 = ", sig1
25180 ! write (*,*) "sig1 = ", sig1
25181 ! write (*,*) "sig2 = ", sig2
25182 ! alpha factors from Fcav/Gcav
25186 a12sq = rborn_scphoi(itypi) * rborn_scphoj(itypi)
25188 b1 = alphasur_scpho(1,itypi)
25190 b2 = alphasur_scpho(2,itypi)
25191 b3 = alphasur_scpho(3,itypi)
25192 b4 = alphasur_scpho(4,itypi)
25193 ! used to determine whether we want to do quadrupole calculations
25195 eps_in = epsintab_scpho(itypi)
25196 if (eps_in.eq.0.0) eps_in=1.0
25197 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
25198 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
25199 !-------------------------------------------------------------------
25200 ! tail location and distance calculations
25201 d1i = dhead_scphoi(itypi) !this is shift of dipole/charge
25204 ! location of polar head is computed by taking hydrophobic centre
25205 ! and moving by a d1 * dc_norm vector
25206 ! see unres publications for very informative images
25207 chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
25208 chead(k,2) = (c(k, j) + c(k, j+1))/2.0
25210 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
25211 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
25212 Rhead_distance(k) = chead(k,2) - chead(k,1)
25214 ! pitagoras (root of sum of squares)
25216 (Rhead_distance(1)*Rhead_distance(1)) &
25217 + (Rhead_distance(2)*Rhead_distance(2)) &
25218 + (Rhead_distance(3)*Rhead_distance(3)))
25219 Rhead_sq=Rhead**2.0
25220 !-------------------------------------------------------------------
25221 ! zero everything that should be zero'ed
25240 dscj_inv = vbld_inv(j+1)/2.0
25241 !dhead_scbasej(itypi,itypj)
25242 ! print *,i,j,dscj_inv,dsci_inv
25243 ! rij holds 1/(distance of Calpha atoms)
25244 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
25246 !----------------------------
25248 ! this should be in elgrad_init but om's are calculated by sc_angular
25249 ! which in turn is used by older potentials
25250 ! om = omega, sqom = om^2
25253 sqom12 = om12 * om12
25255 ! now we calculate EGB - Gey-Berne
25256 ! It will be summed up in evdwij and saved in evdw
25257 sigsq = 1.0D0 / sigsq
25258 sig = sig0ij * dsqrt(sigsq)
25259 ! rij_shift = 1.0D0 / rij - sig + sig0ij
25260 rij_shift = 1.0/rij - sig + sig0ij
25261 IF (rij_shift.le.0.0D0) THEN
25265 sigder = -sig * sigsq
25266 rij_shift = 1.0D0 / rij_shift
25267 fac = rij_shift**expon
25268 c1 = fac * fac * aa_scpho(itypi)
25270 c2 = fac * bb_scpho(itypi)
25272 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
25273 eps2der = eps3rt * evdwij
25274 eps3der = eps2rt * evdwij
25275 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
25276 evdwij = eps2rt * eps3rt * evdwij
25277 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
25278 fac = -expon * (c1 + evdwij) * rij_shift
25279 sigder = fac * sigder
25281 ! Calculate distance derivative
25285 fac = chis1 * sqom1 + chis2 * sqom2 &
25286 - 2.0d0 * chis12 * om1 * om2 * om12
25287 ! we will use pom later in Gcav, so dont mess with it!
25288 pom = 1.0d0 - chis1 * chis2 * sqom12
25289 Lambf = (1.0d0 - (fac / pom))
25290 Lambf = dsqrt(Lambf)
25291 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
25292 ! write (*,*) "sparrow = ", sparrow
25293 Chif = 1.0d0/rij * sparrow
25294 ChiLambf = Chif * Lambf
25295 eagle = dsqrt(ChiLambf)
25296 bat = ChiLambf ** 11.0d0
25297 top = b1 * ( eagle + b2 * ChiLambf - b3 )
25298 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
25301 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
25302 dbot = 12.0d0 * b4 * bat * Lambf
25303 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
25305 ! write (*,*) "dFcav/dR = ", dFdR
25306 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
25307 dbot = 12.0d0 * b4 * bat * Chif
25308 eagle = Lambf * pom
25309 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
25310 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
25311 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
25312 * (chis2 * om2 * om12 - om1) / (eagle * pom)
25314 dFdL = ((dtop * bot - top * dbot) / botsq)
25316 dCAVdOM1 = dFdL * ( dFdOM1 )
25317 dCAVdOM2 = dFdL * ( dFdOM2 )
25318 dCAVdOM12 = dFdL * ( dFdOM12 )
25324 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
25325 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
25326 ! if (i.eq.3) print *,'decl0',gvdwx_scpho(k,i),i
25329 ! print *,pom,gg(k),dFdR
25330 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
25331 gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
25332 - (( dFdR + gg(k) ) * pom)
25333 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
25334 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
25335 ! & - ( dFdR * pom )
25337 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
25338 ! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
25339 ! + (( dFdR + gg(k) ) * pom)
25340 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
25341 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
25342 !c! & + ( dFdR * pom )
25344 gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
25345 - (( dFdR + gg(k) ) * ertail(k))
25346 !c! & - ( dFdR * ertail(k))
25348 gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
25349 + (( dFdR + gg(k) ) * ertail(k))/2.0
25351 gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
25352 + (( dFdR + gg(k) ) * ertail(k))/2.0
25354 !c! & + ( dFdR * ertail(k))
25358 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
25359 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
25360 ! alphapol1 = alphapol_scpho(itypi)
25361 if (wqq_scpho(itypi).ne.0.0) then
25362 Qij=wqq_scpho(itypi)/eps_in
25363 alpha_sco=1.d0/alphi_scpho(itypi)
25365 Ecl = (332.0d0 * Qij*dexp(-Rhead*alpha_sco)) / Rhead
25366 !c! derivative of Ecl is Gcl...
25367 dGCLdR = (-332.0d0 * Qij*dexp(-Rhead*alpha_sco)* &
25368 (Rhead*alpha_sco+1) ) / Rhead_sq
25369 if (energy_dec) write(iout,*) "ECL",ECL,Rhead,1.0/rij
25370 else if (wqdip_scpho(2,itypi).gt.0.0d0) then
25371 w1 = wqdip_scpho(1,itypi)
25372 w2 = wqdip_scpho(2,itypi)
25375 ! pis = sig0head_scbase(itypi,itypj)
25376 ! eps_head = epshead_scbase(itypi,itypj)
25377 !c!-------------------------------------------------------------------
25379 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
25380 !c! & +dhead(1,1,itypi,itypj))**2))
25381 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
25382 !c! & +dhead(2,1,itypi,itypj))**2))
25384 !c!-------------------------------------------------------------------
25387 hawk = w2 * (1.0d0 - sqom2)
25388 Ecl = sparrow / Rhead**2.0d0 &
25389 - hawk / Rhead**4.0d0
25390 !c!-------------------------------------------------------------------
25391 if (energy_dec) write(iout,*) "ECLdipdip",ECL,Rhead,&
25394 !c! derivative of ecl is Gcl
25396 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
25397 + 4.0d0 * hawk / Rhead**5.0d0
25399 dGCLdOM1 = (w1) / (Rhead**2.0d0)
25401 dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
25404 !c--------------------------------------------------------------------
25405 !c Polarization energy
25409 !c! Calculate head-to-tail distances tail is center of side-chain
25410 R1=R1+((c(k,j)+c(k,j+1))/2.0-chead(k,1))**2
25415 alphapol1 = alphapol_scpho(itypi)
25417 MomoFac1 = (1.0d0 - chi2 * sqom1)
25418 RR1 = R1 * R1 / MomoFac1
25419 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
25420 ! print *,"ee1",ee1,a12sq,alphapol1,eps_inout_fac
25421 fgb1 = sqrt( RR1 + a12sq * ee1)
25422 ! eps_inout_fac=0.0d0
25423 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
25424 ! derivative of Epol is Gpol...
25425 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
25427 dFGBdR1 = ( (R1 / MomoFac1) &
25428 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
25430 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
25431 * (2.0d0 - 0.5d0 * ee1) ) &
25433 dPOLdR1 = dPOLdFGB1 * dFGBdR1
25436 dFGBdOM1 = (((R1 * R1 * chi2 * om1) / (MomoFac1 * MomoFac1)) &
25437 * (2.0d0 - 0.5d0 * ee1) ) &
25440 dPOLdOM1 = dPOLdFGB1 * dFGBdOM1
25443 erhead(k) = Rhead_distance(k)/Rhead
25444 erhead_tail(k,1) = (((c(k,j)+c(k,j+1))/2.0-chead(k,1))/R1)
25447 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
25448 erdxj = scalar( erhead(1), dC_norm(1,j) )
25449 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
25451 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j))
25452 facd1 = d1i * vbld_inv(i+nres)
25453 facd2 = d1j * vbld_inv(j)
25454 ! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
25457 hawk = (erhead_tail(k,1) + &
25458 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
25461 ! if (i.eq.3) print *,'decl1',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i,&
25462 ! pom,(erhead_tail(k,1))
25464 ! print *,'decl',dGCLdR,dPOLdR1,gvdwc_scpho(k,i)
25465 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
25466 gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
25468 - dPOLdR1 * (erhead_tail(k,1))
25471 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
25472 ! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
25474 ! + dPOLdR1 * (erhead_tail(k,1))
25478 gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
25479 - dGCLdR * erhead(k) &
25480 - dPOLdR1 * erhead_tail(k,1)
25481 ! & - dGLJdR * erhead(k)
25483 gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
25484 + (dGCLdR * erhead(k) &
25485 + dPOLdR1 * erhead_tail(k,1))/2.0
25486 gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
25487 + (dGCLdR * erhead(k) &
25488 + dPOLdR1 * erhead_tail(k,1))/2.0
25490 ! & + dGLJdR * erhead(k)
25491 ! if (i.eq.3) print *,'decl2',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i
25494 ! if (i.eq.3) print *,i,j,evdwij,epol,Fcav,ECL
25495 if (energy_dec) write (iout,'(a22,2i5,4f8.3,f16.3)'), &
25496 "escpho:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,escpho
25497 escpho=escpho+evdwij+epol+Fcav+ECL
25504 end subroutine eprot_sc_phosphate
25505 SUBROUTINE sc_grad_scpho
25508 real (kind=8) :: dcosom1(3),dcosom2(3)
25510 eps2der * eps2rt_om1 &
25511 - 2.0D0 * alf1 * eps3der &
25512 + sigder * sigsq_om1 &
25518 eps2der * eps2rt_om2 &
25519 + 2.0D0 * alf2 * eps3der &
25520 + sigder * sigsq_om2 &
25526 evdwij * eps1_om12 &
25527 + eps2der * eps2rt_om12 &
25528 - 2.0D0 * alf12 * eps3der &
25529 + sigder *sigsq_om12 &
25534 ! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
25535 ! if (i.eq.30) print *,gvdwc_scpho(k,i),- gg(k),&
25536 ! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
25538 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
25539 ! gg(1),gg(2),"rozne"
25541 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
25542 dcosom2(k) = rij * (dc_norm(k,j) - om2 * erij(k))
25543 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
25544 gvdwc_scpho(k,j)= gvdwc_scpho(k,j) +0.5*( gg(k)) &
25545 + (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)))&
25547 - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
25548 gvdwc_scpho(k,j+1)= gvdwc_scpho(k,j+1) +0.5*( gg(k)) &
25549 - (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j))) &
25551 + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
25552 gvdwx_scpho(k,i)= gvdwx_scpho(k,i) - gg(k) &
25553 + (eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
25554 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
25556 ! print *,eom12,eom2,om12,om2
25557 !eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
25558 ! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
25559 ! gvdwx_scpho(k,j)= gvdwx_scpho(k,j) + gg(k) &
25560 ! + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
25561 ! + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
25562 gvdwc_scpho(k,i)=gvdwc_scpho(k,i)-gg(k)
25565 END SUBROUTINE sc_grad_scpho
25566 subroutine eprot_pep_phosphate(epeppho)
25568 ! implicit real*8 (a-h,o-z)
25569 ! include 'DIMENSIONS'
25570 ! include 'COMMON.GEO'
25571 ! include 'COMMON.VAR'
25572 ! include 'COMMON.LOCAL'
25573 ! include 'COMMON.CHAIN'
25574 ! include 'COMMON.DERIV'
25575 ! include 'COMMON.NAMES'
25576 ! include 'COMMON.INTERACT'
25577 ! include 'COMMON.IOUNITS'
25578 ! include 'COMMON.CALC'
25579 ! include 'COMMON.CONTROL'
25580 ! include 'COMMON.SBRIDGE'
25582 !el local variables
25583 integer :: iint,itypi,itypi1,itypj,subchap
25584 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
25585 real(kind=8) :: evdw,sig0ij
25586 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
25587 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
25588 sslipi,sslipj,faclip
25590 real(kind=8) :: fracinbuf
25591 real (kind=8) :: epeppho
25592 real (kind=8),dimension(4):: ener
25593 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
25594 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
25595 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
25596 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
25597 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
25598 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
25599 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
25600 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
25601 real(kind=8),dimension(3,2)::chead,erhead_tail
25602 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
25604 real (kind=8) :: dcosom1(3),dcosom2(3)
25606 ! do i=1,nres_molec(1)
25607 do i=ibond_start,ibond_end
25608 if (itype(i,1).eq.ntyp1_molec(1)) cycle
25610 dsci_inv = vbld_inv(i+1)/2.0
25614 xi=(c(1,i)+c(1,i+1))/2.0
25615 yi=(c(2,i)+c(2,i+1))/2.0
25616 zi=(c(3,i)+c(3,i+1))/2.0
25617 xi=mod(xi,boxxsize)
25618 if (xi.lt.0) xi=xi+boxxsize
25619 yi=mod(yi,boxysize)
25620 if (yi.lt.0) yi=yi+boxysize
25621 zi=mod(zi,boxzsize)
25622 if (zi.lt.0) zi=zi+boxzsize
25623 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
25625 if ((itype(j,2).eq.ntyp1_molec(2)).or.&
25626 (itype(j+1,2).eq.ntyp1_molec(2))) cycle
25627 xj=(c(1,j)+c(1,j+1))/2.0
25628 yj=(c(2,j)+c(2,j+1))/2.0
25629 zj=(c(3,j)+c(3,j+1))/2.0
25630 xj=dmod(xj,boxxsize)
25631 if (xj.lt.0) xj=xj+boxxsize
25632 yj=dmod(yj,boxysize)
25633 if (yj.lt.0) yj=yj+boxysize
25634 zj=dmod(zj,boxzsize)
25635 if (zj.lt.0) zj=zj+boxzsize
25636 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
25644 xj=xj_safe+xshift*boxxsize
25645 yj=yj_safe+yshift*boxysize
25646 zj=zj_safe+zshift*boxzsize
25647 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
25648 if(dist_temp.lt.dist_init) then
25649 dist_init=dist_temp
25658 if (subchap.eq.1) then
25667 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
25669 dxj = dc_norm( 1,j )
25670 dyj = dc_norm( 2,j )
25671 dzj = dc_norm( 3,j )
25672 dscj_inv = vbld_inv(j+1)/2.0
25674 sig0ij = sigma_peppho
25677 chi12 = chi1 * chi2
25680 chip12 = chip1 * chip2
25683 chis12 = chis1 * chis2
25684 sig1 = sigmap1_peppho
25685 sig2 = sigmap2_peppho
25686 ! write (*,*) "sig1 = ", sig1
25687 ! write (*,*) "sig1 = ", sig1
25688 ! write (*,*) "sig2 = ", sig2
25689 ! alpha factors from Fcav/Gcav
25693 b1 = alphasur_peppho(1)
25695 b2 = alphasur_peppho(2)
25696 b3 = alphasur_peppho(3)
25697 b4 = alphasur_peppho(4)
25719 fac = rij_shift**expon
25720 c1 = fac * fac * aa_peppho
25722 c2 = fac * bb_peppho
25725 ! Now cavity....................
25726 eagle = dsqrt(1.0/rij_shift)
25727 top = b1 * ( eagle + b2 * 1.0/rij_shift - b3 )
25728 bot = 1.0d0 + b4 * (1.0/rij_shift ** 12.0d0)
25731 dtop = b1 * ((1.0/ (2.0d0 * eagle)) + (b2))
25732 dbot = 12.0d0 * b4 * (1.0/rij_shift) ** 11.0d0
25733 dFdR = ((dtop * bot - top * dbot) / botsq)
25734 w1 = wqdip_peppho(1)
25735 w2 = wqdip_peppho(2)
25738 ! pis = sig0head_scbase(itypi,itypj)
25739 ! eps_head = epshead_scbase(itypi,itypj)
25740 !c!-------------------------------------------------------------------
25742 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
25743 !c! & +dhead(1,1,itypi,itypj))**2))
25744 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
25745 !c! & +dhead(2,1,itypi,itypj))**2))
25747 !c!-------------------------------------------------------------------
25750 hawk = w2 * (1.0d0 - sqom1)
25751 Ecl = sparrow * rij_shift**2.0d0 &
25752 - hawk * rij_shift**4.0d0
25753 !c!-------------------------------------------------------------------
25754 !c! derivative of ecl is Gcl
25757 dGCLdR = - 2.0d0 * sparrow * rij_shift**3.0d0 &
25758 + 4.0d0 * hawk * rij_shift**5.0d0
25760 dGCLdOM1 = (w1) * (rij_shift**2.0d0)
25762 dGCLdOM2 = (2.0d0 * w2 * om1) * (rij_shift ** 4.0d0)
25763 eom1 = dGCLdOM1+dGCLdOM2
25766 fac = -expon * (c1 + evdwij) * rij_shift+dFdR+dGCLdR
25772 gvdwc_peppho(k,j) = gvdwc_peppho(k,j) +gg(k)/2.0
25773 gvdwc_peppho(k,j+1) = gvdwc_peppho(k,j+1) +gg(k)/2.0
25774 gvdwc_peppho(k,i) = gvdwc_peppho(k,i) -gg(k)/2.0
25775 gvdwc_peppho(k,i+1) = gvdwc_peppho(k,i+1) -gg(k)/2.0
25780 dcosom1(k) = rij* (dc_norm(k,i) - om1 * erij(k))
25781 dcosom2(k) = rij* (dc_norm(k,j) - om2 * erij(k))
25782 gg(k) = gg(k) + eom1 * dcosom1(k)! + eom2 * dcosom2(k)
25783 gvdwc_peppho(k,j)= gvdwc_peppho(k,j) +0.5*( gg(k)) !&
25784 ! - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
25785 gvdwc_peppho(k,j+1)= gvdwc_peppho(k,j+1) +0.5*( gg(k)) !&
25786 ! + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
25787 gvdwc_peppho(k,i)= gvdwc_peppho(k,i) -0.5*( gg(k)) &
25788 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
25789 gvdwc_peppho(k,i+1)= gvdwc_peppho(k,i+1) - 0.5*( gg(k)) &
25790 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
25792 epeppho=epeppho+evdwij+Fcav+ECL
25793 ! print *,i,j,evdwij,Fcav,ECL,rij_shift
25796 end subroutine eprot_pep_phosphate
25797 !!!!!!!!!!!!!!!!-------------------------------------------------------------
25798 subroutine emomo(evdw)
25801 ! implicit real*8 (a-h,o-z)
25802 ! include 'DIMENSIONS'
25803 ! include 'COMMON.GEO'
25804 ! include 'COMMON.VAR'
25805 ! include 'COMMON.LOCAL'
25806 ! include 'COMMON.CHAIN'
25807 ! include 'COMMON.DERIV'
25808 ! include 'COMMON.NAMES'
25809 ! include 'COMMON.INTERACT'
25810 ! include 'COMMON.IOUNITS'
25811 ! include 'COMMON.CALC'
25812 ! include 'COMMON.CONTROL'
25813 ! include 'COMMON.SBRIDGE'
25815 !el local variables
25816 integer :: iint,itypi1,subchap,isel
25817 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,e1,e2,sigm,epsi
25818 real(kind=8) :: evdw
25819 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
25820 dist_temp, dist_init,ssgradlipi,ssgradlipj, &
25821 sslipi,sslipj,faclip,alpha_sco
25823 real(kind=8) :: fracinbuf
25824 real (kind=8) :: escpho
25825 real (kind=8),dimension(4):: ener
25826 real(kind=8) :: b1,b2,egb
25827 real(kind=8) :: Fisocav,ECL,Elj,Equad,Epol,eheadtail,&
25829 Chif,ChiLambf,Fcav,dFdR,dFdOM1,&
25830 dFdOM2,dFdL,dFdOM12,&
25833 ! real(kind=8),dimension(3,2)::erhead_tail
25834 ! real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead,Rtail_distance
25835 real(kind=8) :: facd4, adler, Fgb, facd3
25836 integer troll,jj,istate
25837 real (kind=8) :: dcosom1(3),dcosom2(3)
25840 ! print *,"EVDW KURW",evdw,nres
25841 do i=iatsc_s,iatsc_e
25842 ! print *,"I am in EVDW",i
25843 itypi=iabs(itype(i,1))
25844 ! if (i.ne.47) cycle
25845 if (itypi.eq.ntyp1) cycle
25846 itypi1=iabs(itype(i+1,1))
25850 xi=dmod(xi,boxxsize)
25851 if (xi.lt.0) xi=xi+boxxsize
25852 yi=dmod(yi,boxysize)
25853 if (yi.lt.0) yi=yi+boxysize
25854 zi=dmod(zi,boxzsize)
25855 if (zi.lt.0) zi=zi+boxzsize
25857 if ((zi.gt.bordlipbot) &
25858 .and.(zi.lt.bordliptop)) then
25859 !C the energy transfer exist
25860 if (zi.lt.buflipbot) then
25861 !C what fraction I am in
25863 ((zi-bordlipbot)/lipbufthick)
25864 !C lipbufthick is thickenes of lipid buffore
25865 sslipi=sscalelip(fracinbuf)
25866 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
25867 elseif (zi.gt.bufliptop) then
25868 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
25869 sslipi=sscalelip(fracinbuf)
25870 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
25879 ! print *, sslipi,ssgradlipi
25880 dxi=dc_norm(1,nres+i)
25881 dyi=dc_norm(2,nres+i)
25882 dzi=dc_norm(3,nres+i)
25883 ! dsci_inv=dsc_inv(itypi)
25884 dsci_inv=vbld_inv(i+nres)
25885 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
25886 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
25888 ! Calculate SC interaction energy.
25890 do iint=1,nint_gr(i)
25891 do j=istart(i,iint),iend(i,iint)
25892 ! print *,"JA PIER",i,j,iint,istart(i,iint),iend(i,iint)
25893 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
25894 call dyn_ssbond_ene(i,j,evdwij)
25896 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
25897 'evdw',i,j,evdwij,' ss'
25898 ! if (energy_dec) write (iout,*) &
25899 ! 'evdw',i,j,evdwij,' ss'
25900 do k=j+1,iend(i,iint)
25901 !C search over all next residues
25902 if (dyn_ss_mask(k)) then
25903 !C check if they are cysteins
25904 !C write(iout,*) 'k=',k
25906 !c write(iout,*) "PRZED TRI", evdwij
25907 ! evdwij_przed_tri=evdwij
25908 call triple_ssbond_ene(i,j,k,evdwij)
25909 !c if(evdwij_przed_tri.ne.evdwij) then
25910 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
25913 !c write(iout,*) "PO TRI", evdwij
25914 !C call the energy function that removes the artifical triple disulfide
25915 !C bond the soubroutine is located in ssMD.F
25917 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
25918 'evdw',i,j,evdwij,'tss'
25919 endif!dyn_ss_mask(k)
25923 itypj=iabs(itype(j,1))
25924 if (itypj.eq.ntyp1) cycle
25925 CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
25927 ! if (j.ne.78) cycle
25928 ! dscj_inv=dsc_inv(itypj)
25929 dscj_inv=vbld_inv(j+nres)
25933 xj=dmod(xj,boxxsize)
25934 if (xj.lt.0) xj=xj+boxxsize
25935 yj=dmod(yj,boxysize)
25936 if (yj.lt.0) yj=yj+boxysize
25937 zj=dmod(zj,boxzsize)
25938 if (zj.lt.0) zj=zj+boxzsize
25939 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
25948 xj=xj_safe+xshift*boxxsize
25949 yj=yj_safe+yshift*boxysize
25950 zj=zj_safe+zshift*boxzsize
25951 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
25952 if(dist_temp.lt.dist_init) then
25953 dist_init=dist_temp
25962 if (subchap.eq.1) then
25971 dxj = dc_norm( 1, nres+j )
25972 dyj = dc_norm( 2, nres+j )
25973 dzj = dc_norm( 3, nres+j )
25974 ! print *,i,j,itypi,itypj
25977 ! BetaT = 1.0d0 / (298.0d0 * Rb)
25979 !1! sig0ij = sigma_scsc( itypi,itypj )
25984 ! not used by momo potential, but needed by sc_angular which is shared
25985 ! by all energy_potential subroutines
25989 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
25990 ! a12sq = a12sq * a12sq
25991 ! charge of amino acid itypi is...
25992 chis1 = chis(itypi,itypj)
25993 chis2 = chis(itypj,itypi)
25994 chis12 = chis1 * chis2
25995 sig1 = sigmap1(itypi,itypj)
25996 sig2 = sigmap2(itypi,itypj)
25997 ! write (*,*) "sig1 = ", sig1
26000 ! chis12 = chis1 * chis2
26003 ! write (*,*) "sig2 = ", sig2
26004 ! alpha factors from Fcav/Gcav
26005 b1cav = alphasur(1,itypi,itypj)
26007 b2cav = alphasur(2,itypi,itypj)
26008 b3cav = alphasur(3,itypi,itypj)
26009 b4cav = alphasur(4,itypi,itypj)
26010 ! used to determine whether we want to do quadrupole calculations
26011 eps_in = epsintab(itypi,itypj)
26012 if (eps_in.eq.0.0) eps_in=1.0
26014 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
26016 ! dtail(1,itypi,itypj)=0.0
26017 ! dtail(2,itypi,itypj)=0.0
26020 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
26021 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
26023 !c! tail distances will be themselves usefull elswhere
26024 !c1 (in Gcav, for example)
26025 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
26026 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
26027 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
26029 (Rtail_distance(1)*Rtail_distance(1)) &
26030 + (Rtail_distance(2)*Rtail_distance(2)) &
26031 + (Rtail_distance(3)*Rtail_distance(3)))
26033 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
26034 !-------------------------------------------------------------------
26035 ! tail location and distance calculations
26036 d1 = dhead(1, 1, itypi, itypj)
26037 d2 = dhead(2, 1, itypi, itypj)
26040 ! location of polar head is computed by taking hydrophobic centre
26041 ! and moving by a d1 * dc_norm vector
26042 ! see unres publications for very informative images
26043 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
26044 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
26046 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
26047 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
26048 Rhead_distance(k) = chead(k,2) - chead(k,1)
26050 ! pitagoras (root of sum of squares)
26052 (Rhead_distance(1)*Rhead_distance(1)) &
26053 + (Rhead_distance(2)*Rhead_distance(2)) &
26054 + (Rhead_distance(3)*Rhead_distance(3)))
26055 !-------------------------------------------------------------------
26056 ! zero everything that should be zero'ed
26074 dscj_inv = vbld_inv(j+nres)
26075 ! print *,i,j,dscj_inv,dsci_inv
26076 ! rij holds 1/(distance of Calpha atoms)
26077 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
26079 !----------------------------
26081 ! this should be in elgrad_init but om's are calculated by sc_angular
26082 ! which in turn is used by older potentials
26083 ! om = omega, sqom = om^2
26086 sqom12 = om12 * om12
26088 ! now we calculate EGB - Gey-Berne
26089 ! It will be summed up in evdwij and saved in evdw
26090 sigsq = 1.0D0 / sigsq
26091 sig = sig0ij * dsqrt(sigsq)
26092 ! rij_shift = 1.0D0 / rij - sig + sig0ij
26093 rij_shift = Rtail - sig + sig0ij
26094 IF (rij_shift.le.0.0D0) THEN
26098 sigder = -sig * sigsq
26099 rij_shift = 1.0D0 / rij_shift
26100 fac = rij_shift**expon
26101 c1 = fac * fac * aa_aq(itypi,itypj)
26102 ! print *,"ADAM",aa_aq(itypi,itypj)
26105 c2 = fac * bb_aq(itypi,itypj)
26107 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
26108 eps2der = eps3rt * evdwij
26109 eps3der = eps2rt * evdwij
26110 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
26111 evdwij = eps2rt * eps3rt * evdwij
26113 ! IF (bb_aq(itypi,itypj).gt.0) THEN
26114 ! evdw_p = evdw_p + evdwij
26116 ! evdw_m = evdw_m + evdwij
26123 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
26124 fac = -expon * (c1 + evdwij) * rij_shift
26125 sigder = fac * sigder
26127 ! Calculate distance derivative
26131 ! if (b2.gt.0.0) then
26132 fac = chis1 * sqom1 + chis2 * sqom2 &
26133 - 2.0d0 * chis12 * om1 * om2 * om12
26134 ! we will use pom later in Gcav, so dont mess with it!
26135 pom = 1.0d0 - chis1 * chis2 * sqom12
26136 Lambf = (1.0d0 - (fac / pom))
26137 ! print *,"fac,pom",fac,pom,Lambf
26138 Lambf = dsqrt(Lambf)
26139 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
26140 ! print *,"sig1,sig2",sig1,sig2,itypi,itypj
26141 ! write (*,*) "sparrow = ", sparrow
26142 Chif = Rtail * sparrow
26143 ! print *,"rij,sparrow",rij , sparrow
26144 ChiLambf = Chif * Lambf
26145 eagle = dsqrt(ChiLambf)
26146 bat = ChiLambf ** 11.0d0
26147 top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
26148 bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
26150 ! print *,top,bot,"bot,top",ChiLambf,Chif
26153 dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
26154 dbot = 12.0d0 * b4cav * bat * Lambf
26155 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
26157 dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
26158 dbot = 12.0d0 * b4cav * bat * Chif
26159 eagle = Lambf * pom
26160 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
26161 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
26162 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
26163 * (chis2 * om2 * om12 - om1) / (eagle * pom)
26165 dFdL = ((dtop * bot - top * dbot) / botsq)
26167 dCAVdOM1 = dFdL * ( dFdOM1 )
26168 dCAVdOM2 = dFdL * ( dFdOM2 )
26169 dCAVdOM12 = dFdL * ( dFdOM12 )
26172 ertail(k) = Rtail_distance(k)/Rtail
26174 erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
26175 erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
26176 facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
26177 facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
26179 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
26180 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
26181 pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
26182 gvdwx(k,i) = gvdwx(k,i) &
26183 - (( dFdR + gg(k) ) * pom)
26184 !c! & - ( dFdR * pom )
26185 pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
26186 gvdwx(k,j) = gvdwx(k,j) &
26187 + (( dFdR + gg(k) ) * pom)
26188 !c! & + ( dFdR * pom )
26190 gvdwc(k,i) = gvdwc(k,i) &
26191 - (( dFdR + gg(k) ) * ertail(k))
26192 !c! & - ( dFdR * ertail(k))
26194 gvdwc(k,j) = gvdwc(k,j) &
26195 + (( dFdR + gg(k) ) * ertail(k))
26196 !c! & + ( dFdR * ertail(k))
26199 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
26200 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
26204 !c! Compute head-head and head-tail energies for each state
26206 isel = iabs(Qi) + iabs(Qj)
26207 ! double charge for Phophorylated! itype - 25,27,27
26208 ! if ((itype(i).eq.27).or.(itype(i).eq.26).or.(itype(i).eq.25)) then
26212 ! if ((itype(j).eq.27).or.(itype(j).eq.26).or.(itype(j).eq.25)) then
26218 IF (isel.eq.0) THEN
26219 !c! No charges - do nothing
26222 ELSE IF (isel.eq.4) THEN
26223 !c! Calculate dipole-dipole interactions
26226 ! eheadtail = 0.0d0
26228 ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
26229 !c! Charge-nonpolar interactions
26230 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
26234 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
26241 ! eheadtail = 0.0d0
26243 ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
26244 !c! Nonpolar-charge interactions
26245 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
26249 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
26256 ! eheadtail = 0.0d0
26258 ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
26259 !c! Charge-dipole interactions
26260 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
26264 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
26269 CALL eqd(ecl, elj, epol)
26270 eheadtail = ECL + elj + epol
26271 ! eheadtail = 0.0d0
26273 ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
26274 !c! Dipole-charge interactions
26275 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
26279 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
26283 CALL edq(ecl, elj, epol)
26284 eheadtail = ECL + elj + epol
26285 ! eheadtail = 0.0d0
26287 ELSE IF ((isel.eq.2.and. &
26288 iabs(Qi).eq.1).and. &
26289 nstate(itypi,itypj).eq.1) THEN
26290 !c! Same charge-charge interaction ( +/+ or -/- )
26291 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
26295 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
26300 CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
26301 eheadtail = ECL + Egb + Epol + Fisocav + Elj
26302 ! eheadtail = 0.0d0
26304 ELSE IF ((isel.eq.2.and. &
26305 iabs(Qi).eq.1).and. &
26306 nstate(itypi,itypj).ne.1) THEN
26307 !c! Different charge-charge interaction ( +/- or -/+ )
26308 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
26312 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
26317 CALL energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
26319 END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
26320 evdw = evdw + Fcav + eheadtail
26322 IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
26323 restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
26324 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
26325 Equad,evdwij+Fcav+eheadtail,evdw
26326 ! evdw = evdw + Fcav + eheadtail
26328 iF (nstate(itypi,itypj).eq.1) THEN
26331 !c!-------------------------------------------------------------------
26336 !c write (iout,*) "Number of loop steps in EGB:",ind
26337 !c energy_dec=.false.
26338 ! print *,"EVDW KURW",evdw,nres
26341 END SUBROUTINE emomo
26342 !C------------------------------------------------------------------------------------
26343 SUBROUTINE eqq(Ecl,Egb,Epol,Fisocav,Elj)
26346 real (kind=8) :: facd3, facd4, federmaus, adler,&
26347 Ecl,Egb,Epol,Fisocav,Elj,Fgb,debkap
26349 !c! Epol and Gpol analytical parameters
26350 alphapol1 = alphapol(itypi,itypj)
26351 alphapol2 = alphapol(itypj,itypi)
26352 !c! Fisocav and Gisocav analytical parameters
26353 al1 = alphiso(1,itypi,itypj)
26354 al2 = alphiso(2,itypi,itypj)
26355 al3 = alphiso(3,itypi,itypj)
26356 al4 = alphiso(4,itypi,itypj)
26358 / dsqrt(sigiso1(itypi, itypj)**2.0d0 &
26359 + sigiso2(itypi,itypj)**2.0d0))
26361 pis = sig0head(itypi,itypj)
26362 eps_head = epshead(itypi,itypj)
26363 Rhead_sq = Rhead * Rhead
26364 !c! R1 - distance between head of ith side chain and tail of jth sidechain
26365 !c! R2 - distance between head of jth side chain and tail of ith sidechain
26369 !c! Calculate head-to-tail distances needed by Epol
26370 R1=R1+(ctail(k,2)-chead(k,1))**2
26371 R2=R2+(chead(k,2)-ctail(k,1))**2
26377 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
26378 !c! & +dhead(1,1,itypi,itypj))**2))
26379 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
26380 !c! & +dhead(2,1,itypi,itypj))**2))
26382 !c!-------------------------------------------------------------------
26383 !c! Coulomb electrostatic interaction
26384 Ecl = (332.0d0 * Qij) / Rhead
26385 !c! derivative of Ecl is Gcl...
26386 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
26390 ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
26391 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
26392 debkap=debaykap(itypi,itypj)
26393 Egb = -(332.0d0 * Qij *&
26394 (1.0/eps_in-dexp(-debkap*Fgb)/eps_out)) / Fgb
26395 ! print *,"EGB WTF",Qij,eps_inout_fac,Fgb,itypi,itypj,eps_in,eps_out
26396 !c! Derivative of Egb is Ggb...
26397 dGGBdFGB = -(-332.0d0 * Qij * &
26398 (1.0/eps_in-dexp(-debkap*Fgb)/eps_out))/(Fgb*Fgb)&
26400 (dexp(-debkap*Fgb)*debkap/eps_out))/ Fgb
26401 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )/ ( 2.0d0 * Fgb )
26402 dGGBdR = dGGBdFGB * dFGBdR
26403 !c!-------------------------------------------------------------------
26404 !c! Fisocav - isotropic cavity creation term
26405 !c! or "how much energy it costs to put charged head in water"
26407 top = al1 * (dsqrt(pom) + al2 * pom - al3)
26408 bot = (1.0d0 + al4 * pom**12.0d0)
26410 FisoCav = top / bot
26411 ! write (*,*) "Rhead = ",Rhead
26412 ! write (*,*) "csig = ",csig
26413 ! write (*,*) "pom = ",pom
26414 ! write (*,*) "al1 = ",al1
26415 ! write (*,*) "al2 = ",al2
26416 ! write (*,*) "al3 = ",al3
26417 ! write (*,*) "al4 = ",al4
26418 ! write (*,*) "top = ",top
26419 ! write (*,*) "bot = ",bot
26420 !c! Derivative of Fisocav is GCV...
26421 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
26422 dbot = 12.0d0 * al4 * pom ** 11.0d0
26423 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
26424 !c!-------------------------------------------------------------------
26426 !c! Polarization energy - charged heads polarize hydrophobic "neck"
26427 MomoFac1 = (1.0d0 - chi1 * sqom2)
26428 MomoFac2 = (1.0d0 - chi2 * sqom1)
26429 RR1 = ( R1 * R1 ) / MomoFac1
26430 RR2 = ( R2 * R2 ) / MomoFac2
26431 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
26432 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
26433 fgb1 = sqrt( RR1 + a12sq * ee1 )
26434 fgb2 = sqrt( RR2 + a12sq * ee2 )
26435 epol = 332.0d0 * eps_inout_fac * ( &
26436 (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
26438 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
26440 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
26442 dFGBdR1 = ( (R1 / MomoFac1)* ( 2.0d0 - (0.5d0 * ee1) ) )&
26444 dFGBdR2 = ( (R2 / MomoFac2)* ( 2.0d0 - (0.5d0 * ee2) ) )&
26446 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))&
26447 * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 )
26448 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))&
26449 * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 )
26450 dPOLdR1 = dPOLdFGB1 * dFGBdR1
26451 !c! dPOLdR1 = 0.0d0
26452 dPOLdR2 = dPOLdFGB2 * dFGBdR2
26453 !c! dPOLdR2 = 0.0d0
26454 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
26455 !c! dPOLdOM1 = 0.0d0
26456 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
26457 !c! dPOLdOM2 = 0.0d0
26458 !c!-------------------------------------------------------------------
26460 !c! Lennard-Jones 6-12 interaction between heads
26461 pom = (pis / Rhead)**6.0d0
26462 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
26463 !c! derivative of Elj is Glj
26464 dGLJdR = 4.0d0 * eps_head*(((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))&
26465 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
26466 !c!-------------------------------------------------------------------
26467 !c! Return the results
26468 !c! These things do the dRdX derivatives, that is
26469 !c! allow us to change what we see from function that changes with
26470 !c! distance to function that changes with LOCATION (of the interaction
26473 erhead(k) = Rhead_distance(k)/Rhead
26474 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
26475 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
26478 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
26479 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
26480 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
26481 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
26482 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
26483 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
26484 facd1 = d1 * vbld_inv(i+nres)
26485 facd2 = d2 * vbld_inv(j+nres)
26486 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
26487 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
26489 !c! Now we add appropriate partial derivatives (one in each dimension)
26491 hawk = (erhead_tail(k,1) + &
26492 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
26493 condor = (erhead_tail(k,2) + &
26494 facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
26496 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
26497 gvdwx(k,i) = gvdwx(k,i) &
26502 - dPOLdR2 * (erhead_tail(k,2)&
26503 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
26506 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
26507 gvdwx(k,j) = gvdwx(k,j)+ dGCLdR * pom&
26508 + dGGBdR * pom+ dGCVdR * pom&
26509 + dPOLdR1 * (erhead_tail(k,1)&
26510 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))&
26511 + dPOLdR2 * condor + dGLJdR * pom
26513 gvdwc(k,i) = gvdwc(k,i) &
26514 - dGCLdR * erhead(k)&
26515 - dGGBdR * erhead(k)&
26516 - dGCVdR * erhead(k)&
26517 - dPOLdR1 * erhead_tail(k,1)&
26518 - dPOLdR2 * erhead_tail(k,2)&
26519 - dGLJdR * erhead(k)
26521 gvdwc(k,j) = gvdwc(k,j) &
26522 + dGCLdR * erhead(k) &
26523 + dGGBdR * erhead(k) &
26524 + dGCVdR * erhead(k) &
26525 + dPOLdR1 * erhead_tail(k,1) &
26526 + dPOLdR2 * erhead_tail(k,2)&
26527 + dGLJdR * erhead(k)
26533 SUBROUTINE eqq_cat(Ecl,Egb,Epol,Fisocav,Elj)
26536 real (kind=8) :: facd3, facd4, federmaus, adler,&
26537 Ecl,Egb,Epol,Fisocav,Elj,Fgb,debkap
26539 !c! Epol and Gpol analytical parameters
26540 alphapol1 = alphapolcat(itypi,itypj)
26541 alphapol2 = alphapolcat(itypj,itypi)
26542 !c! Fisocav and Gisocav analytical parameters
26543 al1 = alphisocat(1,itypi,itypj)
26544 al2 = alphisocat(2,itypi,itypj)
26545 al3 = alphisocat(3,itypi,itypj)
26546 al4 = alphisocat(4,itypi,itypj)
26548 / dsqrt(sigiso1cat(itypi, itypj)**2.0d0 &
26549 + sigiso2cat(itypi,itypj)**2.0d0))
26551 pis = sig0headcat(itypi,itypj)
26552 eps_head = epsheadcat(itypi,itypj)
26553 Rhead_sq = Rhead * Rhead
26554 !c! R1 - distance between head of ith side chain and tail of jth sidechain
26555 !c! R2 - distance between head of jth side chain and tail of ith sidechain
26559 !c! Calculate head-to-tail distances needed by Epol
26560 R1=R1+(ctail(k,2)-chead(k,1))**2
26561 R2=R2+(chead(k,2)-ctail(k,1))**2
26567 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
26568 !c! & +dhead(1,1,itypi,itypj))**2))
26569 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
26570 !c! & +dhead(2,1,itypi,itypj))**2))
26572 !c!-------------------------------------------------------------------
26573 !c! Coulomb electrostatic interaction
26574 Ecl = (332.0d0 * Qij) / Rhead
26575 !c! derivative of Ecl is Gcl...
26576 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
26580 ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
26581 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
26582 debkap=debaykapcat(itypi,itypj)
26583 Egb = -(332.0d0 * Qij *&
26584 (1.0/eps_in-dexp(-debkap*Fgb)/eps_out)) / Fgb
26585 ! print *,"EGB WTF",Qij,eps_inout_fac,Fgb,itypi,itypj,eps_in,eps_out
26586 !c! Derivative of Egb is Ggb...
26587 dGGBdFGB = -(-332.0d0 * Qij * &
26588 (1.0/eps_in-dexp(-debkap*Fgb)/eps_out))/(Fgb*Fgb)&
26590 (dexp(-debkap*Fgb)*debkap/eps_out))/ Fgb
26591 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )/ ( 2.0d0 * Fgb )
26592 dGGBdR = dGGBdFGB * dFGBdR
26593 !c!-------------------------------------------------------------------
26594 !c! Fisocav - isotropic cavity creation term
26595 !c! or "how much energy it costs to put charged head in water"
26597 top = al1 * (dsqrt(pom) + al2 * pom - al3)
26598 bot = (1.0d0 + al4 * pom**12.0d0)
26600 FisoCav = top / bot
26601 ! write (*,*) "Rhead = ",Rhead
26602 ! write (*,*) "csig = ",csig
26603 ! write (*,*) "pom = ",pom
26604 ! write (*,*) "al1 = ",al1
26605 ! write (*,*) "al2 = ",al2
26606 ! write (*,*) "al3 = ",al3
26607 ! write (*,*) "al4 = ",al4
26608 ! write (*,*) "top = ",top
26609 ! write (*,*) "bot = ",bot
26610 !c! Derivative of Fisocav is GCV...
26611 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
26612 dbot = 12.0d0 * al4 * pom ** 11.0d0
26613 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
26614 !c!-------------------------------------------------------------------
26616 !c! Polarization energy - charged heads polarize hydrophobic "neck"
26617 MomoFac1 = (1.0d0 - chi1 * sqom2)
26618 MomoFac2 = (1.0d0 - chi2 * sqom1)
26619 RR1 = ( R1 * R1 ) / MomoFac1
26620 RR2 = ( R2 * R2 ) / MomoFac2
26621 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
26622 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
26623 fgb1 = sqrt( RR1 + a12sq * ee1 )
26624 fgb2 = sqrt( RR2 + a12sq * ee2 )
26625 epol = 332.0d0 * eps_inout_fac * ( &
26626 (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
26628 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
26630 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
26632 dFGBdR1 = ( (R1 / MomoFac1)* ( 2.0d0 - (0.5d0 * ee1) ) )&
26634 dFGBdR2 = ( (R2 / MomoFac2)* ( 2.0d0 - (0.5d0 * ee2) ) )&
26636 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))&
26637 * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 )
26638 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))&
26639 * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 )
26640 dPOLdR1 = dPOLdFGB1 * dFGBdR1
26641 !c! dPOLdR1 = 0.0d0
26642 dPOLdR2 = dPOLdFGB2 * dFGBdR2
26643 !c! dPOLdR2 = 0.0d0
26644 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
26645 !c! dPOLdOM1 = 0.0d0
26646 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
26647 !c! dPOLdOM2 = 0.0d0
26648 !c!-------------------------------------------------------------------
26650 !c! Lennard-Jones 6-12 interaction between heads
26651 pom = (pis / Rhead)**6.0d0
26652 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
26653 !c! derivative of Elj is Glj
26654 dGLJdR = 4.0d0 * eps_head*(((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))&
26655 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
26656 !c!-------------------------------------------------------------------
26657 !c! Return the results
26658 !c! These things do the dRdX derivatives, that is
26659 !c! allow us to change what we see from function that changes with
26660 !c! distance to function that changes with LOCATION (of the interaction
26663 erhead(k) = Rhead_distance(k)/Rhead
26664 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
26665 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
26668 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
26669 erdxj = scalar( erhead(1), dC_norm(1,j) )
26670 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
26671 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j))
26672 eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
26673 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
26674 facd1 = d1 * vbld_inv(i+nres)
26675 facd2 = d2 * vbld_inv(j)
26676 facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
26677 facd4 = dtailcat(2,itypi,itypj) * vbld_inv(j)
26679 !c! Now we add appropriate partial derivatives (one in each dimension)
26681 hawk = (erhead_tail(k,1) + &
26682 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
26683 condor = (erhead_tail(k,2) + &
26684 facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
26686 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
26687 gradpepcatx(k,i) = gradpepcatx(k,i) &
26692 - dPOLdR2 * (erhead_tail(k,2)&
26693 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
26696 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
26697 ! gradpepcatx(k,j) = gradpepcatx(k,j)+ dGCLdR * pom&
26698 ! + dGGBdR * pom+ dGCVdR * pom&
26699 ! + dPOLdR1 * (erhead_tail(k,1)&
26700 ! -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j)))&
26701 ! + dPOLdR2 * condor + dGLJdR * pom
26703 gradpepcat(k,i) = gradpepcat(k,i) &
26704 - dGCLdR * erhead(k)&
26705 - dGGBdR * erhead(k)&
26706 - dGCVdR * erhead(k)&
26707 - dPOLdR1 * erhead_tail(k,1)&
26708 - dPOLdR2 * erhead_tail(k,2)&
26709 - dGLJdR * erhead(k)
26711 gradpepcat(k,j) = gradpepcat(k,j) &
26712 + dGCLdR * erhead(k) &
26713 + dGGBdR * erhead(k) &
26714 + dGCVdR * erhead(k) &
26715 + dPOLdR1 * erhead_tail(k,1) &
26716 + dPOLdR2 * erhead_tail(k,2)&
26717 + dGLJdR * erhead(k)
26721 END SUBROUTINE eqq_cat
26722 !c!-------------------------------------------------------------------
26723 SUBROUTINE energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
26727 double precision eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad
26728 double precision ener(4)
26729 double precision dcosom1(3),dcosom2(3)
26730 !c! used in Epol derivatives
26731 double precision facd3, facd4
26732 double precision federmaus, adler
26733 integer istate,ii,jj
26734 real (kind=8) :: Fgb
26735 ! print *,"CALLING EQUAD"
26736 !c! Epol and Gpol analytical parameters
26737 alphapol1 = alphapol(itypi,itypj)
26738 alphapol2 = alphapol(itypj,itypi)
26739 !c! Fisocav and Gisocav analytical parameters
26740 al1 = alphiso(1,itypi,itypj)
26741 al2 = alphiso(2,itypi,itypj)
26742 al3 = alphiso(3,itypi,itypj)
26743 al4 = alphiso(4,itypi,itypj)
26744 csig = (1.0d0 / dsqrt(sigiso1(itypi, itypj)**2.0d0&
26745 + sigiso2(itypi,itypj)**2.0d0))
26747 w1 = wqdip(1,itypi,itypj)
26748 w2 = wqdip(2,itypi,itypj)
26749 pis = sig0head(itypi,itypj)
26750 eps_head = epshead(itypi,itypj)
26751 !c! First things first:
26752 !c! We need to do sc_grad's job with GB and Fcav
26753 eom1 = eps2der * eps2rt_om1 &
26754 - 2.0D0 * alf1 * eps3der&
26755 + sigder * sigsq_om1&
26757 eom2 = eps2der * eps2rt_om2 &
26758 + 2.0D0 * alf2 * eps3der&
26759 + sigder * sigsq_om2&
26761 eom12 = evdwij * eps1_om12 &
26762 + eps2der * eps2rt_om12 &
26763 - 2.0D0 * alf12 * eps3der&
26764 + sigder *sigsq_om12&
26766 !c! now some magical transformations to project gradient into
26767 !c! three cartesian vectors
26769 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
26770 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
26771 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
26772 !c! this acts on hydrophobic center of interaction
26773 gvdwx(k,i)= gvdwx(k,i) - gg(k) &
26774 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
26775 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
26776 gvdwx(k,j)= gvdwx(k,j) + gg(k) &
26777 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))&
26778 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
26779 !c! this acts on Calpha
26780 gvdwc(k,i)=gvdwc(k,i)-gg(k)
26781 gvdwc(k,j)=gvdwc(k,j)+gg(k)
26783 !c! sc_grad is done, now we will compute
26788 DO istate = 1, nstate(itypi,itypj)
26789 !c*************************************************************
26790 IF (istate.ne.1) THEN
26791 IF (istate.lt.3) THEN
26797 d1 = dhead(1,ii,itypi,itypj)
26798 d2 = dhead(2,jj,itypi,itypj)
26800 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
26801 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
26802 Rhead_distance(k) = chead(k,2) - chead(k,1)
26804 !c! pitagoras (root of sum of squares)
26806 (Rhead_distance(1)*Rhead_distance(1)) &
26807 + (Rhead_distance(2)*Rhead_distance(2)) &
26808 + (Rhead_distance(3)*Rhead_distance(3)))
26810 Rhead_sq = Rhead * Rhead
26812 !c! R1 - distance between head of ith side chain and tail of jth sidechain
26813 !c! R2 - distance between head of jth side chain and tail of ith sidechain
26817 !c! Calculate head-to-tail distances
26818 R1=R1+(ctail(k,2)-chead(k,1))**2
26819 R2=R2+(chead(k,2)-ctail(k,1))**2
26824 Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
26826 !c! write (*,*) "Ecl = ", Ecl
26827 !c! derivative of Ecl is Gcl...
26828 dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
26833 !c!-------------------------------------------------------------------
26834 !c! Generalised Born Solvent Polarization
26835 ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
26836 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
26837 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
26839 !c! write (*,*) "a1*a2 = ", a12sq
26840 !c! write (*,*) "Rhead = ", Rhead
26841 !c! write (*,*) "Rhead_sq = ", Rhead_sq
26842 !c! write (*,*) "ee = ", ee
26843 !c! write (*,*) "Fgb = ", Fgb
26844 !c! write (*,*) "fac = ", eps_inout_fac
26845 !c! write (*,*) "Qij = ", Qij
26846 !c! write (*,*) "Egb = ", Egb
26847 !c! Derivative of Egb is Ggb...
26848 !c! dFGBdR is used by Quad's later...
26849 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
26850 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )&
26852 dGGBdR = dGGBdFGB * dFGBdR
26854 !c!-------------------------------------------------------------------
26855 !c! Fisocav - isotropic cavity creation term
26857 top = al1 * (dsqrt(pom) + al2 * pom - al3)
26858 bot = (1.0d0 + al4 * pom**12.0d0)
26860 FisoCav = top / bot
26861 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
26862 dbot = 12.0d0 * al4 * pom ** 11.0d0
26863 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
26865 !c!-------------------------------------------------------------------
26866 !c! Polarization energy
26868 MomoFac1 = (1.0d0 - chi1 * sqom2)
26869 MomoFac2 = (1.0d0 - chi2 * sqom1)
26870 RR1 = ( R1 * R1 ) / MomoFac1
26871 RR2 = ( R2 * R2 ) / MomoFac2
26872 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
26873 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
26874 fgb1 = sqrt( RR1 + a12sq * ee1 )
26875 fgb2 = sqrt( RR2 + a12sq * ee2 )
26876 epol = 332.0d0 * eps_inout_fac * (&
26877 (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
26879 !c! derivative of Epol is Gpol...
26880 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
26882 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
26884 dFGBdR1 = ( (R1 / MomoFac1) &
26885 * ( 2.0d0 - (0.5d0 * ee1) ) )&
26887 dFGBdR2 = ( (R2 / MomoFac2) &
26888 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
26890 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
26891 * ( 2.0d0 - 0.5d0 * ee1) ) &
26893 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
26894 * ( 2.0d0 - 0.5d0 * ee2) ) &
26896 dPOLdR1 = dPOLdFGB1 * dFGBdR1
26897 !c! dPOLdR1 = 0.0d0
26898 dPOLdR2 = dPOLdFGB2 * dFGBdR2
26899 !c! dPOLdR2 = 0.0d0
26900 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
26901 !c! dPOLdOM1 = 0.0d0
26902 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
26903 pom = (pis / Rhead)**6.0d0
26904 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
26906 !c! derivative of Elj is Glj
26907 dGLJdR = 4.0d0 * eps_head &
26908 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
26909 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
26911 !c!-------------------------------------------------------------------
26913 IF (Wqd.ne.0.0d0) THEN
26914 Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0) &
26915 - 37.5d0 * ( sqom1 + sqom2 ) &
26916 + 157.5d0 * ( sqom1 * sqom2 ) &
26917 - 45.0d0 * om1*om2*om12
26918 fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
26919 Equad = fac * Beta1
26921 !c! derivative of Equad...
26922 dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
26923 !c! dQUADdR = 0.0d0
26924 dQUADdOM1 = fac* (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
26925 !c! dQUADdOM1 = 0.0d0
26926 dQUADdOM2 = fac* (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
26927 !c! dQUADdOM2 = 0.0d0
26928 dQUADdOM12 = fac * ( 6.0d0*om12 - 45.0d0*om1*om2 )
26933 !c!-------------------------------------------------------------------
26934 !c! Return the results
26936 eom1 = dPOLdOM1 + dQUADdOM1
26937 eom2 = dPOLdOM2 + dQUADdOM2
26939 !c! now some magical transformations to project gradient into
26940 !c! three cartesian vectors
26942 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
26943 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
26944 tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
26948 erhead(k) = Rhead_distance(k)/Rhead
26949 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
26950 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
26952 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
26953 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
26954 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
26955 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
26956 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
26957 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
26958 facd1 = d1 * vbld_inv(i+nres)
26959 facd2 = d2 * vbld_inv(j+nres)
26960 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
26961 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
26963 hawk = erhead_tail(k,1) + &
26964 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
26965 condor = erhead_tail(k,2) + &
26966 facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
26968 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
26969 !c! this acts on hydrophobic center of interaction
26970 gheadtail(k,1,1) = gheadtail(k,1,1) &
26975 - dPOLdR2 * (erhead_tail(k,2) &
26976 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
26980 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
26981 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
26983 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
26984 !c! this acts on hydrophobic center of interaction
26985 gheadtail(k,2,1) = gheadtail(k,2,1) &
26989 + dPOLdR1 * (erhead_tail(k,1) &
26990 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
26991 + dPOLdR2 * condor &
26995 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
26996 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
26998 !c! this acts on Calpha
26999 gheadtail(k,3,1) = gheadtail(k,3,1) &
27000 - dGCLdR * erhead(k)&
27001 - dGGBdR * erhead(k)&
27002 - dGCVdR * erhead(k)&
27003 - dPOLdR1 * erhead_tail(k,1)&
27004 - dPOLdR2 * erhead_tail(k,2)&
27005 - dGLJdR * erhead(k) &
27006 - dQUADdR * erhead(k)&
27008 !c! this acts on Calpha
27009 gheadtail(k,4,1) = gheadtail(k,4,1) &
27010 + dGCLdR * erhead(k) &
27011 + dGGBdR * erhead(k) &
27012 + dGCVdR * erhead(k) &
27013 + dPOLdR1 * erhead_tail(k,1) &
27014 + dPOLdR2 * erhead_tail(k,2) &
27015 + dGLJdR * erhead(k) &
27016 + dQUADdR * erhead(k)&
27019 ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
27020 eheadtail = eheadtail &
27021 + wstate(istate, itypi, itypj) &
27022 * dexp(-betaT * ener(istate))
27023 !c! foreach cartesian dimension
27025 !c! foreach of two gvdwx and gvdwc
27027 gheadtail(k,l,2) = gheadtail(k,l,2) &
27028 + wstate( istate, itypi, itypj ) &
27029 * dexp(-betaT * ener(istate)) &
27031 gheadtail(k,l,1) = 0.0d0
27035 !c! Here ended the gigantic DO istate = 1, 4, which starts
27036 !c! at the beggining of the subroutine
27040 gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
27042 gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
27043 gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
27044 gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
27045 gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
27047 gheadtail(k,l,1) = 0.0d0
27048 gheadtail(k,l,2) = 0.0d0
27051 eheadtail = (-dlog(eheadtail)) / betaT
27058 END SUBROUTINE energy_quad
27059 !!-----------------------------------------------------------
27060 SUBROUTINE eqn(Epol)
27064 double precision facd4, federmaus,epol
27065 alphapol1 = alphapol(itypi,itypj)
27066 !c! R1 - distance between head of ith side chain and tail of jth sidechain
27069 !c! Calculate head-to-tail distances
27070 R1=R1+(ctail(k,2)-chead(k,1))**2
27075 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
27076 !c! & +dhead(1,1,itypi,itypj))**2))
27077 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
27078 !c! & +dhead(2,1,itypi,itypj))**2))
27079 !c--------------------------------------------------------------------
27080 !c Polarization energy
27082 MomoFac1 = (1.0d0 - chi1 * sqom2)
27083 RR1 = R1 * R1 / MomoFac1
27084 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
27085 fgb1 = sqrt( RR1 + a12sq * ee1)
27086 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
27087 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
27089 dFGBdR1 = ( (R1 / MomoFac1) &
27090 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
27092 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
27093 * (2.0d0 - 0.5d0 * ee1) ) &
27095 dPOLdR1 = dPOLdFGB1 * dFGBdR1
27096 !c! dPOLdR1 = 0.0d0
27098 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
27100 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
27102 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
27103 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
27104 facd1 = d1 * vbld_inv(i+nres)
27105 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
27108 hawk = (erhead_tail(k,1) + &
27109 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
27111 gvdwx(k,i) = gvdwx(k,i) &
27113 gvdwx(k,j) = gvdwx(k,j) &
27114 + dPOLdR1 * (erhead_tail(k,1) &
27115 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
27117 gvdwc(k,i) = gvdwc(k,i) - dPOLdR1 * erhead_tail(k,1)
27118 gvdwc(k,j) = gvdwc(k,j) + dPOLdR1 * erhead_tail(k,1)
27123 SUBROUTINE enq(Epol)
27126 double precision facd3, adler,epol
27127 alphapol2 = alphapol(itypj,itypi)
27128 !c! R2 - distance between head of jth side chain and tail of ith sidechain
27131 !c! Calculate head-to-tail distances
27132 R2=R2+(chead(k,2)-ctail(k,1))**2
27137 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
27138 !c! & +dhead(1,1,itypi,itypj))**2))
27139 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
27140 !c! & +dhead(2,1,itypi,itypj))**2))
27141 !c------------------------------------------------------------------------
27142 !c Polarization energy
27143 MomoFac2 = (1.0d0 - chi2 * sqom1)
27144 RR2 = R2 * R2 / MomoFac2
27145 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
27146 fgb2 = sqrt(RR2 + a12sq * ee2)
27147 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
27148 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
27150 dFGBdR2 = ( (R2 / MomoFac2) &
27151 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
27153 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
27154 * (2.0d0 - 0.5d0 * ee2) ) &
27156 dPOLdR2 = dPOLdFGB2 * dFGBdR2
27157 !c! dPOLdR2 = 0.0d0
27158 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
27159 !c! dPOLdOM1 = 0.0d0
27161 !c!-------------------------------------------------------------------
27162 !c! Return the results
27163 !c! (See comments in Eqq)
27165 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
27167 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
27168 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
27169 facd2 = d2 * vbld_inv(j+nres)
27170 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
27172 condor = (erhead_tail(k,2) &
27173 + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
27175 gvdwx(k,i) = gvdwx(k,i) &
27176 - dPOLdR2 * (erhead_tail(k,2) &
27177 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
27178 gvdwx(k,j) = gvdwx(k,j) &
27181 gvdwc(k,i) = gvdwc(k,i) &
27182 - dPOLdR2 * erhead_tail(k,2)
27183 gvdwc(k,j) = gvdwc(k,j) &
27184 + dPOLdR2 * erhead_tail(k,2)
27190 SUBROUTINE enq_cat(Epol)
27193 double precision facd3, adler,epol
27194 alphapol2 = alphapolcat(itypj,itypi)
27195 !c! R2 - distance between head of jth side chain and tail of ith sidechain
27198 !c! Calculate head-to-tail distances
27199 R2=R2+(chead(k,2)-ctail(k,1))**2
27204 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
27205 !c! & +dhead(1,1,itypi,itypj))**2))
27206 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
27207 !c! & +dhead(2,1,itypi,itypj))**2))
27208 !c------------------------------------------------------------------------
27209 !c Polarization energy
27210 MomoFac2 = (1.0d0 - chi2 * sqom1)
27211 RR2 = R2 * R2 / MomoFac2
27212 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
27213 fgb2 = sqrt(RR2 + a12sq * ee2)
27214 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
27215 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
27217 dFGBdR2 = ( (R2 / MomoFac2) &
27218 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
27220 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
27221 * (2.0d0 - 0.5d0 * ee2) ) &
27223 dPOLdR2 = dPOLdFGB2 * dFGBdR2
27224 !c! dPOLdR2 = 0.0d0
27225 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
27226 !c! dPOLdOM1 = 0.0d0
27229 !c!-------------------------------------------------------------------
27230 !c! Return the results
27231 !c! (See comments in Eqq)
27233 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
27235 eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
27236 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
27237 facd2 = d2 * vbld_inv(j+nres)
27238 facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
27240 condor = (erhead_tail(k,2) &
27241 + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
27243 gradpepcatx(k,i) = gradpepcatx(k,i) &
27244 - dPOLdR2 * (erhead_tail(k,2) &
27245 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
27246 ! gradpepcatx(k,j) = gradpepcatx(k,j) &
27247 ! + dPOLdR2 * condor
27249 gradpepcat(k,i) = gradpepcat(k,i) &
27250 - dPOLdR2 * erhead_tail(k,2)
27251 gradpepcat(k,j) = gradpepcat(k,j) &
27252 + dPOLdR2 * erhead_tail(k,2)
27256 END SUBROUTINE enq_cat
27258 SUBROUTINE eqd(Ecl,Elj,Epol)
27261 double precision facd4, federmaus,ecl,elj,epol
27262 alphapol1 = alphapol(itypi,itypj)
27263 w1 = wqdip(1,itypi,itypj)
27264 w2 = wqdip(2,itypi,itypj)
27265 pis = sig0head(itypi,itypj)
27266 eps_head = epshead(itypi,itypj)
27267 !c!-------------------------------------------------------------------
27268 !c! R1 - distance between head of ith side chain and tail of jth sidechain
27271 !c! Calculate head-to-tail distances
27272 R1=R1+(ctail(k,2)-chead(k,1))**2
27277 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
27278 !c! & +dhead(1,1,itypi,itypj))**2))
27279 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
27280 !c! & +dhead(2,1,itypi,itypj))**2))
27282 !c!-------------------------------------------------------------------
27284 sparrow = w1 * Qi * om1
27285 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
27286 Ecl = sparrow / Rhead**2.0d0 &
27287 - hawk / Rhead**4.0d0
27288 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
27289 + 4.0d0 * hawk / Rhead**5.0d0
27291 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
27293 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
27294 !c--------------------------------------------------------------------
27295 !c Polarization energy
27297 MomoFac1 = (1.0d0 - chi1 * sqom2)
27298 RR1 = R1 * R1 / MomoFac1
27299 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
27300 fgb1 = sqrt( RR1 + a12sq * ee1)
27301 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
27303 !c!------------------------------------------------------------------
27304 !c! derivative of Epol is Gpol...
27305 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
27307 dFGBdR1 = ( (R1 / MomoFac1) &
27308 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
27310 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
27311 * (2.0d0 - 0.5d0 * ee1) ) &
27313 dPOLdR1 = dPOLdFGB1 * dFGBdR1
27314 !c! dPOLdR1 = 0.0d0
27316 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
27317 !c! dPOLdOM2 = 0.0d0
27318 !c!-------------------------------------------------------------------
27320 pom = (pis / Rhead)**6.0d0
27321 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
27322 !c! derivative of Elj is Glj
27323 dGLJdR = 4.0d0 * eps_head &
27324 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
27325 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
27327 erhead(k) = Rhead_distance(k)/Rhead
27328 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
27331 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
27332 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
27333 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
27334 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
27335 facd1 = d1 * vbld_inv(i+nres)
27336 facd2 = d2 * vbld_inv(j+nres)
27337 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
27340 hawk = (erhead_tail(k,1) + &
27341 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
27343 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
27344 gvdwx(k,i) = gvdwx(k,i) &
27349 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
27350 gvdwx(k,j) = gvdwx(k,j) &
27352 + dPOLdR1 * (erhead_tail(k,1) &
27353 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
27357 gvdwc(k,i) = gvdwc(k,i) &
27358 - dGCLdR * erhead(k) &
27359 - dPOLdR1 * erhead_tail(k,1) &
27360 - dGLJdR * erhead(k)
27362 gvdwc(k,j) = gvdwc(k,j) &
27363 + dGCLdR * erhead(k) &
27364 + dPOLdR1 * erhead_tail(k,1) &
27365 + dGLJdR * erhead(k)
27370 SUBROUTINE edq(Ecl,Elj,Epol)
27375 double precision facd3, adler,ecl,elj,epol
27376 alphapol2 = alphapol(itypj,itypi)
27377 w1 = wqdip(1,itypi,itypj)
27378 w2 = wqdip(2,itypi,itypj)
27379 pis = sig0head(itypi,itypj)
27380 eps_head = epshead(itypi,itypj)
27381 !c!-------------------------------------------------------------------
27382 !c! R2 - distance between head of jth side chain and tail of ith sidechain
27385 !c! Calculate head-to-tail distances
27386 R2=R2+(chead(k,2)-ctail(k,1))**2
27391 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
27392 !c! & +dhead(1,1,itypi,itypj))**2))
27393 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
27394 !c! & +dhead(2,1,itypi,itypj))**2))
27397 !c!-------------------------------------------------------------------
27399 sparrow = w1 * Qj * om1
27400 hawk = w2 * Qj * Qj * (1.0d0 - sqom2)
27401 ECL = sparrow / Rhead**2.0d0 &
27402 - hawk / Rhead**4.0d0
27403 !c!-------------------------------------------------------------------
27404 !c! derivative of ecl is Gcl
27406 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
27407 + 4.0d0 * hawk / Rhead**5.0d0
27409 dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0)
27411 dGCLdOM2 = (2.0d0 * w2 * Qj * Qj * om2) / (Rhead ** 4.0d0)
27412 !c--------------------------------------------------------------------
27413 !c Polarization energy
27415 MomoFac2 = (1.0d0 - chi2 * sqom1)
27416 RR2 = R2 * R2 / MomoFac2
27417 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
27418 fgb2 = sqrt(RR2 + a12sq * ee2)
27419 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
27420 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
27422 dFGBdR2 = ( (R2 / MomoFac2) &
27423 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
27425 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
27426 * (2.0d0 - 0.5d0 * ee2) ) &
27428 dPOLdR2 = dPOLdFGB2 * dFGBdR2
27429 !c! dPOLdR2 = 0.0d0
27430 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
27431 !c! dPOLdOM1 = 0.0d0
27433 !c!-------------------------------------------------------------------
27435 pom = (pis / Rhead)**6.0d0
27436 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
27437 !c! derivative of Elj is Glj
27438 dGLJdR = 4.0d0 * eps_head &
27439 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
27440 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
27441 !c!-------------------------------------------------------------------
27442 !c! Return the results
27443 !c! (see comments in Eqq)
27445 erhead(k) = Rhead_distance(k)/Rhead
27446 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
27448 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
27449 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
27450 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
27451 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
27452 facd1 = d1 * vbld_inv(i+nres)
27453 facd2 = d2 * vbld_inv(j+nres)
27454 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
27456 condor = (erhead_tail(k,2) &
27457 + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
27459 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
27460 gvdwx(k,i) = gvdwx(k,i) &
27462 - dPOLdR2 * (erhead_tail(k,2) &
27463 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) &
27466 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
27467 gvdwx(k,j) = gvdwx(k,j) &
27469 + dPOLdR2 * condor &
27473 gvdwc(k,i) = gvdwc(k,i) &
27474 - dGCLdR * erhead(k) &
27475 - dPOLdR2 * erhead_tail(k,2) &
27476 - dGLJdR * erhead(k)
27478 gvdwc(k,j) = gvdwc(k,j) &
27479 + dGCLdR * erhead(k) &
27480 + dPOLdR2 * erhead_tail(k,2) &
27481 + dGLJdR * erhead(k)
27487 SUBROUTINE edq_cat(Ecl,Elj,Epol)
27491 double precision facd3, adler,ecl,elj,epol
27492 alphapol2 = alphapolcat(itypj,itypi)
27493 w1 = wqdipcat(1,itypi,itypj)
27494 w2 = wqdipcat(2,itypi,itypj)
27495 pis = sig0headcat(itypi,itypj)
27496 eps_head = epsheadcat(itypi,itypj)
27497 !c!-------------------------------------------------------------------
27498 !c! R2 - distance between head of jth side chain and tail of ith sidechain
27501 !c! Calculate head-to-tail distances
27502 R2=R2+(chead(k,2)-ctail(k,1))**2
27507 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
27508 !c! & +dhead(1,1,itypi,itypj))**2))
27509 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
27510 !c! & +dhead(2,1,itypi,itypj))**2))
27513 !c!-------------------------------------------------------------------
27515 sparrow = w1 * Qj * om1
27516 hawk = w2 * Qj * Qj * (1.0d0 - sqom2)
27517 ECL = sparrow / Rhead**2.0d0 &
27518 - hawk / Rhead**4.0d0
27519 !c!-------------------------------------------------------------------
27520 !c! derivative of ecl is Gcl
27522 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
27523 + 4.0d0 * hawk / Rhead**5.0d0
27525 dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0)
27527 dGCLdOM2 = (2.0d0 * w2 * Qj * Qj * om2) / (Rhead ** 4.0d0)
27528 !c--------------------------------------------------------------------
27529 !c--------------------------------------------------------------------
27530 !c Polarization energy
27532 MomoFac2 = (1.0d0 - chi2 * sqom1)
27533 RR2 = R2 * R2 / MomoFac2
27534 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
27535 fgb2 = sqrt(RR2 + a12sq * ee2)
27536 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
27537 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
27539 dFGBdR2 = ( (R2 / MomoFac2) &
27540 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
27542 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
27543 * (2.0d0 - 0.5d0 * ee2) ) &
27545 dPOLdR2 = dPOLdFGB2 * dFGBdR2
27546 !c! dPOLdR2 = 0.0d0
27547 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
27548 !c! dPOLdOM1 = 0.0d0
27550 !c!-------------------------------------------------------------------
27552 pom = (pis / Rhead)**6.0d0
27553 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
27554 !c! derivative of Elj is Glj
27555 dGLJdR = 4.0d0 * eps_head &
27556 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
27557 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
27558 !c!-------------------------------------------------------------------
27560 !c! Return the results
27561 !c! (see comments in Eqq)
27563 erhead(k) = Rhead_distance(k)/Rhead
27564 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
27566 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
27567 erdxj = scalar( erhead(1), dC_norm(1,j) )
27568 eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
27569 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
27570 facd1 = d1 * vbld_inv(i+nres)
27571 facd2 = d2 * vbld_inv(j)
27572 facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
27574 condor = (erhead_tail(k,2) &
27575 + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
27577 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
27578 gradpepcatx(k,i) = gradpepcatx(k,i) &
27580 - dPOLdR2 * (erhead_tail(k,2) &
27581 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) &
27584 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
27585 ! gradpepcatx(k,j) = gradpepcatx(k,j) &
27587 ! + dPOLdR2 * condor &
27591 gradpepcat(k,i) = gradpepcat(k,i) &
27592 - dGCLdR * erhead(k) &
27593 - dPOLdR2 * erhead_tail(k,2) &
27594 - dGLJdR * erhead(k)
27596 gradpepcat(k,j) = gradpepcat(k,j) &
27597 + dGCLdR * erhead(k) &
27598 + dPOLdR2 * erhead_tail(k,2) &
27599 + dGLJdR * erhead(k)
27603 END SUBROUTINE edq_cat
27605 SUBROUTINE edq_cat_pep(Ecl,Elj,Epol)
27609 double precision facd3, adler,ecl,elj,epol
27610 alphapol2 = alphapolcat(itypj,itypi)
27611 w1 = wqdipcat(1,itypi,itypj)
27612 w2 = wqdipcat(2,itypi,itypj)
27613 pis = sig0headcat(itypi,itypj)
27614 eps_head = epsheadcat(itypi,itypj)
27615 !c!-------------------------------------------------------------------
27616 !c! R2 - distance between head of jth side chain and tail of ith sidechain
27619 !c! Calculate head-to-tail distances
27620 R2=R2+(chead(k,2)-ctail(k,1))**2
27625 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
27626 !c! & +dhead(1,1,itypi,itypj))**2))
27627 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
27628 !c! & +dhead(2,1,itypi,itypj))**2))
27631 !c!-------------------------------------------------------------------
27633 sparrow = w1 * Qj * om1
27634 hawk = w2 * Qj * Qj * (1.0d0 - sqom2)
27635 ! print *,"CO?!.", w1,w2,Qj,om1
27636 ECL = sparrow / Rhead**2.0d0 &
27637 - hawk / Rhead**4.0d0
27638 !c!-------------------------------------------------------------------
27639 !c! derivative of ecl is Gcl
27641 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
27642 + 4.0d0 * hawk / Rhead**5.0d0
27644 dGCLdOM1 = (w1 * Qj) / (Rhead**2.0d0)
27646 dGCLdOM2 = (2.0d0 * w2 * Qj * Qj * om2) / (Rhead ** 4.0d0)
27647 !c--------------------------------------------------------------------
27648 !c--------------------------------------------------------------------
27649 !c Polarization energy
27651 MomoFac2 = (1.0d0 - chi2 * sqom1)
27652 RR2 = R2 * R2 / MomoFac2
27653 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
27654 fgb2 = sqrt(RR2 + a12sq * ee2)
27655 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
27656 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
27658 dFGBdR2 = ( (R2 / MomoFac2) &
27659 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
27661 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
27662 * (2.0d0 - 0.5d0 * ee2) ) &
27664 dPOLdR2 = dPOLdFGB2 * dFGBdR2
27665 !c! dPOLdR2 = 0.0d0
27666 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
27667 !c! dPOLdOM1 = 0.0d0
27669 !c!-------------------------------------------------------------------
27671 pom = (pis / Rhead)**6.0d0
27672 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
27673 !c! derivative of Elj is Glj
27674 dGLJdR = 4.0d0 * eps_head &
27675 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
27676 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
27677 !c!-------------------------------------------------------------------
27679 !c! Return the results
27680 !c! (see comments in Eqq)
27682 erhead(k) = Rhead_distance(k)/Rhead
27683 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
27685 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
27686 erdxj = scalar( erhead(1), dC_norm(1,j) )
27687 eagle = scalar( erhead_tail(1,2), dC_norm(1,j) )
27688 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
27689 facd1 = d1 * vbld_inv(i+1)/2.0
27690 facd2 = d2 * vbld_inv(j)
27691 facd3 = dtailcat(1,itypi,itypj) * vbld_inv(i+nres)
27693 condor = (erhead_tail(k,2) &
27694 + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j)))
27696 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
27697 ! gradpepcatx(k,i) = gradpepcatx(k,i) &
27699 ! - dPOLdR2 * (erhead_tail(k,2) &
27700 ! -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) &
27703 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
27704 ! gradpepcatx(k,j) = gradpepcatx(k,j) &
27706 ! + dPOLdR2 * condor &
27710 gradpepcat(k,i) = gradpepcat(k,i) +0.5d0*( &
27711 - dGCLdR * erhead(k) &
27712 - dPOLdR2 * erhead_tail(k,2) &
27713 - dGLJdR * erhead(k))
27714 gradpepcat(k,i+1) = gradpepcat(k,i+1) +0.5d0*( &
27715 - dGCLdR * erhead(k) &
27716 - dPOLdR2 * erhead_tail(k,2) &
27717 - dGLJdR * erhead(k))
27720 gradpepcat(k,j) = gradpepcat(k,j) &
27721 + dGCLdR * erhead(k) &
27722 + dPOLdR2 * erhead_tail(k,2) &
27723 + dGLJdR * erhead(k)
27727 END SUBROUTINE edq_cat_pep
27729 SUBROUTINE edd(ECL)
27734 double precision ecl
27735 !c! csig = sigiso(itypi,itypj)
27736 w1 = wqdip(1,itypi,itypj)
27737 w2 = wqdip(2,itypi,itypj)
27738 !c!-------------------------------------------------------------------
27740 fac = (om12 - 3.0d0 * om1 * om2)
27741 c1 = (w1 / (Rhead**3.0d0)) * fac
27742 c2 = (w2 / Rhead ** 6.0d0) &
27743 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
27745 !c! write (*,*) "w1 = ", w1
27746 !c! write (*,*) "w2 = ", w2
27747 !c! write (*,*) "om1 = ", om1
27748 !c! write (*,*) "om2 = ", om2
27749 !c! write (*,*) "om12 = ", om12
27750 !c! write (*,*) "fac = ", fac
27751 !c! write (*,*) "c1 = ", c1
27752 !c! write (*,*) "c2 = ", c2
27753 !c! write (*,*) "Ecl = ", Ecl
27754 !c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
27755 !c! write (*,*) "c2_2 = ",
27756 !c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
27757 !c!-------------------------------------------------------------------
27758 !c! dervative of ECL is GCL...
27760 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
27761 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
27762 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
27765 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
27766 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
27767 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
27770 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
27771 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
27772 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
27775 c1 = w1 / (Rhead ** 3.0d0)
27776 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
27777 dGCLdOM12 = c1 - c2
27778 !c!-------------------------------------------------------------------
27779 !c! Return the results
27780 !c! (see comments in Eqq)
27782 erhead(k) = Rhead_distance(k)/Rhead
27784 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
27785 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
27786 facd1 = d1 * vbld_inv(i+nres)
27787 facd2 = d2 * vbld_inv(j+nres)
27790 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
27791 gvdwx(k,i) = gvdwx(k,i) - dGCLdR * pom
27792 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
27793 gvdwx(k,j) = gvdwx(k,j) + dGCLdR * pom
27795 gvdwc(k,i) = gvdwc(k,i) - dGCLdR * erhead(k)
27796 gvdwc(k,j) = gvdwc(k,j) + dGCLdR * erhead(k)
27800 SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
27805 real(kind=8) :: eheadtail,Egb,Ecl,Elj,Equad,Epol,Rb
27809 !c! 1/(Gas Constant * Thermostate temperature) = BetaT
27810 !c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
27812 !c! BetaT = 1.0d0 / (t_bath * Rb)i
27814 BetaT = 1.0d0 / (298.0d0 * Rb)
27815 !c! Gay-berne var's
27816 sig0ij = sigma( itypi,itypj )
27817 chi1 = chi( itypi, itypj )
27818 chi2 = chi( itypj, itypi )
27819 chi12 = chi1 * chi2
27820 chip1 = chipp( itypi, itypj )
27821 chip2 = chipp( itypj, itypi )
27822 chip12 = chip1 * chip2
27829 !c! not used by momo potential, but needed by sc_angular which is shared
27830 !c! by all energy_potential subroutines
27834 !c! location, location, location
27835 ! xj = c( 1, nres+j ) - xi
27836 ! yj = c( 2, nres+j ) - yi
27837 ! zj = c( 3, nres+j ) - zi
27838 dxj = dc_norm( 1, nres+j )
27839 dyj = dc_norm( 2, nres+j )
27840 dzj = dc_norm( 3, nres+j )
27841 !c! distance from center of chain(?) to polar/charged head
27842 !c! write (*,*) "istate = ", 1
27843 !c! write (*,*) "ii = ", 1
27844 !c! write (*,*) "jj = ", 1
27845 d1 = dhead(1, 1, itypi, itypj)
27846 d2 = dhead(2, 1, itypi, itypj)
27848 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
27849 !c! a12sq = a12sq * a12sq
27850 !c! charge of amino acid itypi is...
27851 Qi = icharge(itypi)
27852 Qj = icharge(itypj)
27855 chis1 = chis(itypi,itypj)
27856 chis2 = chis(itypj,itypi)
27857 chis12 = chis1 * chis2
27858 sig1 = sigmap1(itypi,itypj)
27859 sig2 = sigmap2(itypi,itypj)
27860 !c! write (*,*) "sig1 = ", sig1
27861 !c! write (*,*) "sig2 = ", sig2
27862 !c! alpha factors from Fcav/Gcav
27863 b1cav = alphasur(1,itypi,itypj)
27865 b2cav = alphasur(2,itypi,itypj)
27866 b3cav = alphasur(3,itypi,itypj)
27867 b4cav = alphasur(4,itypi,itypj)
27868 wqd = wquad(itypi, itypj)
27870 eps_in = epsintab(itypi,itypj)
27871 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
27872 !c! write (*,*) "eps_inout_fac = ", eps_inout_fac
27873 !c!-------------------------------------------------------------------
27874 !c! tail location and distance calculations
27877 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
27878 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
27880 !c! tail distances will be themselves usefull elswhere
27881 !c1 (in Gcav, for example)
27882 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
27883 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
27884 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
27886 (Rtail_distance(1)*Rtail_distance(1)) &
27887 + (Rtail_distance(2)*Rtail_distance(2)) &
27888 + (Rtail_distance(3)*Rtail_distance(3)))
27889 !c!-------------------------------------------------------------------
27890 !c! Calculate location and distance between polar heads
27891 !c! distance between heads
27892 !c! for each one of our three dimensional space...
27893 d1 = dhead(1, 1, itypi, itypj)
27894 d2 = dhead(2, 1, itypi, itypj)
27897 !c! location of polar head is computed by taking hydrophobic centre
27898 !c! and moving by a d1 * dc_norm vector
27899 !c! see unres publications for very informative images
27900 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
27901 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
27903 !c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
27904 !c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
27905 Rhead_distance(k) = chead(k,2) - chead(k,1)
27907 !c! pitagoras (root of sum of squares)
27909 (Rhead_distance(1)*Rhead_distance(1)) &
27910 + (Rhead_distance(2)*Rhead_distance(2)) &
27911 + (Rhead_distance(3)*Rhead_distance(3)))
27912 !c!-------------------------------------------------------------------
27913 !c! zero everything that should be zero'ed
27926 END SUBROUTINE elgrad_init
27929 SUBROUTINE elgrad_init_cat(eheadtail,Egb,Ecl,Elj,Equad,Epol)
27932 real(kind=8) :: eheadtail,Egb,Ecl,Elj,Equad,Epol,Rb
27936 !c! 1/(Gas Constant * Thermostate temperature) = BetaT
27937 !c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
27939 !c! BetaT = 1.0d0 / (t_bath * Rb)i
27941 BetaT = 1.0d0 / (298.0d0 * Rb)
27942 !c! Gay-berne var's
27943 sig0ij = sigmacat( itypi,itypj )
27944 chi1 = chi1cat( itypi, itypj )
27947 chip1 = chipp1cat( itypi, itypj )
27950 !c! not used by momo potential, but needed by sc_angular which is shared
27951 !c! by all energy_potential subroutines
27955 dxj = dc_norm( 1, nres+j )
27956 dyj = dc_norm( 2, nres+j )
27957 dzj = dc_norm( 3, nres+j )
27958 !c! distance from center of chain(?) to polar/charged head
27959 d1 = dheadcat(1, 1, itypi, itypj)
27960 d2 = dheadcat(2, 1, itypi, itypj)
27962 a12sq = rborn1cat(itypi,itypj) * rborn2cat(itypi,itypj)
27963 !c! a12sq = a12sq * a12sq
27964 !c! charge of amino acid itypi is...
27965 Qi = icharge(itypi)
27966 Qj = ichargecat(itypj)
27969 chis1 = chis1cat(itypi,itypj)
27972 sig1 = sigmap1cat(itypi,itypj)
27973 sig2 = sigmap2cat(itypi,itypj)
27974 !c! alpha factors from Fcav/Gcav
27975 b1cav = alphasurcat(1,itypi,itypj)
27976 b2cav = alphasurcat(2,itypi,itypj)
27977 b3cav = alphasurcat(3,itypi,itypj)
27978 b4cav = alphasurcat(4,itypi,itypj)
27979 wqd = wquadcat(itypi, itypj)
27981 eps_in = epsintabcat(itypi,itypj)
27982 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
27983 !c!-------------------------------------------------------------------
27984 !c! tail location and distance calculations
27987 ctail(k,1)=c(k,i+nres)-dtailcat(1,itypi,itypj)*dc_norm(k,nres+i)
27988 ctail(k,2)=c(k,j)!-dtailcat(2,itypi,itypj)*dc_norm(k,nres+j)
27990 !c! tail distances will be themselves usefull elswhere
27991 !c1 (in Gcav, for example)
27992 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
27993 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
27994 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
27996 (Rtail_distance(1)*Rtail_distance(1)) &
27997 + (Rtail_distance(2)*Rtail_distance(2)) &
27998 + (Rtail_distance(3)*Rtail_distance(3)))
27999 !c!-------------------------------------------------------------------
28000 !c! Calculate location and distance between polar heads
28001 !c! distance between heads
28002 !c! for each one of our three dimensional space...
28003 d1 = dheadcat(1, 1, itypi, itypj)
28004 d2 = dheadcat(2, 1, itypi, itypj)
28007 !c! location of polar head is computed by taking hydrophobic centre
28008 !c! and moving by a d1 * dc_norm vector
28009 !c! see unres publications for very informative images
28010 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
28011 chead(k,2) = c(k, j)
28013 !c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
28014 !c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
28015 Rhead_distance(k) = chead(k,2) - chead(k,1)
28017 !c! pitagoras (root of sum of squares)
28019 (Rhead_distance(1)*Rhead_distance(1)) &
28020 + (Rhead_distance(2)*Rhead_distance(2)) &
28021 + (Rhead_distance(3)*Rhead_distance(3)))
28022 !c!-------------------------------------------------------------------
28023 !c! zero everything that should be zero'ed
28036 END SUBROUTINE elgrad_init_cat
28038 SUBROUTINE elgrad_init_cat_pep(eheadtail,Egb,Ecl,Elj,Equad,Epol)
28041 real(kind=8) :: eheadtail,Egb,Ecl,Elj,Equad,Epol,Rb
28045 !c! 1/(Gas Constant * Thermostate temperature) = BetaT
28046 !c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
28048 !c! BetaT = 1.0d0 / (t_bath * Rb)i
28050 BetaT = 1.0d0 / (298.0d0 * Rb)
28051 !c! Gay-berne var's
28052 sig0ij = sigmacat( itypi,itypj )
28053 chi1 = chi1cat( itypi, itypj )
28056 chip1 = chipp1cat( itypi, itypj )
28059 !c! not used by momo potential, but needed by sc_angular which is shared
28060 !c! by all energy_potential subroutines
28064 dxj = 0.0d0 !dc_norm( 1, nres+j )
28065 dyj = 0.0d0 !dc_norm( 2, nres+j )
28066 dzj = 0.0d0 !dc_norm( 3, nres+j )
28067 !c! distance from center of chain(?) to polar/charged head
28068 d1 = dheadcat(1, 1, itypi, itypj)
28069 d2 = dheadcat(2, 1, itypi, itypj)
28071 a12sq = rborn1cat(itypi,itypj) * rborn2cat(itypi,itypj)
28072 !c! a12sq = a12sq * a12sq
28073 !c! charge of amino acid itypi is...
28075 Qj = ichargecat(itypj)
28078 chis1 = chis1cat(itypi,itypj)
28081 sig1 = sigmap1cat(itypi,itypj)
28082 sig2 = sigmap2cat(itypi,itypj)
28083 !c! alpha factors from Fcav/Gcav
28084 b1cav = alphasurcat(1,itypi,itypj)
28085 b2cav = alphasurcat(2,itypi,itypj)
28086 b3cav = alphasurcat(3,itypi,itypj)
28087 b4cav = alphasurcat(4,itypi,itypj)
28088 wqd = wquadcat(itypi, itypj)
28090 eps_in = epsintabcat(itypi,itypj)
28091 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
28092 !c!-------------------------------------------------------------------
28093 !c! tail location and distance calculations
28096 ctail(k,1)=(c(k,i)+c(k,i+1))/2.0-dtailcat(1,itypi,itypj)*dc_norm(k,i)
28097 ctail(k,2)=c(k,j)!-dtailcat(2,itypi,itypj)*dc_norm(k,nres+j)
28099 !c! tail distances will be themselves usefull elswhere
28100 !c1 (in Gcav, for example)
28101 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
28102 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
28103 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
28105 (Rtail_distance(1)*Rtail_distance(1)) &
28106 + (Rtail_distance(2)*Rtail_distance(2)) &
28107 + (Rtail_distance(3)*Rtail_distance(3)))
28108 !c!-------------------------------------------------------------------
28109 !c! Calculate location and distance between polar heads
28110 !c! distance between heads
28111 !c! for each one of our three dimensional space...
28112 d1 = dheadcat(1, 1, itypi, itypj)
28113 d2 = dheadcat(2, 1, itypi, itypj)
28116 !c! location of polar head is computed by taking hydrophobic centre
28117 !c! and moving by a d1 * dc_norm vector
28118 !c! see unres publications for very informative images
28119 chead(k,1) = (c(k, i)+c(k,i+1))/2.0 + d1 * dc_norm(k, i)
28120 chead(k,2) = c(k, j)
28122 !c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
28123 !c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
28124 Rhead_distance(k) = chead(k,2) - chead(k,1)
28126 !c! pitagoras (root of sum of squares)
28128 (Rhead_distance(1)*Rhead_distance(1)) &
28129 + (Rhead_distance(2)*Rhead_distance(2)) &
28130 + (Rhead_distance(3)*Rhead_distance(3)))
28131 !c!-------------------------------------------------------------------
28132 !c! zero everything that should be zero'ed
28145 END SUBROUTINE elgrad_init_cat_pep
28147 double precision function tschebyshev(m,n,x,y)
28150 double precision x(n),y,yy(0:maxvar),aux
28151 !c Tschebyshev polynomial. Note that the first term is omitted
28152 !c m=0: the constant term is included
28153 !c m=1: the constant term is not included
28157 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
28165 end function tschebyshev
28166 !C--------------------------------------------------------------------------
28167 double precision function gradtschebyshev(m,n,x,y)
28170 double precision x(n+1),y,yy(0:maxvar),aux
28171 !c Tschebyshev polynomial. Note that the first term is omitted
28172 !c m=0: the constant term is included
28173 !c m=1: the constant term is not included
28177 yy(i)=2*y*yy(i-1)-yy(i-2)
28181 aux=aux+x(i+1)*yy(i)*(i+1)
28182 !C print *, x(i+1),yy(i),i
28184 gradtschebyshev=aux
28186 end function gradtschebyshev