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
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
334 ! wcatcat= weights(41)
335 ! wcatprot=weights(42)
337 ! FG Master broadcasts the WEIGHTS_ array
338 call MPI_Bcast(weights_(1),n_ene,&
339 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
341 ! FG slaves receive the WEIGHTS array
342 call MPI_Bcast(weights(1),n_ene,&
343 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
363 wvdwpp_nucl =weights(26)
369 wbond_nucl =weights(32)
370 wang_nucl =weights(33)
372 wtor_nucl =weights(35)
373 wtor_d_nucl =weights(36)
374 wcorr_nucl =weights(37)
375 wcorr3_nucl =weights(38)
382 time_Bcast=time_Bcast+MPI_Wtime()-time00
383 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
384 ! call chainbuild_cart
386 ! print *,'Processor',myrank,' calling etotal ipot=',ipot
387 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
389 ! if (modecalc.eq.12.or.modecalc.eq.14) then
390 ! call int_from_cart1(.false.)
397 ! Compute the side-chain and electrostatic interaction energy
398 ! print *, "Before EVDW"
399 ! goto (101,102,103,104,105,106) ipot
401 ! Lennard-Jones potential.
405 !d print '(a)','Exit ELJcall el'
407 ! Lennard-Jones-Kihara potential (shifted).
408 ! 102 call eljk(evdw)
412 ! Berne-Pechukas potential (dilated LJ, angular dependence).
417 ! Gay-Berne potential (shifted LJ, angular dependence).
420 ! print *,"MOMO",scelemode
421 if (scelemode.eq.0) then
427 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
428 ! 105 call egbv(evdw)
432 ! Soft-sphere potential
433 ! 106 call e_softsphere(evdw)
435 call e_softsphere(evdw)
437 ! Calculate electrostatic (H-bonding) energy of the main chain.
441 write(iout,*)"Wrong ipot"
446 ! print *,"after EGB"
448 if (shield_mode.eq.2) then
451 if (nfgtasks.gt.1) then
452 grad_shield_sidebuf1(:)=0.0d0
453 grad_shield_locbuf1(:)=0.0d0
454 grad_shield_sidebuf2(:)=0.0d0
455 grad_shield_locbuf2(:)=0.0d0
456 grad_shieldbuf1(:)=0.0d0
457 grad_shieldbuf2(:)=0.0d0
460 write(iout,*) "befor reduce fac_shield reduce"
462 write(2,*) "fac",itype(i,1),fac_shield(i),grad_shield(1,i)
463 write(2,*) "list", shield_list(1,i),ishield_list(i), &
464 grad_shield_side(1,1,i),grad_shield_loc(1,1,i)
473 grad_shieldbuf1(iii)=grad_shield(k,i)
480 grad_shield_sidebuf1(jjj)=grad_shield_side(k,j,i)
481 grad_shield_locbuf1(jjj)=grad_shield_loc(k,j,i)
485 call MPI_Allgatherv(fac_shield(ivec_start), &
486 ivec_count(fg_rank1), &
487 MPI_DOUBLE_PRECISION,fac_shieldbuf(1),ivec_count(0), &
489 MPI_DOUBLE_PRECISION,FG_COMM,IERROR)
490 call MPI_Allgatherv(shield_list(1,ivec_start), &
491 ivec_count(fg_rank1), &
492 MPI_I50,shield_listbuf(1,1),ivec_count(0), &
494 MPI_I50,FG_COMM,IERROR)
495 ! write(2,*) "After I50"
497 call MPI_Allgatherv(ishield_list(ivec_start), &
498 ivec_count(fg_rank1), &
499 MPI_INTEGER,ishield_listbuf(1),ivec_count(0), &
501 MPI_INTEGER,FG_COMM,IERROR)
502 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
504 ! write(2,*) ivec_count(fg_rank1)*3,ivec_count(0)*3,ivec_displ(0)*3,3*ivec_start-2
505 ! write (2,*) "before"
506 ! write(2,*) grad_shieldbuf1
507 ! call MPI_Allgatherv(grad_shieldbuf1(3*ivec_start-2), &
508 ! ivec_count(fg_rank1)*3, &
509 ! MPI_DOUBLE_PRECISION,grad_shieldbuf2(1),ivec_count(0), &
511 ! MPI_DOUBLE_PRECISION,FG_COMM,IERROR)
512 call MPI_Allreduce(grad_shieldbuf1(1),grad_shieldbuf2(1), &
514 MPI_DOUBLE_PRECISION, &
517 call MPI_Allreduce(grad_shield_sidebuf1(1),grad_shield_sidebuf2(1), &
518 nres*3*maxcontsshi, &
519 MPI_DOUBLE_PRECISION, &
523 call MPI_Allreduce(grad_shield_locbuf1(1),grad_shield_locbuf2(1), &
524 nres*3*maxcontsshi, &
525 MPI_DOUBLE_PRECISION, &
530 ! write(2,*) grad_shieldbuf2
532 ! call MPI_Allgatherv(grad_shield_sidebuf1(3*maxcontsshi*ivec_start-2), &
533 ! ivec_count(fg_rank1)*3*maxcontsshi, &
534 ! MPI_DOUBLE_PRECISION,grad_shield_sidebuf2(1),ivec_count(0)*3*maxcontsshi,&
535 ! ivec_displ(0)*3*maxcontsshi, &
536 ! MPI_DOUBLE_PRECISION,FG_COMM,IERROR)
537 ! write(2,*) "After grad_shield_side"
539 ! call MPI_Allgatherv(grad_shield_locbuf1(3*maxcontsshi*ivec_start-2), &
540 ! ivec_count(fg_rank1)*3*maxcontsshi, &
541 ! MPI_DOUBLE_PRECISION,grad_shield_locbuf2(1),ivec_count(0)*3*maxcontsshi, &
542 ! ivec_displ(0)*3*maxcontsshi, &
543 ! MPI_DOUBLE_PRECISION,FG_COMM,IERROR)
544 ! write(2,*) "After MPI_SHI"
549 fac_shield(i)=fac_shieldbuf(i)
550 ishield_list(i)=ishield_listbuf(i)
551 ! write(iout,*) i,fac_shield(i)
554 grad_shield(j,i)=grad_shieldbuf2(iii)
556 do j=1,ishield_list(i)
557 ! write (iout,*) "ishild", ishield_list(i),i
558 shield_list(j,i)=shield_listbuf(j,i)
563 grad_shield_loc(k,j,i)=grad_shield_locbuf2(jjj)
564 grad_shield_side(k,j,i)=grad_shield_sidebuf2(jjj)
570 write(iout,*) "after reduce fac_shield reduce"
572 write(2,*) "fac",itype(i,1),fac_shield(i),grad_shield(1,i)
573 write(2,*) "list", shield_list(1,i),ishield_list(i), &
574 grad_shield_side(1,1,i),grad_shield_loc(1,1,i)
582 ! print *,"AFTER EGB",ipot,evdw
584 !mc Sep-06: egb takes care of dynamic ss bonds too
586 ! if (dyn_ss) call dyn_set_nss
587 ! print *,"Processor",myrank," computed USCSC"
593 time_vec=time_vec+MPI_Wtime()-time01
599 ! print *,"Processor",myrank," left VEC_AND_DERIV"
602 ! print *,"after ipot if", ipot
603 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
604 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
605 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
606 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
608 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
609 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
610 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
611 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
613 ! print *,"just befor eelec call"
614 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
615 ! print *, "ELEC calc"
624 ! write (iout,*) "Soft-spheer ELEC potential"
625 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
628 ! print *,"Processor",myrank," computed UELEC"
630 ! Calculate excluded-volume interaction energy between peptide groups
633 ! write(iout,*) "in etotal calc exc;luded",ipot
637 call escp(evdw2,evdw2_14)
643 ! write (iout,*) "Soft-sphere SCP potential"
644 call escp_soft_sphere(evdw2,evdw2_14)
646 ! write(iout,*) "in etotal before ebond",ipot
649 ! Calculate the bond-stretching energy
652 ! print *,"EBOND",estr
653 ! write(iout,*) "in etotal afer ebond",ipot
656 ! Calculate the disulfide-bridge and other energy and the contributions
657 ! from other distance constraints.
658 ! print *,'Calling EHPB'
660 !elwrite(iout,*) "in etotal afer edis",ipot
661 ! print *,'EHPB exitted succesfully.'
663 ! Calculate the virtual-bond-angle energy.
664 ! write(iout,*) "in etotal afer edis",ipot
666 ! if (wang.gt.0.0d0) then
667 ! call ebend(ebe,ethetacnstr)
672 if (wang.gt.0d0) then
673 if (tor_mode.eq.0) then
676 !C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
684 if (with_theta_constr) call etheta_constr(ethetacnstr)
686 ! write(iout,*) "in etotal afer ebe",ipot
688 ! print *,"Processor",myrank," computed UB"
690 ! Calculate the SC local energy.
693 !elwrite(iout,*) "in etotal afer esc",ipot
694 ! print *,"Processor",myrank," computed USC"
696 ! Calculate the virtual-bond torsional energy.
698 !d print *,'nterm=',nterm
699 ! if (wtor.gt.0) then
700 ! call etor(etors,edihcnstr)
705 if (wtor.gt.0.0d0) then
706 if (tor_mode.eq.0) then
709 !C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
717 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
718 !c print *,"Processor",myrank," computed Utor"
720 ! print *,"Processor",myrank," computed Utor"
723 ! 6/23/01 Calculate double-torsional energy
725 !elwrite(iout,*) "in etotal",ipot
726 if (wtor_d.gt.0) then
731 ! print *,"Processor",myrank," computed Utord"
733 ! 21/5/07 Calculate local sicdechain correlation energy
735 if (wsccor.gt.0.0d0) then
736 call eback_sc_corr(esccor)
741 ! write(iout,*) "before multibody"
743 ! print *,"Processor",myrank," computed Usccorr"
745 ! 12/1/95 Multi-body terms
750 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
751 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
752 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
753 !d write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
754 !d &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
761 !elwrite(iout,*) "in etotal",ipot
762 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
763 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
764 !d write (iout,*) "multibody_hb ecorr",ecorr
766 ! write(iout,*) "afeter multibody hb"
768 ! print *,"Processor",myrank," computed Ucorr"
770 ! If performing constraint dynamics, call the constraint energy
771 ! after the equilibration time
772 if(usampl.and.totT.gt.eq_time) then
773 !elwrite(iout,*) "afeter multibody hb"
775 !elwrite(iout,*) "afeter multibody hb"
777 !elwrite(iout,*) "afeter multibody hb"
783 ! write(iout,*) "after Econstr"
785 if (wliptran.gt.0) then
786 ! print *,"PRZED WYWOLANIEM"
787 call Eliptransfer(eliptran)
791 if (fg_rank.eq.0) then
792 if (AFMlog.gt.0) then
793 call AFMforce(Eafmforce)
794 else if (selfguide.gt.0) then
795 call AFMvel(Eafmforce)
798 if (tubemode.eq.1) then
800 else if (tubemode.eq.2) then
801 call calctube2(etube)
802 elseif (tubemode.eq.3) then
807 !--------------------------------------------------------
808 ! write (iout,*) "NRES_MOLEC(2),",nres_molec(2)
809 ! print *,"before",ees,evdw1,ecorr
810 ! write(iout,*) ecorr_nucl,"ecorr_nucl",nres_molec(2)
811 if (nres_molec(2).gt.0) then
812 call ebond_nucl(estr_nucl)
813 call ebend_nucl(ebe_nucl)
814 call etor_nucl(etors_nucl)
815 call esb_gb(evdwsb,eelsb)
816 call epp_nucl_sub(evdwpp,eespp)
817 call epsb(evdwpsb,eelpsb)
819 call multibody_hb_nucl(ecorr_nucl,ecorr3_nucl,n_corr,n_corr1)
833 ! write(iout,*) ecorr_nucl,"ecorr_nucl",nres_molec(2)
834 ! print *,"before ecatcat"
835 if (nfgtasks.gt.1) then
836 if (fg_rank.eq.0) then
837 call ecatcat(ecationcation)
840 call ecatcat(ecationcation)
842 call ecat_prot(ecation_prot)
843 if (nres_molec(2).gt.0) then
844 call eprot_sc_base(escbase)
845 call epep_sc_base(epepbase)
846 call eprot_sc_phosphate(escpho)
847 call eprot_pep_phosphate(epeppho)
854 ! call ecatcat(ecationcation)
855 ! print *,"after ebend", ebe_nucl
857 time_enecalc=time_enecalc+MPI_Wtime()-time00
859 ! print *,"Processor",myrank," computed Uconstr"
868 energia(2)=evdw2-evdw2_14
885 energia(8)=eello_turn3
886 energia(9)=eello_turn4
893 energia(19)=edihcnstr
895 energia(20)=Uconst+Uconst_back
898 energia(23)=Eafmforce
899 energia(24)=ethetacnstr
901 !---------------------------------------------------------------
908 energia(32)=estr_nucl
911 energia(35)=etors_nucl
912 energia(36)=etors_d_nucl
913 energia(37)=ecorr_nucl
914 energia(38)=ecorr3_nucl
915 !----------------------------------------------------------------------
916 ! Here are the energies showed per procesor if the are more processors
917 ! per molecule then we sum it up in sum_energy subroutine
918 ! print *," Processor",myrank," calls SUM_ENERGY"
919 energia(41)=ecation_prot
920 energia(42)=ecationcation
925 call sum_energy(energia,.true.)
926 if (dyn_ss) call dyn_set_nss
927 ! print *," Processor",myrank," left SUM_ENERGY"
929 time_sumene=time_sumene+MPI_Wtime()-time00
931 ! call enerprint(energia)
932 !elwrite(iout,*)"finish etotal"
934 end subroutine etotal
935 !-----------------------------------------------------------------------------
936 subroutine sum_energy(energia,reduce)
937 ! implicit real*8 (a-h,o-z)
938 ! include 'DIMENSIONS'
942 !MS$ATTRIBUTES C :: proc_proc
948 ! include 'COMMON.SETUP'
949 ! include 'COMMON.IOUNITS'
950 real(kind=8) :: energia(0:n_ene),enebuff(0:n_ene+1)
951 ! include 'COMMON.FFIELD'
952 ! include 'COMMON.DERIV'
953 ! include 'COMMON.INTERACT'
954 ! include 'COMMON.SBRIDGE'
955 ! include 'COMMON.CHAIN'
956 ! include 'COMMON.VAR'
957 ! include 'COMMON.CONTROL'
958 ! include 'COMMON.TIME1'
960 real(kind=8) :: evdw,evdw2,evdw2_14,ees,evdw1,ecorr,ecorr5,ecorr6
961 real(kind=8) :: eel_loc,eello_turn3,eello_turn4,eturn6,ebe,escloc
962 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,esccor,etot, &
963 eliptran,etube, Eafmforce,ethetacnstr
964 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
965 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
967 real(kind=8) :: ecation_prot,ecationcation
968 real(kind=8) :: escbase,epepbase,escpho,epeppho
972 real(kind=8) :: time00
973 if (nfgtasks.gt.1 .and. reduce) then
976 write (iout,*) "energies before REDUCE"
977 call enerprint(energia)
981 enebuff(i)=energia(i)
984 call MPI_Barrier(FG_COMM,IERR)
985 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
987 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,&
988 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
990 write (iout,*) "energies after REDUCE"
991 call enerprint(energia)
994 time_Reduce=time_Reduce+MPI_Wtime()-time00
996 if (fg_rank.eq.0) then
1000 evdw2=energia(2)+energia(18)
1001 evdw2_14=energia(18)
1016 eello_turn3=energia(8)
1017 eello_turn4=energia(9)
1024 edihcnstr=energia(19)
1028 eliptran=energia(22)
1029 Eafmforce=energia(23)
1030 ethetacnstr=energia(24)
1038 estr_nucl=energia(32)
1039 ebe_nucl=energia(33)
1041 etors_nucl=energia(35)
1042 etors_d_nucl=energia(36)
1043 ecorr_nucl=energia(37)
1044 ecorr3_nucl=energia(38)
1045 ecation_prot=energia(41)
1046 ecationcation=energia(42)
1048 epepbase=energia(47)
1051 ! energia(41)=ecation_prot
1052 ! energia(42)=ecationcation
1056 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1 &
1057 +wang*ebe+wtor*etors+wscloc*escloc &
1058 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
1059 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
1060 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
1061 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
1062 +Eafmforce+ethetacnstr &
1063 +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
1064 +wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
1065 +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
1066 +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
1067 +wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
1068 +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho
1070 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1) &
1071 +wang*ebe+wtor*etors+wscloc*escloc &
1072 +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5 &
1073 +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3 &
1074 +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d &
1075 +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+wtube*etube&
1076 +Eafmforce+ethetacnstr &
1077 +wbond_nucl*estr_nucl+wang_nucl*ebe_nucl&
1078 +wvdwpp_nucl*evdwpp+welpp*eespp+wvdwpsb*evdwpsb+welpsb*eelpsb&
1079 +wvdwsb*evdwsb+welsb*eelsb+wsbloc*esbloc+wtor_nucl*etors_nucl&
1080 +wtor_d_nucl*etors_d_nucl+wcorr_nucl*ecorr_nucl+wcorr3_nucl*ecorr3_nucl&
1081 +wcatprot*ecation_prot+wcatcat*ecationcation+wscbase*escbase&
1082 +wpepbase*epepbase+wscpho*escpho+wpeppho*epeppho
1088 if (isnan(etot).ne.0) energia(0)=1.0d+99
1090 if (isnan(etot)) energia(0)=1.0d+99
1095 idumm=proc_proc(etot,i)
1097 call proc_proc(etot,i)
1099 if(i.eq.1)energia(0)=1.0d+99
1104 ! call enerprint(energia)
1107 end subroutine sum_energy
1108 !-----------------------------------------------------------------------------
1109 subroutine rescale_weights(t_bath)
1110 ! implicit real*8 (a-h,o-z)
1114 ! include 'DIMENSIONS'
1115 ! include 'COMMON.IOUNITS'
1116 ! include 'COMMON.FFIELD'
1117 ! include 'COMMON.SBRIDGE'
1118 real(kind=8) :: kfac=2.4d0
1119 real(kind=8) :: x,x2,x3,x4,x5,licznik=1.12692801104297249644
1121 real(kind=8) :: t_bath,facT(6) !,facT2,facT3,facT4,facT5,facT6
1122 real(kind=8) :: T0=3.0d2
1125 ! facT=2*temp0/(t_bath+temp0)
1126 if (rescale_mode.eq.0) then
1133 else if (rescale_mode.eq.1) then
1134 facT(1)=kfac/(kfac-1.0d0+t_bath/temp0)
1135 facT(2)=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
1136 facT(3)=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
1137 facT(4)=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
1138 facT(5)=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
1140 !#if defined(WHAM_RUN) || defined(CLUSTER)
1142 ! tt = 1.0d0/(beta_h(ib,ipar)*1.987D-3)
1143 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1144 #elif defined(FUNCT)
1150 else if (rescale_mode.eq.2) then
1156 facT(1)=licznik/dlog(dexp(x)+dexp(-x))
1157 facT(2)=licznik/dlog(dexp(x2)+dexp(-x2))
1158 facT(3)=licznik/dlog(dexp(x3)+dexp(-x3))
1159 facT(4)=licznik/dlog(dexp(x4)+dexp(-x4))
1160 facT(5)=licznik/dlog(dexp(x5)+dexp(-x5))
1162 !#if defined(WHAM_RUN) || defined(CLUSTER)
1164 facT(6)=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1165 #elif defined(FUNCT)
1172 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
1173 write (*,*) "Wrong RESCALE_MODE",rescale_mode
1175 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
1179 welec=weights(3)*fact(1)
1180 wcorr=weights(4)*fact(3)
1181 wcorr5=weights(5)*fact(4)
1182 wcorr6=weights(6)*fact(5)
1183 wel_loc=weights(7)*fact(2)
1184 wturn3=weights(8)*fact(2)
1185 wturn4=weights(9)*fact(3)
1186 wturn6=weights(10)*fact(5)
1187 wtor=weights(13)*fact(1)
1188 wtor_d=weights(14)*fact(2)
1189 wsccor=weights(21)*fact(1)
1192 end subroutine rescale_weights
1193 !-----------------------------------------------------------------------------
1194 subroutine enerprint(energia)
1195 ! implicit real*8 (a-h,o-z)
1196 ! include 'DIMENSIONS'
1197 ! include 'COMMON.IOUNITS'
1198 ! include 'COMMON.FFIELD'
1199 ! include 'COMMON.SBRIDGE'
1200 ! include 'COMMON.MD'
1201 real(kind=8) :: energia(0:n_ene)
1203 real(kind=8) :: etot,evdw,evdw2,ees,evdw1,ecorr,ecorr5,ecorr6,eel_loc
1204 real(kind=8) :: eello_turn6,eello_turn3,eello_turn4,ebe,escloc
1205 real(kind=8) :: etors,etors_d,ehpb,edihcnstr,estr,Uconst,esccor,eliptran,&
1206 etube,ethetacnstr,Eafmforce
1207 real(kind=8) :: evdwpp,eespp,evdwpsb,eelpsb,evdwsb,eelsb,estr_nucl,&
1208 ebe_nucl,esbloc,etors_nucl,etors_d_nucl,ecorr_nucl,&
1210 real(kind=8) :: ecation_prot,ecationcation
1211 real(kind=8) :: escbase,epepbase,escpho,epeppho
1217 evdw2=energia(2)+energia(18)
1229 eello_turn3=energia(8)
1230 eello_turn4=energia(9)
1231 eello_turn6=energia(10)
1237 edihcnstr=energia(19)
1241 eliptran=energia(22)
1242 Eafmforce=energia(23)
1243 ethetacnstr=energia(24)
1251 estr_nucl=energia(32)
1252 ebe_nucl=energia(33)
1254 etors_nucl=energia(35)
1255 etors_d_nucl=energia(36)
1256 ecorr_nucl=energia(37)
1257 ecorr3_nucl=energia(38)
1258 ecation_prot=energia(41)
1259 ecationcation=energia(42)
1261 epepbase=energia(47)
1265 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,&
1266 estr,wbond,ebe,wang,&
1267 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
1269 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
1270 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,&
1271 edihcnstr,ethetacnstr,ebr*nss,&
1272 Uconst,eliptran,wliptran,Eafmforce,etube,wtube, & ! till now protein
1273 estr_nucl,wbond_nucl,ebe_nucl,wang_nucl, &
1274 evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb,&
1275 evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl,&
1276 etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
1277 ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, &
1278 escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
1280 10 format (/'Virtual-chain energies:'// &
1281 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
1282 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
1283 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
1284 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/ &
1285 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
1286 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
1287 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
1288 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
1289 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
1290 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
1291 ' (SS bridges & dist. cnstr.)'/ &
1292 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1293 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1294 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1295 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
1296 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
1297 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
1298 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
1299 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
1300 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
1301 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
1302 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
1303 'UCONST= ',1pE16.6,' (Constraint energy)'/ &
1304 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/&
1305 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
1306 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
1307 'ESTR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
1308 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
1309 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
1310 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
1311 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
1312 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
1313 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
1314 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
1315 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
1316 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
1317 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
1318 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
1319 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
1320 'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ &
1321 'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ &
1322 'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ &
1323 'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
1324 'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
1325 'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
1326 'ETOT= ',1pE16.6,' (total)')
1328 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,&
1329 estr,wbond,ebe,wang,&
1330 escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,&
1332 ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,&
1333 eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,edihcnstr,&
1334 ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc, &
1336 estr_nucl,wbond_nucl, ebe_nucl,wang_nucl,&
1337 evdwpp,wvdwpp_nucl,eespp,welpp,evdwpsb,wvdwpsb,eelpsb,welpsb&
1338 evdwsb,wvdwsb,eelsb,welsb,esbloc,wsbloc,etors_nucl,wtor_nucl&
1339 etors_d_nucl,wtor_d_nucl,ecorr_nucl,wcorr_nucl,&
1340 ecorr3_nucl,wcorr3_nucl,ecation_prot,wcatprot,ecationcation,wcatcat, &
1341 escbase,wscbase,epepbase,wpepbase,escpho,wscpho,epeppho,wpeppho,&
1343 10 format (/'Virtual-chain energies:'// &
1344 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/ &
1345 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/ &
1346 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/ &
1347 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/ &
1348 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/ &
1349 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/ &
1350 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/ &
1351 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/ &
1352 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6, &
1353 ' (SS bridges & dist. cnstr.)'/ &
1354 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1355 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1356 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/ &
1357 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/ &
1358 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/ &
1359 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/ &
1360 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/ &
1361 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/ &
1362 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/ &
1363 'ETHETC= ',1pE16.6,' (valence angle constraints)'/ &
1364 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/ &
1365 'UCONST=',1pE16.6,' (Constraint energy)'/ &
1366 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/ &
1367 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/ &
1368 'ETUBE=',1pE16.6, ' WEIGHT=',1pD16.6,' (cylindrical energy)'/ &
1369 'ESTR_nucl= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching for nucleic)'/ &
1370 'EBE_nucl=',1pE16.6,' WEIGHT=',1pD16.6,' (bending for nucleic)'/ &
1371 'EVDW_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate VDW)'/ &
1372 'EESPP_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-phosphate elec)'/ &
1373 'EVDWPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase VDW)'/ &
1374 'EESPSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(phosphate-sugarbase elec)'/ &
1375 'EVDWSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase VDW)'/ &
1376 'EESSB_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase-sugarbase elec)'/ &
1377 'ESBLOC_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(sugarbase rotamer)'/ &
1378 'ETORS_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(torsional)'/ &
1379 'ETORSD_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(double torsional)'/ &
1380 'ECORR_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 4th order)'/ &
1381 'ECORR3_nucl=',1pE16.6,' WEIGHT=',1pD16.6,'(multibody 3th order)'/ &
1382 'ECATPROT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation prot)'/ &
1383 'ECATCAT=',1pE16.6,' WEIGHT=',1pD16.6,'(cation cation)'/ &
1384 'ESCBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-base)'/ &
1385 'EPEPBASE=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-base)'/ &
1386 'ESCPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(sc-prot nucl-phosphate)'/&
1387 'EPEPPHO=',1pE16.6,' WEIGHT=',1pD16.6,'(pep-prot nucl-phosphate)'/&
1388 'ETOT= ',1pE16.6,' (total)')
1391 end subroutine enerprint
1392 !-----------------------------------------------------------------------------
1393 subroutine elj(evdw)
1395 ! This subroutine calculates the interaction energy of nonbonded side chains
1396 ! assuming the LJ potential of interaction.
1398 ! implicit real*8 (a-h,o-z)
1399 ! include 'DIMENSIONS'
1400 real(kind=8),parameter :: accur=1.0d-10
1401 ! include 'COMMON.GEO'
1402 ! include 'COMMON.VAR'
1403 ! include 'COMMON.LOCAL'
1404 ! include 'COMMON.CHAIN'
1405 ! include 'COMMON.DERIV'
1406 ! include 'COMMON.INTERACT'
1407 ! include 'COMMON.TORSION'
1408 ! include 'COMMON.SBRIDGE'
1409 ! include 'COMMON.NAMES'
1410 ! include 'COMMON.IOUNITS'
1411 ! include 'COMMON.CONTACTS'
1412 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1413 integer :: num_conti
1415 integer :: i,itypi,iint,j,itypi1,itypj,k
1416 real(kind=8) :: rij,rcut,fcont,fprimcont,rrij
1417 real(kind=8) :: evdw,xi,yi,zi,xj,yj,zj
1418 real(kind=8) :: eps0ij,fac,e1,e2,evdwij,sigij,r0ij
1420 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1422 ! allocate(num_cont(iatsc_s:iatsc_e)) !(maxres) nnt,nct-2
1423 ! allocate(jcont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres) (maxconts=maxres/4)
1424 ! allocate(facont(nres/4,iatsc_s:iatsc_e)) !(maxconts,maxres)
1425 ! allocate(gacont(3,nres/4,iatsc_s:iatsc_e)) !(3,maxconts,maxres)
1427 do i=iatsc_s,iatsc_e
1428 itypi=iabs(itype(i,1))
1429 if (itypi.eq.ntyp1) cycle
1430 itypi1=iabs(itype(i+1,1))
1437 ! Calculate SC interaction energy.
1439 do iint=1,nint_gr(i)
1440 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1441 !d & 'iend=',iend(i,iint)
1442 do j=istart(i,iint),iend(i,iint)
1443 itypj=iabs(itype(j,1))
1444 if (itypj.eq.ntyp1) cycle
1448 ! Change 12/1/95 to calculate four-body interactions
1449 rij=xj*xj+yj*yj+zj*zj
1451 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1452 eps0ij=eps(itypi,itypj)
1454 e1=fac*fac*aa_aq(itypi,itypj)
1455 e2=fac*bb_aq(itypi,itypj)
1457 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1458 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1459 !d write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1460 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1461 !d & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1462 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1465 ! Calculate the components of the gradient in DC and X
1467 fac=-rrij*(e1+evdwij)
1472 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1473 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1474 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1475 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1479 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1483 ! 12/1/95, revised on 5/20/97
1485 ! Calculate the contact function. The ith column of the array JCONT will
1486 ! contain the numbers of atoms that make contacts with the atom I (of numbers
1487 ! greater than I). The arrays FACONT and GACONT will contain the values of
1488 ! the contact function and its derivative.
1490 ! Uncomment next line, if the correlation interactions include EVDW explicitly.
1491 ! if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1492 ! Uncomment next line, if the correlation interactions are contact function only
1493 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1495 sigij=sigma(itypi,itypj)
1496 r0ij=rs0(itypi,itypj)
1498 ! Check whether the SC's are not too far to make a contact.
1501 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1502 ! Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1504 if (fcont.gt.0.0D0) then
1505 ! If the SC-SC distance if close to sigma, apply spline.
1506 !Adam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1507 !Adam & fcont1,fprimcont1)
1508 !Adam fcont1=1.0d0-fcont1
1509 !Adam if (fcont1.gt.0.0d0) then
1510 !Adam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1511 !Adam fcont=fcont*fcont1
1513 ! Uncomment following 4 lines to have the geometric average of the epsilon0's
1514 !ga eps0ij=1.0d0/dsqrt(eps0ij)
1516 !ga gg(k)=gg(k)*eps0ij
1518 !ga eps0ij=-evdwij*eps0ij
1519 ! Uncomment for AL's type of SC correlation interactions.
1520 !adam eps0ij=-evdwij
1521 num_conti=num_conti+1
1522 jcont(num_conti,i)=j
1523 facont(num_conti,i)=fcont*eps0ij
1524 fprimcont=eps0ij*fprimcont/rij
1526 !Adam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1527 !Adam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1528 !Adam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1529 ! Uncomment following 3 lines for Skolnick's type of SC correlation.
1530 gacont(1,num_conti,i)=-fprimcont*xj
1531 gacont(2,num_conti,i)=-fprimcont*yj
1532 gacont(3,num_conti,i)=-fprimcont*zj
1533 !d write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1534 !d write (iout,'(2i3,3f10.5)')
1535 !d & i,j,(gacont(kk,num_conti,i),kk=1,3)
1541 num_cont(i)=num_conti
1545 gvdwc(j,i)=expon*gvdwc(j,i)
1546 gvdwx(j,i)=expon*gvdwx(j,i)
1549 !******************************************************************************
1553 ! To save time, the factor of EXPON has been extracted from ALL components
1554 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
1557 !******************************************************************************
1560 !-----------------------------------------------------------------------------
1561 subroutine eljk(evdw)
1563 ! This subroutine calculates the interaction energy of nonbonded side chains
1564 ! assuming the LJK potential of interaction.
1566 ! implicit real*8 (a-h,o-z)
1567 ! include 'DIMENSIONS'
1568 ! include 'COMMON.GEO'
1569 ! include 'COMMON.VAR'
1570 ! include 'COMMON.LOCAL'
1571 ! include 'COMMON.CHAIN'
1572 ! include 'COMMON.DERIV'
1573 ! include 'COMMON.INTERACT'
1574 ! include 'COMMON.IOUNITS'
1575 ! include 'COMMON.NAMES'
1576 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
1579 integer :: i,iint,j,itypi,itypi1,k,itypj
1580 real(kind=8) :: rrij,xi,yi,zi,xj,yj,zj,fac_augm,e_augm,r_inv_ij
1581 real(kind=8) :: evdw,rij,r_shift_inv,fac,e1,e2,evdwij
1583 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1585 do i=iatsc_s,iatsc_e
1586 itypi=iabs(itype(i,1))
1587 if (itypi.eq.ntyp1) cycle
1588 itypi1=iabs(itype(i+1,1))
1593 ! Calculate SC interaction energy.
1595 do iint=1,nint_gr(i)
1596 do j=istart(i,iint),iend(i,iint)
1597 itypj=iabs(itype(j,1))
1598 if (itypj.eq.ntyp1) cycle
1602 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1603 fac_augm=rrij**expon
1604 e_augm=augm(itypi,itypj)*fac_augm
1605 r_inv_ij=dsqrt(rrij)
1607 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1608 fac=r_shift_inv**expon
1609 e1=fac*fac*aa_aq(itypi,itypj)
1610 e2=fac*bb_aq(itypi,itypj)
1612 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1613 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1614 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1615 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
1616 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1617 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1618 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
1621 ! Calculate the components of the gradient in DC and X
1623 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1628 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1629 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1630 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1631 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1635 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1643 gvdwc(j,i)=expon*gvdwc(j,i)
1644 gvdwx(j,i)=expon*gvdwx(j,i)
1649 !-----------------------------------------------------------------------------
1650 subroutine ebp(evdw)
1652 ! This subroutine calculates the interaction energy of nonbonded side chains
1653 ! assuming the Berne-Pechukas potential of interaction.
1657 ! implicit real*8 (a-h,o-z)
1658 ! include 'DIMENSIONS'
1659 ! include 'COMMON.GEO'
1660 ! include 'COMMON.VAR'
1661 ! include 'COMMON.LOCAL'
1662 ! include 'COMMON.CHAIN'
1663 ! include 'COMMON.DERIV'
1664 ! include 'COMMON.NAMES'
1665 ! include 'COMMON.INTERACT'
1666 ! include 'COMMON.IOUNITS'
1667 ! include 'COMMON.CALC'
1669 !el integer :: icall
1670 !el common /srutu/ icall
1671 ! double precision rrsave(maxdim)
1674 integer :: iint,itypi,itypi1,itypj
1675 real(kind=8) :: rrij,xi,yi,zi
1676 real(kind=8) :: evdw,fac,e1,e2,sigm,epsi
1678 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1680 ! if (icall.eq.0) then
1686 do i=iatsc_s,iatsc_e
1687 itypi=iabs(itype(i,1))
1688 if (itypi.eq.ntyp1) cycle
1689 itypi1=iabs(itype(i+1,1))
1693 dxi=dc_norm(1,nres+i)
1694 dyi=dc_norm(2,nres+i)
1695 dzi=dc_norm(3,nres+i)
1696 ! dsci_inv=dsc_inv(itypi)
1697 dsci_inv=vbld_inv(i+nres)
1699 ! Calculate SC interaction energy.
1701 do iint=1,nint_gr(i)
1702 do j=istart(i,iint),iend(i,iint)
1704 itypj=iabs(itype(j,1))
1705 if (itypj.eq.ntyp1) cycle
1706 ! dscj_inv=dsc_inv(itypj)
1707 dscj_inv=vbld_inv(j+nres)
1708 chi1=chi(itypi,itypj)
1709 chi2=chi(itypj,itypi)
1716 alf12=0.5D0*(alf1+alf2)
1717 ! For diagnostics only!!!
1730 dxj=dc_norm(1,nres+j)
1731 dyj=dc_norm(2,nres+j)
1732 dzj=dc_norm(3,nres+j)
1733 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1734 !d if (icall.eq.0) then
1740 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
1742 ! Calculate whole angle-dependent part of epsilon and contributions
1743 ! to its derivatives
1744 fac=(rrij*sigsq)**expon2
1745 e1=fac*fac*aa_aq(itypi,itypj)
1746 e2=fac*bb_aq(itypi,itypj)
1747 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1748 eps2der=evdwij*eps3rt
1749 eps3der=evdwij*eps2rt
1750 evdwij=evdwij*eps2rt*eps3rt
1753 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
1754 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
1755 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1756 !d & restyp(itypi,1),i,restyp(itypj,1),j,
1757 !d & epsi,sigm,chi1,chi2,chip1,chip2,
1758 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1759 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
1762 ! Calculate gradient components.
1763 e1=e1*eps1*eps2rt**2*eps3rt**2
1764 fac=-expon*(e1+evdwij)
1767 ! Calculate radial part of the gradient
1771 ! Calculate the angular part of the gradient and sum add the contributions
1772 ! to the appropriate components of the Cartesian gradient.
1780 !-----------------------------------------------------------------------------
1781 subroutine egb(evdw)
1783 ! This subroutine calculates the interaction energy of nonbonded side chains
1784 ! assuming the Gay-Berne potential of interaction.
1787 ! implicit real*8 (a-h,o-z)
1788 ! include 'DIMENSIONS'
1789 ! include 'COMMON.GEO'
1790 ! include 'COMMON.VAR'
1791 ! include 'COMMON.LOCAL'
1792 ! include 'COMMON.CHAIN'
1793 ! include 'COMMON.DERIV'
1794 ! include 'COMMON.NAMES'
1795 ! include 'COMMON.INTERACT'
1796 ! include 'COMMON.IOUNITS'
1797 ! include 'COMMON.CALC'
1798 ! include 'COMMON.CONTROL'
1799 ! include 'COMMON.SBRIDGE'
1802 integer :: iint,itypi,itypi1,itypj,subchap
1803 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
1804 real(kind=8) :: evdw,sig0ij
1805 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
1806 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
1807 sslipi,sslipj,faclip
1809 real(kind=8) :: fracinbuf
1811 !cccc energy_dec=.false.
1812 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1815 ! if (icall.eq.0) lprn=.false.
1825 do i=iatsc_s,iatsc_e
1826 !C print *,"I am in EVDW",i
1827 itypi=iabs(itype(i,1))
1828 ! if (i.ne.47) cycle
1829 if (itypi.eq.ntyp1) cycle
1830 itypi1=iabs(itype(i+1,1))
1834 xi=dmod(xi,boxxsize)
1835 if (xi.lt.0) xi=xi+boxxsize
1836 yi=dmod(yi,boxysize)
1837 if (yi.lt.0) yi=yi+boxysize
1838 zi=dmod(zi,boxzsize)
1839 if (zi.lt.0) zi=zi+boxzsize
1841 if ((zi.gt.bordlipbot) &
1842 .and.(zi.lt.bordliptop)) then
1843 !C the energy transfer exist
1844 if (zi.lt.buflipbot) then
1845 !C what fraction I am in
1847 ((zi-bordlipbot)/lipbufthick)
1848 !C lipbufthick is thickenes of lipid buffore
1849 sslipi=sscalelip(fracinbuf)
1850 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1851 elseif (zi.gt.bufliptop) then
1852 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1853 sslipi=sscalelip(fracinbuf)
1854 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1863 ! print *, sslipi,ssgradlipi
1864 dxi=dc_norm(1,nres+i)
1865 dyi=dc_norm(2,nres+i)
1866 dzi=dc_norm(3,nres+i)
1867 ! dsci_inv=dsc_inv(itypi)
1868 dsci_inv=vbld_inv(i+nres)
1869 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1870 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1872 ! Calculate SC interaction energy.
1874 do iint=1,nint_gr(i)
1875 do j=istart(i,iint),iend(i,iint)
1876 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1877 call dyn_ssbond_ene(i,j,evdwij)
1879 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1880 'evdw',i,j,evdwij,' ss'
1881 ! if (energy_dec) write (iout,*) &
1882 ! 'evdw',i,j,evdwij,' ss'
1883 do k=j+1,iend(i,iint)
1884 !C search over all next residues
1885 if (dyn_ss_mask(k)) then
1886 !C check if they are cysteins
1887 !C write(iout,*) 'k=',k
1889 !c write(iout,*) "PRZED TRI", evdwij
1890 ! evdwij_przed_tri=evdwij
1891 call triple_ssbond_ene(i,j,k,evdwij)
1892 !c if(evdwij_przed_tri.ne.evdwij) then
1893 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1896 !c write(iout,*) "PO TRI", evdwij
1897 !C call the energy function that removes the artifical triple disulfide
1898 !C bond the soubroutine is located in ssMD.F
1900 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
1901 'evdw',i,j,evdwij,'tss'
1902 endif!dyn_ss_mask(k)
1906 itypj=iabs(itype(j,1))
1907 if (itypj.eq.ntyp1) cycle
1908 ! if (j.ne.78) cycle
1909 ! dscj_inv=dsc_inv(itypj)
1910 dscj_inv=vbld_inv(j+nres)
1911 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,&
1912 ! 1.0d0/vbld(j+nres) !d
1913 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
1914 sig0ij=sigma(itypi,itypj)
1915 chi1=chi(itypi,itypj)
1916 chi2=chi(itypj,itypi)
1923 alf12=0.5D0*(alf1+alf2)
1924 ! For diagnostics only!!!
1937 xj=dmod(xj,boxxsize)
1938 if (xj.lt.0) xj=xj+boxxsize
1939 yj=dmod(yj,boxysize)
1940 if (yj.lt.0) yj=yj+boxysize
1941 zj=dmod(zj,boxzsize)
1942 if (zj.lt.0) zj=zj+boxzsize
1943 ! print *,"tu",xi,yi,zi,xj,yj,zj
1944 ! print *,"tu2",j,j+nres,c(1,j),c(1,j+nres)
1945 ! this fragment set correct epsilon for lipid phase
1946 if ((zj.gt.bordlipbot) &
1947 .and.(zj.lt.bordliptop)) then
1948 !C the energy transfer exist
1949 if (zj.lt.buflipbot) then
1950 !C what fraction I am in
1952 ((zj-bordlipbot)/lipbufthick)
1953 !C lipbufthick is thickenes of lipid buffore
1954 sslipj=sscalelip(fracinbuf)
1955 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1956 elseif (zj.gt.bufliptop) then
1957 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1958 sslipj=sscalelip(fracinbuf)
1959 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1968 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1969 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1970 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
1971 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1972 !------------------------------------------------
1973 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1981 xj=xj_safe+xshift*boxxsize
1982 yj=yj_safe+yshift*boxysize
1983 zj=zj_safe+zshift*boxzsize
1984 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1985 if(dist_temp.lt.dist_init) then
1995 if (subchap.eq.1) then
2004 dxj=dc_norm(1,nres+j)
2005 dyj=dc_norm(2,nres+j)
2006 dzj=dc_norm(3,nres+j)
2007 ! write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
2008 ! write (iout,*) "j",j," dc_norm",& !d
2009 ! dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
2010 ! write(iout,*)"rrij ",rrij
2011 ! write(iout,*)"xj yj zj ", xj, yj, zj
2012 ! write(iout,*)"xi yi zi ", xi, yi, zi
2013 ! write(iout,*)"c ", c(1,:), c(2,:), c(3,:)
2014 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2016 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
2017 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
2018 ! print *,sss_ele_cut,sss_ele_grad,&
2019 ! 1.0d0/(rij),r_cut_ele,rlamb_ele
2020 if (sss_ele_cut.le.0.0) cycle
2021 ! Calculate angle-dependent terms of energy and contributions to their
2025 sig=sig0ij*dsqrt(sigsq)
2026 rij_shift=1.0D0/rij-sig+sig0ij
2027 ! write(iout,*)" rij_shift",rij_shift," rij",rij," sig",sig,&
2029 ! for diagnostics; uncomment
2030 ! rij_shift=1.2*sig0ij
2031 ! I hate to put IF's in the loops, but here don't have another choice!!!!
2032 if (rij_shift.le.0.0D0) then
2034 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2035 !d & restyp(itypi,1),i,restyp(itypj,1),j,
2036 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
2040 !---------------------------------------------------------------
2041 rij_shift=1.0D0/rij_shift
2042 fac=rij_shift**expon
2044 e1=fac*fac*aa!(itypi,itypj)
2045 e2=fac*bb!(itypi,itypj)
2046 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2047 eps2der=evdwij*eps3rt
2048 eps3der=evdwij*eps2rt
2049 ! write(iout,*)"aa, bb ",aa(:,:),bb(:,:)
2050 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,& !d
2051 ! " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2," fac",fac !d
2052 evdwij=evdwij*eps2rt*eps3rt
2053 evdw=evdw+evdwij*sss_ele_cut
2055 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2056 epsi=bb**2/aa!(itypi,itypj)
2057 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
2058 restyp(itypi,1),i,restyp(itypj,1),j, &
2059 epsi,sigm,chi1,chi2,chip1,chip2, &
2060 eps1,eps2rt**2,eps3rt**2,sig,sig0ij, &
2061 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift, &
2065 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2e10.2,e11.3)')&
2066 'evdw',i,j,evdwij,xi,xj,rij !,"egb"
2067 !C print *,i,j,c(1,i),c(1,j),c(2,i),c(2,j),c(3,i),c(3,j)
2068 ! if (energy_dec) write (iout,*) &
2070 ! print *,"ZALAMKA", evdw
2072 ! Calculate gradient components.
2073 e1=e1*eps1*eps2rt**2*eps3rt**2
2074 fac=-expon*(e1+evdwij)*rij_shift
2077 ! print *,'before fac',fac,rij,evdwij
2078 fac=fac+evdwij*sss_ele_grad/sss_ele_cut&
2079 /sigma(itypi,itypj)*rij
2080 ! print *,'grad part scale',fac, &
2081 ! evdwij*sss_ele_grad/sss_ele_cut &
2082 ! /sigma(itypi,itypj)*rij
2084 ! Calculate the radial part of the gradient
2088 !C Calculate the radial part of the gradient
2089 gg_lipi(3)=eps1*(eps2rt*eps2rt)&
2090 *(eps3rt*eps3rt)*sss_ele_cut/2.0d0*(faclip*faclip*&
2091 (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))&
2092 +faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
2093 gg_lipj(3)=ssgradlipj*gg_lipi(3)
2094 gg_lipi(3)=gg_lipi(3)*ssgradlipi
2096 ! print *,'before sc_grad', gg(1),gg(2),gg(3)
2097 ! Calculate angular part of the gradient.
2103 ! print *,"ZALAMKA", evdw
2104 ! write (iout,*) "Number of loop steps in EGB:",ind
2105 !ccc energy_dec=.false.
2108 !-----------------------------------------------------------------------------
2109 subroutine egbv(evdw)
2111 ! This subroutine calculates the interaction energy of nonbonded side chains
2112 ! assuming the Gay-Berne-Vorobjev potential of interaction.
2116 ! implicit real*8 (a-h,o-z)
2117 ! include 'DIMENSIONS'
2118 ! include 'COMMON.GEO'
2119 ! include 'COMMON.VAR'
2120 ! include 'COMMON.LOCAL'
2121 ! include 'COMMON.CHAIN'
2122 ! include 'COMMON.DERIV'
2123 ! include 'COMMON.NAMES'
2124 ! include 'COMMON.INTERACT'
2125 ! include 'COMMON.IOUNITS'
2126 ! include 'COMMON.CALC'
2128 !el integer :: icall
2129 !el common /srutu/ icall
2132 integer :: iint,itypi,itypi1,itypj
2133 real(kind=8) :: rrij,xi,yi,zi,r0ij,fac_augm,e_augm,fac,e1,e2,sigm
2134 real(kind=8) :: evdw,sig0ij,sig,rij_shift,epsi
2136 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
2139 ! if (icall.eq.0) lprn=.true.
2141 do i=iatsc_s,iatsc_e
2142 itypi=iabs(itype(i,1))
2143 if (itypi.eq.ntyp1) cycle
2144 itypi1=iabs(itype(i+1,1))
2148 dxi=dc_norm(1,nres+i)
2149 dyi=dc_norm(2,nres+i)
2150 dzi=dc_norm(3,nres+i)
2151 ! dsci_inv=dsc_inv(itypi)
2152 dsci_inv=vbld_inv(i+nres)
2154 ! Calculate SC interaction energy.
2156 do iint=1,nint_gr(i)
2157 do j=istart(i,iint),iend(i,iint)
2159 itypj=iabs(itype(j,1))
2160 if (itypj.eq.ntyp1) cycle
2161 ! dscj_inv=dsc_inv(itypj)
2162 dscj_inv=vbld_inv(j+nres)
2163 sig0ij=sigma(itypi,itypj)
2164 r0ij=r0(itypi,itypj)
2165 chi1=chi(itypi,itypj)
2166 chi2=chi(itypj,itypi)
2173 alf12=0.5D0*(alf1+alf2)
2174 ! For diagnostics only!!!
2187 dxj=dc_norm(1,nres+j)
2188 dyj=dc_norm(2,nres+j)
2189 dzj=dc_norm(3,nres+j)
2190 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2192 ! Calculate angle-dependent terms of energy and contributions to their
2196 sig=sig0ij*dsqrt(sigsq)
2197 rij_shift=1.0D0/rij-sig+r0ij
2198 ! I hate to put IF's in the loops, but here don't have another choice!!!!
2199 if (rij_shift.le.0.0D0) then
2204 !---------------------------------------------------------------
2205 rij_shift=1.0D0/rij_shift
2206 fac=rij_shift**expon
2207 e1=fac*fac*aa_aq(itypi,itypj)
2208 e2=fac*bb_aq(itypi,itypj)
2209 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2210 eps2der=evdwij*eps3rt
2211 eps3der=evdwij*eps2rt
2212 fac_augm=rrij**expon
2213 e_augm=augm(itypi,itypj)*fac_augm
2214 evdwij=evdwij*eps2rt*eps3rt
2215 evdw=evdw+evdwij+e_augm
2217 sigm=dabs(aa_aq(itypi,itypj)/&
2218 bb_aq(itypi,itypj))**(1.0D0/6.0D0)
2219 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
2220 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
2221 restyp(itypi,1),i,restyp(itypj,1),j,&
2222 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
2223 chi1,chi2,chip1,chip2,&
2224 eps1,eps2rt**2,eps3rt**2,&
2225 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
2228 ! Calculate gradient components.
2229 e1=e1*eps1*eps2rt**2*eps3rt**2
2230 fac=-expon*(e1+evdwij)*rij_shift
2232 fac=rij*fac-2*expon*rrij*e_augm
2233 ! Calculate the radial part of the gradient
2237 ! Calculate angular part of the gradient.
2243 !-----------------------------------------------------------------------------
2244 !el subroutine sc_angular in module geometry
2245 !-----------------------------------------------------------------------------
2246 subroutine e_softsphere(evdw)
2248 ! This subroutine calculates the interaction energy of nonbonded side chains
2249 ! assuming the LJ potential of interaction.
2251 ! implicit real*8 (a-h,o-z)
2252 ! include 'DIMENSIONS'
2253 real(kind=8),parameter :: accur=1.0d-10
2254 ! include 'COMMON.GEO'
2255 ! include 'COMMON.VAR'
2256 ! include 'COMMON.LOCAL'
2257 ! include 'COMMON.CHAIN'
2258 ! include 'COMMON.DERIV'
2259 ! include 'COMMON.INTERACT'
2260 ! include 'COMMON.TORSION'
2261 ! include 'COMMON.SBRIDGE'
2262 ! include 'COMMON.NAMES'
2263 ! include 'COMMON.IOUNITS'
2264 ! include 'COMMON.CONTACTS'
2265 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
2266 !d print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2268 integer :: i,iint,j,itypi,itypi1,itypj,k
2269 real(kind=8) :: evdw,xj,yj,zj,xi,yi,zi,rij,r0ij,r0ijsq,evdwij
2273 do i=iatsc_s,iatsc_e
2274 itypi=iabs(itype(i,1))
2275 if (itypi.eq.ntyp1) cycle
2276 itypi1=iabs(itype(i+1,1))
2281 ! Calculate SC interaction energy.
2283 do iint=1,nint_gr(i)
2284 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2285 !d & 'iend=',iend(i,iint)
2286 do j=istart(i,iint),iend(i,iint)
2287 itypj=iabs(itype(j,1))
2288 if (itypj.eq.ntyp1) cycle
2292 rij=xj*xj+yj*yj+zj*zj
2293 ! write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2294 r0ij=r0(itypi,itypj)
2296 ! print *,i,j,r0ij,dsqrt(rij)
2297 if (rij.lt.r0ijsq) then
2298 evdwij=0.25d0*(rij-r0ijsq)**2
2306 ! Calculate the components of the gradient in DC and X
2312 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2313 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2314 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2315 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2319 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2326 end subroutine e_softsphere
2327 !-----------------------------------------------------------------------------
2328 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2330 ! Soft-sphere potential of p-p interaction
2332 ! implicit real*8 (a-h,o-z)
2333 ! include 'DIMENSIONS'
2334 ! include 'COMMON.CONTROL'
2335 ! include 'COMMON.IOUNITS'
2336 ! include 'COMMON.GEO'
2337 ! include 'COMMON.VAR'
2338 ! include 'COMMON.LOCAL'
2339 ! include 'COMMON.CHAIN'
2340 ! include 'COMMON.DERIV'
2341 ! include 'COMMON.INTERACT'
2342 ! include 'COMMON.CONTACTS'
2343 ! include 'COMMON.TORSION'
2344 ! include 'COMMON.VECTORS'
2345 ! include 'COMMON.FFIELD'
2346 real(kind=8),dimension(3) :: ggg
2347 !d write(iout,*) 'In EELEC_soft_sphere'
2349 integer :: i,j,k,num_conti,iteli,itelj
2350 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
2351 real(kind=8) :: dxi,dyi,dzi,xmedi,ymedi,zmedi,r0ij,r0ijsq
2352 real(kind=8) :: dxj,dyj,dzj,xj,yj,zj,rij,evdw1ij,fac
2360 do i=iatel_s,iatel_e
2361 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
2365 xmedi=c(1,i)+0.5d0*dxi
2366 ymedi=c(2,i)+0.5d0*dyi
2367 zmedi=c(3,i)+0.5d0*dzi
2369 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2370 do j=ielstart(i),ielend(i)
2371 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
2375 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2376 r0ij=rpp(iteli,itelj)
2381 xj=c(1,j)+0.5D0*dxj-xmedi
2382 yj=c(2,j)+0.5D0*dyj-ymedi
2383 zj=c(3,j)+0.5D0*dzj-zmedi
2384 rij=xj*xj+yj*yj+zj*zj
2385 if (rij.lt.r0ijsq) then
2386 evdw1ij=0.25d0*(rij-r0ijsq)**2
2394 ! Calculate contributions to the Cartesian gradient.
2400 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2401 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2404 ! Loop over residues i+1 thru j-1.
2408 !grad gelc(l,k)=gelc(l,k)+ggg(l)
2413 !grad do i=nnt,nct-1
2415 !grad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2417 !grad do j=i+1,nct-1
2419 !grad gelc(k,i)=gelc(k,i)+gelc(k,j)
2424 end subroutine eelec_soft_sphere
2425 !-----------------------------------------------------------------------------
2426 subroutine vec_and_deriv
2427 ! implicit real*8 (a-h,o-z)
2428 ! include 'DIMENSIONS'
2432 ! include 'COMMON.IOUNITS'
2433 ! include 'COMMON.GEO'
2434 ! include 'COMMON.VAR'
2435 ! include 'COMMON.LOCAL'
2436 ! include 'COMMON.CHAIN'
2437 ! include 'COMMON.VECTORS'
2438 ! include 'COMMON.SETUP'
2439 ! include 'COMMON.TIME1'
2440 real(kind=8),dimension(3,3,2) :: uyder,uzder
2441 real(kind=8),dimension(2) :: vbld_inv_temp
2442 ! Compute the local reference systems. For reference system (i), the
2443 ! X-axis points from CA(i) to CA(i+1), the Y axis is in the
2444 ! CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2447 real(kind=8) :: facy,fac,costh
2450 do i=ivec_start,ivec_end
2454 if (i.eq.nres-1) then
2455 ! Case of the last full residue
2456 ! Compute the Z-axis
2457 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2458 costh=dcos(pi-theta(nres))
2459 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2463 ! Compute the derivatives of uz
2465 uzder(2,1,1)=-dc_norm(3,i-1)
2466 uzder(3,1,1)= dc_norm(2,i-1)
2467 uzder(1,2,1)= dc_norm(3,i-1)
2469 uzder(3,2,1)=-dc_norm(1,i-1)
2470 uzder(1,3,1)=-dc_norm(2,i-1)
2471 uzder(2,3,1)= dc_norm(1,i-1)
2474 uzder(2,1,2)= dc_norm(3,i)
2475 uzder(3,1,2)=-dc_norm(2,i)
2476 uzder(1,2,2)=-dc_norm(3,i)
2478 uzder(3,2,2)= dc_norm(1,i)
2479 uzder(1,3,2)= dc_norm(2,i)
2480 uzder(2,3,2)=-dc_norm(1,i)
2482 ! Compute the Y-axis
2485 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2487 ! Compute the derivatives of uy
2490 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i) &
2491 -dc_norm(k,i)*dc_norm(j,i-1)
2492 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2494 uyder(j,j,1)=uyder(j,j,1)-costh
2495 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2500 uygrad(l,k,j,i)=uyder(l,k,j)
2501 uzgrad(l,k,j,i)=uzder(l,k,j)
2505 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2506 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2507 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2508 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2511 ! Compute the Z-axis
2512 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2513 costh=dcos(pi-theta(i+2))
2514 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2518 ! Compute the derivatives of uz
2520 uzder(2,1,1)=-dc_norm(3,i+1)
2521 uzder(3,1,1)= dc_norm(2,i+1)
2522 uzder(1,2,1)= dc_norm(3,i+1)
2524 uzder(3,2,1)=-dc_norm(1,i+1)
2525 uzder(1,3,1)=-dc_norm(2,i+1)
2526 uzder(2,3,1)= dc_norm(1,i+1)
2529 uzder(2,1,2)= dc_norm(3,i)
2530 uzder(3,1,2)=-dc_norm(2,i)
2531 uzder(1,2,2)=-dc_norm(3,i)
2533 uzder(3,2,2)= dc_norm(1,i)
2534 uzder(1,3,2)= dc_norm(2,i)
2535 uzder(2,3,2)=-dc_norm(1,i)
2537 ! Compute the Y-axis
2540 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2542 ! Compute the derivatives of uy
2545 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i) &
2546 -dc_norm(k,i)*dc_norm(j,i+1)
2547 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2549 uyder(j,j,1)=uyder(j,j,1)-costh
2550 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2555 uygrad(l,k,j,i)=uyder(l,k,j)
2556 uzgrad(l,k,j,i)=uzder(l,k,j)
2560 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2561 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2562 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2563 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2567 vbld_inv_temp(1)=vbld_inv(i+1)
2568 if (i.lt.nres-1) then
2569 vbld_inv_temp(2)=vbld_inv(i+2)
2571 vbld_inv_temp(2)=vbld_inv(i)
2576 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2577 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2582 #if defined(PARVEC) && defined(MPI)
2583 if (nfgtasks1.gt.1) then
2585 ! print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2586 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2587 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2588 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),&
2589 MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2591 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),&
2592 MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,&
2594 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),&
2595 ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),&
2596 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2597 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),&
2598 ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),&
2599 ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2600 time_gather=time_gather+MPI_Wtime()-time00
2602 ! if (fg_rank.eq.0) then
2603 ! write (iout,*) "Arrays UY and UZ"
2605 ! write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2611 end subroutine vec_and_deriv
2612 !-----------------------------------------------------------------------------
2613 subroutine check_vecgrad
2614 ! implicit real*8 (a-h,o-z)
2615 ! include 'DIMENSIONS'
2616 ! include 'COMMON.IOUNITS'
2617 ! include 'COMMON.GEO'
2618 ! include 'COMMON.VAR'
2619 ! include 'COMMON.LOCAL'
2620 ! include 'COMMON.CHAIN'
2621 ! include 'COMMON.VECTORS'
2622 real(kind=8),dimension(3,3,2,nres) :: uygradt,uzgradt !(3,3,2,maxres)
2623 real(kind=8),dimension(3,nres) :: uyt,uzt !(3,maxres)
2624 real(kind=8),dimension(3,3,2) :: uygradn,uzgradn
2625 real(kind=8),dimension(3) :: erij
2626 real(kind=8) :: delta=1.0d-7
2632 !rc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2633 !rc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2634 !rc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2635 !d write(iout,'(2i5,2(3f10.5,5x))') i,1,
2636 !d & (dc_norm(if90,i),if90=1,3)
2637 !d write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2638 !d write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2639 !d write(iout,'(a)')
2645 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2646 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2659 !d write (iout,*) 'i=',i
2661 erij(k)=dc_norm(k,i)
2665 dc_norm(k,i)=erij(k)
2667 dc_norm(j,i)=dc_norm(j,i)+delta
2668 ! fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2670 ! dc_norm(k,i)=dc_norm(k,i)/fac
2672 ! write (iout,*) (dc_norm(k,i),k=1,3)
2673 ! write (iout,*) (erij(k),k=1,3)
2676 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2677 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2678 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2679 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2681 ! write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2682 ! & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2683 ! & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2686 dc_norm(k,i)=erij(k)
2689 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2690 !d & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2691 !d & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2692 !d write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2693 !d & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2694 !d & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2695 !d write (iout,'(a)')
2699 end subroutine check_vecgrad
2700 !-----------------------------------------------------------------------------
2701 subroutine set_matrices
2702 ! implicit real*8 (a-h,o-z)
2703 ! include 'DIMENSIONS'
2706 ! include "COMMON.SETUP"
2708 integer :: status(MPI_STATUS_SIZE)
2710 ! include 'COMMON.IOUNITS'
2711 ! include 'COMMON.GEO'
2712 ! include 'COMMON.VAR'
2713 ! include 'COMMON.LOCAL'
2714 ! include 'COMMON.CHAIN'
2715 ! include 'COMMON.DERIV'
2716 ! include 'COMMON.INTERACT'
2717 ! include 'COMMON.CONTACTS'
2718 ! include 'COMMON.TORSION'
2719 ! include 'COMMON.VECTORS'
2720 ! include 'COMMON.FFIELD'
2721 real(kind=8) :: auxvec(2),auxmat(2,2)
2722 integer :: i,iti1,iti,k,l
2723 real(kind=8) :: sin1,cos1,sin2,cos2,dwacos2,dwasin2,cost1,sint1,&
2724 sint1sq,sint1cub,sint1cost1,b1k,b2k,aux
2725 ! print *,"in set matrices"
2727 ! Compute the virtual-bond-torsional-angle dependent quantities needed
2728 ! to calculate the el-loc multibody terms of various order.
2733 do i=ivec_start+2,ivec_end+2
2737 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2738 if (itype(i-2,1).eq.0) then
2741 iti = itype2loc(itype(i-2,1))
2746 !c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2747 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2748 iti1 = itype2loc(itype(i-1,1))
2752 ! print *,i,itype(i-2,1),iti
2754 cost1=dcos(theta(i-1))
2755 sint1=dsin(theta(i-1))
2757 sint1cub=sint1sq*sint1
2758 sint1cost1=2*sint1*cost1
2759 ! print *,"cost1",cost1,theta(i-1)
2760 !c write (iout,*) "bnew1",i,iti
2761 !c write (iout,*) (bnew1(k,1,iti),k=1,3)
2762 !c write (iout,*) (bnew1(k,2,iti),k=1,3)
2763 !c write (iout,*) "bnew2",i,iti
2764 !c write (iout,*) (bnew2(k,1,iti),k=1,3)
2765 !c write (iout,*) (bnew2(k,2,iti),k=1,3)
2767 ! print *,bnew1(1,k,iti),"bnew1"
2769 b1k=bnew1(1,k,iti)+(bnew1(2,k,iti)+bnew1(3,k,iti)*cost1)*cost1
2771 ! write(*,*) shape(b1)
2772 ! if(.not.allocated(b1)) print *, "WTF?"
2777 gtb1(k,i-2)=cost1*b1k-sint1sq*&
2778 (bnew1(2,k,iti)+2*bnew1(3,k,iti)*cost1)
2779 ! print *,gtb1(k,i-2)
2781 b2k=bnew2(1,k,iti)+(bnew2(2,k,iti)+bnew2(3,k,iti)*cost1)*cost1
2785 gtb2(k,i-2)=cost1*b2k-sint1sq*&
2786 (bnew2(2,k,iti)+2*bnew2(3,k,iti)*cost1)
2787 ! print *,gtb2(k,i-2)
2792 aux=ccnew(1,k,iti)+(ccnew(2,k,iti)+ccnew(3,k,iti)*cost1)*cost1
2793 cc(1,k,i-2)=sint1sq*aux
2794 gtcc(1,k,i-2)=sint1cost1*aux-sint1cub*&
2795 (ccnew(2,k,iti)+2*ccnew(3,k,iti)*cost1)
2796 aux=ddnew(1,k,iti)+(ddnew(2,k,iti)+ddnew(3,k,iti)*cost1)*cost1
2797 dd(1,k,i-2)=sint1sq*aux
2798 gtdd(1,k,i-2)=sint1cost1*aux-sint1cub*&
2799 (ddnew(2,k,iti)+2*ddnew(3,k,iti)*cost1)
2801 ! print *,"after cc"
2802 cc(2,1,i-2)=cc(1,2,i-2)
2803 cc(2,2,i-2)=-cc(1,1,i-2)
2804 gtcc(2,1,i-2)=gtcc(1,2,i-2)
2805 gtcc(2,2,i-2)=-gtcc(1,1,i-2)
2806 dd(2,1,i-2)=dd(1,2,i-2)
2807 dd(2,2,i-2)=-dd(1,1,i-2)
2808 gtdd(2,1,i-2)=gtdd(1,2,i-2)
2809 gtdd(2,2,i-2)=-gtdd(1,1,i-2)
2810 ! print *,"after dd"
2814 aux=eenew(1,l,k,iti)+eenew(2,l,k,iti)*cost1
2815 EE(l,k,i-2)=sint1sq*aux
2816 gtEE(l,k,i-2)=sint1cost1*aux-sint1cub*eenew(2,l,k,iti)
2819 EE(1,1,i-2)=EE(1,1,i-2)+e0new(1,iti)*cost1
2820 EE(1,2,i-2)=EE(1,2,i-2)+e0new(2,iti)+e0new(3,iti)*cost1
2821 EE(2,1,i-2)=EE(2,1,i-2)+e0new(2,iti)*cost1+e0new(3,iti)
2822 EE(2,2,i-2)=EE(2,2,i-2)-e0new(1,iti)
2823 gtEE(1,1,i-2)=gtEE(1,1,i-2)-e0new(1,iti)*sint1
2824 gtEE(1,2,i-2)=gtEE(1,2,i-2)-e0new(3,iti)*sint1
2825 gtEE(2,1,i-2)=gtEE(2,1,i-2)-e0new(2,iti)*sint1
2826 ! print *,"after ee"
2828 !c b1tilde(1,i-2)=b1(1,i-2)
2829 !c b1tilde(2,i-2)=-b1(2,i-2)
2830 !c b2tilde(1,i-2)=b2(1,i-2)
2831 !c b2tilde(2,i-2)=-b2(2,i-2)
2833 write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2834 write(iout,*) 'b1=',(b1(k,i-2),k=1,2)
2835 write(iout,*) 'b2=',(b2(k,i-2),k=1,2)
2836 write (iout,*) 'theta=', theta(i-1)
2839 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2840 iti = itype2loc(itype(i-2,1))
2844 !c write (iout,*) "i",i-1," itype",itype(i-2)," iti",iti
2845 !c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2846 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2847 iti1 = itype2loc(itype(i-1,1))
2857 CC(k,l,i-2)=ccold(k,l,iti)
2858 DD(k,l,i-2)=ddold(k,l,iti)
2859 EE(k,l,i-2)=eeold(k,l,iti)
2863 b1tilde(1,i-2)= b1(1,i-2)
2864 b1tilde(2,i-2)=-b1(2,i-2)
2865 b2tilde(1,i-2)= b2(1,i-2)
2866 b2tilde(2,i-2)=-b2(2,i-2)
2868 Ctilde(1,1,i-2)= CC(1,1,i-2)
2869 Ctilde(1,2,i-2)= CC(1,2,i-2)
2870 Ctilde(2,1,i-2)=-CC(2,1,i-2)
2871 Ctilde(2,2,i-2)=-CC(2,2,i-2)
2873 Dtilde(1,1,i-2)= DD(1,1,i-2)
2874 Dtilde(1,2,i-2)= DD(1,2,i-2)
2875 Dtilde(2,1,i-2)=-DD(2,1,i-2)
2876 Dtilde(2,2,i-2)=-DD(2,2,i-2)
2879 do i=ivec_start+2,ivec_end+2
2885 if (i .lt. nres+1) then
2922 if (i .gt. 3 .and. i .lt. nres+1) then
2923 obrot_der(1,i-2)=-sin1
2924 obrot_der(2,i-2)= cos1
2925 Ugder(1,1,i-2)= sin1
2926 Ugder(1,2,i-2)=-cos1
2927 Ugder(2,1,i-2)=-cos1
2928 Ugder(2,2,i-2)=-sin1
2931 obrot2_der(1,i-2)=-dwasin2
2932 obrot2_der(2,i-2)= dwacos2
2933 Ug2der(1,1,i-2)= dwasin2
2934 Ug2der(1,2,i-2)=-dwacos2
2935 Ug2der(2,1,i-2)=-dwacos2
2936 Ug2der(2,2,i-2)=-dwasin2
2938 obrot_der(1,i-2)=0.0d0
2939 obrot_der(2,i-2)=0.0d0
2940 Ugder(1,1,i-2)=0.0d0
2941 Ugder(1,2,i-2)=0.0d0
2942 Ugder(2,1,i-2)=0.0d0
2943 Ugder(2,2,i-2)=0.0d0
2944 obrot2_der(1,i-2)=0.0d0
2945 obrot2_der(2,i-2)=0.0d0
2946 Ug2der(1,1,i-2)=0.0d0
2947 Ug2der(1,2,i-2)=0.0d0
2948 Ug2der(2,1,i-2)=0.0d0
2949 Ug2der(2,2,i-2)=0.0d0
2951 ! if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2952 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2953 if (itype(i-2,1).eq.0) then
2956 iti = itype2loc(itype(i-2,1))
2961 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2962 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2963 if (itype(i-1,1).eq.0) then
2966 iti1 = itype2loc(itype(i-1,1))
2971 ! print *,iti,i,"iti",iti1,itype(i-1,1),itype(i-2,1)
2972 !d write (iout,*) '*******i',i,' iti1',iti
2973 ! write (iout,*) 'b1',b1(:,iti)
2974 ! write (iout,*) 'b2',b2(:,i-2)
2975 !d write (iout,*) 'Ug',Ug(:,:,i-2)
2976 ! if (i .gt. iatel_s+2) then
2977 if (i .gt. nnt+2) then
2978 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2980 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2981 !c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2984 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2985 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2986 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
2988 call matmat2(CC(1,1,i-2),Ug(1,1,i-2),CUg(1,1,i-2))
2989 call matmat2(DD(1,1,i-2),Ug(1,1,i-2),DUg(1,1,i-2))
2990 call matmat2(Dtilde(1,1,i-2),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2991 call matvec2(Ctilde(1,1,i-1),obrot(1,i-2),Ctobr(1,i-2))
2992 call matvec2(Dtilde(1,1,i-2),obrot2(1,i-2),Dtobr2(1,i-2))
3003 DtUg2(l,k,i-2)=0.0d0
3007 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
3008 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
3010 muder(k,i-2)=Ub2der(k,i-2)
3012 ! if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
3013 if (i.gt. nnt+1 .and. i.lt.nct+1) then
3014 if (itype(i-1,1).eq.0) then
3016 elseif (itype(i-1,1).le.ntyp) then
3017 iti1 = itype2loc(itype(i-1,1))
3025 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
3027 if (energy_dec) write (iout,*) 'Ub2 ',i,Ub2(:,i-2)
3028 if (energy_dec) write (iout,*) 'b1 ',iti1,b1(:,i-1)
3029 if (energy_dec) write (iout,*) 'mu ',i,iti1,mu(:,i-2)
3030 !d write (iout,*) 'mu1',mu1(:,i-2)
3031 !d write (iout,*) 'mu2',mu2(:,i-2)
3032 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
3034 call matmat2(CC(1,1,i-1),Ugder(1,1,i-2),CUgder(1,1,i-2))
3035 call matmat2(DD(1,1,i-2),Ugder(1,1,i-2),DUgder(1,1,i-2))
3036 call matmat2(Dtilde(1,1,i-2),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
3037 call matvec2(Ctilde(1,1,i-1),obrot_der(1,i-2),Ctobrder(1,i-2))
3038 call matvec2(Dtilde(1,1,i-2),obrot2_der(1,i-2),Dtobr2der(1,i-2))
3039 ! Vectors and matrices dependent on a single virtual-bond dihedral.
3040 call matvec2(DD(1,1,i-2),b1tilde(1,iti1),auxvec(1))
3041 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
3042 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
3043 call matvec2(CC(1,1,i-1),Ub2(1,i-2),CUgb2(1,i-2))
3044 call matvec2(CC(1,1,i-1),Ub2der(1,i-2),CUgb2der(1,i-2))
3045 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
3046 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
3047 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
3048 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
3051 ! Matrices dependent on two consecutive virtual-bond dihedrals.
3052 ! The order of matrices is from left to right.
3053 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0) &
3055 ! do i=max0(ivec_start,2),ivec_end
3057 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
3058 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
3059 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
3060 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
3061 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
3062 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
3063 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
3064 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
3067 #if defined(MPI) && defined(PARMAT)
3069 ! if (fg_rank.eq.0) then
3070 write (iout,*) "Arrays UG and UGDER before GATHER"
3072 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3073 ((ug(l,k,i),l=1,2),k=1,2),&
3074 ((ugder(l,k,i),l=1,2),k=1,2)
3076 write (iout,*) "Arrays UG2 and UG2DER"
3078 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3079 ((ug2(l,k,i),l=1,2),k=1,2),&
3080 ((ug2der(l,k,i),l=1,2),k=1,2)
3082 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3084 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3085 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
3086 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3088 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3090 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3091 costab(i),sintab(i),costab2(i),sintab2(i)
3093 write (iout,*) "Array MUDER"
3095 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3099 if (nfgtasks.gt.1) then
3101 ! write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
3102 ! & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
3103 ! & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
3105 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),&
3106 MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3108 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),&
3109 MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3111 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),&
3112 MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3114 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),&
3115 MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3117 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),&
3118 MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3120 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),&
3121 MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3123 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),&
3124 MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),&
3125 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3126 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),&
3127 MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),&
3128 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3129 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),&
3130 MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),&
3131 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3132 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),&
3133 MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),&
3134 MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3135 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
3137 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),&
3138 MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3140 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),&
3141 MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3143 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),&
3144 MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3146 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),&
3147 MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3149 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),&
3150 MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3152 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),&
3153 ivec_count(fg_rank1),&
3154 MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3156 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),&
3157 MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3159 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),&
3160 MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,&
3162 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),&
3163 MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3165 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),&
3166 MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3168 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),&
3169 MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3171 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),&
3172 MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3174 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),&
3175 MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3177 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),&
3178 ivec_count(fg_rank1),&
3179 MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3181 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),&
3182 MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3184 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),&
3185 MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3187 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),&
3188 MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3190 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),&
3191 MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3193 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),&
3194 ivec_count(fg_rank1),&
3195 MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3197 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),&
3198 ivec_count(fg_rank1),&
3199 MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,&
3201 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),&
3202 ivec_count(fg_rank1),&
3203 MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
3204 MPI_MAT2,FG_COMM1,IERR)
3205 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),&
3206 ivec_count(fg_rank1),&
3207 MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),&
3208 MPI_MAT2,FG_COMM1,IERR)
3211 ! Passes matrix info through the ring
3214 if (irecv.lt.0) irecv=nfgtasks1-1
3217 if (inext.ge.nfgtasks1) inext=0
3219 ! write (iout,*) "isend",isend," irecv",irecv
3221 lensend=lentyp(isend)
3222 lenrecv=lentyp(irecv)
3223 ! write (iout,*) "lensend",lensend," lenrecv",lenrecv
3224 ! call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3225 ! & MPI_ROTAT1(lensend),inext,2200+isend,
3226 ! & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3227 ! & iprev,2200+irecv,FG_COMM,status,IERR)
3228 ! write (iout,*) "Gather ROTAT1"
3230 ! call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3231 ! & MPI_ROTAT2(lensend),inext,3300+isend,
3232 ! & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3233 ! & iprev,3300+irecv,FG_COMM,status,IERR)
3234 ! write (iout,*) "Gather ROTAT2"
3236 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,&
3237 MPI_ROTAT_OLD(lensend),inext,4400+isend,&
3238 costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),&
3239 iprev,4400+irecv,FG_COMM,status,IERR)
3240 ! write (iout,*) "Gather ROTAT_OLD"
3242 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,&
3243 MPI_PRECOMP11(lensend),inext,5500+isend,&
3244 mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),&
3245 iprev,5500+irecv,FG_COMM,status,IERR)
3246 ! write (iout,*) "Gather PRECOMP11"
3248 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,&
3249 MPI_PRECOMP12(lensend),inext,6600+isend,&
3250 Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),&
3251 iprev,6600+irecv,FG_COMM,status,IERR)
3252 ! write (iout,*) "Gather PRECOMP12"
3254 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) &
3256 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,&
3257 MPI_ROTAT2(lensend),inext,7700+isend,&
3258 ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),&
3259 iprev,7700+irecv,FG_COMM,status,IERR)
3260 ! write (iout,*) "Gather PRECOMP21"
3262 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,&
3263 MPI_PRECOMP22(lensend),inext,8800+isend,&
3264 EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),&
3265 iprev,8800+irecv,FG_COMM,status,IERR)
3266 ! write (iout,*) "Gather PRECOMP22"
3268 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,&
3269 MPI_PRECOMP23(lensend),inext,9900+isend,&
3270 Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,&
3271 MPI_PRECOMP23(lenrecv),&
3272 iprev,9900+irecv,FG_COMM,status,IERR)
3273 ! write (iout,*) "Gather PRECOMP23"
3278 if (irecv.lt.0) irecv=nfgtasks1-1
3281 time_gather=time_gather+MPI_Wtime()-time00
3284 ! if (fg_rank.eq.0) then
3285 write (iout,*) "Arrays UG and UGDER"
3287 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3288 ((ug(l,k,i),l=1,2),k=1,2),&
3289 ((ugder(l,k,i),l=1,2),k=1,2)
3291 write (iout,*) "Arrays UG2 and UG2DER"
3293 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3294 ((ug2(l,k,i),l=1,2),k=1,2),&
3295 ((ug2der(l,k,i),l=1,2),k=1,2)
3297 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3299 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3300 (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),&
3301 (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3303 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3305 write (iout,'(i5,4f10.5,5x,4f10.5)') i,&
3306 costab(i),sintab(i),costab2(i),sintab2(i)
3308 write (iout,*) "Array MUDER"
3310 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3316 !d iti = itortyp(itype(i,1))
3319 !d write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3320 !d & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3324 end subroutine set_matrices
3325 !-----------------------------------------------------------------------------
3326 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3328 ! This subroutine calculates the average interaction energy and its gradient
3329 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
3330 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3331 ! The potential depends both on the distance of peptide-group centers and on
3332 ! the orientation of the CA-CA virtual bonds.
3335 ! implicit real*8 (a-h,o-z)
3339 ! include 'DIMENSIONS'
3340 ! include 'COMMON.CONTROL'
3341 ! include 'COMMON.SETUP'
3342 ! include 'COMMON.IOUNITS'
3343 ! include 'COMMON.GEO'
3344 ! include 'COMMON.VAR'
3345 ! include 'COMMON.LOCAL'
3346 ! include 'COMMON.CHAIN'
3347 ! include 'COMMON.DERIV'
3348 ! include 'COMMON.INTERACT'
3349 ! include 'COMMON.CONTACTS'
3350 ! include 'COMMON.TORSION'
3351 ! include 'COMMON.VECTORS'
3352 ! include 'COMMON.FFIELD'
3353 ! include 'COMMON.TIME1'
3354 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
3355 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
3356 real(kind=8),dimension(2,2) :: acipa !el,a_temp
3357 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3358 real(kind=8),dimension(4) :: muij
3359 !el integer :: num_conti,j1,j2
3360 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3361 !el dz_normi,xmedi,ymedi,zmedi
3363 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3364 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3367 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3369 real(kind=8) :: scal_el=1.0d0
3371 real(kind=8) :: scal_el=0.5d0
3374 ! 13-go grudnia roku pamietnego...
3375 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
3377 0.0d0,0.0d0,1.0d0/),shape(unmat))
3380 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
3381 real(kind=8) :: fac,t_eelecij,fracinbuf
3384 !d write(iout,*) 'In EELEC'
3385 ! print *,"IN EELEC"
3387 !d write(iout,*) 'Type',i
3388 !d write(iout,*) 'B1',B1(:,i)
3389 !d write(iout,*) 'B2',B2(:,i)
3390 !d write(iout,*) 'CC',CC(:,:,i)
3391 !d write(iout,*) 'DD',DD(:,:,i)
3392 !d write(iout,*) 'EE',EE(:,:,i)
3394 !d call check_vecgrad
3409 if (icheckgrad.eq.1) then
3412 ! dc_norm(1,i)=0.0d0
3413 ! dc_norm(2,i)=0.0d0
3414 ! dc_norm(3,i)=0.0d0
3417 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3419 dc_norm(k,i)=dc(k,i)*fac
3421 ! write (iout,*) 'i',i,' fac',fac
3424 ! print *,wel_loc,"wel_loc",wcorr4,wcorr5,wcorr6,wturn3,wturn4, &
3426 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
3427 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
3428 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3429 ! call vec_and_deriv
3433 ! print *, "before set matrices"
3435 ! print *, "after set matrices"
3438 time_mat=time_mat+MPI_Wtime()-time01
3441 ! print *, "after set matrices"
3443 !d write (iout,*) 'i=',i
3445 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3448 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3449 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3462 !d print '(a)','Enter EELEC'
3463 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3464 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
3465 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
3467 gel_loc_loc(i)=0.0d0
3472 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3474 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
3478 ! print *,"before iturn3 loop"
3479 do i=iturn3_start,iturn3_end
3480 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
3481 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
3485 dx_normi=dc_norm(1,i)
3486 dy_normi=dc_norm(2,i)
3487 dz_normi=dc_norm(3,i)
3488 xmedi=c(1,i)+0.5d0*dxi
3489 ymedi=c(2,i)+0.5d0*dyi
3490 zmedi=c(3,i)+0.5d0*dzi
3491 xmedi=dmod(xmedi,boxxsize)
3492 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3493 ymedi=dmod(ymedi,boxysize)
3494 if (ymedi.lt.0) ymedi=ymedi+boxysize
3495 zmedi=dmod(zmedi,boxzsize)
3496 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3498 if ((zmedi.gt.bordlipbot) &
3499 .and.(zmedi.lt.bordliptop)) then
3500 !C the energy transfer exist
3501 if (zmedi.lt.buflipbot) then
3502 !C what fraction I am in
3504 ((zmedi-bordlipbot)/lipbufthick)
3505 !C lipbufthick is thickenes of lipid buffore
3506 sslipi=sscalelip(fracinbuf)
3507 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3508 elseif (zmedi.gt.bufliptop) then
3509 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3510 sslipi=sscalelip(fracinbuf)
3511 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3520 ! print *,i,sslipi,ssgradlipi
3521 call eelecij(i,i+2,ees,evdw1,eel_loc)
3522 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3523 num_cont_hb(i)=num_conti
3525 do i=iturn4_start,iturn4_end
3526 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
3527 .or. itype(i+3,1).eq.ntyp1 &
3528 .or. itype(i+4,1).eq.ntyp1) cycle
3529 ! print *,"before2",i,i+3, gshieldc_t4(2,i+3),gshieldc_t4(2,i)
3533 dx_normi=dc_norm(1,i)
3534 dy_normi=dc_norm(2,i)
3535 dz_normi=dc_norm(3,i)
3536 xmedi=c(1,i)+0.5d0*dxi
3537 ymedi=c(2,i)+0.5d0*dyi
3538 zmedi=c(3,i)+0.5d0*dzi
3539 xmedi=dmod(xmedi,boxxsize)
3540 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3541 ymedi=dmod(ymedi,boxysize)
3542 if (ymedi.lt.0) ymedi=ymedi+boxysize
3543 zmedi=dmod(zmedi,boxzsize)
3544 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3545 if ((zmedi.gt.bordlipbot) &
3546 .and.(zmedi.lt.bordliptop)) then
3547 !C the energy transfer exist
3548 if (zmedi.lt.buflipbot) then
3549 !C what fraction I am in
3551 ((zmedi-bordlipbot)/lipbufthick)
3552 !C lipbufthick is thickenes of lipid buffore
3553 sslipi=sscalelip(fracinbuf)
3554 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3555 elseif (zmedi.gt.bufliptop) then
3556 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3557 sslipi=sscalelip(fracinbuf)
3558 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3568 num_conti=num_cont_hb(i)
3569 call eelecij(i,i+3,ees,evdw1,eel_loc)
3570 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
3571 call eturn4(i,eello_turn4)
3572 ! print *,"before",i,i+3, gshieldc_t4(2,i+3),gshieldc_t4(2,i)
3573 num_cont_hb(i)=num_conti
3576 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3578 ! print *,"iatel_s,iatel_e,",iatel_s,iatel_e
3579 do i=iatel_s,iatel_e
3580 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
3584 dx_normi=dc_norm(1,i)
3585 dy_normi=dc_norm(2,i)
3586 dz_normi=dc_norm(3,i)
3587 xmedi=c(1,i)+0.5d0*dxi
3588 ymedi=c(2,i)+0.5d0*dyi
3589 zmedi=c(3,i)+0.5d0*dzi
3590 xmedi=dmod(xmedi,boxxsize)
3591 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3592 ymedi=dmod(ymedi,boxysize)
3593 if (ymedi.lt.0) ymedi=ymedi+boxysize
3594 zmedi=dmod(zmedi,boxzsize)
3595 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3596 if ((zmedi.gt.bordlipbot) &
3597 .and.(zmedi.lt.bordliptop)) then
3598 !C the energy transfer exist
3599 if (zmedi.lt.buflipbot) then
3600 !C what fraction I am in
3602 ((zmedi-bordlipbot)/lipbufthick)
3603 !C lipbufthick is thickenes of lipid buffore
3604 sslipi=sscalelip(fracinbuf)
3605 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
3606 elseif (zmedi.gt.bufliptop) then
3607 fracinbuf=1.0d0-((bordliptop-zmedi)/lipbufthick)
3608 sslipi=sscalelip(fracinbuf)
3609 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
3619 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3620 num_conti=num_cont_hb(i)
3621 do j=ielstart(i),ielend(i)
3622 ! write (iout,*) i,j,itype(i,1),itype(j,1)
3623 if (itype(j,1).eq.ntyp1.or. itype(j+1,1).eq.ntyp1) cycle
3624 call eelecij(i,j,ees,evdw1,eel_loc)
3626 num_cont_hb(i)=num_conti
3628 ! write (iout,*) "Number of loop steps in EELEC:",ind
3630 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
3631 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3633 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3634 !cc eel_loc=eel_loc+eello_turn3
3635 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
3637 end subroutine eelec
3638 !-----------------------------------------------------------------------------
3639 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3642 ! implicit real*8 (a-h,o-z)
3643 ! include 'DIMENSIONS'
3647 ! include 'COMMON.CONTROL'
3648 ! include 'COMMON.IOUNITS'
3649 ! include 'COMMON.GEO'
3650 ! include 'COMMON.VAR'
3651 ! include 'COMMON.LOCAL'
3652 ! include 'COMMON.CHAIN'
3653 ! include 'COMMON.DERIV'
3654 ! include 'COMMON.INTERACT'
3655 ! include 'COMMON.CONTACTS'
3656 ! include 'COMMON.TORSION'
3657 ! include 'COMMON.VECTORS'
3658 ! include 'COMMON.FFIELD'
3659 ! include 'COMMON.TIME1'
3660 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
3661 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
3662 real(kind=8),dimension(2,2) :: acipa !el,a_temp
3663 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
3664 real(kind=8),dimension(4) :: muij
3665 real(kind=8) :: geel_loc_ij,geel_loc_ji
3666 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
3667 dist_temp, dist_init,rlocshield,fracinbuf
3668 integer xshift,yshift,zshift,ilist,iresshield
3669 !el integer :: num_conti,j1,j2
3670 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
3671 !el dz_normi,xmedi,ymedi,zmedi
3673 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
3674 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
3677 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3679 real(kind=8) :: scal_el=1.0d0
3681 real(kind=8) :: scal_el=0.5d0
3684 ! 13-go grudnia roku pamietnego...
3685 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
3687 0.0d0,0.0d0,1.0d0/),shape(unmat))
3688 ! integer :: maxconts=nres/4
3690 integer :: k,i,j,iteli,itelj,kkk,l,kkll,m,isubchap
3691 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp
3692 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i
3693 real(kind=8) :: dxj,dyj,dzj,dx_normj,dy_normj,dz_normj,xj,yj,zj,&
3694 rij,r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,&
3695 evdwij,el1,el2,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
3696 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
3697 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
3698 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
3699 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
3700 ecosgp,ecosam,ecosbm,ecosgm,ghalf
3702 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
3703 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
3705 ! time00=MPI_Wtime()
3706 !d write (iout,*) "eelecij",i,j
3710 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3711 aaa=app(iteli,itelj)
3712 bbb=bpp(iteli,itelj)
3713 ael6i=ael6(iteli,itelj)
3714 ael3i=ael3(iteli,itelj)
3718 dx_normj=dc_norm(1,j)
3719 dy_normj=dc_norm(2,j)
3720 dz_normj=dc_norm(3,j)
3721 ! xj=c(1,j)+0.5D0*dxj-xmedi
3722 ! yj=c(2,j)+0.5D0*dyj-ymedi
3723 ! zj=c(3,j)+0.5D0*dzj-zmedi
3728 if (xj.lt.0) xj=xj+boxxsize
3730 if (yj.lt.0) yj=yj+boxysize
3732 if (zj.lt.0) zj=zj+boxzsize
3733 if ((zj.gt.bordlipbot) &
3734 .and.(zj.lt.bordliptop)) then
3735 !C the energy transfer exist
3736 if (zj.lt.buflipbot) then
3737 !C what fraction I am in
3739 ((zj-bordlipbot)/lipbufthick)
3740 !C lipbufthick is thickenes of lipid buffore
3741 sslipj=sscalelip(fracinbuf)
3742 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
3743 elseif (zj.gt.bufliptop) then
3744 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
3745 sslipj=sscalelip(fracinbuf)
3746 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
3757 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3764 xj=xj_safe+xshift*boxxsize
3765 yj=yj_safe+yshift*boxysize
3766 zj=zj_safe+zshift*boxzsize
3767 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3768 if(dist_temp.lt.dist_init) then
3778 if (isubchap.eq.1) then
3789 rij=xj*xj+yj*yj+zj*zj
3792 !C print *,xmedi,ymedi,zmedi,xj,yj,zj,boxxsize,rij
3793 sss_ele_cut=sscale_ele(rij)
3794 sss_ele_grad=sscagrad_ele(rij)
3796 ! sss_ele_grad=0.0d0
3797 ! print *,sss_ele_cut,sss_ele_grad,&
3798 ! (rij),r_cut_ele,rlamb_ele
3799 ! if (sss_ele_cut.le.0.0) go to 128
3804 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3805 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3806 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3807 fac=cosa-3.0D0*cosb*cosg
3809 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3810 if (j.eq.i+2) ev1=scal_el*ev1
3815 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3818 if (shield_mode.gt.0) then
3819 !C fac_shield(i)=0.4
3820 !C fac_shield(j)=0.6
3821 el1=el1*fac_shield(i)**2*fac_shield(j)**2
3822 el2=el2*fac_shield(i)**2*fac_shield(j)**2
3824 ees=ees+eesij*sss_ele_cut
3825 !C FOR NOW SHIELD IS NOT USED WITH LIPSCALE
3826 !C & *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3832 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)*sss_ele_cut
3833 !C print *,"TUCC",(sslipi+sslipj)/2.0d0*lipscale**2+1.0d0
3836 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
3837 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3838 ! ees=ees+eesij*sss_ele_cut
3839 evdw1=evdw1+evdwij*sss_ele_cut &
3840 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3841 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3842 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3843 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3844 !d & xmedi,ymedi,zmedi,xj,yj,zj
3846 if (energy_dec) then
3847 ! write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)') &
3848 ! 'evdw1',i,j,evdwij,&
3849 ! iteli,itelj,aaa,evdw1
3850 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3851 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3854 ! Calculate contributions to the Cartesian gradient.
3857 facvdw=-6*rrmij*(ev1+evdwij)*sss_ele_cut &
3858 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3859 facel=-3*rrmij*(el1+eesij)*sss_ele_cut &
3860 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3866 ! Radial derivatives. First process both termini of the fragment (i,j)
3868 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj* &
3869 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3870 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj* &
3871 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3872 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj* &
3873 ((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3875 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
3876 (shield_mode.gt.0)) then
3878 do ilist=1,ishield_list(i)
3879 iresshield=shield_list(ilist,i)
3881 rlocshield=grad_shield_side(k,ilist,i)*eesij/fac_shield(i)&
3883 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3885 +grad_shield_loc(k,ilist,i)*eesij/fac_shield(i)*2.0 &
3887 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3890 do ilist=1,ishield_list(j)
3891 iresshield=shield_list(ilist,j)
3893 rlocshield=grad_shield_side(k,ilist,j)*eesij/fac_shield(j) &
3895 gshieldx(k,iresshield)=gshieldx(k,iresshield)+ &
3897 +grad_shield_loc(k,ilist,j)*eesij/fac_shield(j)*2.0 &
3899 gshieldc(k,iresshield-1)=gshieldc(k,iresshield-1)+rlocshield
3903 gshieldc(k,i)=gshieldc(k,i)+ &
3904 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3907 gshieldc(k,j)=gshieldc(k,j)+ &
3908 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3911 gshieldc(k,i-1)=gshieldc(k,i-1)+ &
3912 grad_shield(k,i)*eesij/fac_shield(i)*2.0 &
3915 gshieldc(k,j-1)=gshieldc(k,j-1)+ &
3916 grad_shield(k,j)*eesij/fac_shield(j)*2.0 &
3924 ! ghalf=0.5D0*ggg(k)
3925 ! gelc(k,i)=gelc(k,i)+ghalf
3926 ! gelc(k,j)=gelc(k,j)+ghalf
3928 ! 9/28/08 AL Gradient compotents will be summed only at the end
3930 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3931 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3933 gelc_long(3,j)=gelc_long(3,j)+ &
3934 ssgradlipj*eesij/2.0d0*lipscale**2&
3937 gelc_long(3,i)=gelc_long(3,i)+ &
3938 ssgradlipi*eesij/2.0d0*lipscale**2&
3943 ! Loop over residues i+1 thru j-1.
3947 !grad gelc(l,k)=gelc(l,k)+ggg(l)
3950 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj &
3951 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3952 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj &
3953 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3954 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj &
3955 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3958 ! ghalf=0.5D0*ggg(k)
3959 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3960 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3962 ! 9/28/08 AL Gradient compotents will be summed only at the end
3964 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3965 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3968 !C Lipidic part for scaling weight
3969 gvdwpp(3,j)=gvdwpp(3,j)+ &
3970 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
3971 gvdwpp(3,i)=gvdwpp(3,i)+ &
3972 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
3973 !! Loop over residues i+1 thru j-1.
3977 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3981 facvdw=(ev1+evdwij)*sss_ele_cut &
3982 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
3984 facel=(el1+eesij)*sss_ele_cut
3986 fac=-3*rrmij*(facvdw+facvdw+facel)
3991 ! Radial derivatives. First process both termini of the fragment (i,j)
3993 ggg(1)=fac*xj+sss_ele_grad*rmij*(eesij+evdwij)*xj
3994 ggg(2)=fac*yj+sss_ele_grad*rmij*(eesij+evdwij)*yj
3995 ggg(3)=fac*zj+sss_ele_grad*rmij*(eesij+evdwij)*zj
3997 ! ghalf=0.5D0*ggg(k)
3998 ! gelc(k,i)=gelc(k,i)+ghalf
3999 ! gelc(k,j)=gelc(k,j)+ghalf
4001 ! 9/28/08 AL Gradient compotents will be summed only at the end
4003 gelc_long(k,j)=gelc(k,j)+ggg(k)
4004 gelc_long(k,i)=gelc(k,i)-ggg(k)
4007 ! Loop over residues i+1 thru j-1.
4011 !grad gelc(l,k)=gelc(l,k)+ggg(l)
4014 ! 9/28/08 AL Gradient compotents will be summed only at the end
4016 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4018 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4020 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4023 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
4024 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
4026 gvdwpp(3,j)=gvdwpp(3,j)+ &
4027 sss_ele_cut*ssgradlipj*evdwij/2.0d0*lipscale**2
4028 gvdwpp(3,i)=gvdwpp(3,i)+ &
4029 sss_ele_cut*ssgradlipi*evdwij/2.0d0*lipscale**2
4035 ecosa=2.0D0*fac3*fac1+fac4
4038 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
4039 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
4041 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4042 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4044 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
4045 !d & (dcosg(k),k=1,3)
4047 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k))*sss_ele_cut &
4048 *fac_shield(i)**2*fac_shield(j)**2 &
4049 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4053 ! ghalf=0.5D0*ggg(k)
4054 ! gelc(k,i)=gelc(k,i)+ghalf
4055 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
4056 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4057 ! gelc(k,j)=gelc(k,j)+ghalf
4058 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
4059 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4063 !grad gelc(l,k)=gelc(l,k)+ggg(l)
4067 gelc(k,i)=gelc(k,i) &
4068 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4069 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
4071 *fac_shield(i)**2*fac_shield(j)**2 &
4072 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4074 gelc(k,j)=gelc(k,j) &
4075 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4076 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
4078 *fac_shield(i)**2*fac_shield(j)**2 &
4079 *((sslipi+sslipj)/2.0d0*lipscale**2+1.0d0)
4081 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4082 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4085 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
4086 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
4087 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4089 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
4090 ! energy of a peptide unit is assumed in the form of a second-order
4091 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
4092 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
4093 ! are computed for EVERY pair of non-contiguous peptide groups.
4095 if (j.lt.nres-1) then
4106 muij(kkk)=mu(k,i)*mu(l,j)
4108 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
4109 !c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
4110 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
4111 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
4112 !c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
4113 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
4118 !d write (iout,*) 'EELEC: i',i,' j',j
4119 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
4120 !d write(iout,*) 'muij',muij
4121 ury=scalar(uy(1,i),erij)
4122 urz=scalar(uz(1,i),erij)
4123 vry=scalar(uy(1,j),erij)
4124 vrz=scalar(uz(1,j),erij)
4125 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
4126 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
4127 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
4128 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
4129 fac=dsqrt(-ael6i)*r3ij
4134 !d write (iout,'(4i5,4f10.5)')
4135 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
4136 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
4137 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
4138 !d & uy(:,j),uz(:,j)
4139 !d write (iout,'(4f10.5)')
4140 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
4141 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
4142 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
4143 !d write (iout,'(9f10.5/)')
4144 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
4145 ! Derivatives of the elements of A in virtual-bond vectors
4146 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
4148 uryg(k,1)=scalar(erder(1,k),uy(1,i))
4149 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
4150 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
4151 urzg(k,1)=scalar(erder(1,k),uz(1,i))
4152 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
4153 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
4154 vryg(k,1)=scalar(erder(1,k),uy(1,j))
4155 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
4156 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
4157 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
4158 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
4159 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
4161 ! Compute radial contributions to the gradient
4179 ! Add the contributions coming from er
4182 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
4183 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
4184 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
4185 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
4188 ! Derivatives in DC(i)
4189 !grad ghalf1=0.5d0*agg(k,1)
4190 !grad ghalf2=0.5d0*agg(k,2)
4191 !grad ghalf3=0.5d0*agg(k,3)
4192 !grad ghalf4=0.5d0*agg(k,4)
4193 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
4194 -3.0d0*uryg(k,2)*vry)!+ghalf1
4195 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
4196 -3.0d0*uryg(k,2)*vrz)!+ghalf2
4197 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
4198 -3.0d0*urzg(k,2)*vry)!+ghalf3
4199 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
4200 -3.0d0*urzg(k,2)*vrz)!+ghalf4
4201 ! Derivatives in DC(i+1)
4202 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
4203 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
4204 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
4205 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
4206 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
4207 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
4208 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
4209 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
4210 ! Derivatives in DC(j)
4211 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
4212 -3.0d0*vryg(k,2)*ury)!+ghalf1
4213 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
4214 -3.0d0*vrzg(k,2)*ury)!+ghalf2
4215 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
4216 -3.0d0*vryg(k,2)*urz)!+ghalf3
4217 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
4218 -3.0d0*vrzg(k,2)*urz)!+ghalf4
4219 ! Derivatives in DC(j+1) or DC(nres-1)
4220 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
4221 -3.0d0*vryg(k,3)*ury)
4222 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
4223 -3.0d0*vrzg(k,3)*ury)
4224 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
4225 -3.0d0*vryg(k,3)*urz)
4226 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
4227 -3.0d0*vrzg(k,3)*urz)
4228 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
4230 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
4243 aggi(k,l)=-aggi(k,l)
4244 aggi1(k,l)=-aggi1(k,l)
4245 aggj(k,l)=-aggj(k,l)
4246 aggj1(k,l)=-aggj1(k,l)
4249 if (j.lt.nres-1) then
4255 aggi(k,l)=-aggi(k,l)
4256 aggi1(k,l)=-aggi1(k,l)
4257 aggj(k,l)=-aggj(k,l)
4258 aggj1(k,l)=-aggj1(k,l)
4269 aggi(k,l)=-aggi(k,l)
4270 aggi1(k,l)=-aggi1(k,l)
4271 aggj(k,l)=-aggj(k,l)
4272 aggj1(k,l)=-aggj1(k,l)
4277 IF (wel_loc.gt.0.0d0) THEN
4278 ! Contribution to the local-electrostatic energy coming from the i-j pair
4279 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
4281 if (shield_mode.eq.0) then
4285 eel_loc_ij=eel_loc_ij &
4286 *fac_shield(i)*fac_shield(j) &
4287 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4288 !C Now derivative over eel_loc
4289 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4290 (shield_mode.gt.0)) then
4293 do ilist=1,ishield_list(i)
4294 iresshield=shield_list(ilist,i)
4296 rlocshield=grad_shield_side(k,ilist,i)*eel_loc_ij &
4299 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
4301 +grad_shield_loc(k,ilist,i)*eel_loc_ij/fac_shield(i) &
4304 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
4308 do ilist=1,ishield_list(j)
4309 iresshield=shield_list(ilist,j)
4311 rlocshield=grad_shield_side(k,ilist,j)*eel_loc_ij &
4314 gshieldx_ll(k,iresshield)=gshieldx_ll(k,iresshield)+ &
4316 +grad_shield_loc(k,ilist,j)*eel_loc_ij/fac_shield(j) &
4319 gshieldc_ll(k,iresshield-1)=gshieldc_ll(k,iresshield-1)&
4326 gshieldc_ll(k,i)=gshieldc_ll(k,i)+ &
4327 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
4329 gshieldc_ll(k,j)=gshieldc_ll(k,j)+ &
4330 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
4332 gshieldc_ll(k,i-1)=gshieldc_ll(k,i-1)+ &
4333 grad_shield(k,i)*eel_loc_ij/fac_shield(i) &
4335 gshieldc_ll(k,j-1)=gshieldc_ll(k,j-1)+ &
4336 grad_shield(k,j)*eel_loc_ij/fac_shield(j) &
4343 geel_loc_ij=(a22*gmuij1(1)&
4347 *fac_shield(i)*fac_shield(j)&
4350 !c write(iout,*) "derivative over thatai"
4351 !c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4353 gloc(nphi+i,icg)=gloc(nphi+i,icg)+&
4355 !c write(iout,*) "derivative over thatai-1"
4356 !c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4363 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+&
4364 geel_loc_ij*wel_loc&
4365 *fac_shield(i)*fac_shield(j)&
4369 !c Derivative over j residue
4370 geel_loc_ji=a22*gmuji1(1)&
4374 !c write(iout,*) "derivative over thataj"
4375 !c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4378 gloc(nphi+j,icg)=gloc(nphi+j,icg)+&
4379 geel_loc_ji*wel_loc&
4380 *fac_shield(i)*fac_shield(j)&
4389 !c write(iout,*) "derivative over thataj-1"
4390 !c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4392 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+&
4393 geel_loc_ji*wel_loc&
4394 *fac_shield(i)*fac_shield(j)&
4398 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4400 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4401 ! 'eelloc',i,j,eel_loc_ij
4402 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,8f8.3)') &
4403 'eelloc',i,j,eel_loc_ij,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4404 ! print *,"EELLOC",i,gel_loc_loc(i-1)
4406 ! if (energy_dec) write (iout,*) "a22",a22," a23",a23," a32",a32," a33",a33
4407 ! if (energy_dec) write (iout,*) "muij",muij
4408 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
4410 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
4411 ! Partial derivatives in virtual-bond dihedral angles gamma
4413 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
4414 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
4415 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
4417 *fac_shield(i)*fac_shield(j) &
4418 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4420 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
4421 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
4422 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
4424 *fac_shield(i)*fac_shield(j) &
4425 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4426 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4428 ! ggg(1)=(agg(1,1)*muij(1)+ &
4429 ! agg(1,2)*muij(2)+agg(1,3)*muij(3)+agg(1,4)*muij(4)) &
4431 ! +eel_loc_ij*sss_ele_grad*rmij*xj
4432 ! ggg(2)=(agg(2,1)*muij(1)+ &
4433 ! agg(2,2)*muij(2)+agg(2,3)*muij(3)+agg(2,4)*muij(4)) &
4435 ! +eel_loc_ij*sss_ele_grad*rmij*yj
4436 ! ggg(3)=(agg(3,1)*muij(1)+ &
4437 ! agg(3,2)*muij(2)+agg(3,3)*muij(3)+agg(3,4)*muij(4)) &
4439 ! +eel_loc_ij*sss_ele_grad*rmij*zj
4445 ggg(l)=(agg(l,1)*muij(1)+ &
4446 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
4448 *fac_shield(i)*fac_shield(j) &
4449 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0) &
4450 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4453 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4454 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4455 !grad ghalf=0.5d0*ggg(l)
4456 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
4457 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
4459 gel_loc_long(3,j)=gel_loc_long(3,j)+ &
4460 ssgradlipj*eel_loc_ij/2.0d0*lipscale/ &
4461 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
4463 gel_loc_long(3,i)=gel_loc_long(3,i)+ &
4464 ssgradlipi*eel_loc_ij/2.0d0*lipscale/ &
4465 ((sslipi+sslipj)/2.0d0*lipscale+1.0d0)*sss_ele_cut
4469 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4472 ! Remaining derivatives of eello
4474 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
4475 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
4477 *fac_shield(i)*fac_shield(j) &
4478 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4480 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4481 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
4482 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3) &
4483 +aggi1(l,4)*muij(4))&
4485 *fac_shield(i)*fac_shield(j) &
4486 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4488 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4489 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
4490 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
4492 *fac_shield(i)*fac_shield(j) &
4493 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4495 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4496 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
4497 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3) &
4498 +aggj1(l,4)*muij(4))&
4500 *fac_shield(i)*fac_shield(j) &
4501 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4503 !+eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
4506 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
4507 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
4508 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
4509 .and. num_conti.le.maxconts) then
4510 ! write (iout,*) i,j," entered corr"
4512 ! Calculate the contact function. The ith column of the array JCONT will
4513 ! contain the numbers of atoms that make contacts with the atom I (of numbers
4514 ! greater than I). The arrays FACONT and GACONT will contain the values of
4515 ! the contact function and its derivative.
4516 ! r0ij=1.02D0*rpp(iteli,itelj)
4517 ! r0ij=1.11D0*rpp(iteli,itelj)
4518 r0ij=2.20D0*rpp(iteli,itelj)
4519 ! r0ij=1.55D0*rpp(iteli,itelj)
4520 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4521 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
4522 if (fcont.gt.0.0D0) then
4523 num_conti=num_conti+1
4524 if (num_conti.gt.maxconts) then
4525 !el write (iout,*) "esrgresgdsrgdfsrgdswrgaresfgaerwgae"
4526 !el write (iout,*) "num_conti",num_conti, "maxconts",maxconts
4527 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
4528 ' will skip next contacts for this conf.', num_conti
4530 jcont_hb(num_conti,i)=j
4531 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
4532 !d & " jcont_hb",jcont_hb(num_conti,i)
4533 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
4534 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4535 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4537 d_cont(num_conti,i)=rij
4538 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4539 ! --- Electrostatic-interaction matrix ---
4540 a_chuj(1,1,num_conti,i)=a22
4541 a_chuj(1,2,num_conti,i)=a23
4542 a_chuj(2,1,num_conti,i)=a32
4543 a_chuj(2,2,num_conti,i)=a33
4544 ! --- Gradient of rij
4546 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4553 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4554 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4555 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4556 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4557 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4562 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4563 ! Calculate contact energies
4565 wij=cosa-3.0D0*cosb*cosg
4568 ! fac3=dsqrt(-ael6i)/r0ij**3
4569 fac3=dsqrt(-ael6i)*r3ij
4570 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4571 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4572 if (ees0tmp.gt.0) then
4573 ees0pij=dsqrt(ees0tmp)
4577 if (shield_mode.eq.0) then
4581 ees0plist(num_conti,i)=j
4583 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4584 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4585 if (ees0tmp.gt.0) then
4586 ees0mij=dsqrt(ees0tmp)
4591 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
4593 *fac_shield(i)*fac_shield(j)
4595 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
4597 *fac_shield(i)*fac_shield(j)
4599 ! Diagnostics. Comment out or remove after debugging!
4600 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4601 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4602 ! ees0m(num_conti,i)=0.0D0
4604 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4605 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4606 ! Angular derivatives of the contact function
4607 ees0pij1=fac3/ees0pij
4608 ees0mij1=fac3/ees0mij
4609 fac3p=-3.0D0*fac3*rrmij
4610 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4611 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4613 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4614 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4615 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4616 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4617 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4618 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4619 ecosap=ecosa1+ecosa2
4620 ecosbp=ecosb1+ecosb2
4621 ecosgp=ecosg1+ecosg2
4622 ecosam=ecosa1-ecosa2
4623 ecosbm=ecosb1-ecosb2
4624 ecosgm=ecosg1-ecosg2
4633 facont_hb(num_conti,i)=fcont
4634 fprimcont=fprimcont/rij
4635 !d facont_hb(num_conti,i)=1.0D0
4636 ! Following line is for diagnostics.
4639 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4640 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4643 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4644 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4646 gggp(1)=gggp(1)+ees0pijp*xj &
4647 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
4648 gggp(2)=gggp(2)+ees0pijp*yj &
4649 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
4650 gggp(3)=gggp(3)+ees0pijp*zj &
4651 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
4653 gggm(1)=gggm(1)+ees0mijp*xj &
4654 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
4656 gggm(2)=gggm(2)+ees0mijp*yj &
4657 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
4659 gggm(3)=gggm(3)+ees0mijp*zj &
4660 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
4662 ! Derivatives due to the contact function
4663 gacont_hbr(1,num_conti,i)=fprimcont*xj
4664 gacont_hbr(2,num_conti,i)=fprimcont*yj
4665 gacont_hbr(3,num_conti,i)=fprimcont*zj
4668 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
4669 ! following the change of gradient-summation algorithm.
4671 !grad ghalfp=0.5D0*gggp(k)
4672 !grad ghalfm=0.5D0*gggm(k)
4673 gacontp_hb1(k,num_conti,i)= & !ghalfp+
4674 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4675 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
4676 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4678 gacontp_hb2(k,num_conti,i)= & !ghalfp+
4679 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4680 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
4681 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4683 gacontp_hb3(k,num_conti,i)=gggp(k) &
4684 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4686 gacontm_hb1(k,num_conti,i)= & !ghalfm+
4687 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
4688 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
4689 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4691 gacontm_hb2(k,num_conti,i)= & !ghalfm+
4692 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
4693 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
4694 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4696 gacontm_hb3(k,num_conti,i)=gggm(k) &
4697 *sss_ele_cut*fac_shield(i)*fac_shield(j)
4700 ! Diagnostics. Comment out or remove after debugging!
4702 !diag gacontp_hb1(k,num_conti,i)=0.0D0
4703 !diag gacontp_hb2(k,num_conti,i)=0.0D0
4704 !diag gacontp_hb3(k,num_conti,i)=0.0D0
4705 !diag gacontm_hb1(k,num_conti,i)=0.0D0
4706 !diag gacontm_hb2(k,num_conti,i)=0.0D0
4707 !diag gacontm_hb3(k,num_conti,i)=0.0D0
4710 endif ! num_conti.le.maxconts
4713 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4716 ghalf=0.5d0*agg(l,k)
4717 aggi(l,k)=aggi(l,k)+ghalf
4718 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4719 aggj(l,k)=aggj(l,k)+ghalf
4722 if (j.eq.nres-1 .and. i.lt.j-2) then
4725 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4731 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
4733 end subroutine eelecij
4734 !-----------------------------------------------------------------------------
4735 subroutine eturn3(i,eello_turn3)
4736 ! Third- and fourth-order contributions from turns
4739 ! implicit real*8 (a-h,o-z)
4740 ! include 'DIMENSIONS'
4741 ! include 'COMMON.IOUNITS'
4742 ! include 'COMMON.GEO'
4743 ! include 'COMMON.VAR'
4744 ! include 'COMMON.LOCAL'
4745 ! include 'COMMON.CHAIN'
4746 ! include 'COMMON.DERIV'
4747 ! include 'COMMON.INTERACT'
4748 ! include 'COMMON.CONTACTS'
4749 ! include 'COMMON.TORSION'
4750 ! include 'COMMON.VECTORS'
4751 ! include 'COMMON.FFIELD'
4752 ! include 'COMMON.CONTROL'
4753 real(kind=8),dimension(3) :: ggg
4754 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4755 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2,gpizda1,&
4756 gpizda2,auxgmat1,auxgmatt1,auxgmat2,auxgmatt2
4758 real(kind=8),dimension(2) :: auxvec,auxvec1
4759 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4760 real(kind=8),dimension(2,2) :: auxmat3 !el, a_temp
4761 !el integer :: num_conti,j1,j2
4762 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
4763 !el dz_normi,xmedi,ymedi,zmedi
4765 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
4766 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
4769 integer :: i,j,l,k,ilist,iresshield
4770 real(kind=8) :: eello_turn3,zj,fracinbuf,eello_t3, rlocshield
4773 ! write (iout,*) "eturn3",i,j,j1,j2
4774 zj=(c(3,j)+c(3,j+1))/2.0d0
4776 if (zj.lt.0) zj=zj+boxzsize
4777 if ((zj.lt.0)) write (*,*) "CHUJ"
4778 if ((zj.gt.bordlipbot) &
4779 .and.(zj.lt.bordliptop)) then
4780 !C the energy transfer exist
4781 if (zj.lt.buflipbot) then
4782 !C what fraction I am in
4784 ((zj-bordlipbot)/lipbufthick)
4785 !C lipbufthick is thickenes of lipid buffore
4786 sslipj=sscalelip(fracinbuf)
4787 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
4788 elseif (zj.gt.bufliptop) then
4789 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
4790 sslipj=sscalelip(fracinbuf)
4791 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
4805 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4807 ! Third-order contributions
4814 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4815 !d call checkint_turn3(i,a_temp,eello_turn3_num)
4816 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4817 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4818 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4819 call transpose2(auxmat(1,1),auxmat1(1,1))
4820 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4821 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4822 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4823 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4824 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4826 if (shield_mode.eq.0) then
4831 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2)) &
4832 *fac_shield(i)*fac_shield(j) &
4833 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4835 0.5d0*(pizda(1,1)+pizda(2,2)) &
4836 *fac_shield(i)*fac_shield(j)
4838 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
4839 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4841 !C Derivatives in theta
4842 gloc(nphi+i,icg)=gloc(nphi+i,icg) &
4843 +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3&
4844 *fac_shield(i)*fac_shield(j)
4845 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)&
4846 +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3&
4847 *fac_shield(i)*fac_shield(j)
4852 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
4853 (shield_mode.gt.0)) then
4856 do ilist=1,ishield_list(i)
4857 iresshield=shield_list(ilist,i)
4859 rlocshield=grad_shield_side(k,ilist,i)*eello_t3/fac_shield(i)
4860 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4862 +grad_shield_loc(k,ilist,i)*eello_t3/fac_shield(i)
4863 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4867 do ilist=1,ishield_list(j)
4868 iresshield=shield_list(ilist,j)
4870 rlocshield=grad_shield_side(k,ilist,j)*eello_t3/fac_shield(j)
4871 gshieldx_t3(k,iresshield)=gshieldx_t3(k,iresshield)+ &
4873 +grad_shield_loc(k,ilist,j)*eello_t3/fac_shield(j)
4874 gshieldc_t3(k,iresshield-1)=gshieldc_t3(k,iresshield-1) &
4881 gshieldc_t3(k,i)=gshieldc_t3(k,i)+ &
4882 grad_shield(k,i)*eello_t3/fac_shield(i)
4883 gshieldc_t3(k,j)=gshieldc_t3(k,j)+ &
4884 grad_shield(k,j)*eello_t3/fac_shield(j)
4885 gshieldc_t3(k,i-1)=gshieldc_t3(k,i-1)+ &
4886 grad_shield(k,i)*eello_t3/fac_shield(i)
4887 gshieldc_t3(k,j-1)=gshieldc_t3(k,j-1)+ &
4888 grad_shield(k,j)*eello_t3/fac_shield(j)
4892 !d write (2,*) 'i,',i,' j',j,'eello_turn3',
4893 !d & 0.5d0*(pizda(1,1)+pizda(2,2)),
4894 !d & ' eello_turn3_num',4*eello_turn3_num
4895 ! Derivatives in gamma(i)
4896 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4897 call transpose2(auxmat2(1,1),auxmat3(1,1))
4898 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4899 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))&
4900 *fac_shield(i)*fac_shield(j) &
4901 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4902 ! Derivatives in gamma(i+1)
4903 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4904 call transpose2(auxmat2(1,1),auxmat3(1,1))
4905 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4906 gel_loc_turn3(i+1)=gel_loc_turn3(i+1) &
4907 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4908 *fac_shield(i)*fac_shield(j) &
4909 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4911 ! Cartesian derivatives
4913 ! ghalf1=0.5d0*agg(l,1)
4914 ! ghalf2=0.5d0*agg(l,2)
4915 ! ghalf3=0.5d0*agg(l,3)
4916 ! ghalf4=0.5d0*agg(l,4)
4917 a_temp(1,1)=aggi(l,1)!+ghalf1
4918 a_temp(1,2)=aggi(l,2)!+ghalf2
4919 a_temp(2,1)=aggi(l,3)!+ghalf3
4920 a_temp(2,2)=aggi(l,4)!+ghalf4
4921 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4922 gcorr3_turn(l,i)=gcorr3_turn(l,i) &
4923 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4924 *fac_shield(i)*fac_shield(j) &
4925 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4927 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4928 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4929 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4930 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4931 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4932 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1) &
4933 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4934 *fac_shield(i)*fac_shield(j) &
4935 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4937 a_temp(1,1)=aggj(l,1)!+ghalf1
4938 a_temp(1,2)=aggj(l,2)!+ghalf2
4939 a_temp(2,1)=aggj(l,3)!+ghalf3
4940 a_temp(2,2)=aggj(l,4)!+ghalf4
4941 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4942 gcorr3_turn(l,j)=gcorr3_turn(l,j) &
4943 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4944 *fac_shield(i)*fac_shield(j) &
4945 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4947 a_temp(1,1)=aggj1(l,1)
4948 a_temp(1,2)=aggj1(l,2)
4949 a_temp(2,1)=aggj1(l,3)
4950 a_temp(2,2)=aggj1(l,4)
4951 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4952 gcorr3_turn(l,j1)=gcorr3_turn(l,j1) &
4953 +0.5d0*(pizda(1,1)+pizda(2,2)) &
4954 *fac_shield(i)*fac_shield(j) &
4955 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
4957 gshieldc_t3(3,i)=gshieldc_t3(3,i)+ &
4958 ssgradlipi*eello_t3/4.0d0*lipscale
4959 gshieldc_t3(3,j)=gshieldc_t3(3,j)+ &
4960 ssgradlipj*eello_t3/4.0d0*lipscale
4961 gshieldc_t3(3,i-1)=gshieldc_t3(3,i-1)+ &
4962 ssgradlipi*eello_t3/4.0d0*lipscale
4963 gshieldc_t3(3,j-1)=gshieldc_t3(3,j-1)+ &
4964 ssgradlipj*eello_t3/4.0d0*lipscale
4967 end subroutine eturn3
4968 !-----------------------------------------------------------------------------
4969 subroutine eturn4(i,eello_turn4)
4970 ! Third- and fourth-order contributions from turns
4973 ! implicit real*8 (a-h,o-z)
4974 ! include 'DIMENSIONS'
4975 ! include 'COMMON.IOUNITS'
4976 ! include 'COMMON.GEO'
4977 ! include 'COMMON.VAR'
4978 ! include 'COMMON.LOCAL'
4979 ! include 'COMMON.CHAIN'
4980 ! include 'COMMON.DERIV'
4981 ! include 'COMMON.INTERACT'
4982 ! include 'COMMON.CONTACTS'
4983 ! include 'COMMON.TORSION'
4984 ! include 'COMMON.VECTORS'
4985 ! include 'COMMON.FFIELD'
4986 ! include 'COMMON.CONTROL'
4987 real(kind=8),dimension(3) :: ggg
4988 real(kind=8),dimension(2,2) :: auxmat,auxmat1,auxmat2,pizda,&
4989 e1t,e2t,e3t,e1tder,e2tder,e3tder,e1a,ae3,ae3e2,&
4991 gte1a,gtae3,gtae3e2, ae3gte2,&
4992 gtEpizda1,gtEpizda2,gtEpizda3
4994 real(kind=8),dimension(2) :: auxvec,auxvec1,auxgEvec1,auxgEvec2,&
4997 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
4998 real(kind=8),dimension(2,2) :: auxmat3 !el a_temp
4999 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
5000 !el dz_normi,xmedi,ymedi,zmedi
5001 !el integer :: num_conti,j1,j2
5002 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
5003 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
5006 integer :: i,j,iti1,iti2,iti3,l,k,ilist,iresshield
5007 real(kind=8) :: eello_turn4,s1,s2,s3,zj,fracinbuf,eello_t4,&
5008 rlocshield,gs23,gs32,gsE13,gs13,gs21,gsE31,gsEE1,gsEE2,gsEE3
5011 ! if (j.ne.20) return
5012 ! print *,i,j,gshieldc_t4(2,j),gshieldc_t4(2,j+1)
5013 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5015 ! Fourth-order contributions
5023 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5024 !d call checkint_turn4(i,a_temp,eello_turn4_num)
5025 ! write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
5026 zj=(c(3,j)+c(3,j+1))/2.0d0
5028 if (zj.lt.0) zj=zj+boxzsize
5029 if ((zj.gt.bordlipbot) &
5030 .and.(zj.lt.bordliptop)) then
5031 !C the energy transfer exist
5032 if (zj.lt.buflipbot) then
5033 !C what fraction I am in
5035 ((zj-bordlipbot)/lipbufthick)
5036 !C lipbufthick is thickenes of lipid buffore
5037 sslipj=sscalelip(fracinbuf)
5038 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
5039 elseif (zj.gt.bufliptop) then
5040 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
5041 sslipj=sscalelip(fracinbuf)
5042 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
5056 iti1=itortyp(itype(i+1,1))
5057 iti2=itortyp(itype(i+2,1))
5058 iti3=itortyp(itype(i+3,1))
5059 ! write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
5060 call transpose2(EUg(1,1,i+1),e1t(1,1))
5061 call transpose2(Eug(1,1,i+2),e2t(1,1))
5062 call transpose2(Eug(1,1,i+3),e3t(1,1))
5063 !C Ematrix derivative in theta
5064 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
5065 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
5066 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
5068 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5069 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5070 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
5071 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
5072 !c auxalary matrix of E i+1
5073 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
5074 s1=scalar2(b1(1,iti2),auxvec(1))
5075 !c derivative of theta i+2 with constant i+3
5076 gs23=scalar2(gtb1(1,i+2),auxvec(1))
5077 !c derivative of theta i+2 with constant i+2
5078 gs32=scalar2(b1(1,i+2),auxgvec(1))
5079 !c derivative of E matix in theta of i+1
5080 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
5082 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5083 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
5084 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5085 !c auxilary matrix auxgvec of Ub2 with constant E matirx
5086 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
5087 !c auxilary matrix auxgEvec1 of E matix with Ub2 constant
5088 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
5089 s2=scalar2(b1(1,iti1),auxvec(1))
5090 !c derivative of theta i+1 with constant i+3
5091 gs13=scalar2(gtb1(1,i+1),auxvec(1))
5092 !c derivative of theta i+2 with constant i+1
5093 gs21=scalar2(b1(1,i+1),auxgvec(1))
5094 !c derivative of theta i+3 with constant i+1
5095 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
5097 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5098 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
5099 !c ae3gte2 is derivative over i+2
5100 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
5102 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5103 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
5105 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
5107 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
5109 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5110 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
5111 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
5112 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
5113 if (shield_mode.eq.0) then
5118 eello_turn4=eello_turn4-(s1+s2+s3) &
5119 *fac_shield(i)*fac_shield(j) &
5120 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5121 eello_t4=-(s1+s2+s3) &
5122 *fac_shield(i)*fac_shield(j)
5123 !C Now derivative over shield:
5124 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
5125 (shield_mode.gt.0)) then
5128 do ilist=1,ishield_list(i)
5129 iresshield=shield_list(ilist,i)
5131 rlocshield=grad_shield_side(k,ilist,i)*eello_t4/fac_shield(i)
5132 ! print *,"rlocshield",rlocshield,grad_shield_side(k,ilist,i),iresshield
5133 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
5135 +grad_shield_loc(k,ilist,i)*eello_t4/fac_shield(i)
5136 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
5140 do ilist=1,ishield_list(j)
5141 iresshield=shield_list(ilist,j)
5143 ! print *,"rlocshieldj",j,rlocshield,grad_shield_side(k,ilist,j),iresshield
5144 rlocshield=grad_shield_side(k,ilist,j)*eello_t4/fac_shield(j)
5145 gshieldx_t4(k,iresshield)=gshieldx_t4(k,iresshield)+ &
5147 +grad_shield_loc(k,ilist,j)*eello_t4/fac_shield(j)
5148 gshieldc_t4(k,iresshield-1)=gshieldc_t4(k,iresshield-1) &
5150 ! print *,"after", gshieldc_t4(k,iresshield-1),iresshield-1,gshieldc_t4(k,iresshield)
5155 gshieldc_t4(k,i)=gshieldc_t4(k,i)+ &
5156 grad_shield(k,i)*eello_t4/fac_shield(i)
5157 gshieldc_t4(k,j)=gshieldc_t4(k,j)+ &
5158 grad_shield(k,j)*eello_t4/fac_shield(j)
5159 gshieldc_t4(k,i-1)=gshieldc_t4(k,i-1)+ &
5160 grad_shield(k,i)*eello_t4/fac_shield(i)
5161 gshieldc_t4(k,j-1)=gshieldc_t4(k,j-1)+ &
5162 grad_shield(k,j)*eello_t4/fac_shield(j)
5163 ! print *,"gshieldc_t4(k,j+1)",j,gshieldc_t4(k,j+1)
5167 gloc(nphi+i,icg)=gloc(nphi+i,icg)&
5168 -(gs13+gsE13+gsEE1)*wturn4&
5169 *fac_shield(i)*fac_shield(j)
5170 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)&
5171 -(gs23+gs21+gsEE2)*wturn4&
5172 *fac_shield(i)*fac_shield(j)
5174 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)&
5175 -(gs32+gsE31+gsEE3)*wturn4&
5176 *fac_shield(i)*fac_shield(j)
5178 !c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
5181 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
5182 'eturn4',i,j,-(s1+s2+s3)
5183 !d write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5184 !d & ' eello_turn4_num',8*eello_turn4_num
5185 ! Derivatives in gamma(i)
5186 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
5187 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
5188 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
5189 s1=scalar2(b1(1,iti2),auxvec(1))
5190 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
5191 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5192 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3) &
5193 *fac_shield(i)*fac_shield(j) &
5194 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5196 ! Derivatives in gamma(i+1)
5197 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
5198 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
5199 s2=scalar2(b1(1,iti1),auxvec(1))
5200 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
5201 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
5202 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5203 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3) &
5204 *fac_shield(i)*fac_shield(j) &
5205 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5207 ! Derivatives in gamma(i+2)
5208 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
5209 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
5210 s1=scalar2(b1(1,iti2),auxvec(1))
5211 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
5212 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
5213 s2=scalar2(b1(1,iti1),auxvec(1))
5214 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
5215 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
5216 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5217 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3) &
5218 *fac_shield(i)*fac_shield(j) &
5219 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5221 ! Cartesian derivatives
5222 ! Derivatives of this turn contributions in DC(i+2)
5223 if (j.lt.nres-1) then
5225 a_temp(1,1)=agg(l,1)
5226 a_temp(1,2)=agg(l,2)
5227 a_temp(2,1)=agg(l,3)
5228 a_temp(2,2)=agg(l,4)
5229 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5230 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5231 s1=scalar2(b1(1,iti2),auxvec(1))
5232 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5233 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5234 s2=scalar2(b1(1,iti1),auxvec(1))
5235 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5236 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5237 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5239 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)&
5240 *fac_shield(i)*fac_shield(j) &
5241 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5245 ! Remaining derivatives of this turn contribution
5247 a_temp(1,1)=aggi(l,1)
5248 a_temp(1,2)=aggi(l,2)
5249 a_temp(2,1)=aggi(l,3)
5250 a_temp(2,2)=aggi(l,4)
5251 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5252 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5253 s1=scalar2(b1(1,iti2),auxvec(1))
5254 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5255 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5256 s2=scalar2(b1(1,iti1),auxvec(1))
5257 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5258 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5259 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5260 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3) &
5261 *fac_shield(i)*fac_shield(j) &
5262 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5265 a_temp(1,1)=aggi1(l,1)
5266 a_temp(1,2)=aggi1(l,2)
5267 a_temp(2,1)=aggi1(l,3)
5268 a_temp(2,2)=aggi1(l,4)
5269 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5270 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5271 s1=scalar2(b1(1,iti2),auxvec(1))
5272 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5273 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5274 s2=scalar2(b1(1,iti1),auxvec(1))
5275 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5276 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5277 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5278 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3) &
5279 *fac_shield(i)*fac_shield(j) &
5280 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5283 a_temp(1,1)=aggj(l,1)
5284 a_temp(1,2)=aggj(l,2)
5285 a_temp(2,1)=aggj(l,3)
5286 a_temp(2,2)=aggj(l,4)
5287 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5288 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5289 s1=scalar2(b1(1,iti2),auxvec(1))
5290 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5291 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5292 s2=scalar2(b1(1,iti1),auxvec(1))
5293 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5294 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5295 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5296 ! if (j.lt.nres-1) then
5297 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3) &
5298 *fac_shield(i)*fac_shield(j) &
5299 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5302 a_temp(1,1)=aggj1(l,1)
5303 a_temp(1,2)=aggj1(l,2)
5304 a_temp(2,1)=aggj1(l,3)
5305 a_temp(2,2)=aggj1(l,4)
5306 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5307 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5308 s1=scalar2(b1(1,iti2),auxvec(1))
5309 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5310 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5311 s2=scalar2(b1(1,iti1),auxvec(1))
5312 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5313 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5314 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5315 ! write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
5316 ! if (j.lt.nres-1) then
5317 ! print *,"juest before",j1, gcorr4_turn(l,j1)
5318 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3) &
5319 *fac_shield(i)*fac_shield(j) &
5320 *((sslipi+sslipj)/2.0d0*lipscale+1.0d0)
5321 ! if (shield_mode.gt.0) then
5322 ! print *,"juest after",j1, gcorr4_turn(l,j1),gshieldc_t4(k,j1),gshieldc_loc_t4(k,j1),gel_loc_turn4(i+2)
5324 ! print *,"juest after",j1, gcorr4_turn(l,j1),gel_loc_turn4(i+2)
5328 gshieldc_t4(3,i)=gshieldc_t4(3,i)+ &
5329 ssgradlipi*eello_t4/4.0d0*lipscale
5330 gshieldc_t4(3,j)=gshieldc_t4(3,j)+ &
5331 ssgradlipj*eello_t4/4.0d0*lipscale
5332 gshieldc_t4(3,i-1)=gshieldc_t4(3,i-1)+ &
5333 ssgradlipi*eello_t4/4.0d0*lipscale
5334 gshieldc_t4(3,j-1)=gshieldc_t4(3,j-1)+ &
5335 ssgradlipj*eello_t4/4.0d0*lipscale
5338 end subroutine eturn4
5339 !-----------------------------------------------------------------------------
5340 subroutine unormderiv(u,ugrad,unorm,ungrad)
5341 ! This subroutine computes the derivatives of a normalized vector u, given
5342 ! the derivatives computed without normalization conditions, ugrad. Returns
5345 real(kind=8),dimension(3) :: u,vec
5346 real(kind=8),dimension(3,3) ::ugrad,ungrad
5347 real(kind=8) :: unorm !,scalar
5349 ! write (2,*) 'ugrad',ugrad
5352 vec(i)=scalar(ugrad(1,i),u(1))
5354 ! write (2,*) 'vec',vec
5357 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
5360 ! write (2,*) 'ungrad',ungrad
5362 end subroutine unormderiv
5363 !-----------------------------------------------------------------------------
5364 subroutine escp_soft_sphere(evdw2,evdw2_14)
5366 ! This subroutine calculates the excluded-volume interaction energy between
5367 ! peptide-group centers and side chains and its gradient in virtual-bond and
5368 ! side-chain vectors.
5370 ! implicit real*8 (a-h,o-z)
5371 ! include 'DIMENSIONS'
5372 ! include 'COMMON.GEO'
5373 ! include 'COMMON.VAR'
5374 ! include 'COMMON.LOCAL'
5375 ! include 'COMMON.CHAIN'
5376 ! include 'COMMON.DERIV'
5377 ! include 'COMMON.INTERACT'
5378 ! include 'COMMON.FFIELD'
5379 ! include 'COMMON.IOUNITS'
5380 ! include 'COMMON.CONTROL'
5381 real(kind=8),dimension(3) :: ggg
5383 integer :: i,iint,j,k,iteli,itypj
5384 real(kind=8) :: evdw2,evdw2_14,r0_scp,xi,yi,zi,xj,yj,zj,&
5385 fac,rij,r0ij,r0ijsq,evdwij,e1,e2
5390 !d print '(a)','Enter ESCP'
5391 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5392 do i=iatscp_s,iatscp_e
5393 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
5395 xi=0.5D0*(c(1,i)+c(1,i+1))
5396 yi=0.5D0*(c(2,i)+c(2,i+1))
5397 zi=0.5D0*(c(3,i)+c(3,i+1))
5399 do iint=1,nscp_gr(i)
5401 do j=iscpstart(i,iint),iscpend(i,iint)
5402 if (itype(j,1).eq.ntyp1) cycle
5403 itypj=iabs(itype(j,1))
5404 ! Uncomment following three lines for SC-p interactions
5408 ! Uncomment following three lines for Ca-p interactions
5412 rij=xj*xj+yj*yj+zj*zj
5415 if (rij.lt.r0ijsq) then
5416 evdwij=0.25d0*(rij-r0ijsq)**2
5424 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
5429 !grad if (j.lt.i) then
5430 !d write (iout,*) 'j<i'
5431 ! Uncomment following three lines for SC-p interactions
5433 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5436 !d write (iout,*) 'j>i'
5438 !grad ggg(k)=-ggg(k)
5439 ! Uncomment following line for SC-p interactions
5440 ! gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5444 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5446 !grad kstart=min0(i+1,j)
5447 !grad kend=max0(i-1,j-1)
5448 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5449 !d write (iout,*) ggg(1),ggg(2),ggg(3)
5450 !grad do k=kstart,kend
5452 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5456 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5457 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5464 end subroutine escp_soft_sphere
5465 !-----------------------------------------------------------------------------
5466 subroutine escp(evdw2,evdw2_14)
5468 ! This subroutine calculates the excluded-volume interaction energy between
5469 ! peptide-group centers and side chains and its gradient in virtual-bond and
5470 ! side-chain vectors.
5472 ! implicit real*8 (a-h,o-z)
5473 ! include 'DIMENSIONS'
5474 ! include 'COMMON.GEO'
5475 ! include 'COMMON.VAR'
5476 ! include 'COMMON.LOCAL'
5477 ! include 'COMMON.CHAIN'
5478 ! include 'COMMON.DERIV'
5479 ! include 'COMMON.INTERACT'
5480 ! include 'COMMON.FFIELD'
5481 ! include 'COMMON.IOUNITS'
5482 ! include 'COMMON.CONTROL'
5483 real(kind=8),dimension(3) :: ggg
5485 integer :: i,iint,j,k,iteli,itypj,subchap
5486 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
5488 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
5489 dist_temp, dist_init
5490 integer xshift,yshift,zshift
5494 !d print '(a)','Enter ESCP'
5495 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5496 do i=iatscp_s,iatscp_e
5497 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
5499 xi=0.5D0*(c(1,i)+c(1,i+1))
5500 yi=0.5D0*(c(2,i)+c(2,i+1))
5501 zi=0.5D0*(c(3,i)+c(3,i+1))
5503 if (xi.lt.0) xi=xi+boxxsize
5505 if (yi.lt.0) yi=yi+boxysize
5507 if (zi.lt.0) zi=zi+boxzsize
5509 do iint=1,nscp_gr(i)
5511 do j=iscpstart(i,iint),iscpend(i,iint)
5512 itypj=iabs(itype(j,1))
5513 if (itypj.eq.ntyp1) cycle
5514 ! Uncomment following three lines for SC-p interactions
5518 ! Uncomment following three lines for Ca-p interactions
5526 if (xj.lt.0) xj=xj+boxxsize
5528 if (yj.lt.0) yj=yj+boxysize
5530 if (zj.lt.0) zj=zj+boxzsize
5531 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5539 xj=xj_safe+xshift*boxxsize
5540 yj=yj_safe+yshift*boxysize
5541 zj=zj_safe+zshift*boxzsize
5542 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5543 if(dist_temp.lt.dist_init) then
5553 if (subchap.eq.1) then
5563 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5564 rij=dsqrt(1.0d0/rrij)
5565 sss_ele_cut=sscale_ele(rij)
5566 sss_ele_grad=sscagrad_ele(rij)
5567 ! print *,sss_ele_cut,sss_ele_grad,&
5568 ! (rij),r_cut_ele,rlamb_ele
5569 if (sss_ele_cut.le.0.0) cycle
5571 e1=fac*fac*aad(itypj,iteli)
5572 e2=fac*bad(itypj,iteli)
5573 if (iabs(j-i) .le. 2) then
5576 evdw2_14=evdw2_14+(e1+e2)*sss_ele_cut
5579 evdw2=evdw2+evdwij*sss_ele_cut
5580 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)') &
5581 ! 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),&
5582 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
5585 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
5587 fac=-(evdwij+e1)*rrij*sss_ele_cut
5588 fac=fac+evdwij*sss_ele_grad/rij/expon
5592 !grad if (j.lt.i) then
5593 !d write (iout,*) 'j<i'
5594 ! Uncomment following three lines for SC-p interactions
5596 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5599 !d write (iout,*) 'j>i'
5601 !grad ggg(k)=-ggg(k)
5602 ! Uncomment following line for SC-p interactions
5603 !cgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5604 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5608 !grad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5610 !grad kstart=min0(i+1,j)
5611 !grad kend=max0(i-1,j-1)
5612 !d write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5613 !d write (iout,*) ggg(1),ggg(2),ggg(3)
5614 !grad do k=kstart,kend
5616 !grad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5620 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5621 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5629 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5630 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5631 gradx_scp(j,i)=expon*gradx_scp(j,i)
5634 !******************************************************************************
5638 ! To save time the factor EXPON has been extracted from ALL components
5639 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
5642 !******************************************************************************
5645 !-----------------------------------------------------------------------------
5646 subroutine edis(ehpb)
5648 ! Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5650 ! implicit real*8 (a-h,o-z)
5651 ! include 'DIMENSIONS'
5652 ! include 'COMMON.SBRIDGE'
5653 ! include 'COMMON.CHAIN'
5654 ! include 'COMMON.DERIV'
5655 ! include 'COMMON.VAR'
5656 ! include 'COMMON.INTERACT'
5657 ! include 'COMMON.IOUNITS'
5658 real(kind=8),dimension(3) :: ggg
5660 integer :: i,j,ii,jj,iii,jjj,k
5661 real(kind=8) :: fac,eij,rdis,ehpb,dd,waga
5664 !d write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5665 !d write(iout,*)'link_start=',link_start,' link_end=',link_end
5666 if (link_end.eq.0) return
5667 do i=link_start,link_end
5668 ! If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5669 ! CA-CA distance used in regularization of structure.
5672 ! iii and jjj point to the residues for which the distance is assigned.
5673 if (ii.gt.nres) then
5680 ! write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5681 ! & dhpb(i),dhpb1(i),forcon(i)
5682 ! 24/11/03 AL: SS bridges handled separately because of introducing a specific
5683 ! distance and angle dependent SS bond potential.
5684 !mc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5685 ! 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5686 if (.not.dyn_ss .and. i.le.nss) then
5687 ! 15/02/13 CC dynamic SSbond - additional check
5688 if (ii.gt.nres .and. iabs(itype(iii,1)).eq.1 .and. &
5689 iabs(itype(jjj,1)).eq.1) then
5690 call ssbond_ene(iii,jjj,eij)
5692 !d write (iout,*) "eij",eij
5694 else if (ii.gt.nres .and. jj.gt.nres) then
5695 !c Restraints from contact prediction
5697 if (constr_dist.eq.11) then
5698 ehpb=ehpb+fordepth(i)**4.0d0 &
5699 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5700 fac=fordepth(i)**4.0d0 &
5701 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5702 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
5705 if (dhpb1(i).gt.0.0d0) then
5706 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5707 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5708 !c write (iout,*) "beta nmr",
5709 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5713 !C Get the force constant corresponding to this distance.
5715 !C Calculate the contribution to energy.
5716 ehpb=ehpb+waga*rdis*rdis
5717 !c write (iout,*) "beta reg",dd,waga*rdis*rdis
5719 !C Evaluate gradient.
5725 ggg(j)=fac*(c(j,jj)-c(j,ii))
5728 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5729 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5732 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5733 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5737 if (constr_dist.eq.11) then
5738 ehpb=ehpb+fordepth(i)**4.0d0 &
5739 *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5740 fac=fordepth(i)**4.0d0 &
5741 *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5742 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj, &
5745 if (dhpb1(i).gt.0.0d0) then
5746 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5747 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5748 !c write (iout,*) "alph nmr",
5749 !c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5752 !C Get the force constant corresponding to this distance.
5754 !C Calculate the contribution to energy.
5755 ehpb=ehpb+waga*rdis*rdis
5756 !c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5758 !C Evaluate gradient.
5765 ggg(j)=fac*(c(j,jj)-c(j,ii))
5767 !cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5768 !C If this is a SC-SC distance, we need to calculate the contributions to the
5769 !C Cartesian gradient in the SC vectors (ghpbx).
5772 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5773 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5776 !cgrad do j=iii,jjj-1
5778 !cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5782 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5783 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5787 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5791 !-----------------------------------------------------------------------------
5792 subroutine ssbond_ene(i,j,eij)
5794 ! Calculate the distance and angle dependent SS-bond potential energy
5795 ! using a free-energy function derived based on RHF/6-31G** ab initio
5796 ! calculations of diethyl disulfide.
5798 ! A. Liwo and U. Kozlowska, 11/24/03
5800 ! implicit real*8 (a-h,o-z)
5801 ! include 'DIMENSIONS'
5802 ! include 'COMMON.SBRIDGE'
5803 ! include 'COMMON.CHAIN'
5804 ! include 'COMMON.DERIV'
5805 ! include 'COMMON.LOCAL'
5806 ! include 'COMMON.INTERACT'
5807 ! include 'COMMON.VAR'
5808 ! include 'COMMON.IOUNITS'
5809 real(kind=8),dimension(3) :: erij,dcosom1,dcosom2,gg
5811 integer :: i,j,itypi,itypj,k
5812 real(kind=8) :: eij,rij,rrij,xi,yi,zi,dxi,dyi,dzi,dsci_inv,&
5813 xj,yj,zj,dxj,dyj,dzj,om1,om2,om12,deltad,dscj_inv,&
5814 deltat1,deltat2,deltat12,ed,pom1,pom2,eom1,eom2,eom12,&
5817 itypi=iabs(itype(i,1))
5821 dxi=dc_norm(1,nres+i)
5822 dyi=dc_norm(2,nres+i)
5823 dzi=dc_norm(3,nres+i)
5824 ! dsci_inv=dsc_inv(itypi)
5825 dsci_inv=vbld_inv(nres+i)
5826 itypj=iabs(itype(j,1))
5827 ! dscj_inv=dsc_inv(itypj)
5828 dscj_inv=vbld_inv(nres+j)
5832 dxj=dc_norm(1,nres+j)
5833 dyj=dc_norm(2,nres+j)
5834 dzj=dc_norm(3,nres+j)
5835 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5840 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5841 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5842 om12=dxi*dxj+dyi*dyj+dzi*dzj
5844 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5845 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5851 deltat12=om2-om1+2.0d0
5853 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2) &
5854 +akct*deltad*deltat12 &
5855 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5856 ! write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5857 ! & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5858 ! & " deltat12",deltat12," eij",eij
5859 ed=2*akcm*deltad+akct*deltat12
5861 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5862 eom1=-2*akth*deltat1-pom1-om2*pom2
5863 eom2= 2*akth*deltat2+pom1-om1*pom2
5866 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5867 ghpbx(k,i)=ghpbx(k,i)-ggk &
5868 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
5869 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5870 ghpbx(k,j)=ghpbx(k,j)+ggk &
5871 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
5872 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5873 ghpbc(k,i)=ghpbc(k,i)-ggk
5874 ghpbc(k,j)=ghpbc(k,j)+ggk
5877 ! Calculate the components of the gradient in DC and X
5881 !grad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5885 end subroutine ssbond_ene
5886 !-----------------------------------------------------------------------------
5887 subroutine ebond(estr)
5889 ! Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5891 ! implicit real*8 (a-h,o-z)
5892 ! include 'DIMENSIONS'
5893 ! include 'COMMON.LOCAL'
5894 ! include 'COMMON.GEO'
5895 ! include 'COMMON.INTERACT'
5896 ! include 'COMMON.DERIV'
5897 ! include 'COMMON.VAR'
5898 ! include 'COMMON.CHAIN'
5899 ! include 'COMMON.IOUNITS'
5900 ! include 'COMMON.NAMES'
5901 ! include 'COMMON.FFIELD'
5902 ! include 'COMMON.CONTROL'
5903 ! include 'COMMON.SETUP'
5904 real(kind=8),dimension(3) :: u,ud
5906 integer :: i,j,iti,nbi,k
5907 real(kind=8) :: estr,estr1,diff,uprod,usum,usumsqder,&
5912 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
5913 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
5915 do i=ibondp_start,ibondp_end
5916 if (itype(i-1,1).eq.ntyp1 .and. itype(i,1).eq.ntyp1) cycle
5917 if (itype(i-1,1).eq.ntyp1 .or. itype(i,1).eq.ntyp1) then
5918 !C estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5920 !C gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax) &
5921 !C *dc(j,i-1)/vbld(i)
5923 !C if (energy_dec) write(iout,*) &
5924 !C "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5925 diff = vbld(i)-vbldpDUM
5927 diff = vbld(i)-vbldp0
5929 if (energy_dec) write (iout,'(a7,i5,4f7.3)') &
5930 "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5933 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5935 ! write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5938 estr=0.5d0*AKP*estr+estr1
5939 ! print *,"estr_bb",estr,AKP
5941 ! 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5943 do i=ibond_start,ibond_end
5944 iti=iabs(itype(i,1))
5945 if (iti.eq.0) print *,"WARNING WRONG SETTTING",i
5946 if (iti.ne.10 .and. iti.ne.ntyp1) then
5949 diff=vbld(i+nres)-vbldsc0(1,iti)
5950 if (energy_dec) write (iout,*) &
5951 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5952 AKSC(1,iti),AKSC(1,iti)*diff*diff
5953 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5954 ! print *,"estr_sc",estr
5956 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5960 diff=vbld(i+nres)-vbldsc0(j,iti)
5961 ud(j)=aksc(j,iti)*diff
5962 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5976 uprod2=uprod2*u(k)*u(k)
5980 usumsqder=usumsqder+ud(j)*uprod2
5982 estr=estr+uprod/usum
5983 ! print *,"estr_sc",estr,i
5985 if (energy_dec) write (iout,*) &
5986 "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,&
5987 AKSC(1,iti),uprod/usum
5989 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5995 end subroutine ebond
5997 !-----------------------------------------------------------------------------
5998 subroutine ebend(etheta)
6000 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6001 ! angles gamma and its derivatives in consecutive thetas and gammas.
6004 ! implicit real*8 (a-h,o-z)
6005 ! include 'DIMENSIONS'
6006 ! include 'COMMON.LOCAL'
6007 ! include 'COMMON.GEO'
6008 ! include 'COMMON.INTERACT'
6009 ! include 'COMMON.DERIV'
6010 ! include 'COMMON.VAR'
6011 ! include 'COMMON.CHAIN'
6012 ! include 'COMMON.IOUNITS'
6013 ! include 'COMMON.NAMES'
6014 ! include 'COMMON.FFIELD'
6015 ! include 'COMMON.CONTROL'
6016 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
6017 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
6018 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
6020 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
6021 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
6022 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6024 integer :: i,k,ichir1,ichir2,itype1,ichir11,ichir12,itype2,&
6026 real(kind=8) :: etheta,delta,ss,ssd,phii,phii1,thet_pred_mean,&
6027 athetk,bthetk,dthett,dthetg1,dthetg2,f0,fprim0,E_tc0,fprim_tc0,&
6028 f1,fprim1,E_tc1,ethetai,E_theta,E_tc
6029 real(kind=8),dimension(2) :: y,z
6032 ! time11=dexp(-2*time)
6035 ! write (*,'(a,i2)') 'EBEND ICG=',icg
6036 do i=ithet_start,ithet_end
6037 if (itype(i-1,1).eq.ntyp1) cycle
6038 ! Zero the energy function and its derivative at 0 or pi.
6039 call splinthet(theta(i),0.5d0*delta,ss,ssd)
6041 ichir1=isign(1,itype(i-2,1))
6042 ichir2=isign(1,itype(i,1))
6043 if (itype(i-2,1).eq.10) ichir1=isign(1,itype(i-1,1))
6044 if (itype(i,1).eq.10) ichir2=isign(1,itype(i-1,1))
6045 if (itype(i-1,1).eq.10) then
6046 itype1=isign(10,itype(i-2,1))
6047 ichir11=isign(1,itype(i-2,1))
6048 ichir12=isign(1,itype(i-2,1))
6049 itype2=isign(10,itype(i,1))
6050 ichir21=isign(1,itype(i,1))
6051 ichir22=isign(1,itype(i,1))
6054 if (i.gt.3 .and. itype(i-2,1).ne.ntyp1) then
6057 if (phii.ne.phii) phii=150.0
6067 if (i.lt.nres .and. itype(i,1).ne.ntyp1) then
6070 if (phii1.ne.phii1) phii1=150.0
6082 ! Calculate the "mean" value of theta from the part of the distribution
6083 ! dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
6084 ! In following comments this theta will be referred to as t_c.
6085 thet_pred_mean=0.0d0
6087 athetk=athet(k,it,ichir1,ichir2)
6088 bthetk=bthet(k,it,ichir1,ichir2)
6090 athetk=athet(k,itype1,ichir11,ichir12)
6091 bthetk=bthet(k,itype2,ichir21,ichir22)
6093 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
6095 dthett=thet_pred_mean*ssd
6096 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
6097 ! Derivatives of the "mean" values in gamma1 and gamma2.
6098 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2) &
6099 +athet(2,it,ichir1,ichir2)*y(1))*ss
6100 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2) &
6101 +bthet(2,it,ichir1,ichir2)*z(1))*ss
6103 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2) &
6104 +athet(2,itype1,ichir11,ichir12)*y(1))*ss
6105 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2) &
6106 +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
6108 if (theta(i).gt.pi-delta) then
6109 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,&
6111 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
6112 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6113 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,&
6115 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,&
6117 else if (theta(i).lt.delta) then
6118 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
6119 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6120 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,&
6122 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
6123 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,&
6126 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,&
6129 etheta=etheta+ethetai
6130 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6132 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
6133 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
6134 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
6136 ! print *,ithetaconstr_start,ithetaconstr_end,"TU"
6138 ! Ufff.... We've done all this!!!
6140 end subroutine ebend
6141 !-----------------------------------------------------------------------------
6142 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc)
6145 ! implicit real*8 (a-h,o-z)
6146 ! include 'DIMENSIONS'
6147 ! include 'COMMON.LOCAL'
6148 ! include 'COMMON.IOUNITS'
6149 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
6150 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
6151 !el delthe0,sig0inv,sigtc,sigsqtc,delthec
6153 real(kind=8) :: thetai,thet_pred_mean,theta0i,ethetai,E_theta,E_tc
6155 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
6156 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
6157 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6159 real(kind=8) :: sig,fac,escloci0,escloci1,esclocbi0,dersc12,&
6160 esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
6162 ! Calculate the contributions to both Gaussian lobes.
6163 ! 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
6164 ! The "polynomial part" of the "standard deviation" of this part of
6168 sig=sig*thet_pred_mean+polthet(j,it)
6170 ! Derivative of the "interior part" of the "standard deviation of the"
6171 ! gamma-dependent Gaussian lobe in t_c.
6172 sigtc=3*polthet(3,it)
6174 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
6177 ! Set the parameters of both Gaussian lobes of the distribution.
6178 ! "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
6179 fac=sig*sig+sigc0(it)
6182 ! Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
6183 sigsqtc=-4.0D0*sigcsq*sigtc
6184 ! print *,i,sig,sigtc,sigsqtc
6185 ! Following variable (sigtc) is d[sigma(t_c)]/dt_c
6186 sigtc=-sigtc/(fac*fac)
6187 ! Following variable is sigma(t_c)**(-2)
6188 sigcsq=sigcsq*sigcsq
6190 sig0inv=1.0D0/sig0i**2
6191 delthec=thetai-thet_pred_mean
6192 delthe0=thetai-theta0i
6193 term1=-0.5D0*sigcsq*delthec*delthec
6194 term2=-0.5D0*sig0inv*delthe0*delthe0
6195 ! Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
6196 ! NaNs in taking the logarithm. We extract the largest exponent which is added
6197 ! to the energy (this being the log of the distribution) at the end of energy
6198 ! term evaluation for this virtual-bond angle.
6199 if (term1.gt.term2) then
6201 term2=dexp(term2-termm)
6205 term1=dexp(term1-termm)
6208 ! The ratio between the gamma-independent and gamma-dependent lobes of
6209 ! the distribution is a Gaussian function of thet_pred_mean too.
6210 diffak=gthet(2,it)-thet_pred_mean
6211 ratak=diffak/gthet(3,it)**2
6212 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
6213 ! Let's differentiate it in thet_pred_mean NOW.
6215 ! Now put together the distribution terms to make complete distribution.
6216 termexp=term1+ak*term2
6217 termpre=sigc+ak*sig0i
6218 ! Contribution of the bending energy from this theta is just the -log of
6219 ! the sum of the contributions from the two lobes and the pre-exponential
6220 ! factor. Simple enough, isn't it?
6221 ethetai=(-dlog(termexp)-termm+dlog(termpre))
6222 ! NOW the derivatives!!!
6223 ! 6/6/97 Take into account the deformation.
6224 E_theta=(delthec*sigcsq*term1 &
6225 +ak*delthe0*sig0inv*term2)/termexp
6226 E_tc=((sigtc+aktc*sig0i)/termpre &
6227 -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+ &
6228 aktc*term2)/termexp)
6230 end subroutine theteng
6232 !-----------------------------------------------------------------------------
6233 subroutine ebend(etheta)
6235 ! Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6236 ! angles gamma and its derivatives in consecutive thetas and gammas.
6237 ! ab initio-derived potentials from
6238 ! Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
6240 ! implicit real*8 (a-h,o-z)
6241 ! include 'DIMENSIONS'
6242 ! include 'COMMON.LOCAL'
6243 ! include 'COMMON.GEO'
6244 ! include 'COMMON.INTERACT'
6245 ! include 'COMMON.DERIV'
6246 ! include 'COMMON.VAR'
6247 ! include 'COMMON.CHAIN'
6248 ! include 'COMMON.IOUNITS'
6249 ! include 'COMMON.NAMES'
6250 ! include 'COMMON.FFIELD'
6251 ! include 'COMMON.CONTROL'
6252 real(kind=8),dimension(nntheterm) :: coskt,sinkt !mmaxtheterm
6253 real(kind=8),dimension(nsingle) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
6254 real(kind=8),dimension(ndouble,ndouble) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
6255 logical :: lprn=.false., lprn1=.false.
6257 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
6258 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
6259 real(kind=8) :: aux,etheta,ccl,ssl,scl,csl,ethetacnstr
6260 ! local variables for constrains
6261 real(kind=8) :: difi,thetiii
6263 ! write(iout,*) "in ebend",ithet_start,ithet_end
6266 do i=ithet_start,ithet_end
6267 if (itype(i-1,1).eq.ntyp1) cycle
6268 if (itype(i-2,1).eq.ntyp1.or.itype(i,1).eq.ntyp1) cycle
6269 if (iabs(itype(i+1,1)).eq.20) iblock=2
6270 if (iabs(itype(i+1,1)).ne.20) iblock=1
6274 theti2=0.5d0*theta(i)
6275 ityp2=ithetyp((itype(i-1,1)))
6277 coskt(k)=dcos(k*theti2)
6278 sinkt(k)=dsin(k*theti2)
6280 if (i.gt.3 .and. itype(max0(i-3,1),1).ne.ntyp1) then
6283 if (phii.ne.phii) phii=150.0
6287 ityp1=ithetyp((itype(i-2,1)))
6288 ! propagation of chirality for glycine type
6290 cosph1(k)=dcos(k*phii)
6291 sinph1(k)=dsin(k*phii)
6295 ityp1=ithetyp(itype(i-2,1))
6301 if (i.lt.nres .and. itype(i+1,1).ne.ntyp1) then
6304 if (phii1.ne.phii1) phii1=150.0
6309 ityp3=ithetyp((itype(i,1)))
6311 cosph2(k)=dcos(k*phii1)
6312 sinph2(k)=dsin(k*phii1)
6316 ityp3=ithetyp(itype(i,1))
6322 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
6325 ccl=cosph1(l)*cosph2(k-l)
6326 ssl=sinph1(l)*sinph2(k-l)
6327 scl=sinph1(l)*cosph2(k-l)
6328 csl=cosph1(l)*sinph2(k-l)
6329 cosph1ph2(l,k)=ccl-ssl
6330 cosph1ph2(k,l)=ccl+ssl
6331 sinph1ph2(l,k)=scl+csl
6332 sinph1ph2(k,l)=scl-csl
6336 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
6337 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
6338 write (iout,*) "coskt and sinkt"
6340 write (iout,*) k,coskt(k),sinkt(k)
6344 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
6345 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock) &
6348 write (iout,*) "k",k,&
6349 "aathet",aathet(k,ityp1,ityp2,ityp3,iblock),&
6353 write (iout,*) "cosph and sinph"
6355 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6357 write (iout,*) "cosph1ph2 and sinph2ph2"
6360 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
6361 sinph1ph2(l,k),sinph1ph2(k,l)
6364 write(iout,*) "ethetai",ethetai
6368 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k) &
6369 +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k) &
6370 +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k) &
6371 +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
6372 ethetai=ethetai+sinkt(m)*aux
6373 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6374 dephii=dephii+k*sinkt(m)* &
6375 (ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)- &
6376 bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
6377 dephii1=dephii1+k*sinkt(m)* &
6378 (eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)- &
6379 ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
6381 write (iout,*) "m",m," k",k," bbthet", &
6382 bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet", &
6383 ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet", &
6384 ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet", &
6385 eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
6389 write(iout,*) "ethetai",ethetai
6393 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
6394 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+ &
6395 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
6396 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
6397 ethetai=ethetai+sinkt(m)*aux
6398 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6399 dephii=dephii+l*sinkt(m)* &
6400 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)- &
6401 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
6402 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+ &
6403 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6404 dephii1=dephii1+(k-l)*sinkt(m)* &
6405 (-ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+ &
6406 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+ &
6407 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)- &
6408 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
6410 write (iout,*) "m",m," k",k," l",l," ffthet",&
6411 ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
6412 ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",&
6413 ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),&
6414 ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),&
6416 write (iout,*) cosph1ph2(l,k)*sinkt(m),&
6417 cosph1ph2(k,l)*sinkt(m),&
6418 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6426 write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
6427 i,theta(i)*rad2deg,phii*rad2deg,&
6428 phii1*rad2deg,ethetai
6430 etheta=etheta+ethetai
6431 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6433 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6434 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6435 gloc(nphi+i-2,icg)=wang*dethetai
6437 !-----------thete constrains
6438 ! if (tor_mode.ne.2) then
6441 end subroutine ebend
6444 !-----------------------------------------------------------------------------
6445 subroutine esc(escloc)
6446 ! Calculate the local energy of a side chain and its derivatives in the
6447 ! corresponding virtual-bond valence angles THETA and the spherical angles
6451 ! implicit real*8 (a-h,o-z)
6452 ! include 'DIMENSIONS'
6453 ! include 'COMMON.GEO'
6454 ! include 'COMMON.LOCAL'
6455 ! include 'COMMON.VAR'
6456 ! include 'COMMON.INTERACT'
6457 ! include 'COMMON.DERIV'
6458 ! include 'COMMON.CHAIN'
6459 ! include 'COMMON.IOUNITS'
6460 ! include 'COMMON.NAMES'
6461 ! include 'COMMON.FFIELD'
6462 ! include 'COMMON.CONTROL'
6463 real(kind=8),dimension(3) :: x,dersc,xemp,dersc0,dersc1,&
6464 ddersc0,ddummy,xtemp,temp
6465 !el real(kind=8) :: time11,time12,time112,theti
6466 real(kind=8) :: escloc,delta
6467 !el integer :: it,nlobit
6468 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6471 real(kind=8) :: escloci0,escloci1,escloci,esclocbi0,&
6472 dersc12,esclocbi1,chuju,esclocbi,dersc02,dersc01,ss,ssd
6475 ! write (iout,'(a)') 'ESC'
6476 do i=loc_start,loc_end
6478 if (it.eq.ntyp1) cycle
6479 if (it.eq.10) goto 1
6480 nlobit=nlob(iabs(it))
6481 ! print *,'i=',i,' it=',it,' nlobit=',nlobit
6482 ! write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6483 theti=theta(i+1)-pipol
6488 if (x(2).gt.pi-delta) then
6492 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6494 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6495 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),&
6497 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
6498 ddersc0(1),dersc(1))
6499 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),&
6500 ddersc0(3),dersc(3))
6502 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6504 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6505 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,&
6506 dersc0(2),esclocbi,dersc02)
6507 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),&
6509 call splinthet(x(2),0.5d0*delta,ss,ssd)
6514 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6516 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6517 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6519 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6521 ! write (iout,*) escloci
6522 else if (x(2).lt.delta) then
6526 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6528 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6529 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),&
6531 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
6532 ddersc0(1),dersc(1))
6533 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),&
6534 ddersc0(3),dersc(3))
6536 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6538 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6539 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,&
6540 dersc0(2),esclocbi,dersc02)
6541 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),&
6546 call splinthet(x(2),0.5d0*delta,ss,ssd)
6548 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6550 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6551 ! write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6553 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6554 ! write (iout,*) escloci
6556 call enesc(x,escloci,dersc,ddummy,.false.)
6559 escloc=escloc+escloci
6560 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
6562 ! write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6564 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+ &
6566 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6567 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6572 !-----------------------------------------------------------------------------
6573 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6576 ! implicit real*8 (a-h,o-z)
6577 ! include 'DIMENSIONS'
6578 ! include 'COMMON.GEO'
6579 ! include 'COMMON.LOCAL'
6580 ! include 'COMMON.IOUNITS'
6581 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6582 real(kind=8),dimension(3) :: x,z,dersc,ddersc
6583 real(kind=8),dimension(3,nlobit,-1:1) :: Ax !(3,maxlob,-1:1)
6584 real(kind=8),dimension(nlobit,-1:1) :: contr !(maxlob,-1:1)
6585 real(kind=8) :: escloci
6588 integer :: j,iii,l,k !el,it,nlobit
6589 real(kind=8) :: escloc_i,x3,Axk,expfac,emin !el,theti,&
6590 !el time11,time12,time112
6591 ! write (iout,*) 'it=',it,' nlobit=',nlobit
6595 if (mixed) ddersc(j)=0.0d0
6599 ! Because of periodicity of the dependence of the SC energy in omega we have
6600 ! to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6601 ! To avoid underflows, first compute & store the exponents.
6609 z(k)=x(k)-censc(k,j,it)
6614 Axk=Axk+gaussc(l,k,j,it)*z(l)
6620 expfac=expfac+Ax(k,j,iii)*z(k)
6628 ! As in the case of ebend, we want to avoid underflows in exponentiation and
6629 ! subsequent NaNs and INFs in energy calculation.
6630 ! Find the largest exponent
6634 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6638 !d print *,'it=',it,' emin=',emin
6640 ! Compute the contribution to SC energy and derivatives
6645 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6646 if(adexp.ne.adexp) adexp=1.0
6649 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6651 !d print *,'j=',j,' expfac=',expfac
6652 escloc_i=escloc_i+expfac
6654 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6658 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii) &
6659 +gaussc(k,2,j,it))*expfac
6666 dersc(1)=dersc(1)/cos(theti)**2
6667 ddersc(1)=ddersc(1)/cos(theti)**2
6670 escloci=-(dlog(escloc_i)-emin)
6672 dersc(j)=dersc(j)/escloc_i
6676 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6680 end subroutine enesc
6681 !-----------------------------------------------------------------------------
6682 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6685 ! implicit real*8 (a-h,o-z)
6686 ! include 'DIMENSIONS'
6687 ! include 'COMMON.GEO'
6688 ! include 'COMMON.LOCAL'
6689 ! include 'COMMON.IOUNITS'
6690 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6691 real(kind=8),dimension(3) :: x,z,dersc
6692 real(kind=8),dimension(3,nlobit) :: Ax !(3,maxlob)
6693 real(kind=8),dimension(nlobit) :: contr !(maxlob)
6694 real(kind=8) :: escloci,dersc12,emin
6697 integer :: j,k,l !el,it,nlobit
6698 real(kind=8) :: escloc_i,Axk,expfac !el,time11,time12,time112,theti
6708 z(k)=x(k)-censc(k,j,it)
6714 Axk=Axk+gaussc(l,k,j,it)*z(l)
6720 expfac=expfac+Ax(k,j)*z(k)
6725 ! As in the case of ebend, we want to avoid underflows in exponentiation and
6726 ! subsequent NaNs and INFs in energy calculation.
6727 ! Find the largest exponent
6730 if (emin.gt.contr(j)) emin=contr(j)
6734 ! Compute the contribution to SC energy and derivatives
6738 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6739 escloc_i=escloc_i+expfac
6741 dersc(k)=dersc(k)+Ax(k,j)*expfac
6743 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j) &
6744 +gaussc(1,2,j,it))*expfac
6748 dersc(1)=dersc(1)/cos(theti)**2
6749 dersc12=dersc12/cos(theti)**2
6750 escloci=-(dlog(escloc_i)-emin)
6752 dersc(j)=dersc(j)/escloc_i
6754 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6756 end subroutine enesc_bound
6758 !-----------------------------------------------------------------------------
6759 subroutine esc(escloc)
6760 ! Calculate the local energy of a side chain and its derivatives in the
6761 ! corresponding virtual-bond valence angles THETA and the spherical angles
6762 ! ALPHA and OMEGA derived from AM1 all-atom calculations.
6763 ! added by Urszula Kozlowska. 07/11/2007
6766 ! implicit real*8 (a-h,o-z)
6767 ! include 'DIMENSIONS'
6768 ! include 'COMMON.GEO'
6769 ! include 'COMMON.LOCAL'
6770 ! include 'COMMON.VAR'
6771 ! include 'COMMON.SCROT'
6772 ! include 'COMMON.INTERACT'
6773 ! include 'COMMON.DERIV'
6774 ! include 'COMMON.CHAIN'
6775 ! include 'COMMON.IOUNITS'
6776 ! include 'COMMON.NAMES'
6777 ! include 'COMMON.FFIELD'
6778 ! include 'COMMON.CONTROL'
6779 ! include 'COMMON.VECTORS'
6780 real(kind=8),dimension(3) :: x_prime,y_prime,z_prime
6781 real(kind=8),dimension(65) :: x
6782 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1,sumene2,sumene3,&
6783 sumene4,s1,s1_6,s2,s2_6,de_dxx,de_dyy,de_dzz,de_dt
6784 real(kind=8) :: s1_t,s1_6_t,s2_t,s2_6_t
6785 real(kind=8),dimension(3) :: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,dYY_Ci,&
6786 dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
6788 integer :: i,j,k !el,it,nlobit
6789 real(kind=8) :: cosfac2,sinfac2,cosfac,sinfac,escloc,delta
6790 !el real(kind=8) :: time11,time12,time112,theti
6791 !el common /sccalc/ time11,time12,time112,theti,it,nlobit
6792 real(kind=8) :: dscp1,dscp2,pom_s1,pom_s16,pom_s2,pom_s26,&
6793 pom,pom_dx,pom_dy,pom_dt1,pom_dt2,pom1,pom2,&
6794 sumene1x,sumene2x,sumene3x,sumene4x,&
6795 sumene1y,sumene2y,sumene3y,sumene4y,cossc,cossc1,&
6798 real(kind=8) :: aincr,xxsave,sumenep,de_dxx_num,yysave,&
6799 de_dyy_num,zzsave,de_dzz_num,costsave,sintsave,&
6802 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
6806 do i=loc_start,loc_end
6807 if (itype(i,1).eq.ntyp1) cycle
6808 costtab(i+1) =dcos(theta(i+1))
6809 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6810 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6811 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6812 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6813 cosfac=dsqrt(cosfac2)
6814 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6815 sinfac=dsqrt(sinfac2)
6817 if (it.eq.10) goto 1
6819 ! Compute the axes of tghe local cartesian coordinates system; store in
6820 ! x_prime, y_prime and z_prime
6827 ! write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6828 ! & dc_norm(3,i+nres)
6830 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6831 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6834 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i,1)))
6837 ! write (2,*) "x_prime",(x_prime(j),j=1,3)
6838 ! write (2,*) "y_prime",(y_prime(j),j=1,3)
6839 ! write (2,*) "z_prime",(z_prime(j),j=1,3)
6840 ! write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6841 ! & " xy",scalar(x_prime(1),y_prime(1)),
6842 ! & " xz",scalar(x_prime(1),z_prime(1)),
6843 ! & " yy",scalar(y_prime(1),y_prime(1)),
6844 ! & " yz",scalar(y_prime(1),z_prime(1)),
6845 ! & " zz",scalar(z_prime(1),z_prime(1))
6847 ! Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6848 ! to local coordinate system. Store in xx, yy, zz.
6854 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6855 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6856 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6863 ! Compute the energy of the ith side cbain
6865 ! write (2,*) "xx",xx," yy",yy," zz",zz
6868 x(j) = sc_parmin(j,it)
6871 !c diagnostics - remove later
6873 yy1 = dsin(alph(2))*dcos(omeg(2))
6874 zz1 = -dsign(1.0,dfloat(itype(i,1)))*dsin(alph(2))*dsin(omeg(2))
6875 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
6876 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
6878 !," --- ", xx_w,yy_w,zz_w
6881 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
6882 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
6884 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
6885 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
6887 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
6888 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
6889 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
6890 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
6891 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
6893 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
6894 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
6895 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
6896 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
6897 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
6899 dsc_i = 0.743d0+x(61)
6901 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6902 *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6903 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
6904 *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6905 s1=(1+x(63))/(0.1d0 + dscp1)
6906 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6907 s2=(1+x(65))/(0.1d0 + dscp2)
6908 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6909 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6) &
6910 + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6911 ! write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6913 ! & dscp1,dscp2,sumene
6914 ! sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6915 escloc = escloc + sumene
6916 ! write (2,*) "i",i," escloc",sumene,escloc,it,itype(i,1)
6921 ! This section to check the numerical derivatives of the energy of ith side
6922 ! chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6923 ! #define DEBUG in the code to turn it on.
6925 write (2,*) "sumene =",sumene
6929 write (2,*) xx,yy,zz
6930 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6931 de_dxx_num=(sumenep-sumene)/aincr
6933 write (2,*) "xx+ sumene from enesc=",sumenep
6936 write (2,*) xx,yy,zz
6937 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6938 de_dyy_num=(sumenep-sumene)/aincr
6940 write (2,*) "yy+ sumene from enesc=",sumenep
6943 write (2,*) xx,yy,zz
6944 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6945 de_dzz_num=(sumenep-sumene)/aincr
6947 write (2,*) "zz+ sumene from enesc=",sumenep
6948 costsave=cost2tab(i+1)
6949 sintsave=sint2tab(i+1)
6950 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6951 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6952 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6953 de_dt_num=(sumenep-sumene)/aincr
6954 write (2,*) " t+ sumene from enesc=",sumenep
6955 cost2tab(i+1)=costsave
6956 sint2tab(i+1)=sintsave
6957 ! End of diagnostics section.
6960 ! Compute the gradient of esc
6962 ! zz=zz*dsign(1.0,dfloat(itype(i,1)))
6963 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6964 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6965 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6966 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6967 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6968 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6969 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6970 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6971 pom1=(sumene3*sint2tab(i+1)+sumene1) &
6972 *(pom_s1/dscp1+pom_s16*dscp1**4)
6973 pom2=(sumene4*cost2tab(i+1)+sumene2) &
6974 *(pom_s2/dscp2+pom_s26*dscp2**4)
6975 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6976 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2 &
6977 +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2) &
6979 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6980 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2 &
6981 +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2) &
6983 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6) &
6984 +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6) &
6987 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i,1)
6990 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6991 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2 &
6992 +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2) &
6994 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6995 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz &
6996 +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz &
6997 +x(59)*zz**2 +x(60)*xx*zz
6998 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6) &
6999 +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6) &
7002 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i,1)
7005 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy &
7006 +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx &
7007 +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6) &
7008 +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6) &
7009 +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2 &
7010 +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy &
7011 +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6) &
7012 + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
7014 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i,1)
7017 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6) &
7018 -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6) &
7019 +pom1*pom_dt1+pom2*pom_dt2
7021 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i,1)
7025 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
7026 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
7027 cosfac2xx=cosfac2*xx
7028 sinfac2yy=sinfac2*yy
7030 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))* &
7032 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))* &
7034 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
7035 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
7036 ! write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
7037 ! & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
7038 ! write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
7039 ! & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
7040 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
7041 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
7042 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
7043 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
7047 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1) &
7048 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
7049 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1) &
7050 *dsign(1.0d0,dfloat(itype(i,1)))*dC_norm(j,i+nres)
7053 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
7054 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
7055 dZZ_XYZ(k)=vbld_inv(i+nres)* &
7056 (z_prime(k)-zz*dC_norm(k,i+nres))
7058 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
7059 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
7063 dXX_Ctab(k,i)=dXX_Ci(k)
7064 dXX_C1tab(k,i)=dXX_Ci1(k)
7065 dYY_Ctab(k,i)=dYY_Ci(k)
7066 dYY_C1tab(k,i)=dYY_Ci1(k)
7067 dZZ_Ctab(k,i)=dZZ_Ci(k)
7068 dZZ_C1tab(k,i)=dZZ_Ci1(k)
7069 dXX_XYZtab(k,i)=dXX_XYZ(k)
7070 dYY_XYZtab(k,i)=dYY_XYZ(k)
7071 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
7075 ! write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
7076 ! & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
7077 ! write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
7078 ! & dyy_ci(k)," dzz_ci",dzz_ci(k)
7079 ! write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
7081 ! write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
7082 ! & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
7083 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k) &
7084 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
7085 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k) &
7086 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
7087 gsclocx(k,i)= de_dxx*dxx_XYZ(k) &
7088 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
7090 ! write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
7091 ! & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
7093 ! to check gradient call subroutine check_grad
7099 !-----------------------------------------------------------------------------
7100 real(kind=8) function enesc(x,xx,yy,zz,cost2,sint2)
7102 real(kind=8),dimension(65) :: x
7103 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2,sumene3,&
7104 sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
7106 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2 &
7107 + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy &
7109 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2 &
7110 + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy &
7112 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2 &
7113 +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy &
7114 +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3 &
7115 +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx &
7116 +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy &
7118 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2 &
7119 +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy &
7120 +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3 &
7121 +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx &
7122 +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy &
7124 dsc_i = 0.743d0+x(61)
7126 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
7127 *(xx*cost2+yy*sint2))
7128 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i &
7129 *(xx*cost2-yy*sint2))
7130 s1=(1+x(63))/(0.1d0 + dscp1)
7131 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7132 s2=(1+x(65))/(0.1d0 + dscp2)
7133 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7134 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6) &
7135 + (sumene4*cost2 +sumene2)*(s2+s2_6)
7140 !-----------------------------------------------------------------------------
7141 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
7143 ! This procedure calculates two-body contact function g(rij) and its derivative:
7146 ! g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
7149 ! where x=(rij-r0ij)/delta
7151 ! rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
7154 real(kind=8) :: rij,r0ij,eps0ij,fcont,fprimcont
7155 real(kind=8) :: x,x2,x4,delta
7159 if (x.lt.-1.0D0) then
7162 else if (x.le.1.0D0) then
7165 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
7166 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
7172 end subroutine gcont
7173 !-----------------------------------------------------------------------------
7174 subroutine splinthet(theti,delta,ss,ssder)
7175 ! implicit real*8 (a-h,o-z)
7176 ! include 'DIMENSIONS'
7177 ! include 'COMMON.VAR'
7178 ! include 'COMMON.GEO'
7179 real(kind=8) :: theti,delta,ss,ssder
7180 real(kind=8) :: thetup,thetlow
7183 if (theti.gt.pipol) then
7184 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
7186 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
7190 end subroutine splinthet
7191 !-----------------------------------------------------------------------------
7192 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
7194 real(kind=8) :: x,x0,delta,f0,f1,fprim0,f,fprim
7195 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
7196 a1=fprim0*delta/(f1-f0)
7202 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
7203 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
7205 end subroutine spline1
7206 !-----------------------------------------------------------------------------
7207 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
7209 real(kind=8) :: x,x0,delta,f0x,f1x,fprim0x,fx
7210 real(kind=8) :: ksi,ksi2,ksi3,a1,a2,a3
7215 a2=3*(f1x-f0x)-2*fprim0x*delta
7216 a3=fprim0x*delta-2*(f1x-f0x)
7217 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
7219 end subroutine spline2
7220 !-----------------------------------------------------------------------------
7222 !-----------------------------------------------------------------------------
7223 subroutine etor(etors,edihcnstr)
7224 ! implicit real*8 (a-h,o-z)
7225 ! include 'DIMENSIONS'
7226 ! include 'COMMON.VAR'
7227 ! include 'COMMON.GEO'
7228 ! include 'COMMON.LOCAL'
7229 ! include 'COMMON.TORSION'
7230 ! include 'COMMON.INTERACT'
7231 ! include 'COMMON.DERIV'
7232 ! include 'COMMON.CHAIN'
7233 ! include 'COMMON.NAMES'
7234 ! include 'COMMON.IOUNITS'
7235 ! include 'COMMON.FFIELD'
7236 ! include 'COMMON.TORCNSTR'
7237 ! include 'COMMON.CONTROL'
7238 real(kind=8) :: etors,edihcnstr
7242 real(kind=8) :: phii,fac,etors_ii
7244 ! Set lprn=.true. for debugging
7248 do i=iphi_start,iphi_end
7250 if (itype(i-2,1).eq.ntyp1.or. itype(i-1,1).eq.ntyp1 &
7251 .or. itype(i,1).eq.ntyp1) cycle
7252 itori=itortyp(itype(i-2,1))
7253 itori1=itortyp(itype(i-1,1))
7256 ! Proline-Proline pair is a special case...
7257 if (itori.eq.3 .and. itori1.eq.3) then
7258 if (phii.gt.-dwapi3) then
7260 fac=1.0D0/(1.0D0-cosphi)
7261 etorsi=v1(1,3,3)*fac
7262 etorsi=etorsi+etorsi
7263 etors=etors+etorsi-v1(1,3,3)
7264 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
7265 gloci=gloci-3*fac*etorsi*dsin(3*phii)
7268 v1ij=v1(j+1,itori,itori1)
7269 v2ij=v2(j+1,itori,itori1)
7272 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7273 if (energy_dec) etors_ii=etors_ii+ &
7274 v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7275 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7279 v1ij=v1(j,itori,itori1)
7280 v2ij=v2(j,itori,itori1)
7283 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7284 if (energy_dec) etors_ii=etors_ii+ &
7285 v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7286 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7289 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
7292 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
7293 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
7294 (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
7295 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7296 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7298 ! 6/20/98 - dihedral angle constraints
7301 itori=idih_constr(i)
7304 if (difi.gt.drange(i)) then
7306 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7307 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7308 else if (difi.lt.-drange(i)) then
7310 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7311 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7313 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
7314 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
7316 ! write (iout,*) 'edihcnstr',edihcnstr
7319 !-----------------------------------------------------------------------------
7320 subroutine etor_d(etors_d)
7321 real(kind=8) :: etors_d
7324 end subroutine etor_d
7326 !-----------------------------------------------------------------------------
7327 subroutine etor(etors)
7328 ! implicit real*8 (a-h,o-z)
7329 ! include 'DIMENSIONS'
7330 ! include 'COMMON.VAR'
7331 ! include 'COMMON.GEO'
7332 ! include 'COMMON.LOCAL'
7333 ! include 'COMMON.TORSION'
7334 ! include 'COMMON.INTERACT'
7335 ! include 'COMMON.DERIV'
7336 ! include 'COMMON.CHAIN'
7337 ! include 'COMMON.NAMES'
7338 ! include 'COMMON.IOUNITS'
7339 ! include 'COMMON.FFIELD'
7340 ! include 'COMMON.TORCNSTR'
7341 ! include 'COMMON.CONTROL'
7342 real(kind=8) :: etors,edihcnstr
7345 integer :: i,j,iblock,itori,itori1
7346 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
7347 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
7348 ! Set lprn=.true. for debugging
7352 do i=iphi_start,iphi_end
7353 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
7354 .or. itype(i-3,1).eq.ntyp1 &
7355 .or. itype(i,1).eq.ntyp1) cycle
7357 if (iabs(itype(i,1)).eq.20) then
7362 itori=itortyp(itype(i-2,1))
7363 itori1=itortyp(itype(i-1,1))
7366 ! Regular cosine and sine terms
7367 do j=1,nterm(itori,itori1,iblock)
7368 v1ij=v1(j,itori,itori1,iblock)
7369 v2ij=v2(j,itori,itori1,iblock)
7372 etors=etors+v1ij*cosphi+v2ij*sinphi
7373 if (energy_dec) etors_ii=etors_ii+ &
7374 v1ij*cosphi+v2ij*sinphi
7375 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7379 ! E = SUM ----------------------------------- - v1
7380 ! [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7382 cosphi=dcos(0.5d0*phii)
7383 sinphi=dsin(0.5d0*phii)
7384 do j=1,nlor(itori,itori1,iblock)
7385 vl1ij=vlor1(j,itori,itori1)
7386 vl2ij=vlor2(j,itori,itori1)
7387 vl3ij=vlor3(j,itori,itori1)
7388 pom=vl2ij*cosphi+vl3ij*sinphi
7389 pom1=1.0d0/(pom*pom+1.0d0)
7390 etors=etors+vl1ij*pom1
7391 if (energy_dec) etors_ii=etors_ii+ &
7394 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7396 ! Subtract the constant term
7397 etors=etors-v0(itori,itori1,iblock)
7398 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
7399 'etor',i,etors_ii-v0(itori,itori1,iblock)
7401 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
7402 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,itori,itori1,&
7403 (v1(j,itori,itori1,iblock),j=1,6),&
7404 (v2(j,itori,itori1,iblock),j=1,6)
7405 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7406 ! write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7408 ! 6/20/98 - dihedral angle constraints
7411 !C The rigorous attempt to derive energy function
7412 !-------------------------------------------------------------------------------------------
7413 subroutine etor_kcc(etors)
7414 double precision c1(0:maxval_kcc),c2(0:maxval_kcc)
7415 real(kind=8) :: etors,glocig,glocit1,glocit2,sinthet1,&
7416 sinthet2,costhet1,costhet2,sint1t2,sint1t2n,phii,sinphi,cosphi,&
7417 sint1t2n1,sumvalc,gradvalct1,gradvalct2,sumvals,gradvalst1,&
7420 integer :: i,j,itori,itori1,nval,k,l
7422 if (lprn) write (iout,*) "etor_kcc tor_mode",tor_mode
7424 do i=iphi_start,iphi_end
7425 !C ANY TWO ARE DUMMY ATOMS in row CYCLE
7426 !c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
7427 !c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
7428 !c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
7429 if (itype(i-2,1).eq.ntyp1.or. itype(i-1,1).eq.ntyp1 &
7430 .or. itype(i,1).eq.ntyp1 .or. itype(i-3,1).eq.ntyp1) cycle
7431 itori=itortyp(itype(i-2,1))
7432 itori1=itortyp(itype(i-1,1))
7437 !C to avoid multiple devision by 2
7438 !c theti22=0.5d0*theta(i)
7439 !C theta 12 is the theta_1 /2
7440 !C theta 22 is theta_2 /2
7441 !c theti12=0.5d0*theta(i-1)
7442 !C and appropriate sinus function
7443 sinthet1=dsin(theta(i-1))
7444 sinthet2=dsin(theta(i))
7445 costhet1=dcos(theta(i-1))
7446 costhet2=dcos(theta(i))
7447 !C to speed up lets store its mutliplication
7448 sint1t2=sinthet2*sinthet1
7450 !C \sum_{i=1}^n (sin(theta_1) * sin(theta_2))^n * (c_n* cos(n*gamma)
7451 !C +d_n*sin(n*gamma)) *
7452 !C \sum_{i=1}^m (1+a_m*Tb_m(cos(theta_1 /2))+b_m*Tb_m(cos(theta_2 /2)))
7453 !C we have two sum 1) Non-Chebyshev which is with n and gamma
7454 nval=nterm_kcc_Tb(itori,itori1)
7460 c1(j)=c1(j-1)*costhet1
7461 c2(j)=c2(j-1)*costhet2
7465 do j=1,nterm_kcc(itori,itori1)
7469 sint1t2n=sint1t2n*sint1t2
7475 sumvalc=sumvalc+v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
7476 gradvalct1=gradvalct1+ &
7477 (k-1)*v1_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
7478 gradvalct2=gradvalct2+ &
7479 (l-1)*v1_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
7482 gradvalct1=-gradvalct1*sinthet1
7483 gradvalct2=-gradvalct2*sinthet2
7489 sumvals=sumvals+v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l)
7490 gradvalst1=gradvalst1+ &
7491 (k-1)*v2_kcc(l,k,j,itori1,itori)*c1(k-1)*c2(l)
7492 gradvalst2=gradvalst2+ &
7493 (l-1)*v2_kcc(l,k,j,itori1,itori)*c1(k)*c2(l-1)
7496 gradvalst1=-gradvalst1*sinthet1
7497 gradvalst2=-gradvalst2*sinthet2
7498 if (lprn) write (iout,*)j,"sumvalc",sumvalc," sumvals",sumvals
7499 etori=etori+sint1t2n*(sumvalc*cosphi+sumvals*sinphi)
7500 !C glocig is the gradient local i site in gamma
7501 glocig=glocig+j*sint1t2n*(sumvals*cosphi-sumvalc*sinphi)
7502 !C now gradient over theta_1
7503 glocit1=glocit1+sint1t2n*(gradvalct1*cosphi+gradvalst1*sinphi)&
7504 +j*sint1t2n1*costhet1*sinthet2*(sumvalc*cosphi+sumvals*sinphi)
7505 glocit2=glocit2+sint1t2n*(gradvalct2*cosphi+gradvalst2*sinphi)&
7506 +j*sint1t2n1*sinthet1*costhet2*(sumvalc*cosphi+sumvals*sinphi)
7509 gloc(i-3,icg)=gloc(i-3,icg)+wtor*glocig
7510 !C derivative over theta1
7511 gloc(nphi+i-3,icg)=gloc(nphi+i-3,icg)+wtor*glocit1
7512 !C now derivative over theta2
7513 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wtor*glocit2
7515 write (iout,*) i-2,i-1,itype(i-2,1),itype(i-1,1),itori,itori1,&
7516 theta(i-1)*rad2deg,theta(i)*rad2deg,phii*rad2deg,etori
7517 write (iout,*) "c1",(c1(k),k=0,nval), &
7518 " c2",(c2(k),k=0,nval)
7522 end subroutine etor_kcc
7523 !------------------------------------------------------------------------------
7525 subroutine etor_constr(edihcnstr)
7526 real(kind=8) :: etors,edihcnstr
7529 integer :: i,j,iblock,itori,itori1
7530 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
7531 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom,&
7532 gaudih_i,gauder_i,s,cos_i,dexpcos_i
7534 if (raw_psipred) then
7535 do i=idihconstr_start,idihconstr_end
7536 itori=idih_constr(i)
7538 gaudih_i=vpsipred(1,i)
7542 cos_i=(1.0d0-dcos(phii-phibound(j,i)))/s**2
7543 dexpcos_i=dexp(-cos_i*cos_i)
7544 gaudih_i=gaudih_i+vpsipred(j+1,i)*dexpcos_i
7545 gauder_i=gauder_i-2*vpsipred(j+1,i)*dsin(phii-phibound(j,i)) &
7546 *cos_i*dexpcos_i/s**2
7548 edihcnstr=edihcnstr-wdihc*dlog(gaudih_i)
7549 gloc(itori-3,icg)=gloc(itori-3,icg)-wdihc*gauder_i/gaudih_i
7551 write (iout,'(2i5,f8.3,f8.5,2(f8.5,2f8.3),f10.5)') &
7552 i,itori,phii*rad2deg,vpsipred(1,i),vpsipred(2,i),&
7553 phibound(1,i)*rad2deg,sdihed(1,i)*rad2deg,vpsipred(3,i),&
7554 phibound(2,i)*rad2deg,sdihed(2,i)*rad2deg,&
7555 -wdihc*dlog(gaudih_i)
7559 do i=idihconstr_start,idihconstr_end
7560 itori=idih_constr(i)
7562 difi=pinorm(phii-phi0(i))
7563 if (difi.gt.drange(i)) then
7565 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7566 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7567 else if (difi.lt.-drange(i)) then
7569 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
7570 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
7580 end subroutine etor_constr
7581 !-----------------------------------------------------------------------------
7582 subroutine etor_d(etors_d)
7583 ! 6/23/01 Compute double torsional energy
7584 ! implicit real*8 (a-h,o-z)
7585 ! include 'DIMENSIONS'
7586 ! include 'COMMON.VAR'
7587 ! include 'COMMON.GEO'
7588 ! include 'COMMON.LOCAL'
7589 ! include 'COMMON.TORSION'
7590 ! include 'COMMON.INTERACT'
7591 ! include 'COMMON.DERIV'
7592 ! include 'COMMON.CHAIN'
7593 ! include 'COMMON.NAMES'
7594 ! include 'COMMON.IOUNITS'
7595 ! include 'COMMON.FFIELD'
7596 ! include 'COMMON.TORCNSTR'
7597 real(kind=8) :: etors_d,etors_d_ii
7600 integer :: i,j,k,l,itori,itori1,itori2,iblock
7601 real(kind=8) :: phii,phii1,gloci1,gloci2,&
7602 v1cij,v1sij,v2cij,v2sij,cosphi1,sinphi1,&
7603 sinphi2,cosphi2,v1cdij,v2cdij,v1sdij,v2sdij,&
7604 cosphi1p2,cosphi1m2,sinphi1p2,sinphi1m2
7605 ! Set lprn=.true. for debugging
7609 ! write(iout,*) "a tu??"
7610 do i=iphid_start,iphid_end
7612 if (itype(i-2,1).eq.ntyp1 .or. itype(i-1,1).eq.ntyp1 &
7613 .or. itype(i-3,1).eq.ntyp1 &
7614 .or. itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
7615 itori=itortyp(itype(i-2,1))
7616 itori1=itortyp(itype(i-1,1))
7617 itori2=itortyp(itype(i,1))
7623 if (iabs(itype(i+1,1)).eq.20) iblock=2
7625 ! Regular cosine and sine terms
7626 do j=1,ntermd_1(itori,itori1,itori2,iblock)
7627 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
7628 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
7629 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
7630 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
7631 cosphi1=dcos(j*phii)
7632 sinphi1=dsin(j*phii)
7633 cosphi2=dcos(j*phii1)
7634 sinphi2=dsin(j*phii1)
7635 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+ &
7636 v2cij*cosphi2+v2sij*sinphi2
7637 if (energy_dec) etors_d_ii=etors_d_ii+ &
7638 v1cij*cosphi1+v1sij*sinphi1+v2cij*cosphi2+v2sij*sinphi2
7639 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7640 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7642 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7644 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7645 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7646 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7647 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7648 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7649 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7650 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7651 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7652 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
7653 v1sdij*sinphi1p2+v2sdij*sinphi1m2
7654 if (energy_dec) etors_d_ii=etors_d_ii+ &
7655 v1cdij*cosphi1p2+v2cdij*cosphi1m2+ &
7656 v1sdij*sinphi1p2+v2sdij*sinphi1m2
7657 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2 &
7658 -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7659 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2 &
7660 -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7663 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
7664 'etor_d',i,etors_d_ii
7665 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7666 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7669 end subroutine etor_d
7672 subroutine ebend_kcc(etheta)
7674 double precision thybt1(maxang_kcc),etheta
7675 integer :: i,iti,j,ihelp
7676 real (kind=8) :: sinthet,costhet,sumth1thyb,gradthybt1
7677 !C Set lprn=.true. for debugging
7680 !C print *,"wchodze kcc"
7681 if (lprn) write (iout,*) "ebend_kcc tor_mode",tor_mode
7683 do i=ithet_start,ithet_end
7684 !c print *,i,itype(i-1),itype(i),itype(i-2)
7685 if ((itype(i-1,1).eq.ntyp1).or.itype(i-2,1).eq.ntyp1 &
7686 .or.itype(i,1).eq.ntyp1) cycle
7687 iti=iabs(itortyp(itype(i-1,1)))
7688 sinthet=dsin(theta(i))
7689 costhet=dcos(theta(i))
7690 do j=1,nbend_kcc_Tb(iti)
7691 thybt1(j)=v1bend_chyb(j,iti)
7693 sumth1thyb=v1bend_chyb(0,iti)+ &
7694 tschebyshev(1,nbend_kcc_Tb(iti),thybt1(1),costhet)
7695 if (lprn) write (iout,*) i-1,itype(i-1,1),iti,theta(i)*rad2deg,&
7697 ihelp=nbend_kcc_Tb(iti)-1
7698 gradthybt1=gradtschebyshev(0,ihelp,thybt1(1),costhet)
7699 etheta=etheta+sumth1thyb
7700 !C print *,sumth1thyb,gradthybt1,sinthet*(-0.5d0)
7701 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)-wang*gradthybt1*sinthet
7704 end subroutine ebend_kcc
7706 !c-------------------------------------------------------------------------------------
7707 subroutine etheta_constr(ethetacnstr)
7708 real (kind=8) :: ethetacnstr,thetiii,difi
7711 !C print *,ithetaconstr_start,ithetaconstr_end,"TU"
7712 do i=ithetaconstr_start,ithetaconstr_end
7713 itheta=itheta_constr(i)
7714 thetiii=theta(itheta)
7715 difi=pinorm(thetiii-theta_constr0(i))
7716 if (difi.gt.theta_drange(i)) then
7717 difi=difi-theta_drange(i)
7718 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7719 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
7720 +for_thet_constr(i)*difi**3
7721 else if (difi.lt.-drange(i)) then
7723 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
7724 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg) &
7725 +for_thet_constr(i)*difi**3
7729 if (energy_dec) then
7730 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",&
7731 i,itheta,rad2deg*thetiii,&
7732 rad2deg*theta_constr0(i), rad2deg*theta_drange(i),&
7733 rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,&
7734 gloc(itheta+nphi-2,icg)
7738 end subroutine etheta_constr
7740 !-----------------------------------------------------------------------------
7741 subroutine eback_sc_corr(esccor)
7742 ! 7/21/2007 Correlations between the backbone-local and side-chain-local
7743 ! conformational states; temporarily implemented as differences
7744 ! between UNRES torsional potentials (dependent on three types of
7745 ! residues) and the torsional potentials dependent on all 20 types
7746 ! of residues computed from AM1 energy surfaces of terminally-blocked
7747 ! amino-acid residues.
7748 ! implicit real*8 (a-h,o-z)
7749 ! include 'DIMENSIONS'
7750 ! include 'COMMON.VAR'
7751 ! include 'COMMON.GEO'
7752 ! include 'COMMON.LOCAL'
7753 ! include 'COMMON.TORSION'
7754 ! include 'COMMON.SCCOR'
7755 ! include 'COMMON.INTERACT'
7756 ! include 'COMMON.DERIV'
7757 ! include 'COMMON.CHAIN'
7758 ! include 'COMMON.NAMES'
7759 ! include 'COMMON.IOUNITS'
7760 ! include 'COMMON.FFIELD'
7761 ! include 'COMMON.CONTROL'
7762 real(kind=8) :: esccor,esccor_ii,phii,gloci,v1ij,v2ij,&
7765 integer :: i,interty,j,isccori,isccori1,intertyp
7766 ! Set lprn=.true. for debugging
7769 ! write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7771 do i=itau_start,itau_end
7772 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1)) cycle
7774 isccori=isccortyp(itype(i-2,1))
7775 isccori1=isccortyp(itype(i-1,1))
7777 ! write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7779 do intertyp=1,3 !intertyp
7781 !c Added 09 May 2012 (Adasko)
7782 !c Intertyp means interaction type of backbone mainchain correlation:
7783 ! 1 = SC...Ca...Ca...Ca
7784 ! 2 = Ca...Ca...Ca...SC
7785 ! 3 = SC...Ca...Ca...SCi
7787 if (((intertyp.eq.3).and.((itype(i-2,1).eq.10).or. &
7788 (itype(i-1,1).eq.10).or.(itype(i-2,1).eq.ntyp1).or. &
7789 (itype(i-1,1).eq.ntyp1))) &
7790 .or. ((intertyp.eq.1).and.((itype(i-2,1).eq.10) &
7791 .or.(itype(i-2,1).eq.ntyp1).or.(itype(i-1,1).eq.ntyp1) &
7792 .or.(itype(i,1).eq.ntyp1))) &
7793 .or.((intertyp.eq.2).and.((itype(i-1,1).eq.10).or. &
7794 (itype(i-1,1).eq.ntyp1).or.(itype(i-2,1).eq.ntyp1).or. &
7795 (itype(i-3,1).eq.ntyp1)))) cycle
7796 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1,1).eq.ntyp1)) cycle
7797 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres,1).eq.ntyp1)) &
7799 do j=1,nterm_sccor(isccori,isccori1)
7800 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7801 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7802 cosphi=dcos(j*tauangle(intertyp,i))
7803 sinphi=dsin(j*tauangle(intertyp,i))
7804 if (energy_dec) esccor_ii=esccor_ii+v1ij*cosphi+v2ij*sinphi
7805 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7806 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7808 if (energy_dec) write (iout,'(a6,i5,i2,0pf7.3)') &
7809 'esccor',i,intertyp,esccor_ii
7810 ! write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7811 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7813 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
7814 restyp(itype(i-2,1),1),i-2,restyp(itype(i-1,1),1),i-1,isccori,isccori1,&
7815 (v1sccor(j,intertyp,isccori,isccori1),j=1,6),&
7816 (v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7817 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7822 end subroutine eback_sc_corr
7823 !-----------------------------------------------------------------------------
7824 subroutine multibody(ecorr)
7825 ! This subroutine calculates multi-body contributions to energy following
7826 ! the idea of Skolnick et al. If side chains I and J make a contact and
7827 ! at the same time side chains I+1 and J+1 make a contact, an extra
7828 ! contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7829 ! implicit real*8 (a-h,o-z)
7830 ! include 'DIMENSIONS'
7831 ! include 'COMMON.IOUNITS'
7832 ! include 'COMMON.DERIV'
7833 ! include 'COMMON.INTERACT'
7834 ! include 'COMMON.CONTACTS'
7835 real(kind=8),dimension(3) :: gx,gx1
7837 real(kind=8) :: ecorr
7838 integer :: i,j,ishift,i1,num_conti,num_conti1,j1,jj,kk
7839 ! Set lprn=.true. for debugging
7843 write (iout,'(a)') 'Contact function values:'
7845 write (iout,'(i2,20(1x,i2,f10.5))') &
7846 i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7851 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
7852 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
7864 num_conti=num_cont(i)
7865 num_conti1=num_cont(i1)
7870 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7871 !d write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7872 !d & ' ishift=',ishift
7873 ! Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7874 ! The system gains extra energy.
7875 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7876 endif ! j1==j+-ishift
7884 end subroutine multibody
7885 !-----------------------------------------------------------------------------
7886 real(kind=8) function esccorr(i,j,k,l,jj,kk)
7887 ! implicit real*8 (a-h,o-z)
7888 ! include 'DIMENSIONS'
7889 ! include 'COMMON.IOUNITS'
7890 ! include 'COMMON.DERIV'
7891 ! include 'COMMON.INTERACT'
7892 ! include 'COMMON.CONTACTS'
7893 real(kind=8),dimension(3) :: gx,gx1
7895 integer :: i,j,k,l,jj,kk,m,ll
7896 real(kind=8) :: eij,ekl
7900 !d write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7901 ! Calculate the multi-body contribution to energy.
7902 ! Calculate multi-body contributions to the gradient.
7903 !d write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7904 !d & k,l,(gacont(m,kk,k),m=1,3)
7906 gx(m) =ekl*gacont(m,jj,i)
7907 gx1(m)=eij*gacont(m,kk,k)
7908 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7909 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7910 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7911 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7915 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7920 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7925 end function esccorr
7926 !-----------------------------------------------------------------------------
7927 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7928 ! This subroutine calculates multi-body contributions to hydrogen-bonding
7929 ! implicit real*8 (a-h,o-z)
7930 ! include 'DIMENSIONS'
7931 ! include 'COMMON.IOUNITS'
7934 ! integer :: maxconts !max_cont=maxconts =nres/4
7935 integer,parameter :: max_dim=26
7936 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7937 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
7938 !el real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
7939 !el common /przechowalnia/ zapas
7940 integer :: status(MPI_STATUS_SIZE)
7941 integer,dimension((nres/4)*2) :: req !maxconts*2
7942 integer :: status_array(MPI_STATUS_SIZE,(nres/4)*2),nn,ireq,ierr
7944 ! include 'COMMON.SETUP'
7945 ! include 'COMMON.FFIELD'
7946 ! include 'COMMON.DERIV'
7947 ! include 'COMMON.INTERACT'
7948 ! include 'COMMON.CONTACTS'
7949 ! include 'COMMON.CONTROL'
7950 ! include 'COMMON.LOCAL'
7951 real(kind=8),dimension(3) :: gx,gx1
7952 real(kind=8) :: time00,ecorr,ecorr5,ecorr6
7953 logical :: lprn,ldone
7955 integer :: i,j,ii,k,n_corr,n_corr1,i1,num_conti,num_conti1,&
7956 jj,jp,kk,j1,jp1,jjc,iii,nnn,iproc
7958 ! Set lprn=.true. for debugging
7962 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
7965 if (nfgtasks.le.1) goto 30
7967 write (iout,'(a)') 'Contact function values before RECEIVE:'
7969 write (iout,'(2i3,50(1x,i2,f5.2))') &
7970 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
7975 do i=1,ntask_cont_from
7978 do i=1,ntask_cont_to
7981 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7983 ! Make the list of contacts to send to send to other procesors
7984 ! write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7986 do i=iturn3_start,iturn3_end
7987 ! write (iout,*) "make contact list turn3",i," num_cont",
7989 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7991 do i=iturn4_start,iturn4_end
7992 ! write (iout,*) "make contact list turn4",i," num_cont",
7994 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7998 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
8000 do j=1,num_cont_hb(i)
8003 iproc=iint_sent_local(k,jjc,ii)
8004 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8005 if (iproc.gt.0) then
8006 ncont_sent(iproc)=ncont_sent(iproc)+1
8007 nn=ncont_sent(iproc)
8009 zapas(2,nn,iproc)=jjc
8010 zapas(3,nn,iproc)=facont_hb(j,i)
8011 zapas(4,nn,iproc)=ees0p(j,i)
8012 zapas(5,nn,iproc)=ees0m(j,i)
8013 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
8014 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
8015 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
8016 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
8017 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
8018 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
8019 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
8020 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
8021 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
8022 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
8023 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
8024 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
8025 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
8026 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
8027 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
8028 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
8029 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
8030 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
8031 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
8032 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
8033 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
8040 "Numbers of contacts to be sent to other processors",&
8041 (ncont_sent(i),i=1,ntask_cont_to)
8042 write (iout,*) "Contacts sent"
8043 do ii=1,ntask_cont_to
8045 iproc=itask_cont_to(ii)
8046 write (iout,*) nn," contacts to processor",iproc,&
8047 " of CONT_TO_COMM group"
8049 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8057 CorrelID1=nfgtasks+fg_rank+1
8059 ! Receive the numbers of needed contacts from other processors
8060 do ii=1,ntask_cont_from
8061 iproc=itask_cont_from(ii)
8063 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
8064 FG_COMM,req(ireq),IERR)
8066 ! write (iout,*) "IRECV ended"
8068 ! Send the number of contacts needed by other processors
8069 do ii=1,ntask_cont_to
8070 iproc=itask_cont_to(ii)
8072 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
8073 FG_COMM,req(ireq),IERR)
8075 ! write (iout,*) "ISEND ended"
8076 ! write (iout,*) "number of requests (nn)",ireq
8079 call MPI_Waitall(ireq,req,status_array,ierr)
8081 ! & "Numbers of contacts to be received from other processors",
8082 ! & (ncont_recv(i),i=1,ntask_cont_from)
8086 do ii=1,ntask_cont_from
8087 iproc=itask_cont_from(ii)
8089 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
8090 ! & " of CONT_TO_COMM group"
8094 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
8095 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8096 ! write (iout,*) "ireq,req",ireq,req(ireq)
8099 ! Send the contacts to processors that need them
8100 do ii=1,ntask_cont_to
8101 iproc=itask_cont_to(ii)
8103 ! write (iout,*) nn," contacts to processor",iproc,
8104 ! & " of CONT_TO_COMM group"
8107 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
8108 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8109 ! write (iout,*) "ireq,req",ireq,req(ireq)
8111 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8115 ! write (iout,*) "number of requests (contacts)",ireq
8116 ! write (iout,*) "req",(req(i),i=1,4)
8119 call MPI_Waitall(ireq,req,status_array,ierr)
8120 do iii=1,ntask_cont_from
8121 iproc=itask_cont_from(iii)
8124 write (iout,*) "Received",nn," contacts from processor",iproc,&
8125 " of CONT_FROM_COMM group"
8128 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
8133 ii=zapas_recv(1,i,iii)
8134 ! Flag the received contacts to prevent double-counting
8135 jj=-zapas_recv(2,i,iii)
8136 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8138 nnn=num_cont_hb(ii)+1
8141 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
8142 ees0p(nnn,ii)=zapas_recv(4,i,iii)
8143 ees0m(nnn,ii)=zapas_recv(5,i,iii)
8144 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
8145 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
8146 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
8147 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
8148 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
8149 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
8150 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
8151 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
8152 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
8153 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
8154 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
8155 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
8156 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
8157 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
8158 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
8159 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
8160 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
8161 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
8162 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
8163 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
8164 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
8169 write (iout,'(a)') 'Contact function values after receive:'
8171 write (iout,'(2i3,50(1x,i3,f5.2))') &
8172 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
8180 write (iout,'(a)') 'Contact function values:'
8182 write (iout,'(2i3,50(1x,i3,f5.2))') &
8183 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
8189 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
8190 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
8191 ! Remove the loop below after debugging !!!
8198 ! Calculate the local-electrostatic correlation terms
8199 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
8201 num_conti=num_cont_hb(i)
8202 num_conti1=num_cont_hb(i+1)
8209 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,&
8210 ! ' jj=',jj,' kk=',kk,"jp=",jp,"jp1",jp1
8211 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
8212 .or. j.lt.0 .and. j1.gt.0) .and. &
8213 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8214 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8215 ! The system gains extra energy.
8216 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8217 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
8218 'ecorrh',i,j,ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8220 else if (j1.eq.j) then
8221 ! Contacts I-J and I-(J+1) occur simultaneously.
8222 ! The system loses extra energy.
8223 ! ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
8228 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8229 ! & ' jj=',jj,' kk=',kk
8231 ! Contacts I-J and (I+1)-J occur simultaneously.
8232 ! The system loses extra energy.
8233 ! ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
8239 end subroutine multibody_hb
8240 !-----------------------------------------------------------------------------
8241 subroutine add_hb_contact(ii,jj,itask)
8242 ! implicit real*8 (a-h,o-z)
8243 ! include "DIMENSIONS"
8244 ! include "COMMON.IOUNITS"
8245 ! include "COMMON.CONTACTS"
8246 ! integer,parameter :: maxconts=nres/4
8247 integer,parameter :: max_dim=26
8248 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
8249 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks)
8250 ! common /przechowalnia/ zapas
8251 integer :: i,j,ii,jj,iproc,nn,jjc
8252 integer,dimension(4) :: itask
8253 ! write (iout,*) "itask",itask
8256 if (iproc.gt.0) then
8257 do j=1,num_cont_hb(ii)
8259 ! write (iout,*) "i",ii," j",jj," jjc",jjc
8261 ncont_sent(iproc)=ncont_sent(iproc)+1
8262 nn=ncont_sent(iproc)
8263 zapas(1,nn,iproc)=ii
8264 zapas(2,nn,iproc)=jjc
8265 zapas(3,nn,iproc)=facont_hb(j,ii)
8266 zapas(4,nn,iproc)=ees0p(j,ii)
8267 zapas(5,nn,iproc)=ees0m(j,ii)
8268 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
8269 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
8270 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
8271 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
8272 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
8273 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
8274 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
8275 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
8276 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
8277 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
8278 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
8279 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
8280 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
8281 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
8282 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
8283 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
8284 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
8285 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
8286 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
8287 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
8288 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
8295 end subroutine add_hb_contact
8296 !-----------------------------------------------------------------------------
8297 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
8298 ! This subroutine calculates multi-body contributions to hydrogen-bonding
8299 ! implicit real*8 (a-h,o-z)
8300 ! include 'DIMENSIONS'
8301 ! include 'COMMON.IOUNITS'
8302 integer,parameter :: max_dim=70
8305 ! integer :: maxconts !max_cont=maxconts=nres/4
8306 integer :: source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8307 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
8308 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
8309 ! common /przechowalnia/ zapas
8310 integer :: status(MPI_STATUS_SIZE),req((nres/4)*2),&
8311 status_array(MPI_STATUS_SIZE,(nres/4)*2),jjc,iproc,ireq,nn,ind,&
8314 ! include 'COMMON.SETUP'
8315 ! include 'COMMON.FFIELD'
8316 ! include 'COMMON.DERIV'
8317 ! include 'COMMON.LOCAL'
8318 ! include 'COMMON.INTERACT'
8319 ! include 'COMMON.CONTACTS'
8320 ! include 'COMMON.CHAIN'
8321 ! include 'COMMON.CONTROL'
8322 real(kind=8),dimension(3) :: gx,gx1
8323 integer,dimension(nres) :: num_cont_hb_old
8324 logical :: lprn,ldone
8325 !EL double precision eello4,eello5,eelo6,eello_turn6
8326 !EL external eello4,eello5,eello6,eello_turn6
8328 integer :: i,ii,j,k,l,jj,kk,ll,mm,n_corr,n_corr1,num_conti,jp,&
8329 j1,jp1,i1,num_conti1
8330 real(kind=8) :: sqd1,sqd2,sred_geom,fac_prim1,fac_prim2,fprimcont
8331 real(kind=8) :: ecorr,ecorr5,ecorr6,eturn6
8333 ! Set lprn=.true. for debugging
8338 if(.not.allocated(zapas)) allocate(zapas(max_dim,maxconts,nfgtasks))
8340 num_cont_hb_old(i)=num_cont_hb(i)
8344 if (nfgtasks.le.1) goto 30
8346 write (iout,'(a)') 'Contact function values before RECEIVE:'
8348 write (iout,'(2i3,50(1x,i2,f5.2))') &
8349 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),&
8354 do i=1,ntask_cont_from
8357 do i=1,ntask_cont_to
8360 ! write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8362 ! Make the list of contacts to send to send to other procesors
8363 do i=iturn3_start,iturn3_end
8364 ! write (iout,*) "make contact list turn3",i," num_cont",
8366 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
8368 do i=iturn4_start,iturn4_end
8369 ! write (iout,*) "make contact list turn4",i," num_cont",
8371 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
8375 ! write (iout,*) "make contact list longrange",i,ii," num_cont",
8377 do j=1,num_cont_hb(i)
8380 iproc=iint_sent_local(k,jjc,ii)
8381 ! write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8382 if (iproc.ne.0) then
8383 ncont_sent(iproc)=ncont_sent(iproc)+1
8384 nn=ncont_sent(iproc)
8386 zapas(2,nn,iproc)=jjc
8387 zapas(3,nn,iproc)=d_cont(j,i)
8391 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
8396 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
8404 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
8415 "Numbers of contacts to be sent to other processors",&
8416 (ncont_sent(i),i=1,ntask_cont_to)
8417 write (iout,*) "Contacts sent"
8418 do ii=1,ntask_cont_to
8420 iproc=itask_cont_to(ii)
8421 write (iout,*) nn," contacts to processor",iproc,&
8422 " of CONT_TO_COMM group"
8424 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
8432 CorrelID1=nfgtasks+fg_rank+1
8434 ! Receive the numbers of needed contacts from other processors
8435 do ii=1,ntask_cont_from
8436 iproc=itask_cont_from(ii)
8438 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,&
8439 FG_COMM,req(ireq),IERR)
8441 ! write (iout,*) "IRECV ended"
8443 ! Send the number of contacts needed by other processors
8444 do ii=1,ntask_cont_to
8445 iproc=itask_cont_to(ii)
8447 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,&
8448 FG_COMM,req(ireq),IERR)
8450 ! write (iout,*) "ISEND ended"
8451 ! write (iout,*) "number of requests (nn)",ireq
8454 call MPI_Waitall(ireq,req,status_array,ierr)
8456 ! & "Numbers of contacts to be received from other processors",
8457 ! & (ncont_recv(i),i=1,ntask_cont_from)
8461 do ii=1,ntask_cont_from
8462 iproc=itask_cont_from(ii)
8464 ! write (iout,*) "Receiving",nn," contacts from processor",iproc,
8465 ! & " of CONT_TO_COMM group"
8469 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,&
8470 MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8471 ! write (iout,*) "ireq,req",ireq,req(ireq)
8474 ! Send the contacts to processors that need them
8475 do ii=1,ntask_cont_to
8476 iproc=itask_cont_to(ii)
8478 ! write (iout,*) nn," contacts to processor",iproc,
8479 ! & " of CONT_TO_COMM group"
8482 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,&
8483 iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8484 ! write (iout,*) "ireq,req",ireq,req(ireq)
8486 ! write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8490 ! write (iout,*) "number of requests (contacts)",ireq
8491 ! write (iout,*) "req",(req(i),i=1,4)
8494 call MPI_Waitall(ireq,req,status_array,ierr)
8495 do iii=1,ntask_cont_from
8496 iproc=itask_cont_from(iii)
8499 write (iout,*) "Received",nn," contacts from processor",iproc,&
8500 " of CONT_FROM_COMM group"
8503 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
8508 ii=zapas_recv(1,i,iii)
8509 ! Flag the received contacts to prevent double-counting
8510 jj=-zapas_recv(2,i,iii)
8511 ! write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8513 nnn=num_cont_hb(ii)+1
8516 d_cont(nnn,ii)=zapas_recv(3,i,iii)
8520 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8525 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8533 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8542 write (iout,'(a)') 'Contact function values after receive:'
8544 write (iout,'(2i3,50(1x,i3,5f6.3))') &
8545 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
8546 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8553 write (iout,'(a)') 'Contact function values:'
8555 write (iout,'(2i3,50(1x,i2,5f6.3))') &
8556 i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),&
8557 ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8564 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres))
8565 ! if (.not.allocated(gradxorr)) allocate(gradxorr(3,nres))
8566 ! Remove the loop below after debugging !!!
8573 ! Calculate the dipole-dipole interaction energies
8574 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8575 do i=iatel_s,iatel_e+1
8576 num_conti=num_cont_hb(i)
8585 ! Calculate the local-electrostatic correlation terms
8586 ! write (iout,*) "gradcorr5 in eello5 before loop"
8588 ! write (iout,'(i5,3f10.5)')
8589 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
8591 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
8592 ! write (iout,*) "corr loop i",i
8594 num_conti=num_cont_hb(i)
8595 num_conti1=num_cont_hb(i+1)
8602 ! write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8603 ! & ' jj=',jj,' kk=',kk
8604 ! if (j1.eq.j+1 .or. j1.eq.j-1) then
8605 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0 &
8606 .or. j.lt.0 .and. j1.gt.0) .and. &
8607 (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8608 ! Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8609 ! The system gains extra energy.
8611 sqd1=dsqrt(d_cont(jj,i))
8612 sqd2=dsqrt(d_cont(kk,i1))
8613 sred_geom = sqd1*sqd2
8614 IF (sred_geom.lt.cutoff_corr) THEN
8615 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,&
8617 !d write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
8618 !d & ' jj=',jj,' kk=',kk
8619 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
8620 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
8622 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
8623 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
8626 !d write (iout,*) 'sred_geom=',sred_geom,
8627 !d & ' ekont=',ekont,' fprim=',fprimcont,
8628 !d & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
8629 !d write (iout,*) "g_contij",g_contij
8630 !d write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
8631 !d write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
8632 call calc_eello(i,jp,i+1,jp1,jj,kk)
8633 if (wcorr4.gt.0.0d0) &
8634 ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
8635 if (energy_dec.and.wcorr4.gt.0.0d0) &
8636 write (iout,'(a6,4i5,0pf7.3)') &
8637 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
8638 ! write (iout,*) "gradcorr5 before eello5"
8640 ! write (iout,'(i5,3f10.5)')
8641 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
8643 if (wcorr5.gt.0.0d0) &
8644 ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
8645 ! write (iout,*) "gradcorr5 after eello5"
8647 ! write (iout,'(i5,3f10.5)')
8648 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
8650 if (energy_dec.and.wcorr5.gt.0.0d0) &
8651 write (iout,'(a6,4i5,0pf7.3)') &
8652 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
8653 !d write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
8654 !d write(2,*)'ijkl',i,jp,i+1,jp1
8655 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3 &
8656 .or. wturn6.eq.0.0d0))then
8657 !d write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
8658 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
8659 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
8660 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
8661 !d write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
8662 !d & 'ecorr6=',ecorr6
8663 !d write (iout,'(4e15.5)') sred_geom,
8664 !d & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
8665 !d & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
8666 !d & dabs(eello6(i,jp,i+1,jp1,jj,kk))
8667 else if (wturn6.gt.0.0d0 &
8668 .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
8669 !d write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8670 eturn6=eturn6+eello_turn6(i,jj,kk)
8671 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)') &
8672 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8673 !d write (2,*) 'multibody_eello:eturn6',eturn6
8682 num_cont_hb(i)=num_cont_hb_old(i)
8684 ! write (iout,*) "gradcorr5 in eello5"
8686 ! write (iout,'(i5,3f10.5)')
8687 ! & iii,(gradcorr5(jjj,iii),jjj=1,3)
8690 end subroutine multibody_eello
8691 !-----------------------------------------------------------------------------
8692 subroutine add_hb_contact_eello(ii,jj,itask)
8693 ! implicit real*8 (a-h,o-z)
8694 ! include "DIMENSIONS"
8695 ! include "COMMON.IOUNITS"
8696 ! include "COMMON.CONTACTS"
8697 ! integer,parameter :: maxconts=nres/4
8698 integer,parameter :: max_dim=70
8699 real(kind=8) :: zapas_recv(max_dim,maxconts,nfgtasks)
8700 ! real(kind=8) :: zapas(max_dim,maxconts,nfgtasks) !(max_dim,maxconts,max_fg_procs)
8701 ! common /przechowalnia/ zapas
8703 integer :: i,j,ii,jj,iproc,nn,ind,jjc,kk,ll,mm
8704 integer,dimension(4) ::itask
8705 ! write (iout,*) "itask",itask
8708 if (iproc.gt.0) then
8709 do j=1,num_cont_hb(ii)
8711 ! write (iout,*) "send turns i",ii," j",jj," jjc",jjc
8713 ncont_sent(iproc)=ncont_sent(iproc)+1
8714 nn=ncont_sent(iproc)
8715 zapas(1,nn,iproc)=ii
8716 zapas(2,nn,iproc)=jjc
8717 zapas(3,nn,iproc)=d_cont(j,ii)
8721 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8726 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8734 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8745 end subroutine add_hb_contact_eello
8746 !-----------------------------------------------------------------------------
8747 real(kind=8) function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8748 ! implicit real*8 (a-h,o-z)
8749 ! include 'DIMENSIONS'
8750 ! include 'COMMON.IOUNITS'
8751 ! include 'COMMON.DERIV'
8752 ! include 'COMMON.INTERACT'
8753 ! include 'COMMON.CONTACTS'
8754 real(kind=8),dimension(3) :: gx,gx1
8757 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
8758 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
8759 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
8760 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
8771 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8772 !d ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8773 ! Following 4 lines for diagnostics.
8778 ! write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8779 ! & 'Contacts ',i,j,
8780 ! & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8781 ! & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8783 ! Calculate the multi-body contribution to energy.
8784 ! ecorr=ecorr+ekont*ees
8785 ! Calculate multi-body contributions to the gradient.
8786 coeffpees0pij=coeffp*ees0pij
8787 coeffmees0mij=coeffm*ees0mij
8788 coeffpees0pkl=coeffp*ees0pkl
8789 coeffmees0mkl=coeffm*ees0mkl
8791 !grad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8792 gradcorr(ll,i)=gradcorr(ll,i) & !+0.5d0*ghalfi
8793 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+ &
8794 coeffmees0mkl*gacontm_hb1(ll,jj,i))
8795 gradcorr(ll,j)=gradcorr(ll,j) & !+0.5d0*ghalfi
8796 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
8797 coeffmees0mkl*gacontm_hb2(ll,jj,i))
8798 !grad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8799 gradcorr(ll,k)=gradcorr(ll,k) & !+0.5d0*ghalfk
8800 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
8801 coeffmees0mij*gacontm_hb1(ll,kk,k))
8802 gradcorr(ll,l)=gradcorr(ll,l) & !+0.5d0*ghalfk
8803 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
8804 coeffmees0mij*gacontm_hb2(ll,kk,k))
8805 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
8806 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
8807 coeffmees0mkl*gacontm_hb3(ll,jj,i))
8808 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8809 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8810 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
8811 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
8812 coeffmees0mij*gacontm_hb3(ll,kk,k))
8813 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8814 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8815 ! write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8820 !grad gradcorr(ll,m)=gradcorr(ll,m)+
8821 !grad & ees*ekl*gacont_hbr(ll,jj,i)-
8822 !grad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8823 !grad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8828 !grad gradcorr(ll,m)=gradcorr(ll,m)+
8829 !grad & ees*eij*gacont_hbr(ll,kk,k)-
8830 !grad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8831 !grad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8834 ! write (iout,*) "ehbcorr",ekont*ees
8836 if (shield_mode.gt.0) then
8839 !C print *,i,j,fac_shield(i),fac_shield(j),
8840 !C &fac_shield(k),fac_shield(l)
8841 if ((fac_shield(i).gt.0).and.(fac_shield(j).gt.0).and. &
8842 (fac_shield(k).gt.0).and.(fac_shield(l).gt.0)) then
8843 do ilist=1,ishield_list(i)
8844 iresshield=shield_list(ilist,i)
8846 rlocshield=grad_shield_side(m,ilist,i)*ehbcorr/fac_shield(i)
8847 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8849 +grad_shield_loc(m,ilist,i)*ehbcorr/fac_shield(i)
8850 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8854 do ilist=1,ishield_list(j)
8855 iresshield=shield_list(ilist,j)
8857 rlocshield=grad_shield_side(m,ilist,j)*ehbcorr/fac_shield(j)
8858 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8860 +grad_shield_loc(m,ilist,j)*ehbcorr/fac_shield(j)
8861 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8866 do ilist=1,ishield_list(k)
8867 iresshield=shield_list(ilist,k)
8869 rlocshield=grad_shield_side(m,ilist,k)*ehbcorr/fac_shield(k)
8870 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8872 +grad_shield_loc(m,ilist,k)*ehbcorr/fac_shield(k)
8873 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8877 do ilist=1,ishield_list(l)
8878 iresshield=shield_list(ilist,l)
8880 rlocshield=grad_shield_side(m,ilist,l)*ehbcorr/fac_shield(l)
8881 gshieldx_ec(m,iresshield)=gshieldx_ec(m,iresshield)+ &
8883 +grad_shield_loc(m,ilist,l)*ehbcorr/fac_shield(l)
8884 gshieldc_ec(m,iresshield-1)=gshieldc_ec(m,iresshield-1) &
8889 gshieldc_ec(m,i)=gshieldc_ec(m,i)+ &
8890 grad_shield(m,i)*ehbcorr/fac_shield(i)
8891 gshieldc_ec(m,j)=gshieldc_ec(m,j)+ &
8892 grad_shield(m,j)*ehbcorr/fac_shield(j)
8893 gshieldc_ec(m,i-1)=gshieldc_ec(m,i-1)+ &
8894 grad_shield(m,i)*ehbcorr/fac_shield(i)
8895 gshieldc_ec(m,j-1)=gshieldc_ec(m,j-1)+ &
8896 grad_shield(m,j)*ehbcorr/fac_shield(j)
8898 gshieldc_ec(m,k)=gshieldc_ec(m,k)+ &
8899 grad_shield(m,k)*ehbcorr/fac_shield(k)
8900 gshieldc_ec(m,l)=gshieldc_ec(m,l)+ &
8901 grad_shield(m,l)*ehbcorr/fac_shield(l)
8902 gshieldc_ec(m,k-1)=gshieldc_ec(m,k-1)+ &
8903 grad_shield(m,k)*ehbcorr/fac_shield(k)
8904 gshieldc_ec(m,l-1)=gshieldc_ec(m,l-1)+ &
8905 grad_shield(m,l)*ehbcorr/fac_shield(l)
8911 end function ehbcorr
8913 !-----------------------------------------------------------------------------
8914 subroutine dipole(i,j,jj)
8915 ! implicit real*8 (a-h,o-z)
8916 ! include 'DIMENSIONS'
8917 ! include 'COMMON.IOUNITS'
8918 ! include 'COMMON.CHAIN'
8919 ! include 'COMMON.FFIELD'
8920 ! include 'COMMON.DERIV'
8921 ! include 'COMMON.INTERACT'
8922 ! include 'COMMON.CONTACTS'
8923 ! include 'COMMON.TORSION'
8924 ! include 'COMMON.VAR'
8925 ! include 'COMMON.GEO'
8926 real(kind=8),dimension(2,2) :: dipi,dipj,auxmat
8927 real(kind=8),dimension(2) :: dipderi,dipderj,auxvec
8928 integer :: i,j,jj,iii,jjj,kkk,lll,iti1,itj1
8930 allocate(dip(4,maxconts,nres),dipderg(4,maxconts,nres))
8931 allocate(dipderx(3,5,4,maxconts,nres))
8934 iti1 = itortyp(itype(i+1,1))
8935 if (j.lt.nres-1) then
8936 itj1 = itype2loc(itype(j+1,1))
8941 dipi(iii,1)=Ub2(iii,i)
8942 dipderi(iii)=Ub2der(iii,i)
8943 dipi(iii,2)=b1(iii,iti1)
8944 dipj(iii,1)=Ub2(iii,j)
8945 dipderj(iii)=Ub2der(iii,j)
8946 dipj(iii,2)=b1(iii,itj1)
8950 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8953 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8960 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),&
8964 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8969 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8970 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8972 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8974 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8976 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8979 end subroutine dipole
8981 !-----------------------------------------------------------------------------
8982 subroutine calc_eello(i,j,k,l,jj,kk)
8984 ! This subroutine computes matrices and vectors needed to calculate
8985 ! the fourth-, fifth-, and sixth-order local-electrostatic terms.
8988 ! implicit real*8 (a-h,o-z)
8989 ! include 'DIMENSIONS'
8990 ! include 'COMMON.IOUNITS'
8991 ! include 'COMMON.CHAIN'
8992 ! include 'COMMON.DERIV'
8993 ! include 'COMMON.INTERACT'
8994 ! include 'COMMON.CONTACTS'
8995 ! include 'COMMON.TORSION'
8996 ! include 'COMMON.VAR'
8997 ! include 'COMMON.GEO'
8998 ! include 'COMMON.FFIELD'
8999 real(kind=8),dimension(2,2) :: aa1,aa2,aa1t,aa2t,auxmat
9000 real(kind=8),dimension(2,2,3,5) :: aa1tder,aa2tder
9001 integer :: i,j,k,l,jj,kk,iii,jjj,kkk,lll,iti,itk1,itj,itl,itl1,&
9004 !el common /kutas/ lprn
9005 !d write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
9006 !d & ' jj=',jj,' kk=',kk
9007 !d if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
9008 !d write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
9009 !d write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
9012 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
9013 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
9016 call transpose2(aa1(1,1),aa1t(1,1))
9017 call transpose2(aa2(1,1),aa2t(1,1))
9020 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),&
9021 aa1tder(1,1,lll,kkk))
9022 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),&
9023 aa2tder(1,1,lll,kkk))
9027 ! parallel orientation of the two CA-CA-CA frames.
9029 iti=itortyp(itype(i,1))
9033 itk1=itortyp(itype(k+1,1))
9034 itj=itortyp(itype(j,1))
9035 if (l.lt.nres-1) then
9036 itl1=itortyp(itype(l+1,1))
9040 ! A1 kernel(j+1) A2T
9042 !d write (iout,'(3f10.5,5x,3f10.5)')
9043 !d & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
9045 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
9046 aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),&
9047 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9048 ! Following matrices are needed only for 6-th order cumulants
9049 IF (wcorr6.gt.0.0d0) THEN
9050 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
9051 aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),&
9052 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9053 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
9054 aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),&
9055 Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
9056 ADtEAderx(1,1,1,1,1,1))
9058 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
9059 aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),&
9060 DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
9061 ADtEA1derx(1,1,1,1,1,1))
9063 ! End 6-th order cumulants
9066 !d write (2,*) 'In calc_eello6'
9068 !d write (2,*) 'iii=',iii
9070 !d write (2,*) 'kkk=',kkk
9072 !d write (2,'(3(2f10.5),5x)')
9073 !d & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9078 call transpose2(EUgder(1,1,k),auxmat(1,1))
9079 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9080 call transpose2(EUg(1,1,k),auxmat(1,1))
9081 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9082 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9086 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
9087 EAEAderx(1,1,lll,kkk,iii,1))
9091 ! A1T kernel(i+1) A2
9092 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
9093 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),&
9094 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9095 ! Following matrices are needed only for 6-th order cumulants
9096 IF (wcorr6.gt.0.0d0) THEN
9097 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
9098 a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),&
9099 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9100 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
9101 a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),&
9102 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
9103 ADtEAderx(1,1,1,1,1,2))
9104 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),&
9105 a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),&
9106 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
9107 ADtEA1derx(1,1,1,1,1,2))
9109 ! End 6-th order cumulants
9110 call transpose2(EUgder(1,1,l),auxmat(1,1))
9111 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
9112 call transpose2(EUg(1,1,l),auxmat(1,1))
9113 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9114 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9118 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
9119 EAEAderx(1,1,lll,kkk,iii,2))
9124 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9125 ! They are needed only when the fifth- or the sixth-order cumulants are
9127 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
9128 call transpose2(AEA(1,1,1),auxmat(1,1))
9129 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
9130 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9131 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9132 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9133 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
9134 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9135 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
9136 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
9137 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9138 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9139 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9140 call transpose2(AEA(1,1,2),auxmat(1,1))
9141 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
9142 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
9143 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
9144 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9145 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
9146 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
9147 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
9148 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
9149 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
9150 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
9151 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
9152 ! Calculate the Cartesian derivatives of the vectors.
9156 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9157 call matvec2(auxmat(1,1),b1(1,iti),&
9158 AEAb1derx(1,lll,kkk,iii,1,1))
9159 call matvec2(auxmat(1,1),Ub2(1,i),&
9160 AEAb2derx(1,lll,kkk,iii,1,1))
9161 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
9162 AEAb1derx(1,lll,kkk,iii,2,1))
9163 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
9164 AEAb2derx(1,lll,kkk,iii,2,1))
9165 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9166 call matvec2(auxmat(1,1),b1(1,itj),&
9167 AEAb1derx(1,lll,kkk,iii,1,2))
9168 call matvec2(auxmat(1,1),Ub2(1,j),&
9169 AEAb2derx(1,lll,kkk,iii,1,2))
9170 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
9171 AEAb1derx(1,lll,kkk,iii,2,2))
9172 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),&
9173 AEAb2derx(1,lll,kkk,iii,2,2))
9180 ! Antiparallel orientation of the two CA-CA-CA frames.
9182 iti=itortyp(itype(i,1))
9186 itk1=itortyp(itype(k+1,1))
9187 itl=itortyp(itype(l,1))
9188 itj=itortyp(itype(j,1))
9189 if (j.lt.nres-1) then
9190 itj1=itortyp(itype(j+1,1))
9194 ! A2 kernel(j-1)T A1T
9195 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
9196 aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),&
9197 AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9198 ! Following matrices are needed only for 6-th order cumulants
9199 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
9200 j.eq.i+4 .and. l.eq.i+3)) THEN
9201 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
9202 aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),&
9203 AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9204 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
9205 aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),&
9206 Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),&
9207 ADtEAderx(1,1,1,1,1,1))
9208 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),&
9209 aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),&
9210 DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),&
9211 ADtEA1derx(1,1,1,1,1,1))
9213 ! End 6-th order cumulants
9214 call transpose2(EUgder(1,1,k),auxmat(1,1))
9215 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9216 call transpose2(EUg(1,1,k),auxmat(1,1))
9217 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9218 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9222 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
9223 EAEAderx(1,1,lll,kkk,iii,1))
9227 ! A2T kernel(i+1)T A1
9228 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
9229 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),&
9230 AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9231 ! Following matrices are needed only for 6-th order cumulants
9232 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and. &
9233 j.eq.i+4 .and. l.eq.i+3)) THEN
9234 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
9235 a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),&
9236 AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9237 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
9238 a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),&
9239 Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),&
9240 ADtEAderx(1,1,1,1,1,2))
9241 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),&
9242 a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),&
9243 DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),&
9244 ADtEA1derx(1,1,1,1,1,2))
9246 ! End 6-th order cumulants
9247 call transpose2(EUgder(1,1,j),auxmat(1,1))
9248 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
9249 call transpose2(EUg(1,1,j),auxmat(1,1))
9250 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9251 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9255 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
9256 EAEAderx(1,1,lll,kkk,iii,2))
9261 ! Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9262 ! They are needed only when the fifth- or the sixth-order cumulants are
9264 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or. &
9265 (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
9266 call transpose2(AEA(1,1,1),auxmat(1,1))
9267 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
9268 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9269 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9270 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9271 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
9272 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9273 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
9274 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
9275 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9276 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9277 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9278 call transpose2(AEA(1,1,2),auxmat(1,1))
9279 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
9280 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
9281 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
9282 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9283 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
9284 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
9285 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
9286 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
9287 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
9288 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
9289 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
9290 ! Calculate the Cartesian derivatives of the vectors.
9294 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9295 call matvec2(auxmat(1,1),b1(1,iti),&
9296 AEAb1derx(1,lll,kkk,iii,1,1))
9297 call matvec2(auxmat(1,1),Ub2(1,i),&
9298 AEAb2derx(1,lll,kkk,iii,1,1))
9299 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
9300 AEAb1derx(1,lll,kkk,iii,2,1))
9301 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),&
9302 AEAb2derx(1,lll,kkk,iii,2,1))
9303 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9304 call matvec2(auxmat(1,1),b1(1,itl),&
9305 AEAb1derx(1,lll,kkk,iii,1,2))
9306 call matvec2(auxmat(1,1),Ub2(1,l),&
9307 AEAb2derx(1,lll,kkk,iii,1,2))
9308 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),&
9309 AEAb1derx(1,lll,kkk,iii,2,2))
9310 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),&
9311 AEAb2derx(1,lll,kkk,iii,2,2))
9319 end subroutine calc_eello
9320 !-----------------------------------------------------------------------------
9321 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,KK,KKderg,AKA,AKAderg,AKAderx)
9326 real(kind=8),dimension(2,2) :: aa1,aa2t,KK,AKA
9327 real(kind=8),dimension(2,2,3,5) :: aa1derx,aa2tderx
9328 real(kind=8),dimension(2,2,3,5,2) :: AKAderx
9329 real(kind=8),dimension(2,2,nderg) :: KKderg,AKAderg
9330 integer :: iii,kkk,lll
9333 !el common /kutas/ lprn
9334 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
9336 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,&
9339 !d if (lprn) write (2,*) 'In kernel'
9341 !d if (lprn) write (2,*) 'kkk=',kkk
9343 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),&
9344 KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
9346 !d write (2,*) 'lll=',lll
9347 !d write (2,*) 'iii=1'
9349 !d write (2,'(3(2f10.5),5x)')
9350 !d & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
9353 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),&
9354 KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
9356 !d write (2,*) 'lll=',lll
9357 !d write (2,*) 'iii=2'
9359 !d write (2,'(3(2f10.5),5x)')
9360 !d & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
9366 end subroutine kernel
9367 !-----------------------------------------------------------------------------
9368 real(kind=8) function eello4(i,j,k,l,jj,kk)
9369 ! implicit real*8 (a-h,o-z)
9370 ! include 'DIMENSIONS'
9371 ! include 'COMMON.IOUNITS'
9372 ! include 'COMMON.CHAIN'
9373 ! include 'COMMON.DERIV'
9374 ! include 'COMMON.INTERACT'
9375 ! include 'COMMON.CONTACTS'
9376 ! include 'COMMON.TORSION'
9377 ! include 'COMMON.VAR'
9378 ! include 'COMMON.GEO'
9379 real(kind=8),dimension(2,2) :: pizda
9380 real(kind=8),dimension(3) :: ggg1,ggg2
9381 real(kind=8) :: eel4,glongij,glongkl
9382 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
9383 !d if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
9387 !d print *,'eello4:',i,j,k,l,jj,kk
9388 !d write (2,*) 'i',i,' j',j,' k',k,' l',l
9389 !d call checkint4(i,j,k,l,jj,kk,eel4_num)
9390 !old eij=facont_hb(jj,i)
9391 !old ekl=facont_hb(kk,k)
9393 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
9394 !d eel41=-EAEA(1,1,2)-EAEA(2,2,2)
9395 gcorr_loc(k-1)=gcorr_loc(k-1) &
9396 -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
9398 gcorr_loc(l-1)=gcorr_loc(l-1) &
9399 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9401 gcorr_loc(j-1)=gcorr_loc(j-1) &
9402 -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9407 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1) &
9408 -EAEAderx(2,2,lll,kkk,iii,1)
9409 !d derx(lll,kkk,iii)=0.0d0
9413 !d gcorr_loc(l-1)=0.0d0
9414 !d gcorr_loc(j-1)=0.0d0
9415 !d gcorr_loc(k-1)=0.0d0
9417 !d write (iout,*)'Contacts have occurred for peptide groups',
9418 !d & i,j,' fcont:',eij,' eij',' and ',k,l,
9419 !d & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
9420 if (j.lt.nres-1) then
9427 if (l.lt.nres-1) then
9435 !grad ggg1(ll)=eel4*g_contij(ll,1)
9436 !grad ggg2(ll)=eel4*g_contij(ll,2)
9437 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
9438 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
9439 !grad ghalf=0.5d0*ggg1(ll)
9440 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
9441 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
9442 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
9443 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
9444 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
9445 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
9446 !grad ghalf=0.5d0*ggg2(ll)
9447 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
9448 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
9449 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
9450 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
9451 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
9452 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
9456 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
9461 !grad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
9466 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
9471 !grad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
9475 !d write (2,*) iii,gcorr_loc(iii)
9478 !d write (2,*) 'ekont',ekont
9479 !d write (iout,*) 'eello4',ekont*eel4
9482 !-----------------------------------------------------------------------------
9483 real(kind=8) function eello5(i,j,k,l,jj,kk)
9484 ! implicit real*8 (a-h,o-z)
9485 ! include 'DIMENSIONS'
9486 ! include 'COMMON.IOUNITS'
9487 ! include 'COMMON.CHAIN'
9488 ! include 'COMMON.DERIV'
9489 ! include 'COMMON.INTERACT'
9490 ! include 'COMMON.CONTACTS'
9491 ! include 'COMMON.TORSION'
9492 ! include 'COMMON.VAR'
9493 ! include 'COMMON.GEO'
9494 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
9495 real(kind=8),dimension(2) :: vv
9496 real(kind=8),dimension(3) :: ggg1,ggg2
9497 real(kind=8) :: eello5_1,eello5_2,eello5_3,eello5_4,eel5
9498 real(kind=8) :: gradcorr5ij,gradcorr5kl,ghalf
9499 integer :: i,j,k,l,jj,kk,itk,itl,itj,iii,kkk,lll,j1,j2,l1,l2,ll
9500 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9505 ! /l\ / \ \ / \ / \ / C
9506 ! / \ / \ \ / \ / \ / C
9507 ! j| o |l1 | o | o| o | | o |o C
9508 ! \ |/k\| |/ \| / |/ \| |/ \| C
9509 ! \i/ \ / \ / / \ / \ C
9511 ! (I) (II) (III) (IV) C
9513 ! eello5_1 eello5_2 eello5_3 eello5_4 C
9515 ! Antiparallel chains C
9518 ! /j\ / \ \ / \ / \ / C
9519 ! / \ / \ \ / \ / \ / C
9520 ! j1| o |l | o | o| o | | o |o C
9521 ! \ |/k\| |/ \| / |/ \| |/ \| C
9522 ! \i/ \ / \ / / \ / \ C
9524 ! (I) (II) (III) (IV) C
9526 ! eello5_1 eello5_2 eello5_3 eello5_4 C
9528 ! o denotes a local interaction, vertical lines an electrostatic interaction. C
9530 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9531 !d if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9536 !d & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9538 itk=itortyp(itype(k,1))
9539 itl=itortyp(itype(l,1))
9540 itj=itortyp(itype(j,1))
9545 !d call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9546 !d & eel5_3_num,eel5_4_num)
9550 derx(lll,kkk,iii)=0.0d0
9554 !d eij=facont_hb(jj,i)
9555 !d ekl=facont_hb(kk,k)
9557 !d write (iout,*)'Contacts have occurred for peptide groups',
9558 !d & i,j,' fcont:',eij,' eij',' and ',k,l
9560 ! Contribution from the graph I.
9561 !d write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9562 !d write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9563 call transpose2(EUg(1,1,k),auxmat(1,1))
9564 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9565 vv(1)=pizda(1,1)-pizda(2,2)
9566 vv(2)=pizda(1,2)+pizda(2,1)
9567 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k)) &
9568 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9569 ! Explicit gradient in virtual-dihedral angles.
9570 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1) &
9571 +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k)) &
9572 +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9573 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9574 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9575 vv(1)=pizda(1,1)-pizda(2,2)
9576 vv(2)=pizda(1,2)+pizda(2,1)
9577 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9578 +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k)) &
9579 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9580 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9581 vv(1)=pizda(1,1)-pizda(2,2)
9582 vv(2)=pizda(1,2)+pizda(2,1)
9584 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9585 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
9586 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9588 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9589 +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k)) &
9590 +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9592 ! Cartesian gradient
9596 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),&
9598 vv(1)=pizda(1,1)-pizda(2,2)
9599 vv(2)=pizda(1,2)+pizda(2,1)
9600 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
9601 +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k)) &
9602 +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9608 ! Contribution from graph II
9609 call transpose2(EE(1,1,itk),auxmat(1,1))
9610 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
9611 vv(1)=pizda(1,1)+pizda(2,2)
9612 vv(2)=pizda(2,1)-pizda(1,2)
9613 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk)) &
9614 -0.5d0*scalar2(vv(1),Ctobr(1,k))
9615 ! Explicit gradient in virtual-dihedral angles.
9616 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9617 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
9618 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
9619 vv(1)=pizda(1,1)+pizda(2,2)
9620 vv(2)=pizda(2,1)-pizda(1,2)
9622 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9623 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
9624 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9626 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9627 +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk)) &
9628 -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9630 ! Cartesian gradient
9634 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),&
9636 vv(1)=pizda(1,1)+pizda(2,2)
9637 vv(2)=pizda(2,1)-pizda(1,2)
9638 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
9639 +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk)) &
9640 -0.5d0*scalar2(vv(1),Ctobr(1,k))
9648 ! Parallel orientation
9649 ! Contribution from graph III
9650 call transpose2(EUg(1,1,l),auxmat(1,1))
9651 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9652 vv(1)=pizda(1,1)-pizda(2,2)
9653 vv(2)=pizda(1,2)+pizda(2,1)
9654 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l)) &
9655 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9656 ! Explicit gradient in virtual-dihedral angles.
9657 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9658 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l)) &
9659 +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
9660 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9661 vv(1)=pizda(1,1)-pizda(2,2)
9662 vv(2)=pizda(1,2)+pizda(2,1)
9663 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9664 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l)) &
9665 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9666 call transpose2(EUgder(1,1,l),auxmat1(1,1))
9667 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9668 vv(1)=pizda(1,1)-pizda(2,2)
9669 vv(2)=pizda(1,2)+pizda(2,1)
9670 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9671 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l)) &
9672 +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9673 ! Cartesian gradient
9677 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
9679 vv(1)=pizda(1,1)-pizda(2,2)
9680 vv(2)=pizda(1,2)+pizda(2,1)
9681 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
9682 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l)) &
9683 +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9688 ! Contribution from graph IV
9690 call transpose2(EE(1,1,itl),auxmat(1,1))
9691 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9692 vv(1)=pizda(1,1)+pizda(2,2)
9693 vv(2)=pizda(2,1)-pizda(1,2)
9694 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl)) &
9695 -0.5d0*scalar2(vv(1),Ctobr(1,l))
9696 ! Explicit gradient in virtual-dihedral angles.
9697 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9698 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
9699 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9700 vv(1)=pizda(1,1)+pizda(2,2)
9701 vv(2)=pizda(2,1)-pizda(1,2)
9702 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9703 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl)) &
9704 -0.5d0*scalar2(vv(1),Ctobr(1,l)))
9705 ! Cartesian gradient
9709 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
9711 vv(1)=pizda(1,1)+pizda(2,2)
9712 vv(2)=pizda(2,1)-pizda(1,2)
9713 derx(lll,kkk,iii)=derx(lll,kkk,iii) &
9714 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl)) &
9715 -0.5d0*scalar2(vv(1),Ctobr(1,l))
9720 ! Antiparallel orientation
9721 ! Contribution from graph III
9723 call transpose2(EUg(1,1,j),auxmat(1,1))
9724 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9725 vv(1)=pizda(1,1)-pizda(2,2)
9726 vv(2)=pizda(1,2)+pizda(2,1)
9727 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j)) &
9728 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9729 ! Explicit gradient in virtual-dihedral angles.
9730 g_corr5_loc(l-1)=g_corr5_loc(l-1) &
9731 +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j)) &
9732 +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9733 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9734 vv(1)=pizda(1,1)-pizda(2,2)
9735 vv(2)=pizda(1,2)+pizda(2,1)
9736 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9737 +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j)) &
9738 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9739 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9740 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9741 vv(1)=pizda(1,1)-pizda(2,2)
9742 vv(2)=pizda(1,2)+pizda(2,1)
9743 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9744 +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j)) &
9745 +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9746 ! Cartesian gradient
9750 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),&
9752 vv(1)=pizda(1,1)-pizda(2,2)
9753 vv(2)=pizda(1,2)+pizda(2,1)
9754 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
9755 +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j)) &
9756 +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9761 ! Contribution from graph IV
9763 call transpose2(EE(1,1,itj),auxmat(1,1))
9764 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9765 vv(1)=pizda(1,1)+pizda(2,2)
9766 vv(2)=pizda(2,1)-pizda(1,2)
9767 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj)) &
9768 -0.5d0*scalar2(vv(1),Ctobr(1,j))
9769 ! Explicit gradient in virtual-dihedral angles.
9770 g_corr5_loc(j-1)=g_corr5_loc(j-1) &
9771 -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9772 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9773 vv(1)=pizda(1,1)+pizda(2,2)
9774 vv(2)=pizda(2,1)-pizda(1,2)
9775 g_corr5_loc(k-1)=g_corr5_loc(k-1) &
9776 +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj)) &
9777 -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9778 ! Cartesian gradient
9782 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),&
9784 vv(1)=pizda(1,1)+pizda(2,2)
9785 vv(2)=pizda(2,1)-pizda(1,2)
9786 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii) &
9787 +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj)) &
9788 -0.5d0*scalar2(vv(1),Ctobr(1,j))
9794 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9795 !d if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9796 !d write (2,*) 'ijkl',i,j,k,l
9797 !d write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9798 !d & ' eello5_3',eello5_3,' eello5_4',eello5_4
9800 !d write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9801 !d write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9802 !d write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9803 !d write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9804 if (j.lt.nres-1) then
9811 if (l.lt.nres-1) then
9821 !d write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9822 ! 2/11/08 AL Gradients over DC's connecting interacting sites will be
9823 ! summed up outside the subrouine as for the other subroutines
9824 ! handling long-range interactions. The old code is commented out
9825 ! with "cgrad" to keep track of changes.
9827 !grad ggg1(ll)=eel5*g_contij(ll,1)
9828 !grad ggg2(ll)=eel5*g_contij(ll,2)
9829 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9830 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9831 ! write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9832 ! & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9833 ! & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9834 ! & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9835 ! write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9836 ! & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9838 ! & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9839 !old ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9840 !grad ghalf=0.5d0*ggg1(ll)
9842 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9843 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9844 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9845 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9846 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9847 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9848 !old ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9849 !grad ghalf=0.5d0*ggg2(ll)
9851 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
9852 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9853 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
9854 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9855 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9856 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9861 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9862 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9867 !old gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9868 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9874 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9879 !grad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9883 !d write (2,*) iii,g_corr5_loc(iii)
9886 !d write (2,*) 'ekont',ekont
9887 !d write (iout,*) 'eello5',ekont*eel5
9890 !-----------------------------------------------------------------------------
9891 real(kind=8) function eello6(i,j,k,l,jj,kk)
9892 ! implicit real*8 (a-h,o-z)
9893 ! include 'DIMENSIONS'
9894 ! include 'COMMON.IOUNITS'
9895 ! include 'COMMON.CHAIN'
9896 ! include 'COMMON.DERIV'
9897 ! include 'COMMON.INTERACT'
9898 ! include 'COMMON.CONTACTS'
9899 ! include 'COMMON.TORSION'
9900 ! include 'COMMON.VAR'
9901 ! include 'COMMON.GEO'
9902 ! include 'COMMON.FFIELD'
9903 real(kind=8),dimension(3) :: ggg1,ggg2
9904 real(kind=8) :: eello6_1,eello6_2,eello6_3,eello6_4,eello6_5,&
9906 real(kind=8) :: gradcorr6ij,gradcorr6kl
9907 integer :: i,j,k,l,jj,kk,iii,kkk,lll,j1,j2,l1,l2,ll
9908 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9913 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9921 !d call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9922 !d & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9926 derx(lll,kkk,iii)=0.0d0
9930 !d eij=facont_hb(jj,i)
9931 !d ekl=facont_hb(kk,k)
9937 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9938 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9939 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9940 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9941 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9942 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9944 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9945 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9946 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9947 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9948 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9949 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9953 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9955 ! If turn contributions are considered, they will be handled separately.
9956 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9957 !d write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9958 !d write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9959 !d write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9960 !d write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9961 !d write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9962 !d write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9964 if (j.lt.nres-1) then
9971 if (l.lt.nres-1) then
9979 !grad ggg1(ll)=eel6*g_contij(ll,1)
9980 !grad ggg2(ll)=eel6*g_contij(ll,2)
9981 !old ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9982 !grad ghalf=0.5d0*ggg1(ll)
9984 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9985 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9986 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9987 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9988 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9989 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9990 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9991 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9992 !grad ghalf=0.5d0*ggg2(ll)
9993 !old ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9995 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9996 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9997 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9998 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9999 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
10000 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
10005 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
10006 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
10011 !old gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
10012 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
10018 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
10023 !grad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
10027 !d write (2,*) iii,g_corr6_loc(iii)
10030 !d write (2,*) 'ekont',ekont
10031 !d write (iout,*) 'eello6',ekont*eel6
10033 end function eello6
10034 !-----------------------------------------------------------------------------
10035 real(kind=8) function eello6_graph1(i,j,k,l,imat,swap)
10037 ! implicit real*8 (a-h,o-z)
10038 ! include 'DIMENSIONS'
10039 ! include 'COMMON.IOUNITS'
10040 ! include 'COMMON.CHAIN'
10041 ! include 'COMMON.DERIV'
10042 ! include 'COMMON.INTERACT'
10043 ! include 'COMMON.CONTACTS'
10044 ! include 'COMMON.TORSION'
10045 ! include 'COMMON.VAR'
10046 ! include 'COMMON.GEO'
10047 real(kind=8),dimension(2) :: vv,vv1
10048 real(kind=8),dimension(2,2) :: pizda,auxmat,pizda1
10050 !el logical :: lprn
10051 !el common /kutas/ lprn
10052 integer :: i,j,k,l,imat,itk,iii,kkk,lll,ind
10053 real(kind=8) :: s1,s2,s3,s4,s5
10054 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10056 ! Parallel Antiparallel C
10062 ! \ j|/k\| / \ |/k\|l / C
10063 ! \ / \ / \ / \ / C
10067 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10068 itk=itortyp(itype(k,1))
10069 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
10070 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
10071 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
10072 call transpose2(EUgC(1,1,k),auxmat(1,1))
10073 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
10074 vv1(1)=pizda1(1,1)-pizda1(2,2)
10075 vv1(2)=pizda1(1,2)+pizda1(2,1)
10076 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10077 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
10078 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
10079 s5=scalar2(vv(1),Dtobr2(1,i))
10080 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
10081 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
10082 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1) &
10083 -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i)) &
10084 -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k)) &
10085 +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k)) &
10086 +0.5d0*scalar2(vv1(1),Dtobr2der(1,i)) &
10087 +scalar2(vv(1),Dtobr2der(1,i)))
10088 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
10089 vv1(1)=pizda1(1,1)-pizda1(2,2)
10090 vv1(2)=pizda1(1,2)+pizda1(2,1)
10091 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
10092 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
10094 g_corr6_loc(l-1)=g_corr6_loc(l-1) &
10095 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
10096 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
10097 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
10098 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
10100 g_corr6_loc(j-1)=g_corr6_loc(j-1) &
10101 +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i)) &
10102 -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k)) &
10103 +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k)) &
10104 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
10106 call transpose2(EUgCder(1,1,k),auxmat(1,1))
10107 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
10108 vv1(1)=pizda1(1,1)-pizda1(2,2)
10109 vv1(2)=pizda1(1,2)+pizda1(2,1)
10110 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1) &
10111 +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k)) &
10112 +scalar2(AEAb2(1,1,imat),CUgb2der(1,k)) &
10113 +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
10122 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
10123 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
10124 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
10125 call transpose2(EUgC(1,1,k),auxmat(1,1))
10126 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
10128 vv1(1)=pizda1(1,1)-pizda1(2,2)
10129 vv1(2)=pizda1(1,2)+pizda1(2,1)
10130 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
10131 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk) &
10132 -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
10133 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk) &
10134 +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
10135 s5=scalar2(vv(1),Dtobr2(1,i))
10136 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
10141 end function eello6_graph1
10142 !-----------------------------------------------------------------------------
10143 real(kind=8) function eello6_graph2(i,j,k,l,jj,kk,swap)
10145 ! implicit real*8 (a-h,o-z)
10146 ! include 'DIMENSIONS'
10147 ! include 'COMMON.IOUNITS'
10148 ! include 'COMMON.CHAIN'
10149 ! include 'COMMON.DERIV'
10150 ! include 'COMMON.INTERACT'
10151 ! include 'COMMON.CONTACTS'
10152 ! include 'COMMON.TORSION'
10153 ! include 'COMMON.VAR'
10154 ! include 'COMMON.GEO'
10156 real(kind=8),dimension(2) :: vv,auxvec,auxvec1,auxvec2
10157 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
10158 !el logical :: lprn
10159 !el common /kutas/ lprn
10160 integer :: i,j,k,l,jj,kk,iii,kkk,lll,jjj,mmm
10161 real(kind=8) :: s2,s3,s4
10162 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10164 ! Parallel Antiparallel C
10170 ! \ j|/k\| \ |/k\|l C
10175 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10176 !d write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
10177 ! AL 7/4/01 s1 would occur in the sixth-order moment,
10178 ! but not in a cluster cumulant
10180 s1=dip(1,jj,i)*dip(1,kk,k)
10182 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
10183 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10184 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
10185 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
10186 call transpose2(EUg(1,1,k),auxmat(1,1))
10187 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
10188 vv(1)=pizda(1,1)-pizda(2,2)
10189 vv(2)=pizda(1,2)+pizda(2,1)
10190 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10191 !d write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10193 eello6_graph2=-(s1+s2+s3+s4)
10195 eello6_graph2=-(s2+s3+s4)
10197 ! eello6_graph2=-s3
10198 ! Derivatives in gamma(i-1)
10201 s1=dipderg(1,jj,i)*dip(1,kk,k)
10203 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10204 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
10205 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10206 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10208 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10210 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10212 ! g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
10214 ! Derivatives in gamma(k-1)
10216 s1=dip(1,jj,i)*dipderg(1,kk,k)
10218 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
10219 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10220 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
10221 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10222 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10223 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
10224 vv(1)=pizda(1,1)-pizda(2,2)
10225 vv(2)=pizda(1,2)+pizda(2,1)
10226 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10228 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10230 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10232 ! g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
10233 ! Derivatives in gamma(j-1) or gamma(l-1)
10236 s1=dipderg(3,jj,i)*dip(1,kk,k)
10238 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
10239 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10240 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
10241 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
10242 vv(1)=pizda(1,1)-pizda(2,2)
10243 vv(2)=pizda(1,2)+pizda(2,1)
10244 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10247 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10249 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10252 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
10253 ! g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
10255 ! Derivatives in gamma(l-1) or gamma(j-1)
10258 s1=dip(1,jj,i)*dipderg(3,kk,k)
10260 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
10261 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10262 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
10263 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10264 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
10265 vv(1)=pizda(1,1)-pizda(2,2)
10266 vv(2)=pizda(1,2)+pizda(2,1)
10267 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10270 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10272 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10275 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
10276 ! g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
10278 ! Cartesian derivatives.
10280 write (2,*) 'In eello6_graph2'
10282 write (2,*) 'iii=',iii
10284 write (2,*) 'kkk=',kkk
10286 write (2,'(3(2f10.5),5x)') &
10287 ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
10297 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
10299 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
10302 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),&
10304 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10305 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),&
10307 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
10308 call transpose2(EUg(1,1,k),auxmat(1,1))
10309 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),&
10311 vv(1)=pizda(1,1)-pizda(2,2)
10312 vv(2)=pizda(1,2)+pizda(2,1)
10313 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10314 !d write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
10316 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10318 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10321 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10323 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10329 end function eello6_graph2
10330 !-----------------------------------------------------------------------------
10331 real(kind=8) function eello6_graph3(i,j,k,l,jj,kk,swap)
10332 ! implicit real*8 (a-h,o-z)
10333 ! include 'DIMENSIONS'
10334 ! include 'COMMON.IOUNITS'
10335 ! include 'COMMON.CHAIN'
10336 ! include 'COMMON.DERIV'
10337 ! include 'COMMON.INTERACT'
10338 ! include 'COMMON.CONTACTS'
10339 ! include 'COMMON.TORSION'
10340 ! include 'COMMON.VAR'
10341 ! include 'COMMON.GEO'
10342 real(kind=8),dimension(2) :: vv,auxvec
10343 real(kind=8),dimension(2,2) :: pizda,auxmat
10345 integer :: i,j,k,l,jj,kk,iti,itj1,itk,itk1,iii,lll,kkk,itl1
10346 real(kind=8) :: s1,s2,s3,s4
10347 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10349 ! Parallel Antiparallel C
10354 ! /| o |o o| o |\ C
10355 ! j|/k\| / |/k\|l / C
10360 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10362 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
10363 ! energy moment and not to the cluster cumulant.
10364 iti=itortyp(itype(i,1))
10365 if (j.lt.nres-1) then
10366 itj1=itortyp(itype(j+1,1))
10370 itk=itortyp(itype(k,1))
10371 itk1=itortyp(itype(k+1,1))
10372 if (l.lt.nres-1) then
10373 itl1=itortyp(itype(l+1,1))
10378 s1=dip(4,jj,i)*dip(4,kk,k)
10380 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
10381 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
10382 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
10383 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
10384 call transpose2(EE(1,1,itk),auxmat(1,1))
10385 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
10386 vv(1)=pizda(1,1)+pizda(2,2)
10387 vv(2)=pizda(2,1)-pizda(1,2)
10388 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10389 !d write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
10390 !d & "sum",-(s2+s3+s4)
10392 eello6_graph3=-(s1+s2+s3+s4)
10394 eello6_graph3=-(s2+s3+s4)
10396 ! eello6_graph3=-s4
10397 ! Derivatives in gamma(k-1)
10398 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
10399 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
10400 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
10401 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
10402 ! Derivatives in gamma(l-1)
10403 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
10404 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
10405 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
10406 vv(1)=pizda(1,1)+pizda(2,2)
10407 vv(2)=pizda(2,1)-pizda(1,2)
10408 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10409 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10410 ! Cartesian derivatives.
10416 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
10418 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
10421 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),&
10423 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
10424 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),&
10426 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
10427 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),&
10429 vv(1)=pizda(1,1)+pizda(2,2)
10430 vv(2)=pizda(2,1)-pizda(1,2)
10431 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10433 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10435 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10438 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10440 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10442 ! derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
10447 end function eello6_graph3
10448 !-----------------------------------------------------------------------------
10449 real(kind=8) function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
10450 ! implicit real*8 (a-h,o-z)
10451 ! include 'DIMENSIONS'
10452 ! include 'COMMON.IOUNITS'
10453 ! include 'COMMON.CHAIN'
10454 ! include 'COMMON.DERIV'
10455 ! include 'COMMON.INTERACT'
10456 ! include 'COMMON.CONTACTS'
10457 ! include 'COMMON.TORSION'
10458 ! include 'COMMON.VAR'
10459 ! include 'COMMON.GEO'
10460 ! include 'COMMON.FFIELD'
10461 real(kind=8),dimension(2) :: vv,auxvec,auxvec1
10462 real(kind=8),dimension(2,2) :: pizda,auxmat,auxmat1
10464 integer :: i,j,k,l,jj,kk,imat,iti,itj,itj1,itk,itk1,itl,itl1,&
10466 real(kind=8) :: s1,s2,s3,s4
10467 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10469 ! Parallel Antiparallel C
10474 ! /| o |o o| o |\ C
10475 ! \ j|/k\| \ |/k\|l C
10480 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10482 ! 4/7/01 AL Component s1 was removed, because it pertains to the respective
10483 ! energy moment and not to the cluster cumulant.
10484 !d write (2,*) 'eello_graph4: wturn6',wturn6
10485 iti=itortyp(itype(i,1))
10486 itj=itortyp(itype(j,1))
10487 if (j.lt.nres-1) then
10488 itj1=itortyp(itype(j+1,1))
10492 itk=itortyp(itype(k,1))
10493 if (k.lt.nres-1) then
10494 itk1=itortyp(itype(k+1,1))
10498 itl=itortyp(itype(l,1))
10499 if (l.lt.nres-1) then
10500 itl1=itortyp(itype(l+1,1))
10504 !d write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
10505 !d write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
10506 !d & ' itl',itl,' itl1',itl1
10508 if (imat.eq.1) then
10509 s1=dip(3,jj,i)*dip(3,kk,k)
10511 s1=dip(2,jj,j)*dip(2,kk,l)
10514 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
10515 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10517 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
10518 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
10520 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
10521 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
10523 call transpose2(EUg(1,1,k),auxmat(1,1))
10524 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10525 vv(1)=pizda(1,1)-pizda(2,2)
10526 vv(2)=pizda(2,1)+pizda(1,2)
10527 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10528 !d write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10530 eello6_graph4=-(s1+s2+s3+s4)
10532 eello6_graph4=-(s2+s3+s4)
10534 ! Derivatives in gamma(i-1)
10537 if (imat.eq.1) then
10538 s1=dipderg(2,jj,i)*dip(3,kk,k)
10540 s1=dipderg(4,jj,j)*dip(2,kk,l)
10543 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10545 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
10546 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
10548 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
10549 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
10551 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10552 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10553 !d write (2,*) 'turn6 derivatives'
10555 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10557 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10561 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10563 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10567 ! Derivatives in gamma(k-1)
10569 if (imat.eq.1) then
10570 s1=dip(3,jj,i)*dipderg(2,kk,k)
10572 s1=dip(2,jj,j)*dipderg(4,kk,l)
10575 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10576 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10578 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
10579 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
10581 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
10582 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
10584 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10585 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
10586 vv(1)=pizda(1,1)-pizda(2,2)
10587 vv(2)=pizda(2,1)+pizda(1,2)
10588 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10589 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10591 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10593 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10597 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10599 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10602 ! Derivatives in gamma(j-1) or gamma(l-1)
10603 if (l.eq.j+1 .and. l.gt.1) then
10604 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10605 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10606 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10607 vv(1)=pizda(1,1)-pizda(2,2)
10608 vv(2)=pizda(2,1)+pizda(1,2)
10609 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10610 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10611 else if (j.gt.1) then
10612 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10613 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10614 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10615 vv(1)=pizda(1,1)-pizda(2,2)
10616 vv(2)=pizda(2,1)+pizda(1,2)
10617 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10618 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10619 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
10621 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
10624 ! Cartesian derivatives.
10630 if (imat.eq.1) then
10631 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
10633 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
10636 if (imat.eq.1) then
10637 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
10639 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
10643 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),&
10645 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10647 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
10648 b1(1,itj1),auxvec(1))
10649 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
10651 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),&
10652 b1(1,itl1),auxvec(1))
10653 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
10655 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),&
10657 vv(1)=pizda(1,1)-pizda(2,2)
10658 vv(2)=pizda(2,1)+pizda(1,2)
10659 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10661 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10663 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
10666 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii) &
10669 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
10672 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
10674 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
10676 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10680 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10682 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10685 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10687 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10694 end function eello6_graph4
10695 !-----------------------------------------------------------------------------
10696 real(kind=8) function eello_turn6(i,jj,kk)
10697 ! implicit real*8 (a-h,o-z)
10698 ! include 'DIMENSIONS'
10699 ! include 'COMMON.IOUNITS'
10700 ! include 'COMMON.CHAIN'
10701 ! include 'COMMON.DERIV'
10702 ! include 'COMMON.INTERACT'
10703 ! include 'COMMON.CONTACTS'
10704 ! include 'COMMON.TORSION'
10705 ! include 'COMMON.VAR'
10706 ! include 'COMMON.GEO'
10707 real(kind=8),dimension(2) :: vtemp1,vtemp2,vtemp3,vtemp4,gvec
10708 real(kind=8),dimension(2,2) :: atemp,auxmat,achuj_temp,gtemp
10709 real(kind=8),dimension(3) :: ggg1,ggg2
10710 real(kind=8),dimension(2) :: vtemp1d,vtemp2d,vtemp3d,vtemp4d,gvecd
10711 real(kind=8),dimension(2,2) :: atempd,auxmatd,achuj_tempd,gtempd
10712 ! 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
10713 ! the respective energy moment and not to the cluster cumulant.
10714 !el local variables
10715 integer :: i,jj,kk,j,k,l,iti,itk,itk1,itl,itj,iii,kkk,lll
10716 integer :: j1,j2,l1,l2,ll
10717 real(kind=8) :: s1,s2,s8,s13,s12,eello6_5,eel_turn6
10718 real(kind=8) :: s1d,s8d,s12d,s2d,gturn6ij,gturn6kl
10727 iti=itortyp(itype(i,1))
10728 itk=itortyp(itype(k,1))
10729 itk1=itortyp(itype(k+1,1))
10730 itl=itortyp(itype(l,1))
10731 itj=itortyp(itype(j,1))
10732 !d write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10733 !d write (2,*) 'i',i,' k',k,' j',j,' l',l
10734 !d if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10739 !d & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10741 !d call checkint_turn6(i,jj,kk,eel_turn6_num)
10745 derx_turn(lll,kkk,iii)=0.0d0
10752 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10754 !d write (2,*) 'eello6_5',eello6_5
10756 call transpose2(AEA(1,1,1),auxmat(1,1))
10757 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10758 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
10759 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10761 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
10762 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10763 s2 = scalar2(b1(1,itk),vtemp1(1))
10765 call transpose2(AEA(1,1,2),atemp(1,1))
10766 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10767 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10768 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10770 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10771 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10772 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10774 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10775 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10776 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10777 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10778 ss13 = scalar2(b1(1,itk),vtemp4(1))
10779 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10781 ! write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10787 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10788 ! Derivatives in gamma(i+2)
10792 call transpose2(AEA(1,1,1),auxmatd(1,1))
10793 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10794 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10795 call transpose2(AEAderg(1,1,2),atempd(1,1))
10796 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10797 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10799 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10800 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10801 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10807 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10808 ! Derivatives in gamma(i+3)
10810 call transpose2(AEA(1,1,1),auxmatd(1,1))
10811 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10812 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
10813 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10815 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
10816 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10817 s2d = scalar2(b1(1,itk),vtemp1d(1))
10819 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10820 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10822 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10824 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10825 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10826 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10834 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
10835 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10837 gel_loc_turn6(i+1)=gel_loc_turn6(i+1) &
10838 -0.5d0*ekont*(s2d+s12d)
10840 ! Derivatives in gamma(i+4)
10841 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10842 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10843 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10845 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10846 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10847 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10855 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10857 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10859 ! Derivatives in gamma(i+5)
10861 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10862 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10863 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10865 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
10866 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10867 s2d = scalar2(b1(1,itk),vtemp1d(1))
10869 call transpose2(AEA(1,1,2),atempd(1,1))
10870 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10871 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10873 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10874 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10876 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10877 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10878 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10886 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
10887 -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10889 gel_loc_turn6(i+3)=gel_loc_turn6(i+3) &
10890 -0.5d0*ekont*(s2d+s12d)
10892 ! Cartesian derivatives
10897 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10898 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10899 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10901 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
10902 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),&
10904 s2d = scalar2(b1(1,itk),vtemp1d(1))
10906 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10907 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10908 s8d = -(atempd(1,1)+atempd(2,2))* &
10909 scalar2(cc(1,1,itl),vtemp2(1))
10911 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),&
10913 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10914 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10921 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
10924 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii) &
10928 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
10931 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii) &
10940 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),&
10942 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10943 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10944 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10945 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10946 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),&
10948 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10949 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10950 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10954 !d write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10955 !d & 16*eel_turn6_num
10957 if (j.lt.nres-1) then
10964 if (l.lt.nres-1) then
10972 !grad ggg1(ll)=eel_turn6*g_contij(ll,1)
10973 !grad ggg2(ll)=eel_turn6*g_contij(ll,2)
10974 !grad ghalf=0.5d0*ggg1(ll)
10976 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10977 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10978 gcorr6_turn(ll,i)=gcorr6_turn(ll,i) & !+ghalf
10979 +ekont*derx_turn(ll,2,1)
10980 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10981 gcorr6_turn(ll,j)=gcorr6_turn(ll,j) & !+ghalf
10982 +ekont*derx_turn(ll,4,1)
10983 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10984 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10985 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10986 !grad ghalf=0.5d0*ggg2(ll)
10988 gcorr6_turn(ll,k)=gcorr6_turn(ll,k) & !+ghalf
10989 +ekont*derx_turn(ll,2,2)
10990 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10991 gcorr6_turn(ll,l)=gcorr6_turn(ll,l) & !+ghalf
10992 +ekont*derx_turn(ll,4,2)
10993 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10994 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10995 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
11000 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
11005 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
11011 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
11016 !grad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
11020 !d write (2,*) iii,g_corr6_loc(iii)
11022 eello_turn6=ekont*eel_turn6
11023 !d write (2,*) 'ekont',ekont
11024 !d write (2,*) 'eel_turn6',ekont*eel_turn6
11026 end function eello_turn6
11027 !-----------------------------------------------------------------------------
11028 subroutine MATVEC2(A1,V1,V2)
11029 !DIR$ INLINEALWAYS MATVEC2
11031 !DEC$ ATTRIBUTES FORCEINLINE::MATVEC2
11033 ! implicit real*8 (a-h,o-z)
11034 ! include 'DIMENSIONS'
11035 real(kind=8),dimension(2) :: V1,V2
11036 real(kind=8),dimension(2,2) :: A1
11037 real(kind=8) :: vaux1,vaux2
11041 ! 3 VI=VI+A1(I,K)*V1(K)
11045 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
11046 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
11050 end subroutine MATVEC2
11051 !-----------------------------------------------------------------------------
11052 subroutine MATMAT2(A1,A2,A3)
11054 !DEC$ ATTRIBUTES FORCEINLINE::MATMAT2
11056 ! implicit real*8 (a-h,o-z)
11057 ! include 'DIMENSIONS'
11058 real(kind=8),dimension(2,2) :: A1,A2,A3
11059 real(kind=8) :: ai3_11,ai3_12,ai3_21,ai3_22
11060 ! DIMENSION AI3(2,2)
11064 ! A3IJ=A3IJ+A1(I,K)*A2(K,J)
11070 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
11071 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
11072 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
11073 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
11079 end subroutine MATMAT2
11080 !-----------------------------------------------------------------------------
11081 real(kind=8) function scalar2(u,v)
11082 !DIR$ INLINEALWAYS scalar2
11084 real(kind=8),dimension(2) :: u,v
11087 scalar2=u(1)*v(1)+u(2)*v(2)
11089 end function scalar2
11090 !-----------------------------------------------------------------------------
11091 subroutine transpose2(a,at)
11092 !DIR$ INLINEALWAYS transpose2
11094 !DEC$ ATTRIBUTES FORCEINLINE::transpose2
11097 real(kind=8),dimension(2,2) :: a,at
11103 end subroutine transpose2
11104 !-----------------------------------------------------------------------------
11105 subroutine transpose(n,a,at)
11108 real(kind=8),dimension(n,n) :: a,at
11115 end subroutine transpose
11116 !-----------------------------------------------------------------------------
11117 subroutine prodmat3(a1,a2,kk,transp,prod)
11118 !DIR$ INLINEALWAYS prodmat3
11120 !DEC$ ATTRIBUTES FORCEINLINE::prodmat3
11124 real(kind=8),dimension(2,2) :: a1,a2,a2t,kk,prod
11126 !rc double precision auxmat(2,2),prod_(2,2)
11129 !rc call transpose2(kk(1,1),auxmat(1,1))
11130 !rc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
11131 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11133 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1) &
11134 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
11135 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2) &
11136 +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
11137 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1) &
11138 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
11139 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2) &
11140 +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
11143 !rc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
11144 !rc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
11146 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1) &
11147 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
11148 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2) &
11149 +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
11150 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1) &
11151 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
11152 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2) &
11153 +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
11156 ! call transpose2(a2(1,1),a2t(1,1))
11159 !rc print *,((prod_(i,j),i=1,2),j=1,2)
11160 !rc print *,((prod(i,j),i=1,2),j=1,2)
11163 end subroutine prodmat3
11164 !-----------------------------------------------------------------------------
11165 ! energy_p_new_barrier.F
11166 !-----------------------------------------------------------------------------
11167 subroutine sum_gradient
11168 ! implicit real*8 (a-h,o-z)
11169 use io_base, only: pdbout
11170 ! include 'DIMENSIONS'
11174 !MS$ATTRIBUTES C :: proc_proc
11180 real(kind=8),dimension(3,-1:nres) :: gradbufc,gradbufx,gradbufc_sum,&
11181 gloc_scbuf !(3,maxres)
11183 real(kind=8),dimension(4*nres) :: glocbuf !(4*maxres)
11185 !el local variables
11186 integer :: i,j,k,ierror,ierr
11187 real(kind=8) :: gvdwc_norm,gvdwc_scp_norm,gelc_norm,gvdwpp_norm,&
11188 gradb_norm,ghpbc_norm,gradcorr_norm,gel_loc_norm,&
11189 gcorr3_turn_norm,gcorr4_turn_norm,gradcorr5_norm,&
11190 gradcorr6_norm,gcorr6_turn_norm,gsccorr_norm,&
11191 gscloc_norm,gvdwx_norm,gradx_scp_norm,ghpbx_norm,&
11192 gradxorr_norm,gsccorrx_norm,gsclocx_norm,gcorr6_max,&
11193 gsccorr_max,gsccorrx_max,time00
11195 ! include 'COMMON.SETUP'
11196 ! include 'COMMON.IOUNITS'
11197 ! include 'COMMON.FFIELD'
11198 ! include 'COMMON.DERIV'
11199 ! include 'COMMON.INTERACT'
11200 ! include 'COMMON.SBRIDGE'
11201 ! include 'COMMON.CHAIN'
11202 ! include 'COMMON.VAR'
11203 ! include 'COMMON.CONTROL'
11204 ! include 'COMMON.TIME1'
11205 ! include 'COMMON.MAXGRAD'
11206 ! include 'COMMON.SCCOR'
11212 write (iout,*) "sum_gradient gvdwc, gvdwx"
11214 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
11215 i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
11225 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
11226 if (nfgtasks.gt.1 .and. fg_rank.eq.0) &
11227 call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
11230 ! 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
11231 ! in virtual-bond-vector coordinates
11234 ! write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
11236 ! write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
11237 ! & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
11239 ! write (iout,*) "gel_loc_tur3 gel_loc_turn4"
11241 ! write (iout,'(i5,3f10.5,2x,f10.5)')
11242 ! & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
11244 ! write (iout,*) "gvdwc gvdwc_scp gvdwc_scpp"
11246 ! write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
11247 ! i,(gvdwc(j,i),j=1,3),(gvdwc_scp(j,i),j=1,3),&
11248 ! (gvdwc_scpp(j,i),j=1,3)
11250 ! write (iout,*) "gelc_long gvdwpp gel_loc_long"
11252 ! write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)') &
11253 ! i,(gelc_long(j,i),j=1,3),(gvdwpp(j,i),j=1,3),&
11254 ! (gelc_loc_long(j,i),j=1,3)
11261 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
11262 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
11263 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
11264 wel_loc*gel_loc_long(j,i)+ &
11265 wcorr*gradcorr_long(j,i)+ &
11266 wcorr5*gradcorr5_long(j,i)+ &
11267 wcorr6*gradcorr6_long(j,i)+ &
11268 wturn6*gcorr6_turn_long(j,i)+ &
11269 wstrain*ghpbc(j,i) &
11270 +wliptran*gliptranc(j,i) &
11272 +welec*gshieldc(j,i) &
11273 +wcorr*gshieldc_ec(j,i) &
11274 +wturn3*gshieldc_t3(j,i)&
11275 +wturn4*gshieldc_t4(j,i)&
11276 +wel_loc*gshieldc_ll(j,i)&
11277 +wtube*gg_tube(j,i) &
11278 +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
11279 wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
11280 wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
11281 wcorr_nucl*gradcorr_nucl(j,i)&
11282 +wcorr3_nucl*gradcorr3_nucl(j,i)+&
11283 wcatprot* gradpepcat(j,i)+ &
11284 wcatcat*gradcatcat(j,i)+ &
11285 wscbase*gvdwc_scbase(j,i)+ &
11286 wpepbase*gvdwc_pepbase(j,i)+&
11287 wscpho*gvdwc_scpho(j,i)+ &
11288 wpeppho*gvdwc_peppho(j,i)
11299 gradbufc(j,i)=wsc*gvdwc(j,i)+ &
11300 wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+ &
11301 welec*gelc_long(j,i)+ &
11302 wbond*gradb(j,i)+ &
11303 wel_loc*gel_loc_long(j,i)+ &
11304 wcorr*gradcorr_long(j,i)+ &
11305 wcorr5*gradcorr5_long(j,i)+ &
11306 wcorr6*gradcorr6_long(j,i)+ &
11307 wturn6*gcorr6_turn_long(j,i)+ &
11308 wstrain*ghpbc(j,i) &
11309 +wliptran*gliptranc(j,i) &
11311 +welec*gshieldc(j,i)&
11312 +wcorr*gshieldc_ec(j,i) &
11313 +wturn4*gshieldc_t4(j,i) &
11314 +wel_loc*gshieldc_ll(j,i)&
11315 +wtube*gg_tube(j,i) &
11316 +wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)+ &
11317 wvdwpsb*(gvdwpsb(j,i)+gvdwpsb1(j,i))+ &
11318 wvdwsb*gvdwsbc(j,i)+welsb*gelsbc(j,i)+ &
11319 wcorr_nucl*gradcorr_nucl(j,i) &
11320 +wcorr3_nucl*gradcorr3_nucl(j,i) +&
11321 wcatprot* gradpepcat(j,i)+ &
11322 wcatcat*gradcatcat(j,i)+ &
11323 wscbase*gvdwc_scbase(j,i) &
11324 wpepbase*gvdwc_pepbase(j,i)+&
11325 wscpho*gvdwc_scpho(j,i)+&
11326 wpeppho*gvdwc_peppho(j,i)
11333 if (nfgtasks.gt.1) then
11336 write (iout,*) "gradbufc before allreduce"
11338 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
11344 gradbufc_sum(j,i)=gradbufc(j,i)
11347 ! call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
11348 ! & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
11349 ! time_reduce=time_reduce+MPI_Wtime()-time00
11351 ! write (iout,*) "gradbufc_sum after allreduce"
11353 ! write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
11358 ! time_allreduce=time_allreduce+MPI_Wtime()-time00
11362 gradbufc(k,i)=0.0d0
11366 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
11367 write (iout,*) (i," jgrad_start",jgrad_start(i),&
11368 " jgrad_end ",jgrad_end(i),&
11369 i=igrad_start,igrad_end)
11372 ! Obsolete and inefficient code; we can make the effort O(n) and, therefore,
11373 ! do not parallelize this part.
11375 ! do i=igrad_start,igrad_end
11376 ! do j=jgrad_start(i),jgrad_end(i)
11378 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
11383 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
11387 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
11391 write (iout,*) "gradbufc after summing"
11393 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
11401 write (iout,*) "gradbufc"
11403 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
11410 gradbufc_sum(j,i)=gradbufc(j,i)
11411 gradbufc(j,i)=0.0d0
11415 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
11419 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
11424 ! gradbufc(k,i)=0.0d0
11428 ! gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
11434 write (iout,*) "gradbufc after summing"
11436 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
11445 gradbufc(k,nres)=0.0d0
11447 !el----------------
11448 !el if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
11449 !el if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
11450 !el-----------------
11454 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
11455 wel_loc*gel_loc(j,i)+ &
11456 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
11457 welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+ &
11458 wel_loc*gel_loc_long(j,i)+ &
11459 wcorr*gradcorr_long(j,i)+ &
11460 wcorr5*gradcorr5_long(j,i)+ &
11461 wcorr6*gradcorr6_long(j,i)+ &
11462 wturn6*gcorr6_turn_long(j,i))+ &
11463 wbond*gradb(j,i)+ &
11464 wcorr*gradcorr(j,i)+ &
11465 wturn3*gcorr3_turn(j,i)+ &
11466 wturn4*gcorr4_turn(j,i)+ &
11467 wcorr5*gradcorr5(j,i)+ &
11468 wcorr6*gradcorr6(j,i)+ &
11469 wturn6*gcorr6_turn(j,i)+ &
11470 wsccor*gsccorc(j,i) &
11471 +wscloc*gscloc(j,i) &
11472 +wliptran*gliptranc(j,i) &
11474 +welec*gshieldc(j,i) &
11475 +welec*gshieldc_loc(j,i) &
11476 +wcorr*gshieldc_ec(j,i) &
11477 +wcorr*gshieldc_loc_ec(j,i) &
11478 +wturn3*gshieldc_t3(j,i) &
11479 +wturn3*gshieldc_loc_t3(j,i) &
11480 +wturn4*gshieldc_t4(j,i) &
11481 +wturn4*gshieldc_loc_t4(j,i) &
11482 +wel_loc*gshieldc_ll(j,i) &
11483 +wel_loc*gshieldc_loc_ll(j,i) &
11484 +wtube*gg_tube(j,i) &
11485 +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
11486 +wvdwpsb*gvdwpsb1(j,i))&
11487 +wbond_nucl*gradb_nucl(j,i)+wsbloc*gsbloc(j,i)
11488 ! if (i.eq.21) then
11489 ! print *,"in sum",gradc(j,i,icg),wturn4*gcorr4_turn(j,i),&
11490 ! wturn4*gshieldc_t4(j,i), &
11491 ! wturn4*gshieldc_loc_t4(j,i)
11493 ! if ((i.le.2).and.(i.ge.1))
11494 ! print *,gradc(j,i,icg),&
11495 ! gradbufc(j,i),welec*gelc(j,i), &
11496 ! wel_loc*gel_loc(j,i), &
11497 ! wscp*gvdwc_scpp(j,i), &
11498 ! welec*gelc_long(j,i),wvdwpp*gvdwpp(j,i), &
11499 ! wel_loc*gel_loc_long(j,i), &
11500 ! wcorr*gradcorr_long(j,i), &
11501 ! wcorr5*gradcorr5_long(j,i), &
11502 ! wcorr6*gradcorr6_long(j,i), &
11503 ! wturn6*gcorr6_turn_long(j,i), &
11504 ! wbond*gradb(j,i), &
11505 ! wcorr*gradcorr(j,i), &
11506 ! wturn3*gcorr3_turn(j,i), &
11507 ! wturn4*gcorr4_turn(j,i), &
11508 ! wcorr5*gradcorr5(j,i), &
11509 ! wcorr6*gradcorr6(j,i), &
11510 ! wturn6*gcorr6_turn(j,i), &
11511 ! wsccor*gsccorc(j,i) &
11512 ! ,wscloc*gscloc(j,i) &
11513 ! ,wliptran*gliptranc(j,i) &
11515 ! ,welec*gshieldc(j,i) &
11516 ! ,welec*gshieldc_loc(j,i) &
11517 ! ,wcorr*gshieldc_ec(j,i) &
11518 ! ,wcorr*gshieldc_loc_ec(j,i) &
11519 ! ,wturn3*gshieldc_t3(j,i) &
11520 ! ,wturn3*gshieldc_loc_t3(j,i) &
11521 ! ,wturn4*gshieldc_t4(j,i) &
11522 ! ,wturn4*gshieldc_loc_t4(j,i) &
11523 ! ,wel_loc*gshieldc_ll(j,i) &
11524 ! ,wel_loc*gshieldc_loc_ll(j,i) &
11525 ! ,wtube*gg_tube(j,i) &
11526 ! ,wbond_nucl*gradb_nucl(j,i) &
11527 ! ,wvdwpp_nucl*gvdwpp_nucl(j,i),welpp*gelpp(j,i),&
11528 ! wvdwpsb*gvdwpsb1(j,i)&
11529 ! ,wbond_nucl*gradb_nucl(j,i),wsbloc*gsbloc(j,i)
11533 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+ &
11534 wel_loc*gel_loc(j,i)+ &
11535 0.5d0*(wscp*gvdwc_scpp(j,i)+ &
11536 welec*gelc_long(j,i)+ &
11537 wel_loc*gel_loc_long(j,i)+ &
11538 !el wcorr*gcorr_long(j,i)+ & !el gcorr_long- brak deklaracji
11539 wcorr5*gradcorr5_long(j,i)+ &
11540 wcorr6*gradcorr6_long(j,i)+ &
11541 wturn6*gcorr6_turn_long(j,i))+ &
11542 wbond*gradb(j,i)+ &
11543 wcorr*gradcorr(j,i)+ &
11544 wturn3*gcorr3_turn(j,i)+ &
11545 wturn4*gcorr4_turn(j,i)+ &
11546 wcorr5*gradcorr5(j,i)+ &
11547 wcorr6*gradcorr6(j,i)+ &
11548 wturn6*gcorr6_turn(j,i)+ &
11549 wsccor*gsccorc(j,i) &
11550 +wscloc*gscloc(j,i) &
11552 +wliptran*gliptranc(j,i) &
11553 +welec*gshieldc(j,i) &
11554 +welec*gshieldc_loc(j,) &
11555 +wcorr*gshieldc_ec(j,i) &
11556 +wcorr*gshieldc_loc_ec(j,i) &
11557 +wturn3*gshieldc_t3(j,i) &
11558 +wturn3*gshieldc_loc_t3(j,i) &
11559 +wturn4*gshieldc_t4(j,i) &
11560 +wturn4*gshieldc_loc_t4(j,i) &
11561 +wel_loc*gshieldc_ll(j,i) &
11562 +wel_loc*gshieldc_loc_ll(j,i) &
11563 +wtube*gg_tube(j,i) &
11564 +wbond_nucl*gradb_nucl(j,i) &
11565 +0.5d0*(wvdwpp_nucl*gvdwpp_nucl(j,i)+welpp*gelpp(j,i)&
11566 +wvdwpsb*gvdwpsb1(j,i))&
11567 +wsbloc*gsbloc(j,i)
11573 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+ &
11574 wbond*gradbx(j,i)+ &
11575 wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+ &
11576 wsccor*gsccorx(j,i) &
11577 +wscloc*gsclocx(j,i) &
11578 +wliptran*gliptranx(j,i) &
11579 +welec*gshieldx(j,i) &
11580 +wcorr*gshieldx_ec(j,i) &
11581 +wturn3*gshieldx_t3(j,i) &
11582 +wturn4*gshieldx_t4(j,i) &
11583 +wel_loc*gshieldx_ll(j,i)&
11584 +wtube*gg_tube_sc(j,i) &
11585 +wbond_nucl*gradbx_nucl(j,i) &
11586 +wvdwsb*gvdwsbx(j,i) &
11587 +welsb*gelsbx(j,i) &
11588 +wcorr_nucl*gradxorr_nucl(j,i)&
11589 +wcorr3_nucl*gradxorr3_nucl(j,i) &
11590 +wsbloc*gsblocx(j,i) &
11591 +wcatprot* gradpepcatx(j,i)&
11592 +wscbase*gvdwx_scbase(j,i) &
11593 +wpepbase*gvdwx_pepbase(j,i)&
11594 +wscpho*gvdwx_scpho(j,i)
11595 ! if (i.eq.3) print *,"tu?", wscpho,gvdwx_scpho(j,i)
11601 write (iout,*) "gloc before adding corr"
11603 write (iout,*) i,gloc(i,icg)
11607 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i) &
11608 +wcorr5*g_corr5_loc(i) &
11609 +wcorr6*g_corr6_loc(i) &
11610 +wturn4*gel_loc_turn4(i) &
11611 +wturn3*gel_loc_turn3(i) &
11612 +wturn6*gel_loc_turn6(i) &
11613 +wel_loc*gel_loc_loc(i)
11616 write (iout,*) "gloc after adding corr"
11618 write (iout,*) i,gloc(i,icg)
11623 if (nfgtasks.gt.1) then
11626 gradbufc(j,i)=gradc(j,i,icg)
11627 gradbufx(j,i)=gradx(j,i,icg)
11631 glocbuf(i)=gloc(i,icg)
11635 write (iout,*) "gloc_sc before reduce"
11638 write (iout,*) i,j,gloc_sc(j,i,icg)
11645 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
11649 call MPI_Barrier(FG_COMM,IERR)
11650 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
11652 call MPI_Reduce(gradbufc(1,0),gradc(1,0,icg),3*nres+3,&
11653 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11654 call MPI_Reduce(gradbufx(1,0),gradx(1,0,icg),3*nres+3,&
11655 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11656 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,&
11657 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11658 time_reduce=time_reduce+MPI_Wtime()-time00
11659 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,&
11660 MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
11661 time_reduce=time_reduce+MPI_Wtime()-time00
11663 ! print *,"gradbuf",gradbufc(1,1),gradc(1,1,icg)
11665 write (iout,*) "gloc_sc after reduce"
11668 write (iout,*) i,j,gloc_sc(j,i,icg)
11674 write (iout,*) "gloc after reduce"
11676 write (iout,*) i,gloc(i,icg)
11681 if (gnorm_check) then
11683 ! Compute the maximum elements of the gradient
11686 gvdwc_scp_max=0.0d0
11693 gcorr3_turn_max=0.0d0
11694 gcorr4_turn_max=0.0d0
11695 gradcorr5_max=0.0d0
11696 gradcorr6_max=0.0d0
11697 gcorr6_turn_max=0.0d0
11701 gradx_scp_max=0.0d0
11707 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
11708 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
11709 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
11710 if (gvdwc_scp_norm.gt.gvdwc_scp_max) &
11711 gvdwc_scp_max=gvdwc_scp_norm
11712 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
11713 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
11714 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
11715 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
11716 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
11717 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
11718 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
11719 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
11720 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
11721 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
11722 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
11723 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
11724 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),&
11726 if (gcorr3_turn_norm.gt.gcorr3_turn_max) &
11727 gcorr3_turn_max=gcorr3_turn_norm
11728 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),&
11730 if (gcorr4_turn_norm.gt.gcorr4_turn_max) &
11731 gcorr4_turn_max=gcorr4_turn_norm
11732 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
11733 if (gradcorr5_norm.gt.gradcorr5_max) &
11734 gradcorr5_max=gradcorr5_norm
11735 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
11736 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
11737 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),&
11739 if (gcorr6_turn_norm.gt.gcorr6_turn_max) &
11740 gcorr6_turn_max=gcorr6_turn_norm
11741 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
11742 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
11743 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
11744 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
11745 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
11746 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
11747 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
11748 if (gradx_scp_norm.gt.gradx_scp_max) &
11749 gradx_scp_max=gradx_scp_norm
11750 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
11751 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
11752 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
11753 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
11754 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
11755 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
11756 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
11757 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
11761 open(istat,file=statname,position="append")
11763 open(istat,file=statname,access="append")
11765 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,&
11766 gelc_max,gvdwpp_max,gradb_max,ghpbc_max,&
11767 gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,&
11768 gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,&
11769 gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,&
11770 gsccorx_max,gsclocx_max
11772 if (gvdwc_max.gt.1.0d4) then
11773 write (iout,*) "gvdwc gvdwx gradb gradbx"
11775 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),&
11776 gradb(j,i),gradbx(j,i),j=1,3)
11778 call pdbout(0.0d0,'cipiszcze',iout)
11785 write (iout,*) "gradc gradx gloc"
11787 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)') &
11788 i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
11793 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
11796 end subroutine sum_gradient
11797 !-----------------------------------------------------------------------------
11799 ! implicit real*8 (a-h,o-z)
11801 ! include 'DIMENSIONS'
11802 ! include 'COMMON.CHAIN'
11803 ! include 'COMMON.DERIV'
11804 ! include 'COMMON.CALC'
11805 ! include 'COMMON.IOUNITS'
11806 real(kind=8), dimension(3) :: dcosom1,dcosom2
11807 ! print *,"wchodze"
11808 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1 &
11809 +dCAVdOM1+ dGCLdOM1+ dPOLdOM1
11810 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2 &
11811 +dCAVdOM2+ dGCLdOM2+ dPOLdOM2
11813 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
11814 -2.0D0*alf12*eps3der+sigder*sigsq_om12&
11815 +dCAVdOM12+ dGCLdOM12
11819 ! eom12=evdwij*eps1_om12
11821 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,&
11823 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
11824 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
11825 !C print *,sss_ele_cut,'in sc_grad'
11827 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
11828 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
11831 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss_ele_cut
11832 !C print *,'gg',k,gg(k)
11834 ! print *,i,j,gg_lipi(3),gg_lipj(3),sss_ele_cut
11835 ! write (iout,*) "gg",(gg(k),k=1,3)
11837 gvdwx(k,i)=gvdwx(k,i)-gg(k) +gg_lipi(k)&
11838 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
11839 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv &
11842 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)&
11843 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
11844 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv &
11847 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
11848 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
11849 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
11850 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
11853 ! Calculate the components of the gradient in DC and X
11857 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
11861 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
11862 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
11865 end subroutine sc_grad
11867 !-----------------------------------------------------------------------------
11868 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
11871 ! implicit real*8 (a-h,o-z)
11872 ! include 'DIMENSIONS'
11873 ! include 'COMMON.LOCAL'
11874 ! include 'COMMON.IOUNITS'
11875 !el real(kind=8) :: term1,term2,termm,diffak,ratak,&
11876 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
11877 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,
11878 real(kind=8) :: thetai,thet_pred_mean,theta0i,E_tc_t
11879 real(kind=8) :: t3,t6,t9,t12,t14,t16,t21,t23,t26,t27,t32,t40
11881 !el common /calcthet/ term1,term2,termm,diffak,ratak,&
11882 !el ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,&
11883 !el delthe0,sig0inv,sigtc,sigsqtc,delthec,it
11884 !el local variables
11886 delthec=thetai-thet_pred_mean
11887 delthe0=thetai-theta0i
11888 ! "Thank you" to MAPLE (probably spared one day of hand-differentiation).
11889 t3 = thetai-thet_pred_mean
11893 t14 = t12+t6*sigsqtc
11895 t21 = thetai-theta0i
11901 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9 &
11902 -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40 &
11903 *(-t12*t9-ak*sig0inv*t27)
11905 end subroutine mixder
11907 !-----------------------------------------------------------------------------
11909 !-----------------------------------------------------------------------------
11911 !-----------------------------------------------------------------------------
11912 ! This subroutine calculates the derivatives of the consecutive virtual
11913 ! bond vectors and the SC vectors in the virtual-bond angles theta and
11914 ! virtual-torsional angles phi, as well as the derivatives of SC vectors
11915 ! in the angles alpha and omega, describing the location of a side chain
11916 ! in its local coordinate system.
11918 ! The derivatives are stored in the following arrays:
11920 ! DDCDV - the derivatives of virtual-bond vectors DC in theta and phi.
11921 ! The structure is as follows:
11923 ! dDC(x,2)/dT(3),...,dDC(z,2)/dT(3),0, 0, 0
11924 ! 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)
11925 ! . . . . . . . . . . . . . . . . . .
11926 ! 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)
11930 ! 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)
11932 ! DXDV - the derivatives of the side-chain vectors in theta and phi.
11933 ! The structure is same as above.
11935 ! DCDS - the derivatives of the side chain vectors in the local spherical
11936 ! andgles alph and omega:
11938 ! 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)
11939 ! 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)
11943 ! 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)
11945 ! Version of March '95, based on an early version of November '91.
11947 !**********************************************************************
11948 ! implicit real*8 (a-h,o-z)
11949 ! include 'DIMENSIONS'
11950 ! include 'COMMON.VAR'
11951 ! include 'COMMON.CHAIN'
11952 ! include 'COMMON.DERIV'
11953 ! include 'COMMON.GEO'
11954 ! include 'COMMON.LOCAL'
11955 ! include 'COMMON.INTERACT'
11956 real(kind=8),dimension(3,3,nres) :: drt,rdt,prordt,prodrt !(3,3,maxres)
11957 real(kind=8),dimension(3,3) :: dp,temp
11958 !el real(kind=8) :: fromto(3,3,maxdim) !(3,3,maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
11959 real(kind=8),dimension(3) :: xx,xx1
11960 !el local variables
11961 integer :: i,k,l,j,m,ind,ind1,jjj
11962 real(kind=8) :: alphi,omegi,theta2,dpkl,dpjk,xj,rj,dxoijk,dxoiij,&
11963 tempkl,dsci,cosalphi,sinalphi,cosomegi,sinomegi,cost2,&
11964 sint2,xp,yp,xxp,yyp,zzp,dj
11966 ! common /przechowalnia/ fromto
11967 if(.not. allocated(fromto)) allocate(fromto(3,3,maxdim))
11968 ! get the position of the jth ijth fragment of the chain coordinate system
11969 ! in the fromto array.
11970 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
11972 ! maxdim=(nres-1)*(nres-2)/2
11973 ! allocate(dcdv(6,maxdim),dxds(6,nres))
11974 ! calculate the derivatives of transformation matrix elements in theta
11977 !el call flush(iout) !el
11979 rdt(1,1,i)=-rt(1,2,i)
11980 rdt(1,2,i)= rt(1,1,i)
11982 rdt(2,1,i)=-rt(2,2,i)
11983 rdt(2,2,i)= rt(2,1,i)
11985 rdt(3,1,i)=-rt(3,2,i)
11986 rdt(3,2,i)= rt(3,1,i)
11990 ! derivatives in phi
11996 drt(2,1,i)= rt(3,1,i)
11997 drt(2,2,i)= rt(3,2,i)
11998 drt(2,3,i)= rt(3,3,i)
11999 drt(3,1,i)=-rt(2,1,i)
12000 drt(3,2,i)=-rt(2,2,i)
12001 drt(3,3,i)=-rt(2,3,i)
12004 ! generate the matrix products of type r(i)t(i)...r(j)t(j)
12010 temp(k,l)=rt(k,l,i)
12015 fromto(k,l,ind)=temp(k,l)
12024 dpkl=dpkl+temp(k,m)*rt(m,l,j)
12027 fromto(k,l,ind)=dpkl
12038 ! Calculate derivatives.
12044 ! Derivatives of DC(i+1) in theta(i+2)
12050 dpjk=dpjk+prod(j,l,i)*rdt(l,k,i)
12053 prordt(j,k,i)=dp(j,k)
12056 dcdv(j,ind1)=vbld(i+1)*dp(j,1)
12059 ! Derivatives of SC(i+1) in theta(i+2)
12061 xx1(1)=-0.5D0*xloc(2,i+1)
12062 xx1(2)= 0.5D0*xloc(1,i+1)
12066 xj=xj+r(j,k,i)*xx1(k)
12073 rj=rj+prod(j,k,i)*xx(k)
12078 ! Derivatives of SC(i+1) in theta(i+3). The have to be handled differently
12079 ! than the other off-diagonal derivatives.
12084 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
12086 dxdv(j,ind1+1)=dxoiij
12088 !d print *,ind1+1,(dxdv(j,ind1+1),j=1,3)
12090 ! Derivatives of DC(i+1) in phi(i+2)
12096 dpjk=dpjk+prod(j,l,i)*drt(l,k,i)
12099 prodrt(j,k,i)=dp(j,k)
12101 dcdv(j+3,ind1)=vbld(i+1)*dp(j,1)
12104 ! Derivatives of SC(i+1) in phi(i+2)
12107 xx(3)= xloc(2,i+1)*r(2,2,i)+xloc(3,i+1)*r(2,3,i)
12108 xx(2)=-xloc(2,i+1)*r(3,2,i)-xloc(3,i+1)*r(3,3,i)
12112 rj=rj+prod(j,k,i)*xx(k)
12117 ! Derivatives of SC(i+1) in phi(i+3).
12122 dxoiij=dxoiij+dp(j,k)*xrot(k,i+2)
12124 dxdv(j+3,ind1+1)=dxoiij
12127 ! Calculate the derivatives of DC(i+1) and SC(i+1) in theta(i+3) thru
12128 ! theta(nres) and phi(i+3) thru phi(nres).
12132 ind=indmat(i+1,j+1)
12133 !d print *,'i=',i,' j=',j,' ind=',ind,' ind1=',ind1
12138 tempkl=tempkl+prordt(k,m,i)*fromto(m,l,ind)
12143 !d print '(9f8.3)',((fromto(k,l,ind),l=1,3),k=1,3)
12144 !d print '(9f8.3)',((prod(k,l,i),l=1,3),k=1,3)
12145 !d print '(9f8.3)',((temp(k,l),l=1,3),k=1,3)
12146 ! Derivatives of virtual-bond vectors in theta
12148 dcdv(k,ind1)=vbld(i+1)*temp(k,1)
12150 !d print '(3f8.3)',(dcdv(k,ind1),k=1,3)
12151 ! Derivatives of SC vectors in theta
12155 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
12157 dxdv(k,ind1+1)=dxoijk
12160 !--- Calculate the derivatives in phi
12166 tempkl=tempkl+prodrt(k,m,i)*fromto(m,l,ind)
12172 dcdv(k+3,ind1)=vbld(i+1)*temp(k,1)
12177 dxoijk=dxoijk+temp(k,l)*xrot(l,j+2)
12179 dxdv(k+3,ind1+1)=dxoijk
12184 ! Derivatives in alpha and omega:
12187 ! dsci=dsc(itype(i,1))
12192 if(alphi.ne.alphi) alphi=100.0
12193 if(omegi.ne.omegi) omegi=-100.0
12198 !d print *,'i=',i,' dsci=',dsci,' alphi=',alphi,' omegi=',omegi
12199 cosalphi=dcos(alphi)
12200 sinalphi=dsin(alphi)
12201 cosomegi=dcos(omegi)
12202 sinomegi=dsin(omegi)
12203 temp(1,1)=-dsci*sinalphi
12204 temp(2,1)= dsci*cosalphi*cosomegi
12205 temp(3,1)=-dsci*cosalphi*sinomegi
12207 temp(2,2)=-dsci*sinalphi*sinomegi
12208 temp(3,2)=-dsci*sinalphi*cosomegi
12209 theta2=pi-0.5D0*theta(i+1)
12213 !d print *,((temp(l,k),l=1,3),k=1,2)
12217 xxp= xp*cost2+yp*sint2
12218 yyp=-xp*sint2+yp*cost2
12221 xx(2)=yyp*r(2,2,i-1)+zzp*r(2,3,i-1)
12222 xx(3)=yyp*r(3,2,i-1)+zzp*r(3,3,i-1)
12226 dj=dj+prod(k,l,i-1)*xx(l)
12234 end subroutine cartder
12235 !-----------------------------------------------------------------------------
12237 !-----------------------------------------------------------------------------
12238 subroutine check_cartgrad
12239 ! Check the gradient of Cartesian coordinates in internal coordinates.
12240 ! implicit real*8 (a-h,o-z)
12241 ! include 'DIMENSIONS'
12242 ! include 'COMMON.IOUNITS'
12243 ! include 'COMMON.VAR'
12244 ! include 'COMMON.CHAIN'
12245 ! include 'COMMON.GEO'
12246 ! include 'COMMON.LOCAL'
12247 ! include 'COMMON.DERIV'
12248 real(kind=8),dimension(6,nres) :: temp
12249 real(kind=8),dimension(3) :: xx,gg
12250 integer :: i,k,j,ii
12251 real(kind=8) :: aincr,aincr2,alphi,omegi,theti,thet,phii
12252 ! indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
12254 ! Check the gradient of the virtual-bond and SC vectors in the internal
12260 write (iout,'(a)') '**************** dx/dalpha'
12264 alph(i)=alph(i)+aincr
12266 temp(k,i)=dc(k,nres+i)
12270 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
12271 xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
12273 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
12274 i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
12280 write (iout,'(a)') '**************** dx/domega'
12284 omeg(i)=omeg(i)+aincr
12286 temp(k,i)=dc(k,nres+i)
12290 gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
12291 xx(k)=dabs((gg(k)-dxds(k+3,i))/ &
12292 (aincr*dabs(dxds(k+3,i))+aincr))
12294 write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)') &
12295 i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
12301 write (iout,'(a)') '**************** dx/dtheta'
12305 theta(i)=theta(i)+aincr
12308 temp(k,j)=dc(k,nres+j)
12314 ! print *,'i=',i-2,' j=',j-1,' ii=',ii
12316 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
12317 xx(k)=dabs((gg(k)-dxdv(k,ii))/ &
12318 (aincr*dabs(dxdv(k,ii))+aincr))
12320 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
12321 i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
12328 write (iout,'(a)') '***************** dx/dphi'
12331 phi(i)=phi(i)+aincr
12334 temp(k,j)=dc(k,nres+j)
12342 gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
12343 xx(k)=dabs((gg(k)-dxdv(k+3,ii))/ &
12344 (aincr*dabs(dxdv(k+3,ii))+aincr))
12346 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
12347 i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
12350 phi(i)=phi(i)-aincr
12353 write (iout,'(a)') '****************** ddc/dtheta'
12356 theta(i+2)=thet+aincr
12367 gg(k)=(dc(k,j)-temp(k,j))/aincr
12368 xx(k)=dabs((gg(k)-dcdv(k,ii))/ &
12369 (aincr*dabs(dcdv(k,ii))+aincr))
12371 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
12372 i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
12382 write (iout,'(a)') '******************* ddc/dphi'
12385 phi(i+3)=phii+aincr
12396 gg(k)=(dc(k,j)-temp(k,j))/aincr
12397 xx(k)=dabs((gg(k)-dcdv(k+3,ii))/ &
12398 (aincr*dabs(dcdv(k+3,ii))+aincr))
12400 write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)') &
12401 i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
12412 end subroutine check_cartgrad
12413 !-----------------------------------------------------------------------------
12414 subroutine check_ecart
12415 ! Check the gradient of the energy in Cartesian coordinates.
12416 ! implicit real*8 (a-h,o-z)
12417 ! include 'DIMENSIONS'
12418 ! include 'COMMON.CHAIN'
12419 ! include 'COMMON.DERIV'
12420 ! include 'COMMON.IOUNITS'
12421 ! include 'COMMON.VAR'
12422 ! include 'COMMON.CONTACTS'
12424 !el integer :: icall
12425 !el common /srutu/ icall
12426 real(kind=8),dimension(6) :: ggg
12427 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
12428 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
12429 real(kind=8),dimension(6,nres) :: grad_s
12430 real(kind=8),dimension(0:n_ene) :: energia,energia1
12431 integer :: uiparm(1)
12432 real(kind=8) :: urparm(1)
12434 integer :: nf,i,j,k
12435 real(kind=8) :: aincr,etot,etot1
12441 print '(a)','CG processor',me,' calling CHECK_CART.',aincr
12444 call geom_to_var(nvar,x)
12445 call etotal(energia)
12447 !el call enerprint(energia)
12448 call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
12451 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
12455 grad_s(j,i)=gradc(j,i,icg)
12456 grad_s(j+3,i)=gradx(j,i,icg)
12460 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
12465 ddx(j)=dc(j,i+nres)
12468 dc(j,i)=dc(j,i)+aincr
12470 c(j,k)=c(j,k)+aincr
12471 c(j,k+nres)=c(j,k+nres)+aincr
12474 call etotal(energia1)
12476 ggg(j)=(etot1-etot)/aincr
12479 c(j,k)=c(j,k)-aincr
12480 c(j,k+nres)=c(j,k+nres)-aincr
12484 c(j,i+nres)=c(j,i+nres)+aincr
12485 dc(j,i+nres)=dc(j,i+nres)+aincr
12487 call etotal(energia1)
12489 ggg(j+3)=(etot1-etot)/aincr
12491 dc(j,i+nres)=ddx(j)
12493 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)') &
12494 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
12497 end subroutine check_ecart
12499 !-----------------------------------------------------------------------------
12500 subroutine check_ecartint
12501 ! Check the gradient of the energy in Cartesian coordinates.
12502 use io_base, only: intout
12503 ! implicit real*8 (a-h,o-z)
12504 ! include 'DIMENSIONS'
12505 ! include 'COMMON.CONTROL'
12506 ! include 'COMMON.CHAIN'
12507 ! include 'COMMON.DERIV'
12508 ! include 'COMMON.IOUNITS'
12509 ! include 'COMMON.VAR'
12510 ! include 'COMMON.CONTACTS'
12511 ! include 'COMMON.MD'
12512 ! include 'COMMON.LOCAL'
12513 ! include 'COMMON.SPLITELE'
12515 !el integer :: icall
12516 !el common /srutu/ icall
12517 real(kind=8),dimension(6) :: ggg,ggg1
12518 real(kind=8),dimension(3) :: cc,xx,ddc,ddx,ddc1,ddcn
12519 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
12520 real(kind=8),dimension(3) :: dcnorm_safe1,dcnorm_safe2,dxnorm_safe
12521 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
12522 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
12523 real(kind=8),dimension(0:n_ene) :: energia,energia1
12524 integer :: uiparm(1)
12525 real(kind=8) :: urparm(1)
12527 integer :: i,j,k,nf
12528 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
12536 ! call intcartderiv
12537 ! call checkintcartgrad
12540 write(iout,*) 'Calling CHECK_ECARTINT.'
12543 call geom_to_var(nvar,x)
12544 write (iout,*) "split_ene ",split_ene
12546 if (.not.split_ene) then
12548 call etotal(energia)
12553 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
12556 grad_s(j,0)=gcart(j,0)
12560 grad_s(j,i)=gcart(j,i)
12561 grad_s(j+3,i)=gxcart(j,i)
12565 !- split gradient check
12567 call etotal_long(energia)
12568 !el call enerprint(energia)
12572 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12573 (gxcart(j,i),j=1,3)
12576 grad_s(j,0)=gcart(j,0)
12580 grad_s(j,i)=gcart(j,i)
12581 grad_s(j+3,i)=gxcart(j,i)
12585 call etotal_short(energia)
12586 call enerprint(energia)
12590 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12591 (gxcart(j,i),j=1,3)
12594 grad_s1(j,0)=gcart(j,0)
12598 grad_s1(j,i)=gcart(j,i)
12599 grad_s1(j+3,i)=gxcart(j,i)
12603 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
12607 if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1)
12608 if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres)
12611 dcnorm_safe1(j)=dc_norm(j,i-1)
12612 dcnorm_safe2(j)=dc_norm(j,i)
12613 dxnorm_safe(j)=dc_norm(j,i+nres)
12616 c(j,i)=ddc(j)+aincr
12617 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr
12618 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr
12619 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
12620 dc(j,i)=c(j,i+1)-c(j,i)
12621 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12622 call int_from_cart1(.false.)
12623 if (.not.split_ene) then
12625 call etotal(energia1)
12627 write (iout,*) "ij",i,j," etot1",etot1
12630 call etotal_long(energia1)
12632 call etotal_short(energia1)
12635 !- end split gradient
12636 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12637 c(j,i)=ddc(j)-aincr
12638 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr
12639 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr
12640 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
12641 dc(j,i)=c(j,i+1)-c(j,i)
12642 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12643 call int_from_cart1(.false.)
12644 if (.not.split_ene) then
12646 call etotal(energia1)
12648 write (iout,*) "ij",i,j," etot2",etot2
12649 ggg(j)=(etot1-etot2)/(2*aincr)
12652 call etotal_long(energia1)
12654 ggg(j)=(etot11-etot21)/(2*aincr)
12655 call etotal_short(energia1)
12657 ggg1(j)=(etot12-etot22)/(2*aincr)
12658 !- end split gradient
12659 ! write (iout,*) "etot21",etot21," etot22",etot22
12661 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12663 if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)
12664 if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)
12665 if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1)
12666 dc(j,i)=c(j,i+1)-c(j,i)
12667 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12668 dc_norm(j,i-1)=dcnorm_safe1(j)
12669 dc_norm(j,i)=dcnorm_safe2(j)
12670 dc_norm(j,i+nres)=dxnorm_safe(j)
12673 c(j,i+nres)=ddx(j)+aincr
12674 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12675 call int_from_cart1(.false.)
12676 if (.not.split_ene) then
12678 call etotal(energia1)
12682 call etotal_long(energia1)
12684 call etotal_short(energia1)
12687 !- end split gradient
12688 c(j,i+nres)=ddx(j)-aincr
12689 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12690 call int_from_cart1(.false.)
12691 if (.not.split_ene) then
12693 call etotal(energia1)
12695 ggg(j+3)=(etot1-etot2)/(2*aincr)
12698 call etotal_long(energia1)
12700 ggg(j+3)=(etot11-etot21)/(2*aincr)
12701 call etotal_short(energia1)
12703 ggg1(j+3)=(etot12-etot22)/(2*aincr)
12704 !- end split gradient
12706 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12708 dc(j,i+nres)=c(j,i+nres)-c(j,i)
12709 dc_norm(j,i+nres)=dxnorm_safe(j)
12710 call int_from_cart1(.false.)
12712 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12713 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
12714 if (split_ene) then
12715 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12716 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
12718 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12719 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
12720 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
12724 end subroutine check_ecartint
12726 !-----------------------------------------------------------------------------
12727 subroutine check_ecartint
12728 ! Check the gradient of the energy in Cartesian coordinates.
12729 use io_base, only: intout
12730 ! implicit real*8 (a-h,o-z)
12731 ! include 'DIMENSIONS'
12732 ! include 'COMMON.CONTROL'
12733 ! include 'COMMON.CHAIN'
12734 ! include 'COMMON.DERIV'
12735 ! include 'COMMON.IOUNITS'
12736 ! include 'COMMON.VAR'
12737 ! include 'COMMON.CONTACTS'
12738 ! include 'COMMON.MD'
12739 ! include 'COMMON.LOCAL'
12740 ! include 'COMMON.SPLITELE'
12742 !el integer :: icall
12743 !el common /srutu/ icall
12744 real(kind=8),dimension(6) :: ggg,ggg1
12745 real(kind=8),dimension(3) :: cc,xx,ddc,ddx
12746 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
12747 real(kind=8),dimension(3) :: dcnorm_safe,dxnorm_safe
12748 real(kind=8),dimension(6,0:nres) :: grad_s,grad_s1 !(6,0:maxres)
12749 real(kind=8),dimension(nres) :: phi_temp,theta_temp,alph_temp,omeg_temp !(maxres)
12750 real(kind=8),dimension(0:n_ene) :: energia,energia1
12751 integer :: uiparm(1)
12752 real(kind=8) :: urparm(1)
12754 integer :: i,j,k,nf
12755 real(kind=8) :: rlambd,aincr,etot,etot1,etot11,etot12,etot2,&
12763 ! call intcartderiv
12764 ! call checkintcartgrad
12767 write(iout,*) 'Calling CHECK_ECARTINT.',aincr
12770 call geom_to_var(nvar,x)
12771 if (.not.split_ene) then
12772 call etotal(energia)
12774 !el call enerprint(energia)
12778 write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
12781 grad_s(j,0)=gcart(j,0)
12785 grad_s(j,i)=gcart(j,i)
12786 ! if (i.eq.21) print *,"PRZEKAZANIE",gcart(j,i)
12788 ! if (i.le.2) print *,"tu?!",gcart(j,i),grad_s(j,i),gxcart(j,i)
12789 grad_s(j+3,i)=gxcart(j,i)
12793 !- split gradient check
12795 call etotal_long(energia)
12796 !el call enerprint(energia)
12800 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12801 (gxcart(j,i),j=1,3)
12804 grad_s(j,0)=gcart(j,0)
12808 grad_s(j,i)=gcart(j,i)
12809 ! if (i.eq.21) print *,"PRZEKAZANIE",gcart(j,i)
12810 grad_s(j+3,i)=gxcart(j,i)
12814 call etotal_short(energia)
12815 !el call enerprint(energia)
12819 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
12820 (gxcart(j,i),j=1,3)
12823 grad_s1(j,0)=gcart(j,0)
12827 grad_s1(j,i)=gcart(j,i)
12828 grad_s1(j+3,i)=gxcart(j,i)
12832 write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
12837 ddx(j)=dc(j,i+nres)
12839 dcnorm_safe(k)=dc_norm(k,i)
12840 dxnorm_safe(k)=dc_norm(k,i+nres)
12844 dc(j,i)=ddc(j)+aincr
12845 call chainbuild_cart
12847 ! Broadcast the order to compute internal coordinates to the slaves.
12848 ! if (nfgtasks.gt.1)
12849 ! & call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
12851 ! call int_from_cart1(.false.)
12852 if (.not.split_ene) then
12854 call etotal(energia1)
12856 ! call enerprint(energia1)
12859 call etotal_long(energia1)
12861 call etotal_short(energia1)
12863 ! write (iout,*) "etot11",etot11," etot12",etot12
12865 !- end split gradient
12866 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12867 dc(j,i)=ddc(j)-aincr
12868 call chainbuild_cart
12869 ! call int_from_cart1(.false.)
12870 if (.not.split_ene) then
12872 call etotal(energia1)
12874 ggg(j)=(etot1-etot2)/(2*aincr)
12877 call etotal_long(energia1)
12879 ggg(j)=(etot11-etot21)/(2*aincr)
12880 call etotal_short(energia1)
12882 ggg1(j)=(etot12-etot22)/(2*aincr)
12883 !- end split gradient
12884 ! write (iout,*) "etot21",etot21," etot22",etot22
12886 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12888 call chainbuild_cart
12891 dc(j,i+nres)=ddx(j)+aincr
12892 call chainbuild_cart
12893 ! write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
12894 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
12895 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
12896 ! write (iout,*) "dxnormnorm",dsqrt(
12897 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
12898 ! write (iout,*) "dxnormnormsafe",dsqrt(
12899 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
12901 if (.not.split_ene) then
12903 call etotal(energia1)
12907 call etotal_long(energia1)
12909 call etotal_short(energia1)
12912 !- end split gradient
12913 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
12914 dc(j,i+nres)=ddx(j)-aincr
12915 call chainbuild_cart
12916 ! write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
12917 ! write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
12918 ! write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
12920 ! write (iout,*) "dxnormnorm",dsqrt(
12921 ! & dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
12922 ! write (iout,*) "dxnormnormsafe",dsqrt(
12923 ! & dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
12924 if (.not.split_ene) then
12926 call etotal(energia1)
12928 ggg(j+3)=(etot1-etot2)/(2*aincr)
12931 call etotal_long(energia1)
12933 ggg(j+3)=(etot11-etot21)/(2*aincr)
12934 call etotal_short(energia1)
12936 ggg1(j+3)=(etot12-etot22)/(2*aincr)
12937 !- end split gradient
12939 ! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
12940 dc(j,i+nres)=ddx(j)
12941 call chainbuild_cart
12943 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12944 i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
12945 if (split_ene) then
12946 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12947 i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),&
12949 write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') &
12950 i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),&
12951 ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
12955 end subroutine check_ecartint
12957 !-----------------------------------------------------------------------------
12958 subroutine check_eint
12959 ! Check the gradient of energy in internal coordinates.
12960 ! implicit real*8 (a-h,o-z)
12961 ! include 'DIMENSIONS'
12962 ! include 'COMMON.CHAIN'
12963 ! include 'COMMON.DERIV'
12964 ! include 'COMMON.IOUNITS'
12965 ! include 'COMMON.VAR'
12966 ! include 'COMMON.GEO'
12968 !el integer :: icall
12969 !el common /srutu/ icall
12970 real(kind=8),dimension(6*nres) :: x,gana,gg !(maxvar) (maxvar=6*maxres)
12971 integer :: uiparm(1)
12972 real(kind=8) :: urparm(1)
12973 real(kind=8),dimension(0:n_ene) :: energia,energia1,energia2
12974 character(len=6) :: key
12977 real(kind=8) :: xi,aincr,etot,etot1,etot2
12980 print '(a)','Calling CHECK_INT.'
12984 call geom_to_var(nvar,x)
12985 call var_to_geom(nvar,x)
12988 ! print *,'ICG=',ICG
12989 call etotal(energia)
12991 !el call enerprint(energia)
12992 ! print *,'ICG=',ICG
12994 if (MyID.ne.BossID) then
12995 call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
13003 !d write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
13004 call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
13005 !d write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar+20) !sp
13009 x(i)=xi-0.5D0*aincr
13010 call var_to_geom(nvar,x)
13012 call etotal(energia1)
13014 x(i)=xi+0.5D0*aincr
13015 call var_to_geom(nvar,x)
13017 call etotal(energia2)
13019 gg(i)=(etot2-etot1)/aincr
13020 write (iout,*) i,etot1,etot2
13023 write (iout,'(/2a)')' Variable Numerical Analytical',&
13026 if (i.le.nphi) then
13029 else if (i.le.nphi+ntheta) then
13032 else if (i.le.nphi+ntheta+nside) then
13036 ii=i-(nphi+ntheta+nside)
13039 write (iout,'(i3,a,i3,3(1pd16.6))') &
13040 i,key,ii,gg(i),gana(i),&
13041 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
13044 end subroutine check_eint
13045 !-----------------------------------------------------------------------------
13047 !-----------------------------------------------------------------------------
13048 subroutine Econstr_back
13049 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
13050 ! implicit real*8 (a-h,o-z)
13051 ! include 'DIMENSIONS'
13052 ! include 'COMMON.CONTROL'
13053 ! include 'COMMON.VAR'
13054 ! include 'COMMON.MD'
13057 ! include 'COMMON.LANGEVIN'
13059 ! include 'COMMON.LANGEVIN.lang0'
13061 ! include 'COMMON.CHAIN'
13062 ! include 'COMMON.DERIV'
13063 ! include 'COMMON.GEO'
13064 ! include 'COMMON.LOCAL'
13065 ! include 'COMMON.INTERACT'
13066 ! include 'COMMON.IOUNITS'
13067 ! include 'COMMON.NAMES'
13068 ! include 'COMMON.TIME1'
13069 integer :: i,j,ii,k
13070 real(kind=8) :: utheta_i,dtheta_i,ugamma_i,dgamma_i,dxx,dyy,dzz
13072 if(.not.allocated(utheta)) allocate(utheta(nfrag_back))
13073 if(.not.allocated(ugamma)) allocate(ugamma(nfrag_back))
13074 if(.not.allocated(uscdiff)) allocate(uscdiff(nfrag_back))
13081 duscdiff(j,i)=0.0d0
13082 duscdiffx(j,i)=0.0d0
13086 ii = ifrag_back(2,i,iset)-ifrag_back(1,i,iset)
13088 ! Deviations from theta angles
13091 do j=ifrag_back(1,i,iset)+2,ifrag_back(2,i,iset)
13092 dtheta_i=theta(j)-thetaref(j)
13093 utheta_i=utheta_i+0.5d0*dtheta_i*dtheta_i
13094 dutheta(j-2)=dutheta(j-2)+wfrag_back(1,i,iset)*dtheta_i/(ii-1)
13096 utheta(i)=utheta_i/(ii-1)
13098 ! Deviations from gamma angles
13101 do j=ifrag_back(1,i,iset)+3,ifrag_back(2,i,iset)
13102 dgamma_i=pinorm(phi(j)-phiref(j))
13103 ! write (iout,*) j,phi(j),phi(j)-phiref(j)
13104 ugamma_i=ugamma_i+0.5d0*dgamma_i*dgamma_i
13105 dugamma(j-3)=dugamma(j-3)+wfrag_back(2,i,iset)*dgamma_i/(ii-2)
13106 ! write (iout,*) i,j,dgamma_i,wfrag_back(2,i,iset),dugamma(j-3)
13108 ugamma(i)=ugamma_i/(ii-2)
13110 ! Deviations from local SC geometry
13113 do j=ifrag_back(1,i,iset)+1,ifrag_back(2,i,iset)-1
13114 dxx=xxtab(j)-xxref(j)
13115 dyy=yytab(j)-yyref(j)
13116 dzz=zztab(j)-zzref(j)
13117 uscdiff(i)=uscdiff(i)+dxx*dxx+dyy*dyy+dzz*dzz
13119 duscdiff(k,j-1)=duscdiff(k,j-1)+wfrag_back(3,i,iset)* &
13120 (dXX_C1tab(k,j)*dxx+dYY_C1tab(k,j)*dyy+dZZ_C1tab(k,j)*dzz)/ &
13122 duscdiff(k,j)=duscdiff(k,j)+wfrag_back(3,i,iset)* &
13123 (dXX_Ctab(k,j)*dxx+dYY_Ctab(k,j)*dyy+dZZ_Ctab(k,j)*dzz)/ &
13125 duscdiffx(k,j)=duscdiffx(k,j)+wfrag_back(3,i,iset)* &
13126 (dXX_XYZtab(k,j)*dxx+dYY_XYZtab(k,j)*dyy+dZZ_XYZtab(k,j)*dzz) &
13129 ! write (iout,'(i5,6f10.5)') j,xxtab(j),yytab(j),zztab(j),
13130 ! & xxref(j),yyref(j),zzref(j)
13132 uscdiff(i)=0.5d0*uscdiff(i)/(ii-1)
13133 ! write (iout,*) i," uscdiff",uscdiff(i)
13135 ! Put together deviations from local geometry
13137 Uconst_back=Uconst_back+wfrag_back(1,i,iset)*utheta(i)+ &
13138 wfrag_back(2,i,iset)*ugamma(i)+wfrag_back(3,i,iset)*uscdiff(i)
13139 ! write(iout,*) "i",i," utheta",utheta(i)," ugamma",ugamma(i),
13140 ! & " uconst_back",uconst_back
13141 utheta(i)=dsqrt(utheta(i))
13142 ugamma(i)=dsqrt(ugamma(i))
13143 uscdiff(i)=dsqrt(uscdiff(i))
13146 end subroutine Econstr_back
13147 !-----------------------------------------------------------------------------
13148 ! energy_p_new-sep_barrier.F
13149 !-----------------------------------------------------------------------------
13150 real(kind=8) function sscale(r)
13151 ! include "COMMON.SPLITELE"
13152 real(kind=8) :: r,gamm
13153 if(r.lt.r_cut-rlamb) then
13155 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
13156 gamm=(r-(r_cut-rlamb))/rlamb
13157 sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
13162 end function sscale
13163 real(kind=8) function sscale_grad(r)
13164 ! include "COMMON.SPLITELE"
13165 real(kind=8) :: r,gamm
13166 if(r.lt.r_cut-rlamb) then
13168 else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
13169 gamm=(r-(r_cut-rlamb))/rlamb
13170 sscale_grad=gamm*(6*gamm-6.0d0)/rlamb
13175 end function sscale_grad
13177 !!!!!!!!!! PBCSCALE
13178 real(kind=8) function sscale_ele(r)
13179 ! include "COMMON.SPLITELE"
13180 real(kind=8) :: r,gamm
13181 if(r.lt.r_cut_ele-rlamb_ele) then
13183 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
13184 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
13185 sscale_ele=1.0d0+gamm*gamm*(2*gamm-3.0d0)
13190 end function sscale_ele
13192 real(kind=8) function sscagrad_ele(r)
13193 real(kind=8) :: r,gamm
13194 ! include "COMMON.SPLITELE"
13195 if(r.lt.r_cut_ele-rlamb_ele) then
13197 else if(r.le.r_cut_ele.and.r.ge.r_cut_ele-rlamb_ele) then
13198 gamm=(r-(r_cut_ele-rlamb_ele))/rlamb_ele
13199 sscagrad_ele=gamm*(6*gamm-6.0d0)/rlamb_ele
13204 end function sscagrad_ele
13205 real(kind=8) function sscalelip(r)
13206 real(kind=8) r,gamm
13207 sscalelip=1.0d0+r*r*(2.0d0*r-3.0d0)
13209 end function sscalelip
13210 !C-----------------------------------------------------------------------
13211 real(kind=8) function sscagradlip(r)
13212 real(kind=8) r,gamm
13213 sscagradlip=r*(6.0d0*r-6.0d0)
13215 end function sscagradlip
13218 !-----------------------------------------------------------------------------
13219 subroutine elj_long(evdw)
13221 ! This subroutine calculates the interaction energy of nonbonded side chains
13222 ! assuming the LJ potential of interaction.
13224 ! implicit real*8 (a-h,o-z)
13225 ! include 'DIMENSIONS'
13226 ! include 'COMMON.GEO'
13227 ! include 'COMMON.VAR'
13228 ! include 'COMMON.LOCAL'
13229 ! include 'COMMON.CHAIN'
13230 ! include 'COMMON.DERIV'
13231 ! include 'COMMON.INTERACT'
13232 ! include 'COMMON.TORSION'
13233 ! include 'COMMON.SBRIDGE'
13234 ! include 'COMMON.NAMES'
13235 ! include 'COMMON.IOUNITS'
13236 ! include 'COMMON.CONTACTS'
13237 real(kind=8),parameter :: accur=1.0d-10
13238 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
13239 !el local variables
13240 integer :: i,iint,j,k,itypi,itypi1,itypj
13241 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
13242 real(kind=8) :: e1,e2,evdwij,evdw
13243 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
13245 do i=iatsc_s,iatsc_e
13247 if (itypi.eq.ntyp1) cycle
13248 itypi1=itype(i+1,1)
13253 ! Calculate SC interaction energy.
13255 do iint=1,nint_gr(i)
13256 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
13257 !d & 'iend=',iend(i,iint)
13258 do j=istart(i,iint),iend(i,iint)
13260 if (itypj.eq.ntyp1) cycle
13264 rij=xj*xj+yj*yj+zj*zj
13265 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
13266 if (sss.lt.1.0d0) then
13268 eps0ij=eps(itypi,itypj)
13270 e1=fac*fac*aa_aq(itypi,itypj)
13271 e2=fac*bb_aq(itypi,itypj)
13273 evdw=evdw+(1.0d0-sss)*evdwij
13275 ! Calculate the components of the gradient in DC and X
13277 fac=-rrij*(e1+evdwij)*(1.0d0-sss)
13282 gvdwx(k,i)=gvdwx(k,i)-gg(k)
13283 gvdwx(k,j)=gvdwx(k,j)+gg(k)
13284 gvdwc(k,i)=gvdwc(k,i)-gg(k)
13285 gvdwc(k,j)=gvdwc(k,j)+gg(k)
13293 gvdwc(j,i)=expon*gvdwc(j,i)
13294 gvdwx(j,i)=expon*gvdwx(j,i)
13297 !******************************************************************************
13301 ! To save time, the factor of EXPON has been extracted from ALL components
13302 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
13305 !******************************************************************************
13307 end subroutine elj_long
13308 !-----------------------------------------------------------------------------
13309 subroutine elj_short(evdw)
13311 ! This subroutine calculates the interaction energy of nonbonded side chains
13312 ! assuming the LJ potential of interaction.
13314 ! implicit real*8 (a-h,o-z)
13315 ! include 'DIMENSIONS'
13316 ! include 'COMMON.GEO'
13317 ! include 'COMMON.VAR'
13318 ! include 'COMMON.LOCAL'
13319 ! include 'COMMON.CHAIN'
13320 ! include 'COMMON.DERIV'
13321 ! include 'COMMON.INTERACT'
13322 ! include 'COMMON.TORSION'
13323 ! include 'COMMON.SBRIDGE'
13324 ! include 'COMMON.NAMES'
13325 ! include 'COMMON.IOUNITS'
13326 ! include 'COMMON.CONTACTS'
13327 real(kind=8),parameter :: accur=1.0d-10
13328 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
13329 !el local variables
13330 integer :: i,iint,j,k,itypi,itypi1,itypj,num_conti
13331 real(kind=8) :: xi,yi,zi,xj,yj,zj,rij,sss,rrij,fac,eps0ij
13332 real(kind=8) :: e1,e2,evdwij,evdw
13333 ! write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
13335 do i=iatsc_s,iatsc_e
13337 if (itypi.eq.ntyp1) cycle
13338 itypi1=itype(i+1,1)
13345 ! Calculate SC interaction energy.
13347 do iint=1,nint_gr(i)
13348 !d write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
13349 !d & 'iend=',iend(i,iint)
13350 do j=istart(i,iint),iend(i,iint)
13352 if (itypj.eq.ntyp1) cycle
13356 ! Change 12/1/95 to calculate four-body interactions
13357 rij=xj*xj+yj*yj+zj*zj
13358 sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
13359 if (sss.gt.0.0d0) then
13361 eps0ij=eps(itypi,itypj)
13363 e1=fac*fac*aa_aq(itypi,itypj)
13364 e2=fac*bb_aq(itypi,itypj)
13366 evdw=evdw+sss*evdwij
13368 ! Calculate the components of the gradient in DC and X
13370 fac=-rrij*(e1+evdwij)*sss
13375 gvdwx(k,i)=gvdwx(k,i)-gg(k)
13376 gvdwx(k,j)=gvdwx(k,j)+gg(k)
13377 gvdwc(k,i)=gvdwc(k,i)-gg(k)
13378 gvdwc(k,j)=gvdwc(k,j)+gg(k)
13386 gvdwc(j,i)=expon*gvdwc(j,i)
13387 gvdwx(j,i)=expon*gvdwx(j,i)
13390 !******************************************************************************
13394 ! To save time, the factor of EXPON has been extracted from ALL components
13395 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
13398 !******************************************************************************
13400 end subroutine elj_short
13401 !-----------------------------------------------------------------------------
13402 subroutine eljk_long(evdw)
13404 ! This subroutine calculates the interaction energy of nonbonded side chains
13405 ! assuming the LJK potential of interaction.
13407 ! implicit real*8 (a-h,o-z)
13408 ! include 'DIMENSIONS'
13409 ! include 'COMMON.GEO'
13410 ! include 'COMMON.VAR'
13411 ! include 'COMMON.LOCAL'
13412 ! include 'COMMON.CHAIN'
13413 ! include 'COMMON.DERIV'
13414 ! include 'COMMON.INTERACT'
13415 ! include 'COMMON.IOUNITS'
13416 ! include 'COMMON.NAMES'
13417 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
13419 !el local variables
13420 integer :: i,iint,j,k,itypi,itypi1,itypj
13421 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
13422 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
13423 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
13425 do i=iatsc_s,iatsc_e
13427 if (itypi.eq.ntyp1) cycle
13428 itypi1=itype(i+1,1)
13433 ! Calculate SC interaction energy.
13435 do iint=1,nint_gr(i)
13436 do j=istart(i,iint),iend(i,iint)
13438 if (itypj.eq.ntyp1) cycle
13442 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13443 fac_augm=rrij**expon
13444 e_augm=augm(itypi,itypj)*fac_augm
13445 r_inv_ij=dsqrt(rrij)
13447 sss=sscale(rij/sigma(itypi,itypj))
13448 if (sss.lt.1.0d0) then
13449 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
13450 fac=r_shift_inv**expon
13451 e1=fac*fac*aa_aq(itypi,itypj)
13452 e2=fac*bb_aq(itypi,itypj)
13453 evdwij=e_augm+e1+e2
13454 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
13455 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
13456 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
13457 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
13458 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
13459 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
13460 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
13461 evdw=evdw+(1.0d0-sss)*evdwij
13463 ! Calculate the components of the gradient in DC and X
13465 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
13466 fac=fac*(1.0d0-sss)
13471 gvdwx(k,i)=gvdwx(k,i)-gg(k)
13472 gvdwx(k,j)=gvdwx(k,j)+gg(k)
13473 gvdwc(k,i)=gvdwc(k,i)-gg(k)
13474 gvdwc(k,j)=gvdwc(k,j)+gg(k)
13482 gvdwc(j,i)=expon*gvdwc(j,i)
13483 gvdwx(j,i)=expon*gvdwx(j,i)
13487 end subroutine eljk_long
13488 !-----------------------------------------------------------------------------
13489 subroutine eljk_short(evdw)
13491 ! This subroutine calculates the interaction energy of nonbonded side chains
13492 ! assuming the LJK potential of interaction.
13494 ! implicit real*8 (a-h,o-z)
13495 ! include 'DIMENSIONS'
13496 ! include 'COMMON.GEO'
13497 ! include 'COMMON.VAR'
13498 ! include 'COMMON.LOCAL'
13499 ! include 'COMMON.CHAIN'
13500 ! include 'COMMON.DERIV'
13501 ! include 'COMMON.INTERACT'
13502 ! include 'COMMON.IOUNITS'
13503 ! include 'COMMON.NAMES'
13504 real(kind=8),dimension(3) :: gg,gg_lipi,gg_lipj
13506 !el local variables
13507 integer :: i,iint,j,k,itypi,itypi1,itypj
13508 real(kind=8) :: rrij,r_inv_ij,xj,yj,zj,xi,yi,zi,fac,evdw,&
13509 fac_augm,e_augm,rij,sss,r_shift_inv,e1,e2,evdwij
13510 ! print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
13512 do i=iatsc_s,iatsc_e
13514 if (itypi.eq.ntyp1) cycle
13515 itypi1=itype(i+1,1)
13520 ! Calculate SC interaction energy.
13522 do iint=1,nint_gr(i)
13523 do j=istart(i,iint),iend(i,iint)
13525 if (itypj.eq.ntyp1) cycle
13529 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13530 fac_augm=rrij**expon
13531 e_augm=augm(itypi,itypj)*fac_augm
13532 r_inv_ij=dsqrt(rrij)
13534 sss=sscale(rij/sigma(itypi,itypj))
13535 if (sss.gt.0.0d0) then
13536 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
13537 fac=r_shift_inv**expon
13538 e1=fac*fac*aa_aq(itypi,itypj)
13539 e2=fac*bb_aq(itypi,itypj)
13540 evdwij=e_augm+e1+e2
13541 !d sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
13542 !d epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
13543 !d write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
13544 !d & restyp(itypi,1),i,restyp(itypj,1),j,aa(itypi,itypj),
13545 !d & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
13546 !d & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
13547 !d & (c(k,i),k=1,3),(c(k,j),k=1,3)
13548 evdw=evdw+sss*evdwij
13550 ! Calculate the components of the gradient in DC and X
13552 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
13558 gvdwx(k,i)=gvdwx(k,i)-gg(k)
13559 gvdwx(k,j)=gvdwx(k,j)+gg(k)
13560 gvdwc(k,i)=gvdwc(k,i)-gg(k)
13561 gvdwc(k,j)=gvdwc(k,j)+gg(k)
13569 gvdwc(j,i)=expon*gvdwc(j,i)
13570 gvdwx(j,i)=expon*gvdwx(j,i)
13574 end subroutine eljk_short
13575 !-----------------------------------------------------------------------------
13576 subroutine ebp_long(evdw)
13578 ! This subroutine calculates the interaction energy of nonbonded side chains
13579 ! assuming the Berne-Pechukas potential of interaction.
13582 ! implicit real*8 (a-h,o-z)
13583 ! include 'DIMENSIONS'
13584 ! include 'COMMON.GEO'
13585 ! include 'COMMON.VAR'
13586 ! include 'COMMON.LOCAL'
13587 ! include 'COMMON.CHAIN'
13588 ! include 'COMMON.DERIV'
13589 ! include 'COMMON.NAMES'
13590 ! include 'COMMON.INTERACT'
13591 ! include 'COMMON.IOUNITS'
13592 ! include 'COMMON.CALC'
13594 !el integer :: icall
13595 !el common /srutu/ icall
13596 ! double precision rrsave(maxdim)
13598 !el local variables
13599 integer :: iint,itypi,itypi1,itypj
13600 real(kind=8) :: rrij,xi,yi,zi,fac
13601 real(kind=8) :: sss,e1,e2,evdw,sigm,epsi
13603 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
13605 ! if (icall.eq.0) then
13611 do i=iatsc_s,iatsc_e
13613 if (itypi.eq.ntyp1) cycle
13614 itypi1=itype(i+1,1)
13618 dxi=dc_norm(1,nres+i)
13619 dyi=dc_norm(2,nres+i)
13620 dzi=dc_norm(3,nres+i)
13621 ! dsci_inv=dsc_inv(itypi)
13622 dsci_inv=vbld_inv(i+nres)
13624 ! Calculate SC interaction energy.
13626 do iint=1,nint_gr(i)
13627 do j=istart(i,iint),iend(i,iint)
13630 if (itypj.eq.ntyp1) cycle
13631 ! dscj_inv=dsc_inv(itypj)
13632 dscj_inv=vbld_inv(j+nres)
13633 chi1=chi(itypi,itypj)
13634 chi2=chi(itypj,itypi)
13641 alf12=0.5D0*(alf1+alf2)
13645 dxj=dc_norm(1,nres+j)
13646 dyj=dc_norm(2,nres+j)
13647 dzj=dc_norm(3,nres+j)
13648 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13650 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13652 if (sss.lt.1.0d0) then
13654 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
13656 ! Calculate whole angle-dependent part of epsilon and contributions
13657 ! to its derivatives
13658 fac=(rrij*sigsq)**expon2
13659 e1=fac*fac*aa_aq(itypi,itypj)
13660 e2=fac*bb_aq(itypi,itypj)
13661 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13662 eps2der=evdwij*eps3rt
13663 eps3der=evdwij*eps2rt
13664 evdwij=evdwij*eps2rt*eps3rt
13665 evdw=evdw+evdwij*(1.0d0-sss)
13667 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13668 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13669 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
13670 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13671 !d & epsi,sigm,chi1,chi2,chip1,chip2,
13672 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
13673 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
13676 ! Calculate gradient components.
13677 e1=e1*eps1*eps2rt**2*eps3rt**2
13678 fac=-expon*(e1+evdwij)
13681 ! Calculate radial part of the gradient
13685 ! Calculate the angular part of the gradient and sum add the contributions
13686 ! to the appropriate components of the Cartesian gradient.
13687 call sc_grad_scale(1.0d0-sss)
13694 end subroutine ebp_long
13695 !-----------------------------------------------------------------------------
13696 subroutine ebp_short(evdw)
13698 ! This subroutine calculates the interaction energy of nonbonded side chains
13699 ! assuming the Berne-Pechukas potential of interaction.
13702 ! implicit real*8 (a-h,o-z)
13703 ! include 'DIMENSIONS'
13704 ! include 'COMMON.GEO'
13705 ! include 'COMMON.VAR'
13706 ! include 'COMMON.LOCAL'
13707 ! include 'COMMON.CHAIN'
13708 ! include 'COMMON.DERIV'
13709 ! include 'COMMON.NAMES'
13710 ! include 'COMMON.INTERACT'
13711 ! include 'COMMON.IOUNITS'
13712 ! include 'COMMON.CALC'
13714 !el integer :: icall
13715 !el common /srutu/ icall
13716 ! double precision rrsave(maxdim)
13718 !el local variables
13719 integer :: iint,itypi,itypi1,itypj
13720 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi
13721 real(kind=8) :: sss,e1,e2,evdw
13723 ! print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
13725 ! if (icall.eq.0) then
13731 do i=iatsc_s,iatsc_e
13733 if (itypi.eq.ntyp1) cycle
13734 itypi1=itype(i+1,1)
13738 dxi=dc_norm(1,nres+i)
13739 dyi=dc_norm(2,nres+i)
13740 dzi=dc_norm(3,nres+i)
13741 ! dsci_inv=dsc_inv(itypi)
13742 dsci_inv=vbld_inv(i+nres)
13744 ! Calculate SC interaction energy.
13746 do iint=1,nint_gr(i)
13747 do j=istart(i,iint),iend(i,iint)
13750 if (itypj.eq.ntyp1) cycle
13751 ! dscj_inv=dsc_inv(itypj)
13752 dscj_inv=vbld_inv(j+nres)
13753 chi1=chi(itypi,itypj)
13754 chi2=chi(itypj,itypi)
13761 alf12=0.5D0*(alf1+alf2)
13765 dxj=dc_norm(1,nres+j)
13766 dyj=dc_norm(2,nres+j)
13767 dzj=dc_norm(3,nres+j)
13768 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
13770 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
13772 if (sss.gt.0.0d0) then
13774 ! Calculate the angle-dependent terms of energy & contributions to derivatives.
13776 ! Calculate whole angle-dependent part of epsilon and contributions
13777 ! to its derivatives
13778 fac=(rrij*sigsq)**expon2
13779 e1=fac*fac*aa_aq(itypi,itypj)
13780 e2=fac*bb_aq(itypi,itypj)
13781 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
13782 eps2der=evdwij*eps3rt
13783 eps3der=evdwij*eps2rt
13784 evdwij=evdwij*eps2rt*eps3rt
13785 evdw=evdw+evdwij*sss
13787 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
13788 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
13789 !d write (iout,'(2(a3,i3,2x),15(0pf7.3))')
13790 !d & restyp(itypi,1),i,restyp(itypj,1),j,
13791 !d & epsi,sigm,chi1,chi2,chip1,chip2,
13792 !d & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
13793 !d & om1,om2,om12,1.0D0/dsqrt(rrij),
13796 ! Calculate gradient components.
13797 e1=e1*eps1*eps2rt**2*eps3rt**2
13798 fac=-expon*(e1+evdwij)
13801 ! Calculate radial part of the gradient
13805 ! Calculate the angular part of the gradient and sum add the contributions
13806 ! to the appropriate components of the Cartesian gradient.
13807 call sc_grad_scale(sss)
13814 end subroutine ebp_short
13815 !-----------------------------------------------------------------------------
13816 subroutine egb_long(evdw)
13818 ! This subroutine calculates the interaction energy of nonbonded side chains
13819 ! assuming the Gay-Berne potential of interaction.
13822 ! implicit real*8 (a-h,o-z)
13823 ! include 'DIMENSIONS'
13824 ! include 'COMMON.GEO'
13825 ! include 'COMMON.VAR'
13826 ! include 'COMMON.LOCAL'
13827 ! include 'COMMON.CHAIN'
13828 ! include 'COMMON.DERIV'
13829 ! include 'COMMON.NAMES'
13830 ! include 'COMMON.INTERACT'
13831 ! include 'COMMON.IOUNITS'
13832 ! include 'COMMON.CALC'
13833 ! include 'COMMON.CONTROL'
13835 !el local variables
13836 integer :: iint,itypi,itypi1,itypj,subchap
13837 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig,sig0ij,rij_shift
13838 real(kind=8) :: sss,e1,e2,evdw,sss_grad
13839 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
13840 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
13841 ssgradlipi,ssgradlipj
13845 !cccc energy_dec=.false.
13846 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
13849 ! if (icall.eq.0) lprn=.false.
13851 do i=iatsc_s,iatsc_e
13853 if (itypi.eq.ntyp1) cycle
13854 itypi1=itype(i+1,1)
13858 xi=mod(xi,boxxsize)
13859 if (xi.lt.0) xi=xi+boxxsize
13860 yi=mod(yi,boxysize)
13861 if (yi.lt.0) yi=yi+boxysize
13862 zi=mod(zi,boxzsize)
13863 if (zi.lt.0) zi=zi+boxzsize
13864 if ((zi.gt.bordlipbot) &
13865 .and.(zi.lt.bordliptop)) then
13866 !C the energy transfer exist
13867 if (zi.lt.buflipbot) then
13868 !C what fraction I am in
13870 ((zi-bordlipbot)/lipbufthick)
13871 !C lipbufthick is thickenes of lipid buffore
13872 sslipi=sscalelip(fracinbuf)
13873 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
13874 elseif (zi.gt.bufliptop) then
13875 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
13876 sslipi=sscalelip(fracinbuf)
13877 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
13887 dxi=dc_norm(1,nres+i)
13888 dyi=dc_norm(2,nres+i)
13889 dzi=dc_norm(3,nres+i)
13890 ! dsci_inv=dsc_inv(itypi)
13891 dsci_inv=vbld_inv(i+nres)
13892 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
13893 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
13895 ! Calculate SC interaction energy.
13897 do iint=1,nint_gr(i)
13898 do j=istart(i,iint),iend(i,iint)
13899 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
13900 ! call dyn_ssbond_ene(i,j,evdwij)
13902 ! if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13903 ! 'evdw',i,j,evdwij,' ss'
13904 ! if (energy_dec) write (iout,*) &
13905 ! 'evdw',i,j,evdwij,' ss'
13906 ! do k=j+1,iend(i,iint)
13907 !C search over all next residues
13908 ! if (dyn_ss_mask(k)) then
13909 !C check if they are cysteins
13910 !C write(iout,*) 'k=',k
13912 !c write(iout,*) "PRZED TRI", evdwij
13913 ! evdwij_przed_tri=evdwij
13914 ! call triple_ssbond_ene(i,j,k,evdwij)
13915 !c if(evdwij_przed_tri.ne.evdwij) then
13916 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
13919 !c write(iout,*) "PO TRI", evdwij
13920 !C call the energy function that removes the artifical triple disulfide
13921 !C bond the soubroutine is located in ssMD.F
13923 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
13924 'evdw',i,j,evdwij,'tss'
13925 ! endif!dyn_ss_mask(k)
13931 if (itypj.eq.ntyp1) cycle
13932 ! dscj_inv=dsc_inv(itypj)
13933 dscj_inv=vbld_inv(j+nres)
13934 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
13935 ! & 1.0d0/vbld(j+nres)
13936 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
13937 sig0ij=sigma(itypi,itypj)
13938 chi1=chi(itypi,itypj)
13939 chi2=chi(itypj,itypi)
13946 alf12=0.5D0*(alf1+alf2)
13950 ! Searching for nearest neighbour
13951 xj=mod(xj,boxxsize)
13952 if (xj.lt.0) xj=xj+boxxsize
13953 yj=mod(yj,boxysize)
13954 if (yj.lt.0) yj=yj+boxysize
13955 zj=mod(zj,boxzsize)
13956 if (zj.lt.0) zj=zj+boxzsize
13957 if ((zj.gt.bordlipbot) &
13958 .and.(zj.lt.bordliptop)) then
13959 !C the energy transfer exist
13960 if (zj.lt.buflipbot) then
13961 !C what fraction I am in
13963 ((zj-bordlipbot)/lipbufthick)
13964 !C lipbufthick is thickenes of lipid buffore
13965 sslipj=sscalelip(fracinbuf)
13966 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
13967 elseif (zj.gt.bufliptop) then
13968 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
13969 sslipj=sscalelip(fracinbuf)
13970 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
13979 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13980 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13981 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
13982 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
13984 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13992 xj=xj_safe+xshift*boxxsize
13993 yj=yj_safe+yshift*boxysize
13994 zj=zj_safe+zshift*boxzsize
13995 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
13996 if(dist_temp.lt.dist_init) then
13997 dist_init=dist_temp
14006 if (subchap.eq.1) then
14016 dxj=dc_norm(1,nres+j)
14017 dyj=dc_norm(2,nres+j)
14018 dzj=dc_norm(3,nres+j)
14019 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14021 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
14022 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
14023 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
14024 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
14025 if (sss_ele_cut.le.0.0) cycle
14026 if (sss.lt.1.0d0) then
14028 ! Calculate angle-dependent terms of energy and contributions to their
14032 sig=sig0ij*dsqrt(sigsq)
14033 rij_shift=1.0D0/rij-sig+sig0ij
14034 ! for diagnostics; uncomment
14035 ! rij_shift=1.2*sig0ij
14036 ! I hate to put IF's in the loops, but here don't have another choice!!!!
14037 if (rij_shift.le.0.0D0) then
14039 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
14040 !d & restyp(itypi,1),i,restyp(itypj,1),j,
14041 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
14045 !---------------------------------------------------------------
14046 rij_shift=1.0D0/rij_shift
14047 fac=rij_shift**expon
14050 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
14051 eps2der=evdwij*eps3rt
14052 eps3der=evdwij*eps2rt
14053 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
14054 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
14055 evdwij=evdwij*eps2rt*eps3rt
14056 evdw=evdw+evdwij*(1.0d0-sss)*sss_ele_cut
14058 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
14059 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
14060 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
14061 restyp(itypi,1),i,restyp(itypj,1),j,&
14062 epsi,sigm,chi1,chi2,chip1,chip2,&
14063 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
14064 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
14068 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
14070 ! if (energy_dec) write (iout,*) &
14071 ! 'evdw',i,j,evdwij,"egb_long"
14073 ! Calculate gradient components.
14074 e1=e1*eps1*eps2rt**2*eps3rt**2
14075 fac=-expon*(e1+evdwij)*rij_shift
14078 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
14079 /sigma(itypi,itypj)*rij-sss_grad/(1.0-sss)*rij &
14080 /sigmaii(itypi,itypj))
14082 ! Calculate the radial part of the gradient
14086 ! Calculate angular part of the gradient.
14087 call sc_grad_scale(1.0d0-sss)
14093 ! write (iout,*) "Number of loop steps in EGB:",ind
14094 !ccc energy_dec=.false.
14096 end subroutine egb_long
14097 !-----------------------------------------------------------------------------
14098 subroutine egb_short(evdw)
14100 ! This subroutine calculates the interaction energy of nonbonded side chains
14101 ! assuming the Gay-Berne potential of interaction.
14104 ! implicit real*8 (a-h,o-z)
14105 ! include 'DIMENSIONS'
14106 ! include 'COMMON.GEO'
14107 ! include 'COMMON.VAR'
14108 ! include 'COMMON.LOCAL'
14109 ! include 'COMMON.CHAIN'
14110 ! include 'COMMON.DERIV'
14111 ! include 'COMMON.NAMES'
14112 ! include 'COMMON.INTERACT'
14113 ! include 'COMMON.IOUNITS'
14114 ! include 'COMMON.CALC'
14115 ! include 'COMMON.CONTROL'
14117 !el local variables
14118 integer :: iint,itypi,itypi1,itypj,subchap
14119 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,sig0ij,sig
14120 real(kind=8) :: sss,e1,e2,evdw,rij_shift,sss_grad
14121 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14122 dist_temp, dist_init,aa,bb,fracinbuf,sslipi,sslipj,&
14123 ssgradlipi,ssgradlipj
14125 !cccc energy_dec=.false.
14126 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
14129 ! if (icall.eq.0) lprn=.false.
14131 do i=iatsc_s,iatsc_e
14133 if (itypi.eq.ntyp1) cycle
14134 itypi1=itype(i+1,1)
14138 xi=mod(xi,boxxsize)
14139 if (xi.lt.0) xi=xi+boxxsize
14140 yi=mod(yi,boxysize)
14141 if (yi.lt.0) yi=yi+boxysize
14142 zi=mod(zi,boxzsize)
14143 if (zi.lt.0) zi=zi+boxzsize
14144 if ((zi.gt.bordlipbot) &
14145 .and.(zi.lt.bordliptop)) then
14146 !C the energy transfer exist
14147 if (zi.lt.buflipbot) then
14148 !C what fraction I am in
14150 ((zi-bordlipbot)/lipbufthick)
14151 !C lipbufthick is thickenes of lipid buffore
14152 sslipi=sscalelip(fracinbuf)
14153 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
14154 elseif (zi.gt.bufliptop) then
14155 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
14156 sslipi=sscalelip(fracinbuf)
14157 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
14167 dxi=dc_norm(1,nres+i)
14168 dyi=dc_norm(2,nres+i)
14169 dzi=dc_norm(3,nres+i)
14170 ! dsci_inv=dsc_inv(itypi)
14171 dsci_inv=vbld_inv(i+nres)
14173 dxi=dc_norm(1,nres+i)
14174 dyi=dc_norm(2,nres+i)
14175 dzi=dc_norm(3,nres+i)
14176 ! dsci_inv=dsc_inv(itypi)
14177 dsci_inv=vbld_inv(i+nres)
14178 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
14179 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
14181 ! Calculate SC interaction energy.
14183 do iint=1,nint_gr(i)
14184 do j=istart(i,iint),iend(i,iint)
14185 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
14186 call dyn_ssbond_ene(i,j,evdwij)
14188 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
14189 'evdw',i,j,evdwij,' ss'
14190 do k=j+1,iend(i,iint)
14191 !C search over all next residues
14192 if (dyn_ss_mask(k)) then
14193 !C check if they are cysteins
14194 !C write(iout,*) 'k=',k
14196 !c write(iout,*) "PRZED TRI", evdwij
14197 ! evdwij_przed_tri=evdwij
14198 call triple_ssbond_ene(i,j,k,evdwij)
14199 !c if(evdwij_przed_tri.ne.evdwij) then
14200 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
14203 !c write(iout,*) "PO TRI", evdwij
14204 !C call the energy function that removes the artifical triple disulfide
14205 !C bond the soubroutine is located in ssMD.F
14207 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
14208 'evdw',i,j,evdwij,'tss'
14209 endif!dyn_ss_mask(k)
14212 ! if (energy_dec) write (iout,*) &
14213 ! 'evdw',i,j,evdwij,' ss'
14217 if (itypj.eq.ntyp1) cycle
14218 ! dscj_inv=dsc_inv(itypj)
14219 dscj_inv=vbld_inv(j+nres)
14220 ! write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
14221 ! & 1.0d0/vbld(j+nres)
14222 ! write (iout,*) "i",i," j", j," itype",itype(i,1),itype(j,1)
14223 sig0ij=sigma(itypi,itypj)
14224 chi1=chi(itypi,itypj)
14225 chi2=chi(itypj,itypi)
14232 alf12=0.5D0*(alf1+alf2)
14233 ! xj=c(1,nres+j)-xi
14234 ! yj=c(2,nres+j)-yi
14235 ! zj=c(3,nres+j)-zi
14239 ! Searching for nearest neighbour
14240 xj=mod(xj,boxxsize)
14241 if (xj.lt.0) xj=xj+boxxsize
14242 yj=mod(yj,boxysize)
14243 if (yj.lt.0) yj=yj+boxysize
14244 zj=mod(zj,boxzsize)
14245 if (zj.lt.0) zj=zj+boxzsize
14246 if ((zj.gt.bordlipbot) &
14247 .and.(zj.lt.bordliptop)) then
14248 !C the energy transfer exist
14249 if (zj.lt.buflipbot) then
14250 !C what fraction I am in
14252 ((zj-bordlipbot)/lipbufthick)
14253 !C lipbufthick is thickenes of lipid buffore
14254 sslipj=sscalelip(fracinbuf)
14255 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
14256 elseif (zj.gt.bufliptop) then
14257 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
14258 sslipj=sscalelip(fracinbuf)
14259 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
14268 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
14269 +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
14270 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0 &
14271 +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
14273 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14282 xj=xj_safe+xshift*boxxsize
14283 yj=yj_safe+yshift*boxysize
14284 zj=zj_safe+zshift*boxzsize
14285 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
14286 if(dist_temp.lt.dist_init) then
14287 dist_init=dist_temp
14296 if (subchap.eq.1) then
14306 dxj=dc_norm(1,nres+j)
14307 dyj=dc_norm(2,nres+j)
14308 dzj=dc_norm(3,nres+j)
14309 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14311 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
14312 sss_grad=sscale_grad(1.0d0/(rij*sigmaii(itypi,itypj)))
14313 sss_ele_cut=sscale_ele(1.0d0/(rij*sigma(itypi,itypj)))
14314 sss_ele_grad=sscagrad_ele(1.0d0/(rij*sigma(itypi,itypj)))
14315 if (sss_ele_cut.le.0.0) cycle
14317 if (sss.gt.0.0d0) then
14319 ! Calculate angle-dependent terms of energy and contributions to their
14323 sig=sig0ij*dsqrt(sigsq)
14324 rij_shift=1.0D0/rij-sig+sig0ij
14325 ! for diagnostics; uncomment
14326 ! rij_shift=1.2*sig0ij
14327 ! I hate to put IF's in the loops, but here don't have another choice!!!!
14328 if (rij_shift.le.0.0D0) then
14330 !d write (iout,'(2(a3,i3,2x),17(0pf7.3))')
14331 !d & restyp(itypi,1),i,restyp(itypj,1),j,
14332 !d & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
14336 !---------------------------------------------------------------
14337 rij_shift=1.0D0/rij_shift
14338 fac=rij_shift**expon
14341 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
14342 eps2der=evdwij*eps3rt
14343 eps3der=evdwij*eps2rt
14344 ! write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
14345 ! & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
14346 evdwij=evdwij*eps2rt*eps3rt
14347 evdw=evdw+evdwij*sss*sss_ele_cut
14349 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
14350 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
14351 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
14352 restyp(itypi,1),i,restyp(itypj,1),j,&
14353 epsi,sigm,chi1,chi2,chip1,chip2,&
14354 eps1,eps2rt**2,eps3rt**2,sig,sig0ij,&
14355 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
14359 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
14361 ! if (energy_dec) write (iout,*) &
14362 ! 'evdw',i,j,evdwij,"egb_short"
14364 ! Calculate gradient components.
14365 e1=e1*eps1*eps2rt**2*eps3rt**2
14366 fac=-expon*(e1+evdwij)*rij_shift
14369 fac=fac+evdwij*(sss_ele_grad/sss_ele_cut&
14370 /sigma(itypi,itypj)*rij+sss_grad/sss*rij &
14371 /sigmaii(itypi,itypj))
14374 ! Calculate the radial part of the gradient
14378 ! Calculate angular part of the gradient.
14379 call sc_grad_scale(sss)
14385 ! write (iout,*) "Number of loop steps in EGB:",ind
14386 !ccc energy_dec=.false.
14388 end subroutine egb_short
14389 !-----------------------------------------------------------------------------
14390 subroutine egbv_long(evdw)
14392 ! This subroutine calculates the interaction energy of nonbonded side chains
14393 ! assuming the Gay-Berne-Vorobjev potential of interaction.
14396 ! implicit real*8 (a-h,o-z)
14397 ! include 'DIMENSIONS'
14398 ! include 'COMMON.GEO'
14399 ! include 'COMMON.VAR'
14400 ! include 'COMMON.LOCAL'
14401 ! include 'COMMON.CHAIN'
14402 ! include 'COMMON.DERIV'
14403 ! include 'COMMON.NAMES'
14404 ! include 'COMMON.INTERACT'
14405 ! include 'COMMON.IOUNITS'
14406 ! include 'COMMON.CALC'
14408 !el integer :: icall
14409 !el common /srutu/ icall
14411 !el local variables
14412 integer :: iint,itypi,itypi1,itypj
14413 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,r0ij,sig,sig0ij
14414 real(kind=8) :: sss,e1,e2,evdw,fac_augm,e_augm,rij_shift
14416 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
14419 ! if (icall.eq.0) lprn=.true.
14421 do i=iatsc_s,iatsc_e
14423 if (itypi.eq.ntyp1) cycle
14424 itypi1=itype(i+1,1)
14428 dxi=dc_norm(1,nres+i)
14429 dyi=dc_norm(2,nres+i)
14430 dzi=dc_norm(3,nres+i)
14431 ! dsci_inv=dsc_inv(itypi)
14432 dsci_inv=vbld_inv(i+nres)
14434 ! Calculate SC interaction energy.
14436 do iint=1,nint_gr(i)
14437 do j=istart(i,iint),iend(i,iint)
14440 if (itypj.eq.ntyp1) cycle
14441 ! dscj_inv=dsc_inv(itypj)
14442 dscj_inv=vbld_inv(j+nres)
14443 sig0ij=sigma(itypi,itypj)
14444 r0ij=r0(itypi,itypj)
14445 chi1=chi(itypi,itypj)
14446 chi2=chi(itypj,itypi)
14453 alf12=0.5D0*(alf1+alf2)
14457 dxj=dc_norm(1,nres+j)
14458 dyj=dc_norm(2,nres+j)
14459 dzj=dc_norm(3,nres+j)
14460 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14463 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
14465 if (sss.lt.1.0d0) then
14467 ! Calculate angle-dependent terms of energy and contributions to their
14471 sig=sig0ij*dsqrt(sigsq)
14472 rij_shift=1.0D0/rij-sig+r0ij
14473 ! I hate to put IF's in the loops, but here don't have another choice!!!!
14474 if (rij_shift.le.0.0D0) then
14479 !---------------------------------------------------------------
14480 rij_shift=1.0D0/rij_shift
14481 fac=rij_shift**expon
14482 e1=fac*fac*aa_aq(itypi,itypj)
14483 e2=fac*bb_aq(itypi,itypj)
14484 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
14485 eps2der=evdwij*eps3rt
14486 eps3der=evdwij*eps2rt
14487 fac_augm=rrij**expon
14488 e_augm=augm(itypi,itypj)*fac_augm
14489 evdwij=evdwij*eps2rt*eps3rt
14490 evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
14492 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
14493 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
14494 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
14495 restyp(itypi,1),i,restyp(itypj,1),j,&
14496 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
14497 chi1,chi2,chip1,chip2,&
14498 eps1,eps2rt**2,eps3rt**2,&
14499 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
14502 ! Calculate gradient components.
14503 e1=e1*eps1*eps2rt**2*eps3rt**2
14504 fac=-expon*(e1+evdwij)*rij_shift
14506 fac=rij*fac-2*expon*rrij*e_augm
14507 ! Calculate the radial part of the gradient
14511 ! Calculate angular part of the gradient.
14512 call sc_grad_scale(1.0d0-sss)
14517 end subroutine egbv_long
14518 !-----------------------------------------------------------------------------
14519 subroutine egbv_short(evdw)
14521 ! This subroutine calculates the interaction energy of nonbonded side chains
14522 ! assuming the Gay-Berne-Vorobjev potential of interaction.
14525 ! implicit real*8 (a-h,o-z)
14526 ! include 'DIMENSIONS'
14527 ! include 'COMMON.GEO'
14528 ! include 'COMMON.VAR'
14529 ! include 'COMMON.LOCAL'
14530 ! include 'COMMON.CHAIN'
14531 ! include 'COMMON.DERIV'
14532 ! include 'COMMON.NAMES'
14533 ! include 'COMMON.INTERACT'
14534 ! include 'COMMON.IOUNITS'
14535 ! include 'COMMON.CALC'
14537 !el integer :: icall
14538 !el common /srutu/ icall
14540 !el local variables
14541 integer :: iint,itypi,itypi1,itypj
14542 real(kind=8) :: rrij,xi,yi,zi,fac,sigm,epsi,rij_shift
14543 real(kind=8) :: sss,e1,e2,evdw,r0ij,sig,sig0ij,fac_augm,e_augm
14545 ! print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
14548 ! if (icall.eq.0) lprn=.true.
14550 do i=iatsc_s,iatsc_e
14552 if (itypi.eq.ntyp1) cycle
14553 itypi1=itype(i+1,1)
14557 dxi=dc_norm(1,nres+i)
14558 dyi=dc_norm(2,nres+i)
14559 dzi=dc_norm(3,nres+i)
14560 ! dsci_inv=dsc_inv(itypi)
14561 dsci_inv=vbld_inv(i+nres)
14563 ! Calculate SC interaction energy.
14565 do iint=1,nint_gr(i)
14566 do j=istart(i,iint),iend(i,iint)
14569 if (itypj.eq.ntyp1) cycle
14570 ! dscj_inv=dsc_inv(itypj)
14571 dscj_inv=vbld_inv(j+nres)
14572 sig0ij=sigma(itypi,itypj)
14573 r0ij=r0(itypi,itypj)
14574 chi1=chi(itypi,itypj)
14575 chi2=chi(itypj,itypi)
14582 alf12=0.5D0*(alf1+alf2)
14586 dxj=dc_norm(1,nres+j)
14587 dyj=dc_norm(2,nres+j)
14588 dzj=dc_norm(3,nres+j)
14589 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
14592 sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
14594 if (sss.gt.0.0d0) then
14596 ! Calculate angle-dependent terms of energy and contributions to their
14600 sig=sig0ij*dsqrt(sigsq)
14601 rij_shift=1.0D0/rij-sig+r0ij
14602 ! I hate to put IF's in the loops, but here don't have another choice!!!!
14603 if (rij_shift.le.0.0D0) then
14608 !---------------------------------------------------------------
14609 rij_shift=1.0D0/rij_shift
14610 fac=rij_shift**expon
14611 e1=fac*fac*aa_aq(itypi,itypj)
14612 e2=fac*bb_aq(itypi,itypj)
14613 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
14614 eps2der=evdwij*eps3rt
14615 eps3der=evdwij*eps2rt
14616 fac_augm=rrij**expon
14617 e_augm=augm(itypi,itypj)*fac_augm
14618 evdwij=evdwij*eps2rt*eps3rt
14619 evdw=evdw+(evdwij+e_augm)*sss
14621 sigm=dabs(aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
14622 epsi=bb_aq(itypi,itypj)**2/aa_aq(itypi,itypj)
14623 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
14624 restyp(itypi,1),i,restyp(itypj,1),j,&
14625 epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),&
14626 chi1,chi2,chip1,chip2,&
14627 eps1,eps2rt**2,eps3rt**2,&
14628 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
14631 ! Calculate gradient components.
14632 e1=e1*eps1*eps2rt**2*eps3rt**2
14633 fac=-expon*(e1+evdwij)*rij_shift
14635 fac=rij*fac-2*expon*rrij*e_augm
14636 ! Calculate the radial part of the gradient
14640 ! Calculate angular part of the gradient.
14641 call sc_grad_scale(sss)
14646 end subroutine egbv_short
14647 !-----------------------------------------------------------------------------
14648 subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
14650 ! This subroutine calculates the average interaction energy and its gradient
14651 ! in the virtual-bond vectors between non-adjacent peptide groups, based on
14652 ! the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
14653 ! The potential depends both on the distance of peptide-group centers and on
14654 ! the orientation of the CA-CA virtual bonds.
14656 ! implicit real*8 (a-h,o-z)
14662 ! include 'DIMENSIONS'
14663 ! include 'COMMON.CONTROL'
14664 ! include 'COMMON.SETUP'
14665 ! include 'COMMON.IOUNITS'
14666 ! include 'COMMON.GEO'
14667 ! include 'COMMON.VAR'
14668 ! include 'COMMON.LOCAL'
14669 ! include 'COMMON.CHAIN'
14670 ! include 'COMMON.DERIV'
14671 ! include 'COMMON.INTERACT'
14672 ! include 'COMMON.CONTACTS'
14673 ! include 'COMMON.TORSION'
14674 ! include 'COMMON.VECTORS'
14675 ! include 'COMMON.FFIELD'
14676 ! include 'COMMON.TIME1'
14677 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg
14678 real(kind=8),dimension(3,3) ::erder,uryg,urzg,vryg,vrzg
14679 real(kind=8),dimension(2,2) :: acipa !el,a_temp
14680 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
14681 real(kind=8),dimension(4) :: muij
14682 !el integer :: num_conti,j1,j2
14683 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
14684 !el dz_normi,xmedi,ymedi,zmedi
14685 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
14686 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14687 !el num_conti,j1,j2
14688 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14690 real(kind=8) :: scal_el=1.0d0
14692 real(kind=8) :: scal_el=0.5d0
14695 ! 13-go grudnia roku pamietnego...
14696 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
14697 0.0d0,1.0d0,0.0d0,&
14698 0.0d0,0.0d0,1.0d0/),shape(unmat))
14699 !el local variables
14701 real(kind=8) :: fac
14702 real(kind=8) :: dxj,dyj,dzj
14703 real(kind=8) :: ees,evdw1,eel_loc,eello_turn3,eello_turn4
14705 ! allocate(num_cont_hb(nres)) !(maxres)
14706 !d write(iout,*) 'In EELEC'
14708 !d write(iout,*) 'Type',i
14709 !d write(iout,*) 'B1',B1(:,i)
14710 !d write(iout,*) 'B2',B2(:,i)
14711 !d write(iout,*) 'CC',CC(:,:,i)
14712 !d write(iout,*) 'DD',DD(:,:,i)
14713 !d write(iout,*) 'EE',EE(:,:,i)
14715 !d call check_vecgrad
14717 if (icheckgrad.eq.1) then
14719 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
14721 dc_norm(k,i)=dc(k,i)*fac
14723 ! write (iout,*) 'i',i,' fac',fac
14726 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
14727 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or. &
14728 wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
14729 ! call vec_and_deriv
14733 ! print *, "before set matrices"
14735 ! print *,"after set martices"
14737 time_mat=time_mat+MPI_Wtime()-time01
14741 !d write (iout,*) 'i=',i
14743 !d write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
14746 !d write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
14747 !d & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
14760 !d print '(a)','Enter EELEC'
14761 !d write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
14762 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
14763 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
14765 gel_loc_loc(i)=0.0d0
14770 ! 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
14772 ! Loop over i,i+2 and i,i+3 pairs of the peptide groups
14774 do i=iturn3_start,iturn3_end
14775 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1 &
14776 .or. itype(i+2,1).eq.ntyp1 .or. itype(i+3,1).eq.ntyp1) cycle
14780 dx_normi=dc_norm(1,i)
14781 dy_normi=dc_norm(2,i)
14782 dz_normi=dc_norm(3,i)
14783 xmedi=c(1,i)+0.5d0*dxi
14784 ymedi=c(2,i)+0.5d0*dyi
14785 zmedi=c(3,i)+0.5d0*dzi
14786 xmedi=dmod(xmedi,boxxsize)
14787 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14788 ymedi=dmod(ymedi,boxysize)
14789 if (ymedi.lt.0) ymedi=ymedi+boxysize
14790 zmedi=dmod(zmedi,boxzsize)
14791 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14793 call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
14794 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
14795 num_cont_hb(i)=num_conti
14797 do i=iturn4_start,iturn4_end
14798 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1 &
14799 .or. itype(i+3,1).eq.ntyp1 &
14800 .or. itype(i+4,1).eq.ntyp1) cycle
14804 dx_normi=dc_norm(1,i)
14805 dy_normi=dc_norm(2,i)
14806 dz_normi=dc_norm(3,i)
14807 xmedi=c(1,i)+0.5d0*dxi
14808 ymedi=c(2,i)+0.5d0*dyi
14809 zmedi=c(3,i)+0.5d0*dzi
14810 xmedi=dmod(xmedi,boxxsize)
14811 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14812 ymedi=dmod(ymedi,boxysize)
14813 if (ymedi.lt.0) ymedi=ymedi+boxysize
14814 zmedi=dmod(zmedi,boxzsize)
14815 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14816 num_conti=num_cont_hb(i)
14817 call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
14818 if (wturn4.gt.0.0d0 .and. itype(i+2,1).ne.ntyp1) &
14819 call eturn4(i,eello_turn4)
14820 num_cont_hb(i)=num_conti
14823 ! Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
14825 do i=iatel_s,iatel_e
14826 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
14830 dx_normi=dc_norm(1,i)
14831 dy_normi=dc_norm(2,i)
14832 dz_normi=dc_norm(3,i)
14833 xmedi=c(1,i)+0.5d0*dxi
14834 ymedi=c(2,i)+0.5d0*dyi
14835 zmedi=c(3,i)+0.5d0*dzi
14836 xmedi=dmod(xmedi,boxxsize)
14837 if (xmedi.lt.0) xmedi=xmedi+boxxsize
14838 ymedi=dmod(ymedi,boxysize)
14839 if (ymedi.lt.0) ymedi=ymedi+boxysize
14840 zmedi=dmod(zmedi,boxzsize)
14841 if (zmedi.lt.0) zmedi=zmedi+boxzsize
14842 ! write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
14843 num_conti=num_cont_hb(i)
14844 do j=ielstart(i),ielend(i)
14845 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
14846 call eelecij_scale(i,j,ees,evdw1,eel_loc)
14848 num_cont_hb(i)=num_conti
14850 ! write (iout,*) "Number of loop steps in EELEC:",ind
14852 !d write (iout,'(i3,3f10.5,5x,3f10.5)')
14853 !d & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
14855 ! 12/7/99 Adam eello_turn3 will be considered as a separate energy term
14856 !cc eel_loc=eel_loc+eello_turn3
14857 !d print *,"Processor",fg_rank," t_eelecij",t_eelecij
14859 end subroutine eelec_scale
14860 !-----------------------------------------------------------------------------
14861 subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
14862 ! implicit real*8 (a-h,o-z)
14865 ! include 'DIMENSIONS'
14869 ! include 'COMMON.CONTROL'
14870 ! include 'COMMON.IOUNITS'
14871 ! include 'COMMON.GEO'
14872 ! include 'COMMON.VAR'
14873 ! include 'COMMON.LOCAL'
14874 ! include 'COMMON.CHAIN'
14875 ! include 'COMMON.DERIV'
14876 ! include 'COMMON.INTERACT'
14877 ! include 'COMMON.CONTACTS'
14878 ! include 'COMMON.TORSION'
14879 ! include 'COMMON.VECTORS'
14880 ! include 'COMMON.FFIELD'
14881 ! include 'COMMON.TIME1'
14882 real(kind=8),dimension(3) :: ggg,gggp,gggm,erij,dcosb,dcosg,xtemp
14883 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
14884 real(kind=8),dimension(2,2) :: acipa !el,a_temp
14885 !el real(kind=8),dimension(3,4) :: agg,aggi,aggi1,aggj,aggj1
14886 real(kind=8),dimension(4) :: muij
14887 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
14888 dist_temp, dist_init,sss_grad
14889 integer xshift,yshift,zshift
14891 !el integer :: num_conti,j1,j2
14892 !el real(kind=8) :: a22,a23,a32,a33,dxi,dyi,dzi,dx_normi,dy_normi,&
14893 !el dz_normi,xmedi,ymedi,zmedi
14894 !el common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,&
14895 !el dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
14896 !el num_conti,j1,j2
14897 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
14899 real(kind=8) :: scal_el=1.0d0
14901 real(kind=8) :: scal_el=0.5d0
14904 ! 13-go grudnia roku pamietnego...
14905 real(kind=8),dimension(3,3) :: unmat=reshape((/1.0d0,0.0d0,0.0d0,&
14906 0.0d0,1.0d0,0.0d0,&
14907 0.0d0,0.0d0,1.0d0/),shape(unmat))
14908 !el local variables
14909 integer :: i,j,k,l,iteli,itelj,kkk,kkll,m,isubchap
14910 real(kind=8) :: aaa,bbb,ael6i,ael3i,dxj,dyj,dzj
14911 real(kind=8) :: xj,yj,zj,rij,rrmij,rmij,sss,r3ij,r6ij,fac
14912 real(kind=8) :: cosa,cosb,cosg,ev1,ev2,fac3,fac4,evdwij
14913 real(kind=8) :: el1,el2,eesij,ees0ij,r0ij,fcont,fprimcont
14914 real(kind=8) :: ees0tmp,ees0pij1,ees0mij1,ees0pijp,ees0mijp
14915 real(kind=8) :: ees,evdw1,eel_loc,eel_loc_ij,dx_normj,dy_normj,&
14916 dz_normj,facvdw,facel,fac1,facr,ecosa,ecosb,ecosg,&
14917 ury,urz,vry,vrz,a22der,a23der,a32der,a33der,cosa4,&
14918 wij,cosbg1,cosbg2,ees0pij,ees0mij,fac3p,ecosa1,ecosb1,&
14919 ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,ecosgp,&
14920 ecosam,ecosbm,ecosgm,ghalf,time00
14921 ! integer :: maxconts
14922 ! maxconts = nres/4
14923 ! allocate(gacontp_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14924 ! allocate(gacontp_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14925 ! allocate(gacontp_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14926 ! allocate(gacontm_hb1(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14927 ! allocate(gacontm_hb2(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14928 ! allocate(gacontm_hb3(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14929 ! allocate(gacont_hbr(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14930 ! allocate(grij_hb_cont(3,maxconts,nres)) !(3,maxconts,maxres) ! (maxconts=maxres/4)
14931 ! allocate(facont_hb(maxconts,nres)) !(maxconts,maxres)
14932 ! allocate(ees0p(maxconts,nres)) !(maxconts,maxres)
14933 ! allocate(ees0m(maxconts,nres)) !(maxconts,maxres)
14934 ! allocate(d_cont(maxconts,nres)) !(maxconts,maxres)
14935 ! allocate(jcont_hb(maxconts,nres)) !(maxconts,maxres)
14937 ! allocate(a_chuj(2,2,maxconts,nres)) !(2,2,maxconts,maxres)
14938 ! allocate(a_chuj_der(2,2,3,5,maxconts,nres)) !(2,2,3,5,maxconts,maxres)
14943 !d write (iout,*) "eelecij",i,j
14947 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
14948 aaa=app(iteli,itelj)
14949 bbb=bpp(iteli,itelj)
14950 ael6i=ael6(iteli,itelj)
14951 ael3i=ael3(iteli,itelj)
14955 dx_normj=dc_norm(1,j)
14956 dy_normj=dc_norm(2,j)
14957 dz_normj=dc_norm(3,j)
14958 ! xj=c(1,j)+0.5D0*dxj-xmedi
14959 ! yj=c(2,j)+0.5D0*dyj-ymedi
14960 ! zj=c(3,j)+0.5D0*dzj-zmedi
14961 xj=c(1,j)+0.5D0*dxj
14962 yj=c(2,j)+0.5D0*dyj
14963 zj=c(3,j)+0.5D0*dzj
14964 xj=mod(xj,boxxsize)
14965 if (xj.lt.0) xj=xj+boxxsize
14966 yj=mod(yj,boxysize)
14967 if (yj.lt.0) yj=yj+boxysize
14968 zj=mod(zj,boxzsize)
14969 if (zj.lt.0) zj=zj+boxzsize
14971 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14978 xj=xj_safe+xshift*boxxsize
14979 yj=yj_safe+yshift*boxysize
14980 zj=zj_safe+zshift*boxzsize
14981 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
14982 if(dist_temp.lt.dist_init) then
14983 dist_init=dist_temp
14992 if (isubchap.eq.1) then
15003 rij=xj*xj+yj*yj+zj*zj
15007 ! For extracting the short-range part of Evdwpp
15008 sss=sscale(rij/rpp(iteli,itelj))
15009 sss_ele_cut=sscale_ele(rij)
15010 sss_ele_grad=sscagrad_ele(rij)
15011 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
15012 ! sss_ele_cut=1.0d0
15013 ! sss_ele_grad=0.0d0
15014 if (sss_ele_cut.le.0.0) go to 128
15018 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
15019 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
15020 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
15021 fac=cosa-3.0D0*cosb*cosg
15023 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
15024 if (j.eq.i+2) ev1=scal_el*ev1
15029 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
15032 ! 12/26/95 - for the evaluation of multi-body H-bonding interactions
15033 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
15034 ees=ees+eesij*sss_ele_cut
15035 evdw1=evdw1+evdwij*(1.0d0-sss)*sss_ele_cut
15036 !d write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
15037 !d & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
15038 !d & 1.0D0/dsqrt(rrmij),evdwij,eesij,
15039 !d & xmedi,ymedi,zmedi,xj,yj,zj
15041 if (energy_dec) then
15042 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
15043 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
15047 ! Calculate contributions to the Cartesian gradient.
15050 facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
15051 facel=-3*rrmij*(el1+eesij)*sss_ele_cut
15057 ! Radial derivatives. First process both termini of the fragment (i,j)
15059 ggg(1)=facel*xj+sss_ele_grad*rmij*eesij*xj
15060 ggg(2)=facel*yj+sss_ele_grad*rmij*eesij*yj
15061 ggg(3)=facel*zj+sss_ele_grad*rmij*eesij*zj
15063 ! ghalf=0.5D0*ggg(k)
15064 ! gelc(k,i)=gelc(k,i)+ghalf
15065 ! gelc(k,j)=gelc(k,j)+ghalf
15067 ! 9/28/08 AL Gradient compotents will be summed only at the end
15069 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
15070 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
15073 ! Loop over residues i+1 thru j-1.
15077 !grad gelc(l,k)=gelc(l,k)+ggg(l)
15080 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*(1.0d0-sss) &
15081 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
15082 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*(1.0d0-sss) &
15083 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
15084 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*(1.0d0-sss) &
15085 -evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
15087 ! ghalf=0.5D0*ggg(k)
15088 ! gvdwpp(k,i)=gvdwpp(k,i)+ghalf
15089 ! gvdwpp(k,j)=gvdwpp(k,j)+ghalf
15091 ! 9/28/08 AL Gradient compotents will be summed only at the end
15093 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
15094 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
15097 ! Loop over residues i+1 thru j-1.
15101 !grad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
15105 facvdw=(ev1+evdwij)*(1.0d0-sss)*sss_ele_cut
15106 facel=(el1+eesij)*sss_ele_cut
15108 fac=-3*rrmij*(facvdw+facvdw+facel)
15113 ! Radial derivatives. First process both termini of the fragment (i,j)
15119 ! ghalf=0.5D0*ggg(k)
15120 ! gelc(k,i)=gelc(k,i)+ghalf
15121 ! gelc(k,j)=gelc(k,j)+ghalf
15123 ! 9/28/08 AL Gradient compotents will be summed only at the end
15125 gelc_long(k,j)=gelc(k,j)+ggg(k)
15126 gelc_long(k,i)=gelc(k,i)-ggg(k)
15129 ! Loop over residues i+1 thru j-1.
15133 !grad gelc(l,k)=gelc(l,k)+ggg(l)
15136 ! 9/28/08 AL Gradient compotents will be summed only at the end
15141 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
15142 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
15148 ecosa=2.0D0*fac3*fac1+fac4
15151 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
15152 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
15154 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
15155 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
15157 !d print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
15158 !d & (dcosg(k),k=1,3)
15160 ggg(k)=(ecosb*dcosb(k)+ecosg*dcosg(k) )*sss_ele_cut
15163 ! ghalf=0.5D0*ggg(k)
15164 ! gelc(k,i)=gelc(k,i)+ghalf
15165 ! & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
15166 ! & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
15167 ! gelc(k,j)=gelc(k,j)+ghalf
15168 ! & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
15169 ! & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
15173 !grad gelc(l,k)=gelc(l,k)+ggg(l)
15177 gelc(k,i)=gelc(k,i) &
15178 +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15179 + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)&
15181 gelc(k,j)=gelc(k,j) &
15182 +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15183 + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
15185 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
15186 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
15188 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 &
15189 .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 &
15190 .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
15192 ! 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
15193 ! energy of a peptide unit is assumed in the form of a second-order
15194 ! Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
15195 ! Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
15196 ! are computed for EVERY pair of non-contiguous peptide groups.
15198 if (j.lt.nres-1) then
15209 muij(kkk)=mu(k,i)*mu(l,j)
15212 !d write (iout,*) 'EELEC: i',i,' j',j
15213 !d write (iout,*) 'j',j,' j1',j1,' j2',j2
15214 !d write(iout,*) 'muij',muij
15215 ury=scalar(uy(1,i),erij)
15216 urz=scalar(uz(1,i),erij)
15217 vry=scalar(uy(1,j),erij)
15218 vrz=scalar(uz(1,j),erij)
15219 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
15220 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
15221 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
15222 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
15223 fac=dsqrt(-ael6i)*r3ij
15228 !d write (iout,'(4i5,4f10.5)')
15229 !d & i,itortyp(itype(i,1)),j,itortyp(itype(j,1)),a22,a23,a32,a33
15230 !d write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
15231 !d write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
15232 !d & uy(:,j),uz(:,j)
15233 !d write (iout,'(4f10.5)')
15234 !d & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
15235 !d & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
15236 !d write (iout,'(4f10.5)') ury,urz,vry,vrz
15237 !d write (iout,'(9f10.5/)')
15238 !d & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
15239 ! Derivatives of the elements of A in virtual-bond vectors
15240 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
15242 uryg(k,1)=scalar(erder(1,k),uy(1,i))
15243 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
15244 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
15245 urzg(k,1)=scalar(erder(1,k),uz(1,i))
15246 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
15247 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
15248 vryg(k,1)=scalar(erder(1,k),uy(1,j))
15249 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
15250 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
15251 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
15252 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
15253 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
15255 ! Compute radial contributions to the gradient
15273 ! Add the contributions coming from er
15276 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
15277 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
15278 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
15279 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
15282 ! Derivatives in DC(i)
15283 !grad ghalf1=0.5d0*agg(k,1)
15284 !grad ghalf2=0.5d0*agg(k,2)
15285 !grad ghalf3=0.5d0*agg(k,3)
15286 !grad ghalf4=0.5d0*agg(k,4)
15287 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j)) &
15288 -3.0d0*uryg(k,2)*vry)!+ghalf1
15289 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j)) &
15290 -3.0d0*uryg(k,2)*vrz)!+ghalf2
15291 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j)) &
15292 -3.0d0*urzg(k,2)*vry)!+ghalf3
15293 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j)) &
15294 -3.0d0*urzg(k,2)*vrz)!+ghalf4
15295 ! Derivatives in DC(i+1)
15296 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j)) &
15297 -3.0d0*uryg(k,3)*vry)!+agg(k,1)
15298 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j)) &
15299 -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
15300 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j)) &
15301 -3.0d0*urzg(k,3)*vry)!+agg(k,3)
15302 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j)) &
15303 -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
15304 ! Derivatives in DC(j)
15305 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i)) &
15306 -3.0d0*vryg(k,2)*ury)!+ghalf1
15307 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i)) &
15308 -3.0d0*vrzg(k,2)*ury)!+ghalf2
15309 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i)) &
15310 -3.0d0*vryg(k,2)*urz)!+ghalf3
15311 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i)) &
15312 -3.0d0*vrzg(k,2)*urz)!+ghalf4
15313 ! Derivatives in DC(j+1) or DC(nres-1)
15314 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i)) &
15315 -3.0d0*vryg(k,3)*ury)
15316 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i)) &
15317 -3.0d0*vrzg(k,3)*ury)
15318 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i)) &
15319 -3.0d0*vryg(k,3)*urz)
15320 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i)) &
15321 -3.0d0*vrzg(k,3)*urz)
15322 !grad if (j.eq.nres-1 .and. i.lt.j-2) then
15324 !grad aggj1(k,l)=aggj1(k,l)+agg(k,l)
15337 aggi(k,l)=-aggi(k,l)
15338 aggi1(k,l)=-aggi1(k,l)
15339 aggj(k,l)=-aggj(k,l)
15340 aggj1(k,l)=-aggj1(k,l)
15343 if (j.lt.nres-1) then
15349 aggi(k,l)=-aggi(k,l)
15350 aggi1(k,l)=-aggi1(k,l)
15351 aggj(k,l)=-aggj(k,l)
15352 aggj1(k,l)=-aggj1(k,l)
15363 aggi(k,l)=-aggi(k,l)
15364 aggi1(k,l)=-aggi1(k,l)
15365 aggj(k,l)=-aggj(k,l)
15366 aggj1(k,l)=-aggj1(k,l)
15371 IF (wel_loc.gt.0.0d0) THEN
15372 ! Contribution to the local-electrostatic energy coming from the i-j pair
15373 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3) &
15375 ! write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
15376 ! print *,"EELLOC",i,gel_loc_loc(i-1)
15377 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
15378 'eelloc',i,j,eel_loc_ij
15379 ! write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3) !d
15381 eel_loc=eel_loc+eel_loc_ij*sss_ele_cut
15382 ! Partial derivatives in virtual-bond dihedral angles gamma
15384 gel_loc_loc(i-1)=gel_loc_loc(i-1)+ &
15385 (a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j) &
15386 +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)) &
15388 gel_loc_loc(j-1)=gel_loc_loc(j-1)+ &
15389 (a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j) &
15390 +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)) &
15396 ! Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
15398 ggg(l)=(agg(l,1)*muij(1)+ &
15399 agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4))&
15401 +eel_loc_ij*sss_ele_grad*rmij*xtemp(l)
15403 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
15404 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
15405 !grad ghalf=0.5d0*ggg(l)
15406 !grad gel_loc(l,i)=gel_loc(l,i)+ghalf
15407 !grad gel_loc(l,j)=gel_loc(l,j)+ghalf
15411 !grad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
15414 ! Remaining derivatives of eello
15416 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+ &
15417 aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))&
15420 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+ &
15421 aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))&
15424 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+ &
15425 aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))&
15428 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+ &
15429 aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))&
15434 ! Change 12/26/95 to calculate four-body contributions to H-bonding energy
15435 ! if (j.gt.i+1 .and. num_conti.le.maxconts) then
15436 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0 &
15437 .and. num_conti.le.maxconts) then
15438 ! write (iout,*) i,j," entered corr"
15440 ! Calculate the contact function. The ith column of the array JCONT will
15441 ! contain the numbers of atoms that make contacts with the atom I (of numbers
15442 ! greater than I). The arrays FACONT and GACONT will contain the values of
15443 ! the contact function and its derivative.
15444 ! r0ij=1.02D0*rpp(iteli,itelj)
15445 ! r0ij=1.11D0*rpp(iteli,itelj)
15446 r0ij=2.20D0*rpp(iteli,itelj)
15447 ! r0ij=1.55D0*rpp(iteli,itelj)
15448 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
15449 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
15450 if (fcont.gt.0.0D0) then
15451 num_conti=num_conti+1
15452 if (num_conti.gt.maxconts) then
15453 !elwrite(iout,*) "num_conti",num_conti, "maxconts",maxconts
15454 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
15455 ' will skip next contacts for this conf.',num_conti
15457 jcont_hb(num_conti,i)=j
15458 !d write (iout,*) "i",i," j",j," num_conti",num_conti,
15459 !d & " jcont_hb",jcont_hb(num_conti,i)
15460 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. &
15461 wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
15462 ! 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
15464 d_cont(num_conti,i)=rij
15465 !d write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
15466 ! --- Electrostatic-interaction matrix ---
15467 a_chuj(1,1,num_conti,i)=a22
15468 a_chuj(1,2,num_conti,i)=a23
15469 a_chuj(2,1,num_conti,i)=a32
15470 a_chuj(2,2,num_conti,i)=a33
15471 ! --- Gradient of rij
15473 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
15480 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
15481 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
15482 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
15483 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
15484 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
15489 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
15490 ! Calculate contact energies
15492 wij=cosa-3.0D0*cosb*cosg
15495 ! fac3=dsqrt(-ael6i)/r0ij**3
15496 fac3=dsqrt(-ael6i)*r3ij
15497 ! ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
15498 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
15499 if (ees0tmp.gt.0) then
15500 ees0pij=dsqrt(ees0tmp)
15504 ! ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
15505 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
15506 if (ees0tmp.gt.0) then
15507 ees0mij=dsqrt(ees0tmp)
15512 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij) &
15515 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij) &
15518 ! Diagnostics. Comment out or remove after debugging!
15519 ! ees0p(num_conti,i)=0.5D0*fac3*ees0pij
15520 ! ees0m(num_conti,i)=0.5D0*fac3*ees0mij
15521 ! ees0m(num_conti,i)=0.0D0
15523 ! write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
15524 ! & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
15525 ! Angular derivatives of the contact function
15526 ees0pij1=fac3/ees0pij
15527 ees0mij1=fac3/ees0mij
15528 fac3p=-3.0D0*fac3*rrmij
15529 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
15530 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
15532 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
15533 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
15534 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
15535 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
15536 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
15537 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
15538 ecosap=ecosa1+ecosa2
15539 ecosbp=ecosb1+ecosb2
15540 ecosgp=ecosg1+ecosg2
15541 ecosam=ecosa1-ecosa2
15542 ecosbm=ecosb1-ecosb2
15543 ecosgm=ecosg1-ecosg2
15552 facont_hb(num_conti,i)=fcont
15553 fprimcont=fprimcont/rij
15554 !d facont_hb(num_conti,i)=1.0D0
15555 ! Following line is for diagnostics.
15558 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
15559 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
15562 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
15563 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
15565 ! gggp(1)=gggp(1)+ees0pijp*xj
15566 ! gggp(2)=gggp(2)+ees0pijp*yj
15567 ! gggp(3)=gggp(3)+ees0pijp*zj
15568 ! gggm(1)=gggm(1)+ees0mijp*xj
15569 ! gggm(2)=gggm(2)+ees0mijp*yj
15570 ! gggm(3)=gggm(3)+ees0mijp*zj
15571 gggp(1)=gggp(1)+ees0pijp*xj &
15572 +ees0p(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
15573 gggp(2)=gggp(2)+ees0pijp*yj &
15574 +ees0p(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
15575 gggp(3)=gggp(3)+ees0pijp*zj &
15576 +ees0p(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
15578 gggm(1)=gggm(1)+ees0mijp*xj &
15579 +ees0m(num_conti,i)/sss_ele_cut*rmij*xj*sss_ele_grad
15581 gggm(2)=gggm(2)+ees0mijp*yj &
15582 +ees0m(num_conti,i)/sss_ele_cut*rmij*yj*sss_ele_grad
15584 gggm(3)=gggm(3)+ees0mijp*zj &
15585 +ees0m(num_conti,i)/sss_ele_cut*rmij*zj*sss_ele_grad
15587 ! Derivatives due to the contact function
15588 gacont_hbr(1,num_conti,i)=fprimcont*xj
15589 gacont_hbr(2,num_conti,i)=fprimcont*yj
15590 gacont_hbr(3,num_conti,i)=fprimcont*zj
15593 ! 10/24/08 cgrad and ! comments indicate the parts of the code removed
15594 ! following the change of gradient-summation algorithm.
15596 !grad ghalfp=0.5D0*gggp(k)
15597 !grad ghalfm=0.5D0*gggm(k)
15598 ! gacontp_hb1(k,num_conti,i)= & !ghalfp
15599 ! +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15600 ! + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
15601 ! gacontp_hb2(k,num_conti,i)= & !ghalfp
15602 ! +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15603 ! + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
15604 ! gacontp_hb3(k,num_conti,i)=gggp(k)
15605 ! gacontm_hb1(k,num_conti,i)= &!ghalfm
15606 ! +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15607 ! + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
15608 ! gacontm_hb2(k,num_conti,i)= & !ghalfm
15609 ! +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15610 ! + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
15611 ! gacontm_hb3(k,num_conti,i)=gggm(k)
15612 gacontp_hb1(k,num_conti,i)= & !ghalfp+
15613 (ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15614 + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
15617 gacontp_hb2(k,num_conti,i)= & !ghalfp+
15618 (ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15619 + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)&
15622 gacontp_hb3(k,num_conti,i)=gggp(k) &
15625 gacontm_hb1(k,num_conti,i)= & !ghalfm+
15626 (ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i)) &
15627 + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1) &
15630 gacontm_hb2(k,num_conti,i)= & !ghalfm+
15631 (ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j)) &
15632 + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1) &
15635 gacontm_hb3(k,num_conti,i)=gggm(k) &
15640 endif ! num_conti.le.maxconts
15643 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
15646 ghalf=0.5d0*agg(l,k)
15647 aggi(l,k)=aggi(l,k)+ghalf
15648 aggi1(l,k)=aggi1(l,k)+agg(l,k)
15649 aggj(l,k)=aggj(l,k)+ghalf
15652 if (j.eq.nres-1 .and. i.lt.j-2) then
15655 aggj1(l,k)=aggj1(l,k)+agg(l,k)
15661 ! t_eelecij=t_eelecij+MPI_Wtime()-time00
15663 end subroutine eelecij_scale
15664 !-----------------------------------------------------------------------------
15665 subroutine evdwpp_short(evdw1)
15669 ! implicit real*8 (a-h,o-z)
15670 ! include 'DIMENSIONS'
15671 ! include 'COMMON.CONTROL'
15672 ! include 'COMMON.IOUNITS'
15673 ! include 'COMMON.GEO'
15674 ! include 'COMMON.VAR'
15675 ! include 'COMMON.LOCAL'
15676 ! include 'COMMON.CHAIN'
15677 ! include 'COMMON.DERIV'
15678 ! include 'COMMON.INTERACT'
15679 ! include 'COMMON.CONTACTS'
15680 ! include 'COMMON.TORSION'
15681 ! include 'COMMON.VECTORS'
15682 ! include 'COMMON.FFIELD'
15683 real(kind=8),dimension(3) :: ggg
15684 ! 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
15686 real(kind=8) :: scal_el=1.0d0
15688 real(kind=8) :: scal_el=0.5d0
15690 !el local variables
15691 integer :: i,j,k,iteli,itelj,num_conti,isubchap
15692 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
15693 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
15694 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
15695 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
15696 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15697 dist_temp, dist_init,sss_grad
15698 integer xshift,yshift,zshift
15702 ! write (iout,*) "iatel_s_vdw",iatel_s_vdw,
15703 ! & " iatel_e_vdw",iatel_e_vdw
15705 do i=iatel_s_vdw,iatel_e_vdw
15706 if (itype(i,1).eq.ntyp1.or. itype(i+1,1).eq.ntyp1) cycle
15710 dx_normi=dc_norm(1,i)
15711 dy_normi=dc_norm(2,i)
15712 dz_normi=dc_norm(3,i)
15713 xmedi=c(1,i)+0.5d0*dxi
15714 ymedi=c(2,i)+0.5d0*dyi
15715 zmedi=c(3,i)+0.5d0*dzi
15716 xmedi=dmod(xmedi,boxxsize)
15717 if (xmedi.lt.0) xmedi=xmedi+boxxsize
15718 ymedi=dmod(ymedi,boxysize)
15719 if (ymedi.lt.0) ymedi=ymedi+boxysize
15720 zmedi=dmod(zmedi,boxzsize)
15721 if (zmedi.lt.0) zmedi=zmedi+boxzsize
15723 ! write (iout,*) 'i',i,' ielstart',ielstart_vdw(i),
15724 ! & ' ielend',ielend_vdw(i)
15726 do j=ielstart_vdw(i),ielend_vdw(i)
15727 if (itype(j,1).eq.ntyp1 .or. itype(j+1,1).eq.ntyp1) cycle
15731 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
15732 aaa=app(iteli,itelj)
15733 bbb=bpp(iteli,itelj)
15737 dx_normj=dc_norm(1,j)
15738 dy_normj=dc_norm(2,j)
15739 dz_normj=dc_norm(3,j)
15740 ! xj=c(1,j)+0.5D0*dxj-xmedi
15741 ! yj=c(2,j)+0.5D0*dyj-ymedi
15742 ! zj=c(3,j)+0.5D0*dzj-zmedi
15743 xj=c(1,j)+0.5D0*dxj
15744 yj=c(2,j)+0.5D0*dyj
15745 zj=c(3,j)+0.5D0*dzj
15746 xj=mod(xj,boxxsize)
15747 if (xj.lt.0) xj=xj+boxxsize
15748 yj=mod(yj,boxysize)
15749 if (yj.lt.0) yj=yj+boxysize
15750 zj=mod(zj,boxzsize)
15751 if (zj.lt.0) zj=zj+boxzsize
15753 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15760 xj=xj_safe+xshift*boxxsize
15761 yj=yj_safe+yshift*boxysize
15762 zj=zj_safe+zshift*boxzsize
15763 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
15764 if(dist_temp.lt.dist_init) then
15765 dist_init=dist_temp
15774 if (isubchap.eq.1) then
15785 rij=xj*xj+yj*yj+zj*zj
15788 sss=sscale(rij/rpp(iteli,itelj))
15789 sss_ele_cut=sscale_ele(rij)
15790 sss_ele_grad=sscagrad_ele(rij)
15791 sss_grad=sscale_grad((rij/rpp(iteli,itelj)))
15792 if (sss_ele_cut.le.0.0) cycle
15793 if (sss.gt.0.0d0) then
15798 ! 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
15799 if (j.eq.i+2) ev1=scal_el*ev1
15802 if (energy_dec) then
15803 write (iout,'(a6,2i5,0pf7.3,f7.3)') 'evdw1',i,j,evdwij,sss
15805 evdw1=evdw1+evdwij*sss*sss_ele_cut
15807 ! Calculate contributions to the Cartesian gradient.
15809 facvdw=-6*rrmij*(ev1+evdwij)*sss*sss_ele_cut
15813 ggg(1)=facvdw*xj+sss_ele_grad*rmij*evdwij*xj*sss &
15814 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*xj
15815 ggg(2)=facvdw*yj+sss_ele_grad*rmij*evdwij*yj*sss &
15816 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*yj
15817 ggg(3)=facvdw*zj+sss_ele_grad*rmij*evdwij*zj*sss &
15818 +evdwij*sss_ele_cut/rij*sss_grad/rpp(iteli,itelj)*zj
15821 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
15822 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
15828 end subroutine evdwpp_short
15829 !-----------------------------------------------------------------------------
15830 subroutine escp_long(evdw2,evdw2_14)
15832 ! This subroutine calculates the excluded-volume interaction energy between
15833 ! peptide-group centers and side chains and its gradient in virtual-bond and
15834 ! side-chain vectors.
15836 ! implicit real*8 (a-h,o-z)
15837 ! include 'DIMENSIONS'
15838 ! include 'COMMON.GEO'
15839 ! include 'COMMON.VAR'
15840 ! include 'COMMON.LOCAL'
15841 ! include 'COMMON.CHAIN'
15842 ! include 'COMMON.DERIV'
15843 ! include 'COMMON.INTERACT'
15844 ! include 'COMMON.FFIELD'
15845 ! include 'COMMON.IOUNITS'
15846 ! include 'COMMON.CONTROL'
15847 real(kind=8),dimension(3) :: ggg
15848 !el local variables
15849 integer :: i,iint,j,k,iteli,itypj,subchap
15850 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
15851 real(kind=8) :: evdw2,evdw2_14,evdwij
15852 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
15853 dist_temp, dist_init
15857 !d print '(a)','Enter ESCP'
15858 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
15859 do i=iatscp_s,iatscp_e
15860 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
15862 xi=0.5D0*(c(1,i)+c(1,i+1))
15863 yi=0.5D0*(c(2,i)+c(2,i+1))
15864 zi=0.5D0*(c(3,i)+c(3,i+1))
15865 xi=mod(xi,boxxsize)
15866 if (xi.lt.0) xi=xi+boxxsize
15867 yi=mod(yi,boxysize)
15868 if (yi.lt.0) yi=yi+boxysize
15869 zi=mod(zi,boxzsize)
15870 if (zi.lt.0) zi=zi+boxzsize
15872 do iint=1,nscp_gr(i)
15874 do j=iscpstart(i,iint),iscpend(i,iint)
15876 if (itypj.eq.ntyp1) cycle
15877 ! Uncomment following three lines for SC-p interactions
15878 ! xj=c(1,nres+j)-xi
15879 ! yj=c(2,nres+j)-yi
15880 ! zj=c(3,nres+j)-zi
15881 ! Uncomment following three lines for Ca-p interactions
15885 xj=mod(xj,boxxsize)
15886 if (xj.lt.0) xj=xj+boxxsize
15887 yj=mod(yj,boxysize)
15888 if (yj.lt.0) yj=yj+boxysize
15889 zj=mod(zj,boxzsize)
15890 if (zj.lt.0) zj=zj+boxzsize
15891 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15899 xj=xj_safe+xshift*boxxsize
15900 yj=yj_safe+yshift*boxysize
15901 zj=zj_safe+zshift*boxzsize
15902 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
15903 if(dist_temp.lt.dist_init) then
15904 dist_init=dist_temp
15913 if (subchap.eq.1) then
15922 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
15924 rij=dsqrt(1.0d0/rrij)
15925 sss_ele_cut=sscale_ele(rij)
15926 sss_ele_grad=sscagrad_ele(rij)
15927 ! print *,sss_ele_cut,sss_ele_grad,&
15928 ! (rij),r_cut_ele,rlamb_ele
15929 if (sss_ele_cut.le.0.0) cycle
15930 sss=sscale((rij/rscp(itypj,iteli)))
15931 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
15932 if (sss.lt.1.0d0) then
15935 e1=fac*fac*aad(itypj,iteli)
15936 e2=fac*bad(itypj,iteli)
15937 if (iabs(j-i) .le. 2) then
15940 evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)*sss_ele_cut
15943 evdw2=evdw2+evdwij*(1.0d0-sss)*sss_ele_cut
15944 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
15945 'evdw2',i,j,sss,evdwij
15947 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
15949 fac=-(evdwij+e1)*rrij*(1.0d0-sss)*sss_ele_cut
15950 fac=fac+evdwij*sss_ele_grad/rij/expon*(1.0d0-sss)&
15951 -evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
15955 ! Uncomment following three lines for SC-p interactions
15957 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15959 ! Uncomment following line for SC-p interactions
15960 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
15962 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
15963 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
15972 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
15973 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
15974 gradx_scp(j,i)=expon*gradx_scp(j,i)
15977 !******************************************************************************
15981 ! To save time the factor EXPON has been extracted from ALL components
15982 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
15985 !******************************************************************************
15987 end subroutine escp_long
15988 !-----------------------------------------------------------------------------
15989 subroutine escp_short(evdw2,evdw2_14)
15991 ! This subroutine calculates the excluded-volume interaction energy between
15992 ! peptide-group centers and side chains and its gradient in virtual-bond and
15993 ! side-chain vectors.
15995 ! implicit real*8 (a-h,o-z)
15996 ! include 'DIMENSIONS'
15997 ! include 'COMMON.GEO'
15998 ! include 'COMMON.VAR'
15999 ! include 'COMMON.LOCAL'
16000 ! include 'COMMON.CHAIN'
16001 ! include 'COMMON.DERIV'
16002 ! include 'COMMON.INTERACT'
16003 ! include 'COMMON.FFIELD'
16004 ! include 'COMMON.IOUNITS'
16005 ! include 'COMMON.CONTROL'
16006 real(kind=8),dimension(3) :: ggg
16007 !el local variables
16008 integer :: i,iint,j,k,iteli,itypj,subchap
16009 real(kind=8) :: xi,yi,zi,xj,yj,zj,rrij,sss,fac,e1,e2,sss_grad,rij
16010 real(kind=8) :: evdw2,evdw2_14,evdwij
16011 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
16012 dist_temp, dist_init
16016 !d print '(a)','Enter ESCP'
16017 !d write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
16018 do i=iatscp_s,iatscp_e
16019 if (itype(i,1).eq.ntyp1 .or. itype(i+1,1).eq.ntyp1) cycle
16021 xi=0.5D0*(c(1,i)+c(1,i+1))
16022 yi=0.5D0*(c(2,i)+c(2,i+1))
16023 zi=0.5D0*(c(3,i)+c(3,i+1))
16024 xi=mod(xi,boxxsize)
16025 if (xi.lt.0) xi=xi+boxxsize
16026 yi=mod(yi,boxysize)
16027 if (yi.lt.0) yi=yi+boxysize
16028 zi=mod(zi,boxzsize)
16029 if (zi.lt.0) zi=zi+boxzsize
16031 do iint=1,nscp_gr(i)
16033 do j=iscpstart(i,iint),iscpend(i,iint)
16035 if (itypj.eq.ntyp1) cycle
16036 ! Uncomment following three lines for SC-p interactions
16037 ! xj=c(1,nres+j)-xi
16038 ! yj=c(2,nres+j)-yi
16039 ! zj=c(3,nres+j)-zi
16040 ! Uncomment following three lines for Ca-p interactions
16047 xj=mod(xj,boxxsize)
16048 if (xj.lt.0) xj=xj+boxxsize
16049 yj=mod(yj,boxysize)
16050 if (yj.lt.0) yj=yj+boxysize
16051 zj=mod(zj,boxzsize)
16052 if (zj.lt.0) zj=zj+boxzsize
16053 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
16061 xj=xj_safe+xshift*boxxsize
16062 yj=yj_safe+yshift*boxysize
16063 zj=zj_safe+zshift*boxzsize
16064 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
16065 if(dist_temp.lt.dist_init) then
16066 dist_init=dist_temp
16075 if (subchap.eq.1) then
16085 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
16086 rij=dsqrt(1.0d0/rrij)
16087 sss_ele_cut=sscale_ele(rij)
16088 sss_ele_grad=sscagrad_ele(rij)
16089 ! print *,sss_ele_cut,sss_ele_grad,&
16090 ! (rij),r_cut_ele,rlamb_ele
16091 if (sss_ele_cut.le.0.0) cycle
16092 sss=sscale(rij/rscp(itypj,iteli))
16093 sss_grad=sscale_grad(rij/rscp(itypj,iteli))
16094 if (sss.gt.0.0d0) then
16097 e1=fac*fac*aad(itypj,iteli)
16098 e2=fac*bad(itypj,iteli)
16099 if (iabs(j-i) .le. 2) then
16102 evdw2_14=evdw2_14+(e1+e2)*sss*sss_ele_cut
16105 evdw2=evdw2+evdwij*sss*sss_ele_cut
16106 if (energy_dec) write (iout,'(a6,2i5,2(0pf7.3))') &
16107 'evdw2',i,j,sss,evdwij
16109 ! Calculate contributions to the gradient in the virtual-bond and SC vectors.
16111 fac=-(evdwij+e1)*rrij*sss*sss_ele_cut
16112 fac=fac+evdwij*sss_ele_grad/rij/expon*sss &
16113 +evdwij*sss_ele_cut/rij/expon*sss_grad/rscp(itypj,iteli)
16118 ! Uncomment following three lines for SC-p interactions
16120 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
16122 ! Uncomment following line for SC-p interactions
16123 ! gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
16125 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
16126 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
16135 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
16136 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
16137 gradx_scp(j,i)=expon*gradx_scp(j,i)
16140 !******************************************************************************
16144 ! To save time the factor EXPON has been extracted from ALL components
16145 ! of GVDWC and GRADX. Remember to multiply them by this factor before further
16148 !******************************************************************************
16150 end subroutine escp_short
16151 !-----------------------------------------------------------------------------
16152 ! energy_p_new-sep_barrier.F
16153 !-----------------------------------------------------------------------------
16154 subroutine sc_grad_scale(scalfac)
16155 ! implicit real*8 (a-h,o-z)
16157 ! include 'DIMENSIONS'
16158 ! include 'COMMON.CHAIN'
16159 ! include 'COMMON.DERIV'
16160 ! include 'COMMON.CALC'
16161 ! include 'COMMON.IOUNITS'
16162 real(kind=8),dimension(3) :: dcosom1,dcosom2
16163 real(kind=8) :: scalfac
16164 !el local variables
16165 ! integer :: i,j,k,l
16167 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
16168 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
16169 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
16170 -2.0D0*alf12*eps3der+sigder*sigsq_om12
16174 ! eom12=evdwij*eps1_om12
16176 ! write (iout,*) "eps2der",eps2der," eps3der",eps3der,
16177 ! & " sigder",sigder
16178 ! write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
16179 ! write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
16181 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
16182 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
16185 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac&
16188 ! write (iout,*) "gg",(gg(k),k=1,3)
16190 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
16191 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
16192 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*scalfac&
16194 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
16195 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
16196 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*scalfac&
16198 ! write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
16199 ! & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
16200 ! write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
16201 ! & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
16204 ! Calculate the components of the gradient in DC and X
16207 gvdwc(l,i)=gvdwc(l,i)-gg(l)
16208 gvdwc(l,j)=gvdwc(l,j)+gg(l)
16211 end subroutine sc_grad_scale
16212 !-----------------------------------------------------------------------------
16213 ! energy_split-sep.F
16214 !-----------------------------------------------------------------------------
16215 subroutine etotal_long(energia)
16217 ! Compute the long-range slow-varying contributions to the energy
16219 ! implicit real*8 (a-h,o-z)
16220 ! include 'DIMENSIONS'
16221 use MD_data, only: totT,usampl,eq_time
16225 !MS$ATTRIBUTES C :: proc_proc
16230 real(kind=8),dimension(n_ene) :: weights_!,time_Bcast,time_Bcastw
16232 ! include 'COMMON.SETUP'
16233 ! include 'COMMON.IOUNITS'
16234 ! include 'COMMON.FFIELD'
16235 ! include 'COMMON.DERIV'
16236 ! include 'COMMON.INTERACT'
16237 ! include 'COMMON.SBRIDGE'
16238 ! include 'COMMON.CHAIN'
16239 ! include 'COMMON.VAR'
16240 ! include 'COMMON.LOCAL'
16241 ! include 'COMMON.MD'
16242 real(kind=8),dimension(0:n_ene) :: energia
16243 !el local variables
16244 integer :: i,n_corr,n_corr1,ierror,ierr
16245 real(kind=8) :: evdw2,evdw2_14,ehpb,etors,edihcnstr,etors_d,esccor,&
16246 evdw,ees,evdw1,eel_loc,eello_turn3,eello_turn4,&
16247 ecorr,ecorr5,ecorr6,eturn6,time00
16248 ! write(iout,'(a,i2)')'Calling etotal_long ipot=',ipot
16249 !elwrite(iout,*)"in etotal long"
16251 if (modecalc.eq.12.or.modecalc.eq.14) then
16253 ! if (fg_rank.eq.0) call int_from_cart1(.false.)
16255 call int_from_cart1(.false.)
16258 !elwrite(iout,*)"in etotal long"
16261 ! write(iout,*) "ETOTAL_LONG Processor",fg_rank,
16262 ! & " absolute rank",myrank," nfgtasks",nfgtasks
16264 if (nfgtasks.gt.1) then
16266 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
16267 if (fg_rank.eq.0) then
16268 call MPI_Bcast(3,1,MPI_INTEGER,king,FG_COMM,IERROR)
16269 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
16271 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
16272 ! FG slaves as WEIGHTS array.
16279 weights_(7)=wel_loc
16282 weights_(10)=wturn6
16284 weights_(12)=wscloc
16286 weights_(14)=wtor_d
16287 weights_(15)=wstrain
16288 weights_(16)=wvdwpp
16290 weights_(18)=scal14
16291 weights_(21)=wsccor
16292 ! FG Master broadcasts the WEIGHTS_ array
16293 call MPI_Bcast(weights_(1),n_ene,&
16294 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
16296 ! FG slaves receive the WEIGHTS array
16297 call MPI_Bcast(weights(1),n_ene,&
16298 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
16313 wstrain=weights(15)
16319 call MPI_Bcast(dc(1,1),6*nres,MPI_DOUBLE_PRECISION,&
16321 time_Bcast=time_Bcast+MPI_Wtime()-time00
16322 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
16323 ! call chainbuild_cart
16324 ! call int_from_cart1(.false.)
16326 ! write (iout,*) 'Processor',myrank,
16327 ! & ' calling etotal_short ipot=',ipot
16329 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
16331 !d print *,'nnt=',nnt,' nct=',nct
16333 !elwrite(iout,*)"in etotal long"
16334 ! Compute the side-chain and electrostatic interaction energy
16336 goto (101,102,103,104,105,106) ipot
16337 ! Lennard-Jones potential.
16338 101 call elj_long(evdw)
16339 !d print '(a)','Exit ELJ'
16341 ! Lennard-Jones-Kihara potential (shifted).
16342 102 call eljk_long(evdw)
16344 ! Berne-Pechukas potential (dilated LJ, angular dependence).
16345 103 call ebp_long(evdw)
16347 ! Gay-Berne potential (shifted LJ, angular dependence).
16348 104 call egb_long(evdw)
16350 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
16351 105 call egbv_long(evdw)
16353 ! Soft-sphere potential
16354 106 call e_softsphere(evdw)
16356 ! Calculate electrostatic (H-bonding) energy of the main chain.
16360 if (ipot.lt.6) then
16362 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or. &
16363 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
16364 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
16365 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
16367 if (welec.gt.0d0.or.wel_loc.gt.0d0.or. &
16368 wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0 &
16369 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0 &
16370 .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
16372 call eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
16381 ! write (iout,*) "Soft-spheer ELEC potential"
16382 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,&
16386 ! Calculate excluded-volume interaction energy between peptide groups
16389 if (ipot.lt.6) then
16390 if(wscp.gt.0d0) then
16391 call escp_long(evdw2,evdw2_14)
16397 call escp_soft_sphere(evdw2,evdw2_14)
16400 ! 12/1/95 Multi-body terms
16404 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 &
16405 .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
16406 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
16407 ! write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
16408 ! &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
16415 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
16416 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
16419 ! If performing constraint dynamics, call the constraint energy
16420 ! after the equilibration time
16421 if(usampl.and.totT.gt.eq_time) then
16436 energia(2)=evdw2-evdw2_14
16437 energia(18)=evdw2_14
16446 energia(3)=ees+evdw1
16453 energia(8)=eello_turn3
16454 energia(9)=eello_turn4
16456 energia(20)=Uconst+Uconst_back
16457 call sum_energy(energia,.true.)
16458 ! write (iout,*) "Exit ETOTAL_LONG"
16461 end subroutine etotal_long
16462 !-----------------------------------------------------------------------------
16463 subroutine etotal_short(energia)
16465 ! Compute the short-range fast-varying contributions to the energy
16467 ! implicit real*8 (a-h,o-z)
16468 ! include 'DIMENSIONS'
16472 !MS$ATTRIBUTES C :: proc_proc
16477 integer :: ierror,ierr
16478 real(kind=8),dimension(n_ene) :: weights_
16479 real(kind=8) :: time00
16481 ! include 'COMMON.SETUP'
16482 ! include 'COMMON.IOUNITS'
16483 ! include 'COMMON.FFIELD'
16484 ! include 'COMMON.DERIV'
16485 ! include 'COMMON.INTERACT'
16486 ! include 'COMMON.SBRIDGE'
16487 ! include 'COMMON.CHAIN'
16488 ! include 'COMMON.VAR'
16489 ! include 'COMMON.LOCAL'
16490 real(kind=8),dimension(0:n_ene) :: energia
16491 !el local variables
16493 real(kind=8) :: evdw,evdw1,evdw2,evdw2_14,esccor,etors_d,etors
16494 real(kind=8) :: ehpb,escloc,estr,ebe,edihcnstr,ethetacnstr
16497 ! write(iout,'(a,i2)')'Calling etotal_short ipot=',ipot
16499 if (modecalc.eq.12.or.modecalc.eq.14) then
16501 if (fg_rank.eq.0) call int_from_cart1(.false.)
16503 call int_from_cart1(.false.)
16507 ! write(iout,*) "ETOTAL_SHORT Processor",fg_rank,
16508 ! & " absolute rank",myrank," nfgtasks",nfgtasks
16510 if (nfgtasks.gt.1) then
16512 ! FG slaves call the following matching MPI_Bcast in ERGASTULUM
16513 if (fg_rank.eq.0) then
16514 call MPI_Bcast(2,1,MPI_INTEGER,king,FG_COMM,IERROR)
16515 ! write (iout,*) "Processor",myrank," BROADCAST iorder"
16517 ! FG master sets up the WEIGHTS_ array which will be broadcast to the
16518 ! FG slaves as WEIGHTS array.
16525 weights_(7)=wel_loc
16528 weights_(10)=wturn6
16530 weights_(12)=wscloc
16532 weights_(14)=wtor_d
16533 weights_(15)=wstrain
16534 weights_(16)=wvdwpp
16536 weights_(18)=scal14
16537 weights_(21)=wsccor
16538 ! FG Master broadcasts the WEIGHTS_ array
16539 call MPI_Bcast(weights_(1),n_ene,&
16540 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
16542 ! FG slaves receive the WEIGHTS array
16543 call MPI_Bcast(weights(1),n_ene,&
16544 MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
16559 wstrain=weights(15)
16565 ! write (iout,*),"Processor",myrank," BROADCAST weights"
16566 call MPI_Bcast(c(1,1),nres6,MPI_DOUBLE_PRECISION,&
16568 ! write (iout,*) "Processor",myrank," BROADCAST c"
16569 call MPI_Bcast(dc(1,1),nres6,MPI_DOUBLE_PRECISION,&
16571 ! write (iout,*) "Processor",myrank," BROADCAST dc"
16572 call MPI_Bcast(dc_norm(1,1),nres6,MPI_DOUBLE_PRECISION,&
16574 ! write (iout,*) "Processor",myrank," BROADCAST dc_norm"
16575 call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,&
16577 ! write (iout,*) "Processor",myrank," BROADCAST theta"
16578 call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,&
16580 ! write (iout,*) "Processor",myrank," BROADCAST phi"
16581 call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,&
16583 ! write (iout,*) "Processor",myrank," BROADCAST alph"
16584 call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,&
16586 ! write (iout,*) "Processor",myrank," BROADCAST omeg"
16587 call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,&
16589 ! write (iout,*) "Processor",myrank," BROADCAST vbld"
16590 call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,&
16592 time_Bcast=time_Bcast+MPI_Wtime()-time00
16593 ! write (iout,*) "Processor",myrank," BROADCAST vbld_inv"
16595 ! write (iout,*) 'Processor',myrank,
16596 ! & ' calling etotal_short ipot=',ipot
16598 ! print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
16600 ! call int_from_cart1(.false.)
16602 ! Compute the side-chain and electrostatic interaction energy
16604 goto (101,102,103,104,105,106) ipot
16605 ! Lennard-Jones potential.
16606 101 call elj_short(evdw)
16607 !d print '(a)','Exit ELJ'
16609 ! Lennard-Jones-Kihara potential (shifted).
16610 102 call eljk_short(evdw)
16612 ! Berne-Pechukas potential (dilated LJ, angular dependence).
16613 103 call ebp_short(evdw)
16615 ! Gay-Berne potential (shifted LJ, angular dependence).
16616 104 call egb_short(evdw)
16618 ! Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
16619 105 call egbv_short(evdw)
16621 ! Soft-sphere potential - already dealt with in the long-range part
16623 ! 106 call e_softsphere_short(evdw)
16625 ! Calculate electrostatic (H-bonding) energy of the main chain.
16629 ! Calculate the short-range part of Evdwpp
16631 call evdwpp_short(evdw1)
16633 ! Calculate the short-range part of ESCp
16635 if (ipot.lt.6) then
16636 call escp_short(evdw2,evdw2_14)
16639 ! Calculate the bond-stretching energy
16643 ! Calculate the disulfide-bridge and other energy and the contributions
16644 ! from other distance constraints.
16647 ! Calculate the virtual-bond-angle energy.
16649 ! Calculate the SC local energy.
16654 if (wang.gt.0d0) then
16655 if (tor_mode.eq.0) then
16658 !C ebend kcc is Kubo cumulant clustered rigorous attemp to derive the
16660 call ebend_kcc(ebe)
16666 if (with_theta_constr) call etheta_constr(ethetacnstr)
16668 ! write(iout,*) "in etotal afer ebe",ipot
16670 ! print *,"Processor",myrank," computed UB"
16672 ! Calculate the SC local energy.
16675 !elwrite(iout,*) "in etotal afer esc",ipot
16676 ! print *,"Processor",myrank," computed USC"
16678 ! Calculate the virtual-bond torsional energy.
16680 !d print *,'nterm=',nterm
16681 ! if (wtor.gt.0) then
16682 ! call etor(etors,edihcnstr)
16687 if (wtor.gt.0.0d0) then
16688 if (tor_mode.eq.0) then
16691 !C etor kcc is Kubo cumulant clustered rigorous attemp to derive the
16693 call etor_kcc(etors)
16699 if (ndih_constr.gt.0) call etor_constr(edihcnstr)
16701 ! Calculate the virtual-bond torsional energy.
16704 ! 6/23/01 Calculate double-torsional energy
16706 if ((wtor_d.gt.0.0d0).and.(tor_mode.eq.0)) then
16707 call etor_d(etors_d)
16710 ! 21/5/07 Calculate local sicdechain correlation energy
16712 if (wsccor.gt.0.0d0) then
16713 call eback_sc_corr(esccor)
16718 ! Put energy components into an array
16725 energia(2)=evdw2-evdw2_14
16726 energia(18)=evdw2_14
16739 energia(14)=etors_d
16742 energia(19)=edihcnstr
16744 ! write (iout,*) "ETOTAL_SHORT before SUM_ENERGY"
16746 call sum_energy(energia,.true.)
16747 ! write (iout,*) "Exit ETOTAL_SHORT"
16750 end subroutine etotal_short
16751 !-----------------------------------------------------------------------------
16753 !-----------------------------------------------------------------------------
16754 real(kind=8) function gnmr1(y,ymin,ymax)
16756 real(kind=8) :: y,ymin,ymax
16757 real(kind=8) :: wykl=4.0d0
16758 if (y.lt.ymin) then
16759 gnmr1=(ymin-y)**wykl/wykl
16760 else if (y.gt.ymax) then
16761 gnmr1=(y-ymax)**wykl/wykl
16767 !-----------------------------------------------------------------------------
16768 real(kind=8) function gnmr1prim(y,ymin,ymax)
16770 real(kind=8) :: y,ymin,ymax
16771 real(kind=8) :: wykl=4.0d0
16772 if (y.lt.ymin) then
16773 gnmr1prim=-(ymin-y)**(wykl-1)
16774 else if (y.gt.ymax) then
16775 gnmr1prim=(y-ymax)**(wykl-1)
16780 end function gnmr1prim
16781 !----------------------------------------------------------------------------
16782 real(kind=8) function rlornmr1(y,ymin,ymax,sigma)
16783 real(kind=8) y,ymin,ymax,sigma
16784 real(kind=8) wykl /4.0d0/
16785 if (y.lt.ymin) then
16786 rlornmr1=(ymin-y)**wykl/((ymin-y)**wykl+sigma**wykl)
16787 else if (y.gt.ymax) then
16788 rlornmr1=(y-ymax)**wykl/((y-ymax)**wykl+sigma**wykl)
16793 end function rlornmr1
16794 !------------------------------------------------------------------------------
16795 real(kind=8) function rlornmr1prim(y,ymin,ymax,sigma)
16796 real(kind=8) y,ymin,ymax,sigma
16797 real(kind=8) wykl /4.0d0/
16798 if (y.lt.ymin) then
16799 rlornmr1prim=-(ymin-y)**(wykl-1)*sigma**wykl*wykl/ &
16800 ((ymin-y)**wykl+sigma**wykl)**2
16801 else if (y.gt.ymax) then
16802 rlornmr1prim=(y-ymax)**(wykl-1)*sigma**wykl*wykl/ &
16803 ((y-ymax)**wykl+sigma**wykl)**2
16808 end function rlornmr1prim
16810 real(kind=8) function harmonic(y,ymax)
16812 real(kind=8) :: y,ymax
16813 real(kind=8) :: wykl=2.0d0
16814 harmonic=(y-ymax)**wykl
16816 end function harmonic
16817 !-----------------------------------------------------------------------------
16818 real(kind=8) function harmonicprim(y,ymax)
16819 real(kind=8) :: y,ymin,ymax
16820 real(kind=8) :: wykl=2.0d0
16821 harmonicprim=(y-ymax)*wykl
16823 end function harmonicprim
16824 !-----------------------------------------------------------------------------
16826 !-----------------------------------------------------------------------------
16827 subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
16829 use io_base, only:intout,briefout
16830 ! implicit real*8 (a-h,o-z)
16831 ! include 'DIMENSIONS'
16832 ! include 'COMMON.CHAIN'
16833 ! include 'COMMON.DERIV'
16834 ! include 'COMMON.VAR'
16835 ! include 'COMMON.INTERACT'
16836 ! include 'COMMON.FFIELD'
16837 ! include 'COMMON.MD'
16838 ! include 'COMMON.IOUNITS'
16839 real(kind=8),external :: ufparm
16840 integer :: uiparm(1)
16841 real(kind=8) :: urparm(1)
16842 real(kind=8),dimension(6*nres) :: x,g !(maxvar) (maxvar=6*maxres)
16843 real(kind=8) :: f,gthetai,gphii,galphai,gomegai
16844 integer :: n,nf,ind,ind1,i,k,j
16846 ! This subroutine calculates total internal coordinate gradient.
16847 ! Depending on the number of function evaluations, either whole energy
16848 ! is evaluated beforehand, Cartesian coordinates and their derivatives in
16849 ! internal coordinates are reevaluated or only the cartesian-in-internal
16850 ! coordinate derivatives are evaluated. The subroutine was designed to work
16856 !d print *,'grad',nf,icg
16857 if (nf-nfl+1) 20,30,40
16858 20 call func(n,x,nf,f,uiparm,urparm,ufparm)
16859 ! write (iout,*) 'grad 20'
16860 if (nf.eq.0) return
16862 30 call var_to_geom(n,x)
16864 ! write (iout,*) 'grad 30'
16866 ! Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
16869 ! write (iout,*) 'grad 40'
16870 ! print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
16872 ! Convert the Cartesian gradient into internal-coordinate gradient.
16882 ! print *,'GRAD: i=',i,' jc=',j,' ind=',ind
16884 gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
16887 gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
16893 ! print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
16895 gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
16896 gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
16899 if (i.gt.1) g(i-1)=gphii
16900 if (n.gt.nphi) g(nphi+i)=gthetai
16902 if (n.le.nphi+ntheta) goto 10
16904 if (itype(i,1).ne.10) then
16908 galphai=galphai+dxds(k,i)*gradx(k,i,icg)
16911 gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
16913 g(ialph(i,1))=galphai
16914 g(ialph(i,1)+nside)=gomegai
16918 ! Add the components corresponding to local energy terms.
16922 !d write (iout,*) 'i=',i,'g=',g(i),' gloc=',gloc(i,icg)
16923 g(i)=g(i)+gloc(i,icg)
16925 ! Uncomment following three lines for diagnostics.
16927 !elwrite(iout,*) "in gradient after calling intout"
16928 !d call briefout(0,0.0d0)
16929 !d write (iout,'(i3,1pe15.5)') (k,g(k),k=1,n)
16931 end subroutine gradient
16932 !-----------------------------------------------------------------------------
16933 subroutine func(n,x,nf,f,uiparm,urparm,ufparm) !from minimize_p.F
16936 ! implicit real*8 (a-h,o-z)
16937 ! include 'DIMENSIONS'
16938 ! include 'COMMON.DERIV'
16939 ! include 'COMMON.IOUNITS'
16940 ! include 'COMMON.GEO'
16943 !el common /chuju/ jjj
16944 real(kind=8) :: energia(0:n_ene)
16945 integer :: uiparm(1)
16946 real(kind=8) :: urparm(1)
16948 real(kind=8),external :: ufparm
16949 real(kind=8),dimension(6*nres) :: x !(maxvar) (maxvar=6*maxres)
16950 ! if (jjj.gt.0) then
16951 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
16955 !d print *,'func',nf,nfl,icg
16956 call var_to_geom(n,x)
16959 !d write (iout,*) 'ETOTAL called from FUNC'
16960 call etotal(energia)
16963 ! if (jjj.gt.0) then
16964 ! write (iout,'(10f8.3)') (rad2deg*x(i),i=1,n)
16965 ! write (iout,*) 'f=',etot
16969 end subroutine func
16970 !-----------------------------------------------------------------------------
16971 subroutine cartgrad
16972 ! implicit real*8 (a-h,o-z)
16973 ! include 'DIMENSIONS'
16975 use MD_data, only: totT,usampl,eq_time
16979 ! include 'COMMON.CHAIN'
16980 ! include 'COMMON.DERIV'
16981 ! include 'COMMON.VAR'
16982 ! include 'COMMON.INTERACT'
16983 ! include 'COMMON.FFIELD'
16984 ! include 'COMMON.MD'
16985 ! include 'COMMON.IOUNITS'
16986 ! include 'COMMON.TIME1'
16990 ! This subrouting calculates total Cartesian coordinate gradient.
16991 ! The subroutine chainbuild_cart and energy MUST be called beforehand.
17002 !el write (iout,*) "After sum_gradient"
17004 !el write (iout,*) "After sum_gradient"
17006 write (iout,*) i," gradc ",(gradc(j,i,icg),j=1,3)
17007 write (iout,*) i," gradx ",(gradx(j,i,icg),j=1,3)
17011 ! If performing constraint dynamics, add the gradients of the constraint energy
17012 if(usampl.and.totT.gt.eq_time) then
17015 gradc(j,i,icg)=gradc(j,i,icg)+dudconst(j,i)+duscdiff(j,i)
17016 gradx(j,i,icg)=gradx(j,i,icg)+dudxconst(j,i)+duscdiffx(j,i)
17020 gloc(i,icg)=gloc(i,icg)+dugamma(i)
17023 gloc(nphi+i,icg)=gloc(nphi+i,icg)+dutheta(i)
17026 !elwrite (iout,*) "After sum_gradient"
17031 !elwrite (iout,*) "After sum_gradient"
17033 time_intcartderiv=time_intcartderiv+MPI_Wtime()-time01
17035 ! call checkintcartgrad
17036 ! write(iout,*) 'calling int_to_cart'
17039 write (iout,*) "gcart, gxcart, gloc before int_to_cart"
17043 gcart(j,i)=gradc(j,i,icg)
17044 gxcart(j,i)=gradx(j,i,icg)
17045 ! if (i.le.2) print *,"gcart_one",gcart(j,i),gradc(j,i,icg)
17048 write (iout,'(i5,2(3f10.5,5x),f10.5)') i,(gcart(j,i),j=1,3),&
17049 (gxcart(j,i),j=1,3),gloc(i,icg)
17055 ! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
17057 ! print *,"gcart_two",gxcart(2,2),gradx(2,2,icg)
17060 time_inttocart=time_inttocart+MPI_Wtime()-time01
17063 write (iout,*) "gcart and gxcart after int_to_cart"
17065 write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),&
17066 (gxcart(j,i),j=1,3)
17072 write (iout,*) "CARGRAD"
17076 gcart(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
17077 ! gcart_new(j,i)=-gcart(j,i)+gcart(j,i-1)-gxcart(j,i)
17079 ! write (iout,'(i5,3f10.5,5x,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), &
17080 ! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
17082 ! Correction: dummy residues
17085 ! gcart_new(j,nnt)=gcart_new(j,nnt)+gcart_new(j,1)
17086 gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
17089 if (nct.lt.nres) then
17091 ! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
17092 gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
17097 time_cartgrad=time_cartgrad+MPI_Wtime()-time00
17101 end subroutine cartgrad
17102 !-----------------------------------------------------------------------------
17103 subroutine zerograd
17104 ! implicit real*8 (a-h,o-z)
17105 ! include 'DIMENSIONS'
17106 ! include 'COMMON.DERIV'
17107 ! include 'COMMON.CHAIN'
17108 ! include 'COMMON.VAR'
17109 ! include 'COMMON.MD'
17110 ! include 'COMMON.SCCOR'
17112 !el local variables
17113 integer :: i,j,intertyp,k
17114 ! Initialize Cartesian-coordinate gradient
17116 ! if (.not.allocated(gradx)) allocate(gradx(3,nres,2)) !(3,maxres,2)
17117 ! if (.not.allocated(gradc)) allocate(gradc(3,nres,2)) !(3,maxres,2)
17119 ! allocate(gvdwx(3,nres),gvdwc(3,nres),gelc(3,nres),gelc_long(3,nres))
17120 ! allocate(gvdwpp(3,nres),gvdwc_scpp(3,nres),gradx_scp(3,nres))
17121 ! allocate(gvdwc_scp(3,nres),ghpbx(3,nres),ghpbc(3,nres))
17122 ! allocate(gradcorr_long(3,nres))
17123 ! allocate(gradcorr5_long(3,nres),gradcorr6_long(3,nres))
17124 ! allocate(gcorr6_turn_long(3,nres))
17125 ! allocate(gradcorr5(3,nres),gradcorr6(3,nres)) !(3,maxres)
17127 ! if (.not.allocated(gradcorr)) allocate(gradcorr(3,nres)) !(3,maxres)
17129 ! allocate(gel_loc(3,nres),gel_loc_long(3,nres),gcorr3_turn(3,nres))
17130 ! allocate(gcorr4_turn(3,nres),gcorr6_turn(3,nres))
17132 ! if (.not.allocated(gradb)) allocate(gradb(3,nres)) !(3,maxres)
17133 ! if (.not.allocated(gradbx)) allocate(gradbx(3,nres)) !(3,maxres)
17135 ! allocate(gsccorc(3,nres),gsccorx(3,nres)) !(3,maxres)
17136 ! allocate(gscloc(3,nres)) !(3,maxres)
17137 ! if (.not.allocated(gsclocx)) allocate(gsclocx(3,nres)) !(3,maxres)
17141 ! common /deriv_scloc/
17142 ! allocate(dXX_C1tab(3,nres),dYY_C1tab(3,nres),dZZ_C1tab(3,nres))
17143 ! allocate(dXX_Ctab(3,nres),dYY_Ctab(3,nres),dZZ_Ctab(3,nres))
17144 ! allocate(dXX_XYZtab(3,nres),dYY_XYZtab(3,nres),dZZ_XYZtab(3,nres)) !(3,maxres)
17146 ! allocate(jgrad_start(nres),jgrad_end(nres)) !(maxres)
17150 ! gradc(j,i,icg)=0.0d0
17151 ! gradx(j,i,icg)=0.0d0
17153 ! allocate(gloc_sc(3,nres,10)) !(3,0:maxres2,10)maxres2=2*maxres
17154 !elwrite(iout,*) "icg",icg
17158 gradx_scp(j,i)=0.0D0
17160 gvdwc_scp(j,i)=0.0D0
17161 gvdwc_scpp(j,i)=0.0d0
17163 gelc_long(j,i)=0.0D0
17168 gel_loc_long(j,i)=0.0d0
17171 gcorr3_turn(j,i)=0.0d0
17172 gcorr4_turn(j,i)=0.0d0
17173 gradcorr(j,i)=0.0d0
17174 gradcorr_long(j,i)=0.0d0
17175 gradcorr5_long(j,i)=0.0d0
17176 gradcorr6_long(j,i)=0.0d0
17177 gcorr6_turn_long(j,i)=0.0d0
17178 gradcorr5(j,i)=0.0d0
17179 gradcorr6(j,i)=0.0d0
17180 gcorr6_turn(j,i)=0.0d0
17183 gradc(j,i,icg)=0.0d0
17184 gradx(j,i,icg)=0.0d0
17187 gliptran(j,i)=0.0d0
17188 gliptranx(j,i)=0.0d0
17189 gliptranc(j,i)=0.0d0
17190 gshieldx(j,i)=0.0d0
17191 gshieldc(j,i)=0.0d0
17192 gshieldc_loc(j,i)=0.0d0
17193 gshieldx_ec(j,i)=0.0d0
17194 gshieldc_ec(j,i)=0.0d0
17195 gshieldc_loc_ec(j,i)=0.0d0
17196 gshieldx_t3(j,i)=0.0d0
17197 gshieldc_t3(j,i)=0.0d0
17198 gshieldc_loc_t3(j,i)=0.0d0
17199 gshieldx_t4(j,i)=0.0d0
17200 gshieldc_t4(j,i)=0.0d0
17201 gshieldc_loc_t4(j,i)=0.0d0
17202 gshieldx_ll(j,i)=0.0d0
17203 gshieldc_ll(j,i)=0.0d0
17204 gshieldc_loc_ll(j,i)=0.0d0
17206 gg_tube_sc(j,i)=0.0d0
17208 gradb_nucl(j,i)=0.0d0
17209 gradbx_nucl(j,i)=0.0d0
17210 gvdwpp_nucl(j,i)=0.0d0
17214 gvdwpsb1(j,i)=0.0d0
17218 gradcorr_nucl(j,i)=0.0d0
17219 gradcorr3_nucl(j,i)=0.0d0
17220 gradxorr_nucl(j,i)=0.0d0
17221 gradxorr3_nucl(j,i)=0.0d0
17225 gradpepcat(j,i)=0.0d0
17226 gradpepcatx(j,i)=0.0d0
17227 gradcatcat(j,i)=0.0d0
17228 gvdwx_scbase(j,i)=0.0d0
17229 gvdwc_scbase(j,i)=0.0d0
17230 gvdwx_pepbase(j,i)=0.0d0
17231 gvdwc_pepbase(j,i)=0.0d0
17232 gvdwx_scpho(j,i)=0.0d0
17233 gvdwc_scpho(j,i)=0.0d0
17234 gvdwc_peppho(j,i)=0.0d0
17240 gloc_sc(intertyp,i,icg)=0.0d0
17249 grad_shield_side(k,j,i)=0.0d0
17250 grad_shield_loc(k,j,i)=0.0d0
17257 ! Initialize the gradient of local energy terms.
17259 ! allocate(gloc(4*nres,2)) !!(maxvar,2)(maxvar=6*maxres)
17260 ! if (.not.allocated(gel_loc_loc)) allocate(gel_loc_loc(nres)) !(maxvar)(maxvar=6*maxres)
17261 ! if (.not.allocated(gcorr_loc)) allocate(gcorr_loc(nres)) !(maxvar)(maxvar=6*maxres)
17262 ! allocate(g_corr5_loc(nres),g_corr6_loc(nres)) !(maxvar)(maxvar=6*maxres)
17263 ! allocate(gel_loc_turn3(nres))
17264 ! allocate(gel_loc_turn4(nres),gel_loc_turn6(nres)) !(maxvar)(maxvar=6*maxres)
17265 ! allocate(gsccor_loc(nres)) !(maxres)
17271 gel_loc_loc(i)=0.0d0
17273 g_corr5_loc(i)=0.0d0
17274 g_corr6_loc(i)=0.0d0
17275 gel_loc_turn3(i)=0.0d0
17276 gel_loc_turn4(i)=0.0d0
17277 gel_loc_turn6(i)=0.0d0
17278 gsccor_loc(i)=0.0d0
17280 ! initialize gcart and gxcart
17281 ! allocate(gcart(3,0:nres),gxcart(3,0:nres)) !(3,0:MAXRES)
17289 end subroutine zerograd
17290 !-----------------------------------------------------------------------------
17291 real(kind=8) function fdum()
17295 !-----------------------------------------------------------------------------
17297 !-----------------------------------------------------------------------------
17298 subroutine intcartderiv
17299 ! implicit real*8 (a-h,o-z)
17300 ! include 'DIMENSIONS'
17304 ! include 'COMMON.SETUP'
17305 ! include 'COMMON.CHAIN'
17306 ! include 'COMMON.VAR'
17307 ! include 'COMMON.GEO'
17308 ! include 'COMMON.INTERACT'
17309 ! include 'COMMON.DERIV'
17310 ! include 'COMMON.IOUNITS'
17311 ! include 'COMMON.LOCAL'
17312 ! include 'COMMON.SCCOR'
17313 real(kind=8) :: pi4,pi34
17314 real(kind=8),dimension(3,2,nres) :: dcostheta ! (3,2,maxres)
17315 real(kind=8),dimension(3,3,nres) :: dcosphi,dsinphi,dcosalpha,&
17316 dcosomega,dsinomega !(3,3,maxres)
17317 real(kind=8),dimension(3) :: vo1,vo2,vo3,dummy,vp1,vp2,vp3,vpp1,n
17320 real(kind=8) :: cost,sint,cost1,sint1,cost2,sint2,sing,cosg,scalp,&
17321 fac0,fac1,fac2,fac3,fac4,fac5,fac6,ctgt,ctgt1,cosg_inv,&
17322 fac7,fac8,fac9,scala1,scala2,cosa,sina,sino,fac15,fac16,&
17323 fac17,coso_inv,fac10,fac11,fac12,fac13,fac14
17327 !el from module energy-------------
17328 !el allocate(dcostau(3,3,3,itau_start:itau_end)) !(3,3,3,maxres2)maxres2=2*maxres
17329 !el allocate(dsintau(3,3,3,itau_start:itau_end))
17330 !el allocate(dtauangle(3,3,3,itau_start:itau_end))
17332 !el allocate(dcostau(3,3,3,0:nres2)) !(3,3,3,maxres2)maxres2=2*maxres
17333 !el allocate(dsintau(3,3,3,0:nres2))
17334 !el allocate(dtauangle(3,3,3,0:nres2))
17335 !el allocate(domicron(3,2,2,0:nres2))
17336 !el allocate(dcosomicron(3,2,2,0:nres2))
17340 #if defined(MPI) && defined(PARINTDER)
17341 if (nfgtasks.gt.1 .and. me.eq.king) &
17342 call MPI_Bcast(8,1,MPI_INTEGER,king,FG_COMM,IERROR)
17347 ! allocate(dtheta(3,2,nres)) !(3,2,maxres)
17348 ! allocate(dphi(3,3,nres),dalpha(3,3,nres),domega(3,3,nres)) !(3,3,maxres)
17350 ! write (iout,*) "iphi1_start",iphi1_start," iphi1_end",iphi1_end
17353 dtheta(j,1,i)=0.0d0
17354 dtheta(j,2,i)=0.0d0
17360 ! Derivatives of theta's
17361 #if defined(MPI) && defined(PARINTDER)
17362 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
17363 do i=max0(ithet_start-1,3),ithet_end
17367 cost=dcos(theta(i))
17368 sint=sqrt(1-cost*cost)
17370 dcostheta(j,1,i)=-(dc_norm(j,i-1)+cost*dc_norm(j,i-2))/&
17372 if (itype(i-1,1).ne.ntyp1) dtheta(j,1,i)=-dcostheta(j,1,i)/sint
17373 dcostheta(j,2,i)=-(dc_norm(j,i-2)+cost*dc_norm(j,i-1))/&
17375 if (itype(i-1,1).ne.ntyp1) dtheta(j,2,i)=-dcostheta(j,2,i)/sint
17378 #if defined(MPI) && defined(PARINTDER)
17379 ! We need dtheta(:,:,i-1) to compute dphi(:,:,i)
17380 do i=max0(ithet_start-1,3),ithet_end
17384 if ((itype(i-1,1).ne.10).and.(itype(i-1,1).ne.ntyp1)) then
17385 cost1=dcos(omicron(1,i))
17386 sint1=sqrt(1-cost1*cost1)
17387 cost2=dcos(omicron(2,i))
17388 sint2=sqrt(1-cost2*cost2)
17390 !C Calculate derivative over first omicron (Cai-2,Cai-1,SCi-1)
17391 dcosomicron(j,1,1,i)=-(dc_norm(j,i-1+nres)+ &
17392 cost1*dc_norm(j,i-2))/ &
17394 domicron(j,1,1,i)=-1.0/sint1*dcosomicron(j,1,1,i)
17395 dcosomicron(j,1,2,i)=-(dc_norm(j,i-2) &
17396 +cost1*(dc_norm(j,i-1+nres)))/ &
17398 domicron(j,1,2,i)=-1.0/sint1*dcosomicron(j,1,2,i)
17399 !C Calculate derivative over second omicron Sci-1,Cai-1 Cai
17400 !C Looks messy but better than if in loop
17401 dcosomicron(j,2,1,i)=-(-dc_norm(j,i-1+nres) &
17402 +cost2*dc_norm(j,i-1))/ &
17404 domicron(j,2,1,i)=-1.0/sint2*dcosomicron(j,2,1,i)
17405 dcosomicron(j,2,2,i)=-(dc_norm(j,i-1) &
17406 +cost2*(-dc_norm(j,i-1+nres)))/ &
17408 ! write(iout,*) "vbld", i,itype(i,1),vbld(i-1+nres)
17409 domicron(j,2,2,i)=-1.0/sint2*dcosomicron(j,2,2,i)
17413 !elwrite(iout,*) "after vbld write"
17414 ! Derivatives of phi:
17415 ! If phi is 0 or 180 degrees, then the formulas
17416 ! have to be derived by power series expansion of the
17417 ! conventional formulas around 0 and 180.
17419 do i=iphi1_start,iphi1_end
17423 ! if (itype(i-1,1).eq.21 .or. itype(i-2,1).eq.21 ) cycle
17424 ! the conventional case
17425 sint=dsin(theta(i))
17426 sint1=dsin(theta(i-1))
17428 cost=dcos(theta(i))
17429 cost1=dcos(theta(i-1))
17431 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1))
17432 fac0=1.0d0/(sint1*sint)
17435 fac3=cosg*cost1/(sint1*sint1)
17436 fac4=cosg*cost/(sint*sint)
17437 ! Obtaining the gamma derivatives from sine derivative
17438 if (phi(i).gt.-pi4.and.phi(i).le.pi4.or. &
17439 phi(i).gt.pi34.and.phi(i).le.pi.or. &
17440 phi(i).ge.-pi.and.phi(i).le.-pi34) then
17441 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
17442 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1),vp2)
17443 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
17447 cosg_inv=1.0d0/cosg
17448 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
17449 dsinphi(j,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
17450 -(fac0*vp1(j)+sing*dc_norm(j,i-3))*vbld_inv(i-2)
17451 dphi(j,1,i)=cosg_inv*dsinphi(j,1,i)
17453 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*dtheta(j,1,i)) &
17454 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17455 dphi(j,2,i)=cosg_inv*dsinphi(j,2,i)
17456 dsinphi(j,3,i)=-sing*ctgt*dtheta(j,2,i) &
17457 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
17458 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
17459 dphi(j,3,i)=cosg_inv*dsinphi(j,3,i)
17461 ! Bug fixed 3/24/05 (AL)
17463 ! Obtaining the gamma derivatives from cosine derivative
17466 if (itype(i-1,1).ne.ntyp1 .and. itype(i-2,1).ne.ntyp1) then
17467 dcosphi(j,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
17468 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
17469 dc_norm(j,i-3))/vbld(i-2)
17470 dphi(j,1,i)=-1.0/sing*dcosphi(j,1,i)
17471 dcosphi(j,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
17472 dcostheta(j,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
17474 dphi(j,2,i)=-1.0/sing*dcosphi(j,2,i)
17475 dcosphi(j,3,i)=fac2*dcostheta(j,2,i)+fac4* &
17476 dcostheta(j,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
17477 dc_norm(j,i-1))/vbld(i)
17478 dphi(j,3,i)=-1.0/sing*dcosphi(j,3,i)
17481 write(iout,*) "just after",dphi(j,3,i),sing,dcosphi(j,3,i)
17488 !alculate derivative of Tauangle
17490 do i=itau_start,itau_end
17493 !elwrite(iout,*) " vecpr",i,nres
17495 if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
17496 ! if ((itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10).or.
17497 ! & (itype(i-1,1).eq.ntyp1).or.(itype(i,1).eq.ntyp1)) cycle
17498 !c dtauangle(j,intertyp,dervityp,residue number)
17499 !c INTERTYP=1 SC...Ca...Ca..Ca
17500 ! the conventional case
17501 sint=dsin(theta(i))
17502 sint1=dsin(omicron(2,i-1))
17503 sing=dsin(tauangle(1,i))
17504 cost=dcos(theta(i))
17505 cost1=dcos(omicron(2,i-1))
17506 cosg=dcos(tauangle(1,i))
17507 !elwrite(iout,*) " vecpr5",i,nres
17509 !elwrite(iout,*) " vecpreee",i,nres,j,i-2+nres
17510 !elwrite(iout,*) " vecpr5",dc_norm2(1,1)
17511 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
17512 ! write(iout,*) dc_norm2(j,i-2+nres),"dcnorm"
17514 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1))
17515 fac0=1.0d0/(sint1*sint)
17518 fac3=cosg*cost1/(sint1*sint1)
17519 fac4=cosg*cost/(sint*sint)
17520 ! write(iout,*) "faki",fac0,fac1,fac2,fac3,fac4
17521 ! Obtaining the gamma derivatives from sine derivative
17522 if (tauangle(1,i).gt.-pi4.and.tauangle(1,i).le.pi4.or. &
17523 tauangle(1,i).gt.pi34.and.tauangle(1,i).le.pi.or. &
17524 tauangle(1,i).gt.-pi.and.tauangle(1,i).le.-pi34) then
17525 call vecpr(dc_norm(1,i-1),dc_norm(1,i-2),vp1)
17526 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1),vp2)
17527 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
17531 cosg_inv=1.0d0/cosg
17532 dsintau(j,1,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
17533 -(fac0*vp1(j)+sing*(dc_norm2(j,i-2+nres))) &
17534 *vbld_inv(i-2+nres)
17535 dtauangle(j,1,1,i)=cosg_inv*dsintau(j,1,1,i)
17536 dsintau(j,1,2,i)= &
17537 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*dtheta(j,1,i)) &
17538 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17539 ! write(iout,*) "dsintau", dsintau(j,1,2,i)
17540 dtauangle(j,1,2,i)=cosg_inv*dsintau(j,1,2,i)
17541 ! Bug fixed 3/24/05 (AL)
17542 dsintau(j,1,3,i)=-sing*ctgt*dtheta(j,2,i) &
17543 +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i)
17544 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
17545 dtauangle(j,1,3,i)=cosg_inv*dsintau(j,1,3,i)
17547 ! Obtaining the gamma derivatives from cosine derivative
17550 dcostau(j,1,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
17551 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1)-scalp* &
17552 (dc_norm2(j,i-2+nres)))/vbld(i-2+nres)
17553 dtauangle(j,1,1,i)=-1/sing*dcostau(j,1,1,i)
17554 dcostau(j,1,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
17555 dcostheta(j,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
17557 dtauangle(j,1,2,i)=-1/sing*dcostau(j,1,2,i)
17558 dcostau(j,1,3,i)=fac2*dcostheta(j,2,i)+fac4* &
17559 dcostheta(j,2,i)-fac0*(-dc_norm(j,i-2+nres)-scalp* &
17560 dc_norm(j,i-1))/vbld(i)
17561 dtauangle(j,1,3,i)=-1/sing*dcostau(j,1,3,i)
17562 ! write (iout,*) "else",i
17566 ! write(iout,*) "tu",i,k,(dtauangle(j,1,k,i),j=1,3)
17569 !C Second case Ca...Ca...Ca...SC
17571 do i=itau_start,itau_end
17575 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
17576 (itype(i-2,1).eq.ntyp1).or.(itype(i-3,1).eq.ntyp1)) cycle
17577 ! the conventional case
17578 sint=dsin(omicron(1,i))
17579 sint1=dsin(theta(i-1))
17580 sing=dsin(tauangle(2,i))
17581 cost=dcos(omicron(1,i))
17582 cost1=dcos(theta(i-1))
17583 cosg=dcos(tauangle(2,i))
17585 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
17587 scalp=scalar(dc_norm(1,i-3),dc_norm(1,i-1+nres))
17588 fac0=1.0d0/(sint1*sint)
17591 fac3=cosg*cost1/(sint1*sint1)
17592 fac4=cosg*cost/(sint*sint)
17593 ! Obtaining the gamma derivatives from sine derivative
17594 if (tauangle(2,i).gt.-pi4.and.tauangle(2,i).le.pi4.or. &
17595 tauangle(2,i).gt.pi34.and.tauangle(2,i).le.pi.or. &
17596 tauangle(2,i).gt.-pi.and.tauangle(2,i).le.-pi34) then
17597 call vecpr(dc_norm2(1,i-1+nres),dc_norm(1,i-2),vp1)
17598 call vecpr(dc_norm(1,i-3),dc_norm(1,i-1+nres),vp2)
17599 call vecpr(dc_norm(1,i-3),dc_norm(1,i-2),vp3)
17603 cosg_inv=1.0d0/cosg
17604 dsintau(j,2,1,i)=-sing*ctgt1*dtheta(j,1,i-1) &
17605 +(fac0*vp1(j)-sing*dc_norm(j,i-3))*vbld_inv(i-2)
17606 ! write(iout,*) i,j,dsintau(j,2,1,i),sing*ctgt1*dtheta(j,1,i-1),
17607 ! &fac0*vp1(j),sing*dc_norm(j,i-3),vbld_inv(i-2),"dsintau(2,1)"
17608 dtauangle(j,2,1,i)=cosg_inv*dsintau(j,2,1,i)
17609 dsintau(j,2,2,i)= &
17610 -sing*(ctgt1*dtheta(j,2,i-1)+ctgt*domicron(j,1,1,i)) &
17611 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17612 ! write(iout,*) "sprawdzenie",i,j,sing*ctgt1*dtheta(j,2,i-1),
17613 ! & sing*ctgt*domicron(j,1,2,i),
17614 ! & (fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17615 dtauangle(j,2,2,i)=cosg_inv*dsintau(j,2,2,i)
17616 ! Bug fixed 3/24/05 (AL)
17617 dsintau(j,2,3,i)=-sing*ctgt*domicron(j,1,2,i) &
17618 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres))*vbld_inv(i-1+nres)
17619 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
17620 dtauangle(j,2,3,i)=cosg_inv*dsintau(j,2,3,i)
17622 ! Obtaining the gamma derivatives from cosine derivative
17625 dcostau(j,2,1,i)=fac1*dcostheta(j,1,i-1)+fac3* &
17626 dcostheta(j,1,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
17627 dc_norm(j,i-3))/vbld(i-2)
17628 dtauangle(j,2,1,i)=-1/sing*dcostau(j,2,1,i)
17629 dcostau(j,2,2,i)=fac1*dcostheta(j,2,i-1)+fac2* &
17630 dcosomicron(j,1,1,i)+fac3*dcostheta(j,2,i-1)+fac4* &
17631 dcosomicron(j,1,1,i)
17632 dtauangle(j,2,2,i)=-1/sing*dcostau(j,2,2,i)
17633 dcostau(j,2,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
17634 dcosomicron(j,1,2,i)-fac0*(dc_norm(j,i-3)-scalp* &
17635 dc_norm(j,i-1+nres))/vbld(i-1+nres)
17636 dtauangle(j,2,3,i)=-1/sing*dcostau(j,2,3,i)
17637 ! write(iout,*) i,j,"else", dtauangle(j,2,3,i)
17642 !CC third case SC...Ca...Ca...SC
17645 do i=itau_start,itau_end
17649 ! the conventional case
17650 if ((itype(i-1,1).eq.ntyp1).or.(itype(i-1,1).eq.10).or. &
17651 (itype(i-2,1).eq.ntyp1).or.(itype(i-2,1).eq.10)) cycle
17652 sint=dsin(omicron(1,i))
17653 sint1=dsin(omicron(2,i-1))
17654 sing=dsin(tauangle(3,i))
17655 cost=dcos(omicron(1,i))
17656 cost1=dcos(omicron(2,i-1))
17657 cosg=dcos(tauangle(3,i))
17659 dc_norm2(j,i-2+nres)=-dc_norm(j,i-2+nres)
17660 ! dc_norm2(j,i-1+nres)=-dc_norm(j,i-1+nres)
17662 scalp=scalar(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres))
17663 fac0=1.0d0/(sint1*sint)
17666 fac3=cosg*cost1/(sint1*sint1)
17667 fac4=cosg*cost/(sint*sint)
17668 ! Obtaining the gamma derivatives from sine derivative
17669 if (tauangle(3,i).gt.-pi4.and.tauangle(3,i).le.pi4.or. &
17670 tauangle(3,i).gt.pi34.and.tauangle(3,i).le.pi.or. &
17671 tauangle(3,i).gt.-pi.and.tauangle(3,i).le.-pi34) then
17672 call vecpr(dc_norm(1,i-1+nres),dc_norm(1,i-2),vp1)
17673 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-1+nres),vp2)
17674 call vecpr(dc_norm2(1,i-2+nres),dc_norm(1,i-2),vp3)
17678 cosg_inv=1.0d0/cosg
17679 dsintau(j,3,1,i)=-sing*ctgt1*domicron(j,2,2,i-1) &
17680 -(fac0*vp1(j)-sing*dc_norm(j,i-2+nres)) &
17681 *vbld_inv(i-2+nres)
17682 dtauangle(j,3,1,i)=cosg_inv*dsintau(j,3,1,i)
17683 dsintau(j,3,2,i)= &
17684 -sing*(ctgt1*domicron(j,2,1,i-1)+ctgt*domicron(j,1,1,i)) &
17685 -(fac0*vp2(j)+sing*dc_norm(j,i-2))*vbld_inv(i-1)
17686 dtauangle(j,3,2,i)=cosg_inv*dsintau(j,3,2,i)
17687 ! Bug fixed 3/24/05 (AL)
17688 dsintau(j,3,3,i)=-sing*ctgt*domicron(j,1,2,i) &
17689 +(fac0*vp3(j)-sing*dc_norm(j,i-1+nres)) &
17690 *vbld_inv(i-1+nres)
17691 ! & +(fac0*vp3(j)-sing*dc_norm(j,i-1))*vbld_inv(i-1)
17692 dtauangle(j,3,3,i)=cosg_inv*dsintau(j,3,3,i)
17694 ! Obtaining the gamma derivatives from cosine derivative
17697 dcostau(j,3,1,i)=fac1*dcosomicron(j,2,2,i-1)+fac3* &
17698 dcosomicron(j,2,2,i-1)-fac0*(dc_norm(j,i-1+nres)-scalp* &
17699 dc_norm2(j,i-2+nres))/vbld(i-2+nres)
17700 dtauangle(j,3,1,i)=-1/sing*dcostau(j,3,1,i)
17701 dcostau(j,3,2,i)=fac1*dcosomicron(j,2,1,i-1)+fac2* &
17702 dcosomicron(j,1,1,i)+fac3*dcosomicron(j,2,1,i-1)+fac4* &
17703 dcosomicron(j,1,1,i)
17704 dtauangle(j,3,2,i)=-1/sing*dcostau(j,3,2,i)
17705 dcostau(j,3,3,i)=fac2*dcosomicron(j,1,2,i)+fac4* &
17706 dcosomicron(j,1,2,i)-fac0*(dc_norm2(j,i-2+nres)-scalp* &
17707 dc_norm(j,i-1+nres))/vbld(i-1+nres)
17708 dtauangle(j,3,3,i)=-1/sing*dcostau(j,3,3,i)
17709 ! write(iout,*) "else",i
17715 ! Derivatives of side-chain angles alpha and omega
17716 #if defined(MPI) && defined(PARINTDER)
17717 do i=ibond_start,ibond_end
17721 if(itype(i,1).ne.10 .and. itype(i,1).ne.ntyp1) then
17722 fac5=1.0d0/dsqrt(2*(1+dcos(theta(i+1))))
17725 fac8=fac5/vbld(i+1)
17726 fac9=fac5/vbld(i+nres)
17727 scala1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
17728 scala2=scalar(dc_norm(1,i),dc_norm(1,i+nres))
17729 cosa=dsqrt(0.5d0/(1.0d0+dcos(theta(i+1))))* &
17730 (scalar(dC_norm(1,i),dC_norm(1,i+nres)) &
17731 -scalar(dC_norm(1,i-1),dC_norm(1,i+nres)))
17732 sina=sqrt(1-cosa*cosa)
17734 ! write (iout,*) "i",i," cosa",cosa," sina",sina," sino",sino
17736 dcosalpha(j,1,i)=fac6*(scala1*dc_norm(j,i-1)- &
17737 dc_norm(j,i+nres))-cosa*fac7*dcostheta(j,1,i+1)
17738 dalpha(j,1,i)=-1/sina*dcosalpha(j,1,i)
17739 dcosalpha(j,2,i)=fac8*(dc_norm(j,i+nres)- &
17740 scala2*dc_norm(j,i))-cosa*fac7*dcostheta(j,2,i+1)
17741 dalpha(j,2,i)=-1/sina*dcosalpha(j,2,i)
17742 dcosalpha(j,3,i)=(fac9*(dc_norm(j,i)- &
17743 dc_norm(j,i-1))-(cosa*dc_norm(j,i+nres))/ &
17745 dalpha(j,3,i)=-1/sina*dcosalpha(j,3,i)
17747 ! obtaining the derivatives of omega from sines
17748 if(omeg(i).gt.-pi4.and.omeg(i).le.pi4.or. &
17749 omeg(i).gt.pi34.and.omeg(i).le.pi.or. &
17750 omeg(i).gt.-pi.and.omeg(i).le.-pi34) then
17751 fac15=dcos(theta(i+1))/(dsin(theta(i+1))* &
17753 fac16=dcos(alph(i))/(dsin(alph(i))*dsin(alph(i)))
17754 fac17=1.0d0/(dsin(theta(i+1))*dsin(alph(i)))
17755 call vecpr(dc_norm(1,i+nres),dc_norm(1,i),vo1)
17756 call vecpr(dc_norm(1,i+nres),dc_norm(1,i-1),vo2)
17757 call vecpr(dc_norm(1,i),dc_norm(1,i-1),vo3)
17758 coso_inv=1.0d0/dcos(omeg(i))
17760 dsinomega(j,1,i)=sino*(fac15*dcostheta(j,1,i+1) &
17761 +fac16*dcosalpha(j,1,i))-fac17/vbld(i)*vo1(j)- &
17762 (sino*dc_norm(j,i-1))/vbld(i)
17763 domega(j,1,i)=coso_inv*dsinomega(j,1,i)
17764 dsinomega(j,2,i)=sino*(fac15*dcostheta(j,2,i+1) &
17765 +fac16*dcosalpha(j,2,i))+fac17/vbld(i+1)*vo2(j) &
17766 -sino*dc_norm(j,i)/vbld(i+1)
17767 domega(j,2,i)=coso_inv*dsinomega(j,2,i)
17768 dsinomega(j,3,i)=sino*fac16*dcosalpha(j,3,i)- &
17769 fac17/vbld(i+nres)*vo3(j)-sino*dc_norm(j,i+nres)/ &
17771 domega(j,3,i)=coso_inv*dsinomega(j,3,i)
17774 ! obtaining the derivatives of omega from cosines
17775 fac10=sqrt(0.5d0*(1-dcos(theta(i+1))))
17776 fac11=sqrt(0.5d0*(1+dcos(theta(i+1))))
17781 dcosomega(j,1,i)=(-(0.25d0*cosa/fac11* &
17782 dcostheta(j,1,i+1)+fac11*dcosalpha(j,1,i))*fac12+ &
17783 (0.25d0/fac10*sina*dcostheta(j,1,i+1)+cosa/sina* &
17784 fac10*dcosalpha(j,1,i))*(scala2-fac11*cosa))/fac13
17785 domega(j,1,i)=-1/sino*dcosomega(j,1,i)
17786 dcosomega(j,2,i)=(((dc_norm(j,i+nres)-scala2* &
17787 dc_norm(j,i))/vbld(i+1)-0.25d0*cosa/fac11* &
17788 dcostheta(j,2,i+1)-fac11*dcosalpha(j,2,i))*fac12+ &
17789 (scala2-fac11*cosa)*(0.25d0*sina/fac10* &
17790 dcostheta(j,2,i+1)+fac10*cosa/sina*dcosalpha(j,2,i)))/fac13
17791 domega(j,2,i)=-1/sino*dcosomega(j,2,i)
17792 dcosomega(j,3,i)=1/fac10*((1/vbld(i+nres)*(dc_norm(j,i)- &
17793 scala2*dc_norm(j,i+nres))-fac11*dcosalpha(j,3,i))*sina+ &
17794 (scala2-fac11*cosa)*(cosa/sina*dcosalpha(j,3,i)))/fac14
17795 domega(j,3,i)=-1/sino*dcosomega(j,3,i)
17801 dalpha(k,j,i)=0.0d0
17802 domega(k,j,i)=0.0d0
17808 #if defined(MPI) && defined(PARINTDER)
17809 if (nfgtasks.gt.1) then
17811 !d write (iout,*) "Gather dtheta"
17812 !d call flush(iout)
17813 write (iout,*) "dtheta before gather"
17815 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),k=1,3),j=1,2)
17818 call MPI_Gatherv(dtheta(1,1,ithet_start),ithet_count(fg_rank),&
17819 MPI_THET,dtheta(1,1,1),ithet_count(0),ithet_displ(0),MPI_THET,&
17820 king,FG_COMM,IERROR)
17823 !d write (iout,*) "Gather dphi"
17824 !d call flush(iout)
17825 write (iout,*) "dphi before gather"
17827 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),k=1,3),j=1,3)
17831 call MPI_Gatherv(dphi(1,1,iphi1_start),iphi1_count(fg_rank),&
17832 MPI_GAM,dphi(1,1,1),iphi1_count(0),iphi1_displ(0),MPI_GAM,&
17833 king,FG_COMM,IERROR)
17834 !d write (iout,*) "Gather dalpha"
17835 !d call flush(iout)
17837 call MPI_Gatherv(dalpha(1,1,ibond_start),ibond_count(fg_rank),&
17838 MPI_GAM,dalpha(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
17839 king,FG_COMM,IERROR)
17840 !d write (iout,*) "Gather domega"
17841 !d call flush(iout)
17842 call MPI_Gatherv(domega(1,1,ibond_start),ibond_count(fg_rank),&
17843 MPI_GAM,domega(1,1,1),ibond_count(0),ibond_displ(0),MPI_GAM,&
17844 king,FG_COMM,IERROR)
17850 write (iout,*) "dtheta after gather"
17852 write (iout,'(i3,3(3f8.5,3x))') i,((dtheta(j,k,i),j=1,3),k=1,2)
17854 write (iout,*) "dphi after gather"
17856 write (iout,'(i3,3(3f8.5,3x))') i,((dphi(j,k,i),j=1,3),k=1,3)
17858 write (iout,*) "dalpha after gather"
17860 write (iout,'(i3,3(3f8.5,3x))') i,((dalpha(j,k,i),j=1,3),k=1,3)
17862 write (iout,*) "domega after gather"
17864 write (iout,'(i3,3(3f8.5,3x))') i,((domega(j,k,i),j=1,3),k=1,3)
17869 end subroutine intcartderiv
17870 !-----------------------------------------------------------------------------
17871 subroutine checkintcartgrad
17872 ! implicit real*8 (a-h,o-z)
17873 ! include 'DIMENSIONS'
17877 ! include 'COMMON.CHAIN'
17878 ! include 'COMMON.VAR'
17879 ! include 'COMMON.GEO'
17880 ! include 'COMMON.INTERACT'
17881 ! include 'COMMON.DERIV'
17882 ! include 'COMMON.IOUNITS'
17883 ! include 'COMMON.SETUP'
17884 real(kind=8),dimension(3,2,nres) :: dthetanum !(3,2,maxres)
17885 real(kind=8),dimension(3,3,nres) :: dphinum,dalphanum,domeganum !(3,3,maxres)
17886 real(kind=8),dimension(nres) :: theta_s,phi_s,alph_s,omeg_s !(maxres)
17887 real(kind=8),dimension(3) :: dc_norm_s
17888 real(kind=8) :: aincr=1.0d-5
17890 real(kind=8) :: dcji
17893 theta_s(i)=theta(i)
17897 ! Check theta gradient
17899 "Analytical (upper) and numerical (lower) gradient of theta"
17904 dc(j,i-2)=dcji+aincr
17905 call chainbuild_cart
17906 call int_from_cart1(.false.)
17907 dthetanum(j,1,i)=(theta(i)-theta_s(i))/aincr
17910 dc(j,i-1)=dc(j,i-1)+aincr
17911 call chainbuild_cart
17912 dthetanum(j,2,i)=(theta(i)-theta_s(i))/aincr
17915 !el write (iout,'(i5,3f10.5,5x,3f10.5)') i,(dtheta(j,1,i),j=1,3),&
17916 !el (dtheta(j,2,i),j=1,3)
17917 !el write (iout,'(5x,3f10.5,5x,3f10.5)') (dthetanum(j,1,i),j=1,3),&
17918 !el (dthetanum(j,2,i),j=1,3)
17919 !el write (iout,'(5x,3f10.5,5x,3f10.5)') &
17920 !el (dthetanum(j,1,i)/dtheta(j,1,i),j=1,3),&
17921 !el (dthetanum(j,2,i)/dtheta(j,2,i),j=1,3)
17924 ! Check gamma gradient
17926 "Analytical (upper) and numerical (lower) gradient of gamma"
17930 dc(j,i-3)=dcji+aincr
17931 call chainbuild_cart
17932 dphinum(j,1,i)=(phi(i)-phi_s(i))/aincr
17935 dc(j,i-2)=dcji+aincr
17936 call chainbuild_cart
17937 dphinum(j,2,i)=(phi(i)-phi_s(i))/aincr
17940 dc(j,i-1)=dc(j,i-1)+aincr
17941 call chainbuild_cart
17942 dphinum(j,3,i)=(phi(i)-phi_s(i))/aincr
17945 !el write (iout,'(i5,3(3f10.5,5x))') i,(dphi(j,1,i),j=1,3),&
17946 !el (dphi(j,2,i),j=1,3),(dphi(j,3,i),j=1,3)
17947 !el write (iout,'(5x,3(3f10.5,5x))') (dphinum(j,1,i),j=1,3),&
17948 !el (dphinum(j,2,i),j=1,3),(dphinum(j,3,i),j=1,3)
17949 !el write (iout,'(5x,3(3f10.5,5x))') &
17950 !el (dphinum(j,1,i)/dphi(j,1,i),j=1,3),&
17951 !el (dphinum(j,2,i)/dphi(j,2,i),j=1,3),&
17952 !el (dphinum(j,3,i)/dphi(j,3,i),j=1,3)
17955 ! Check alpha gradient
17957 "Analytical (upper) and numerical (lower) gradient of alpha"
17959 if(itype(i,1).ne.10) then
17962 dc(j,i-1)=dcji+aincr
17963 call chainbuild_cart
17964 dalphanum(j,1,i)=(alph(i)-alph_s(i)) &
17969 call chainbuild_cart
17970 dalphanum(j,2,i)=(alph(i)-alph_s(i)) &
17974 dc(j,i+nres)=dc(j,i+nres)+aincr
17975 call chainbuild_cart
17976 dalphanum(j,3,i)=(alph(i)-alph_s(i)) &
17981 !el write (iout,'(i5,3(3f10.5,5x))') i,(dalpha(j,1,i),j=1,3),&
17982 !el (dalpha(j,2,i),j=1,3),(dalpha(j,3,i),j=1,3)
17983 !el write (iout,'(5x,3(3f10.5,5x))') (dalphanum(j,1,i),j=1,3),&
17984 !el (dalphanum(j,2,i),j=1,3),(dalphanum(j,3,i),j=1,3)
17985 !el write (iout,'(5x,3(3f10.5,5x))') &
17986 !el (dalphanum(j,1,i)/dalpha(j,1,i),j=1,3),&
17987 !el (dalphanum(j,2,i)/dalpha(j,2,i),j=1,3),&
17988 !el (dalphanum(j,3,i)/dalpha(j,3,i),j=1,3)
17991 ! Check omega gradient
17993 "Analytical (upper) and numerical (lower) gradient of omega"
17995 if(itype(i,1).ne.10) then
17998 dc(j,i-1)=dcji+aincr
17999 call chainbuild_cart
18000 domeganum(j,1,i)=(omeg(i)-omeg_s(i)) &
18005 call chainbuild_cart
18006 domeganum(j,2,i)=(omeg(i)-omeg_s(i)) &
18010 dc(j,i+nres)=dc(j,i+nres)+aincr
18011 call chainbuild_cart
18012 domeganum(j,3,i)=(omeg(i)-omeg_s(i)) &
18017 !el write (iout,'(i5,3(3f10.5,5x))') i,(domega(j,1,i),j=1,3),&
18018 !el (domega(j,2,i),j=1,3),(domega(j,3,i),j=1,3)
18019 !el write (iout,'(5x,3(3f10.5,5x))') (domeganum(j,1,i),j=1,3),&
18020 !el (domeganum(j,2,i),j=1,3),(domeganum(j,3,i),j=1,3)
18021 !el write (iout,'(5x,3(3f10.5,5x))') &
18022 !el (domeganum(j,1,i)/domega(j,1,i),j=1,3),&
18023 !el (domeganum(j,2,i)/domega(j,2,i),j=1,3),&
18024 !el (domeganum(j,3,i)/domega(j,3,i),j=1,3)
18028 end subroutine checkintcartgrad
18029 !-----------------------------------------------------------------------------
18031 !-----------------------------------------------------------------------------
18032 real(kind=8) function qwolynes(seg1,seg2,flag,seg3,seg4)
18033 ! implicit real*8 (a-h,o-z)
18034 ! include 'DIMENSIONS'
18035 ! include 'COMMON.IOUNITS'
18036 ! include 'COMMON.CHAIN'
18037 ! include 'COMMON.INTERACT'
18038 ! include 'COMMON.VAR'
18039 integer :: i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4,secseg
18040 integer :: kkk,nsep=3
18041 real(kind=8) :: qm !dist,
18042 real(kind=8) :: qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM,qqmax
18043 logical :: lprn=.false.
18045 ! real(kind=8) :: sigm,x
18047 !el sigm(x)=0.25d0*x ! local function
18053 do il=seg1+nsep,seg2
18056 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2 + &
18057 (cref(2,jl,kkk)-cref(2,il,kkk))**2 + &
18058 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
18060 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
18061 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
18064 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
18065 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
18066 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
18067 dijCM=dist(il+nres,jl+nres)
18068 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
18070 qq = qq+qqij+qqijCM
18076 if((seg3-il).lt.3) then
18083 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
18084 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
18085 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
18087 qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2)
18088 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
18091 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
18092 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
18093 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
18094 dijCM=dist(il+nres,jl+nres)
18095 qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2)
18097 qq = qq+qqij+qqijCM
18102 if (qqmax.le.qq) qqmax=qq
18104 qwolynes=1.0d0-qqmax
18106 end function qwolynes
18107 !-----------------------------------------------------------------------------
18108 subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4)
18109 ! implicit real*8 (a-h,o-z)
18110 ! include 'DIMENSIONS'
18111 ! include 'COMMON.IOUNITS'
18112 ! include 'COMMON.CHAIN'
18113 ! include 'COMMON.INTERACT'
18114 ! include 'COMMON.VAR'
18115 ! include 'COMMON.MD'
18116 integer :: i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4,secseg
18117 integer :: nsep=3, kkk
18118 !el real(kind=8) :: dist
18119 real(kind=8) :: dij,d0ij,dijCM,d0ijCM
18120 logical :: lprn=.false.
18122 real(kind=8) :: sim,dd0,fac,ddqij
18123 !el sigm(x)=0.25d0*x ! local function
18133 do il=seg1+nsep,seg2
18136 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
18137 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
18138 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
18140 sim = 1.0d0/sigm(d0ij)
18143 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
18145 ddqij = (c(k,il)-c(k,jl))*fac
18146 dqwol(k,il)=dqwol(k,il)+ddqij
18147 dqwol(k,jl)=dqwol(k,jl)-ddqij
18150 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
18153 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
18154 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
18155 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
18156 dijCM=dist(il+nres,jl+nres)
18157 sim = 1.0d0/sigm(d0ijCM)
18160 fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
18162 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
18163 dxqwol(k,il)=dxqwol(k,il)+ddqij
18164 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
18171 if((seg3-il).lt.3) then
18178 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ &
18179 (cref(2,jl,kkk)-cref(2,il,kkk))**2+ &
18180 (cref(3,jl,kkk)-cref(3,il,kkk))**2)
18182 sim = 1.0d0/sigm(d0ij)
18185 fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim)
18187 ddqij = (c(k,il)-c(k,jl))*fac
18188 dqwol(k,il)=dqwol(k,il)+ddqij
18189 dqwol(k,jl)=dqwol(k,jl)-ddqij
18191 if (itype(il,1).ne.10 .or. itype(jl,1).ne.10) then
18194 (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ &
18195 (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ &
18196 (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2)
18197 dijCM=dist(il+nres,jl+nres)
18198 sim = 1.0d0/sigm(d0ijCM)
18201 fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim)
18203 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac
18204 dxqwol(k,il)=dxqwol(k,il)+ddqij
18205 dxqwol(k,jl)=dxqwol(k,jl)-ddqij
18214 dqwol(j,i)=dqwol(j,i)/nl
18215 dxqwol(j,i)=dxqwol(j,i)/nl
18219 end subroutine qwolynes_prim
18220 !-----------------------------------------------------------------------------
18221 subroutine qwol_num(seg1,seg2,flag,seg3,seg4)
18222 ! implicit real*8 (a-h,o-z)
18223 ! include 'DIMENSIONS'
18224 ! include 'COMMON.IOUNITS'
18225 ! include 'COMMON.CHAIN'
18226 ! include 'COMMON.INTERACT'
18227 ! include 'COMMON.VAR'
18228 integer :: seg1,seg2,seg3,seg4
18230 real(kind=8),dimension(3,0:nres) :: qwolan,qwolxan
18231 real(kind=8),dimension(3,0:2*nres) :: cdummy
18232 real(kind=8) :: q1,q2
18233 real(kind=8) :: delta=1.0d-10
18238 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
18240 c(j,i)=c(j,i)+delta
18241 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
18242 qwolan(j,i)=(q2-q1)/delta
18248 q1=qwolynes(seg1,seg2,flag,seg3,seg4)
18249 cdummy(j,i+nres)=c(j,i+nres)
18250 c(j,i+nres)=c(j,i+nres)+delta
18251 q2=qwolynes(seg1,seg2,flag,seg3,seg4)
18252 qwolxan(j,i)=(q2-q1)/delta
18253 c(j,i+nres)=cdummy(j,i+nres)
18256 ! write(iout,*) "Numerical Q carteisan gradients backbone: "
18258 ! write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3)
18260 ! write(iout,*) "Numerical Q carteisan gradients side-chain: "
18262 ! write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3)
18265 end subroutine qwol_num
18266 !-----------------------------------------------------------------------------
18267 subroutine EconstrQ
18268 ! MD with umbrella_sampling using Wolyne's distance measure as a constraint
18269 ! implicit real*8 (a-h,o-z)
18270 ! include 'DIMENSIONS'
18271 ! include 'COMMON.CONTROL'
18272 ! include 'COMMON.VAR'
18273 ! include 'COMMON.MD'
18276 ! include 'COMMON.LANGEVIN'
18278 ! include 'COMMON.LANGEVIN.lang0'
18280 ! include 'COMMON.CHAIN'
18281 ! include 'COMMON.DERIV'
18282 ! include 'COMMON.GEO'
18283 ! include 'COMMON.LOCAL'
18284 ! include 'COMMON.INTERACT'
18285 ! include 'COMMON.IOUNITS'
18286 ! include 'COMMON.NAMES'
18287 ! include 'COMMON.TIME1'
18288 real(kind=8) :: uzap1,uzap2,hm1,hm2,hmnum,ucdelan
18289 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy,&
18291 integer :: kstart,kend,lstart,lend,idummy
18292 real(kind=8) :: delta=1.0d-7
18293 integer :: i,j,k,ii
18297 dudconst(j,i)=0.0d0
18298 duxconst(j,i)=0.0d0
18299 dudxconst(j,i)=0.0d0
18304 qfrag(i)=qwolynes(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
18306 Uconst=Uconst+wfrag(i,iset)*harmonic(qfrag(i),qinfrag(i,iset))
18307 ! Calculating the derivatives of Constraint energy with respect to Q
18308 Ucdfrag=wfrag(i,iset)*harmonicprim(qfrag(i),&
18310 ! hm1=harmonic(qfrag(i,iset),qinfrag(i,iset))
18311 ! hm2=harmonic(qfrag(i,iset)+delta,qinfrag(i,iset))
18312 ! hmnum=(hm2-hm1)/delta
18313 ! write(iout,*) "harmonicprim frag",harmonicprim(qfrag(i,iset),
18314 ! & qinfrag(i,iset))
18315 ! write(iout,*) "harmonicnum frag", hmnum
18316 ! Calculating the derivatives of Q with respect to cartesian coordinates
18317 call qwolynes_prim(ifrag(1,i,iset),ifrag(2,i,iset),.true.,&
18319 ! write(iout,*) "dqwol "
18321 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
18323 ! write(iout,*) "dxqwol "
18325 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
18327 ! Calculating numerical gradients of dU/dQi and dQi/dxi
18328 ! call qwol_num(ifrag(1,i,iset),ifrag(2,i,iset),.true.
18329 ! & ,idummy,idummy)
18330 ! The gradients of Uconst in Cs
18333 duconst(j,ii)=dUconst(j,ii)+ucdfrag*dqwol(j,ii)
18334 dUxconst(j,ii)=dUxconst(j,ii)+ucdfrag*dxqwol(j,ii)
18339 kstart=ifrag(1,ipair(1,i,iset),iset)
18340 kend=ifrag(2,ipair(1,i,iset),iset)
18341 lstart=ifrag(1,ipair(2,i,iset),iset)
18342 lend=ifrag(2,ipair(2,i,iset),iset)
18343 qpair(i)=qwolynes(kstart,kend,.false.,lstart,lend)
18344 Uconst=Uconst+wpair(i,iset)*harmonic(qpair(i),qinpair(i,iset))
18345 ! Calculating dU/dQ
18346 Ucdpair=wpair(i,iset)*harmonicprim(qpair(i),qinpair(i,iset))
18347 ! hm1=harmonic(qpair(i),qinpair(i,iset))
18348 ! hm2=harmonic(qpair(i)+delta,qinpair(i,iset))
18349 ! hmnum=(hm2-hm1)/delta
18350 ! write(iout,*) "harmonicprim pair ",harmonicprim(qpair(i),
18351 ! & qinpair(i,iset))
18352 ! write(iout,*) "harmonicnum pair ", hmnum
18353 ! Calculating dQ/dXi
18354 call qwolynes_prim(kstart,kend,.false.,&
18356 ! write(iout,*) "dqwol "
18358 ! write(iout,'(i5,3e15.5)') ii,(dqwol(j,ii),j=1,3)
18360 ! write(iout,*) "dxqwol "
18362 ! write(iout,'(i5,3e15.5)') ii,(dxqwol(j,ii),j=1,3)
18364 ! Calculating numerical gradients
18365 ! call qwol_num(kstart,kend,.false.
18367 ! The gradients of Uconst in Cs
18370 duconst(j,ii)=dUconst(j,ii)+ucdpair*dqwol(j,ii)
18371 dUxconst(j,ii)=dUxconst(j,ii)+ucdpair*dxqwol(j,ii)
18375 ! write(iout,*) "Uconst inside subroutine ", Uconst
18376 ! Transforming the gradients from Cs to dCs for the backbone
18380 dudconst(k,i)=dudconst(k,i)+duconst(k,j)+duxconst(k,j)
18384 ! Transforming the gradients from Cs to dCs for the side chains
18387 dudxconst(j,i)=duxconst(j,i)
18390 ! write(iout,*) "dU/ddc backbone "
18392 ! write(iout,'(i5,3e15.5)') ii, (dudconst(j,ii),j=1,3)
18394 ! write(iout,*) "dU/ddX side chain "
18396 ! write(iout,'(i5,3e15.5)') ii,(duxconst(j,ii),j=1,3)
18398 ! Calculating numerical gradients of dUconst/ddc and dUconst/ddx
18399 ! call dEconstrQ_num
18401 end subroutine EconstrQ
18402 !-----------------------------------------------------------------------------
18403 subroutine dEconstrQ_num
18404 ! Calculating numerical dUconst/ddc and dUconst/ddx
18405 ! implicit real*8 (a-h,o-z)
18406 ! include 'DIMENSIONS'
18407 ! include 'COMMON.CONTROL'
18408 ! include 'COMMON.VAR'
18409 ! include 'COMMON.MD'
18412 ! include 'COMMON.LANGEVIN'
18414 ! include 'COMMON.LANGEVIN.lang0'
18416 ! include 'COMMON.CHAIN'
18417 ! include 'COMMON.DERIV'
18418 ! include 'COMMON.GEO'
18419 ! include 'COMMON.LOCAL'
18420 ! include 'COMMON.INTERACT'
18421 ! include 'COMMON.IOUNITS'
18422 ! include 'COMMON.NAMES'
18423 ! include 'COMMON.TIME1'
18424 real(kind=8) :: uzap1,uzap2
18425 real(kind=8),dimension(3,0:nres) :: dUcartan,dUxcartan,cdummy
18426 integer :: kstart,kend,lstart,lend,idummy
18427 real(kind=8) :: delta=1.0d-7
18428 !el local variables
18434 dUcartan(j,i)=0.0d0
18435 cdummy(j,i)=dc(j,i)
18436 dc(j,i)=dc(j,i)+delta
18437 call chainbuild_cart
18440 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
18442 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
18446 kstart=ifrag(1,ipair(1,ii,iset),iset)
18447 kend=ifrag(2,ipair(1,ii,iset),iset)
18448 lstart=ifrag(1,ipair(2,ii,iset),iset)
18449 lend=ifrag(2,ipair(2,ii,iset),iset)
18450 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
18451 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
18454 dc(j,i)=cdummy(j,i)
18455 call chainbuild_cart
18458 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
18460 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
18464 kstart=ifrag(1,ipair(1,ii,iset),iset)
18465 kend=ifrag(2,ipair(1,ii,iset),iset)
18466 lstart=ifrag(1,ipair(2,ii,iset),iset)
18467 lend=ifrag(2,ipair(2,ii,iset),iset)
18468 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
18469 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
18472 ducartan(j,i)=(uzap2-uzap1)/(delta)
18475 ! Calculating numerical gradients for dU/ddx
18477 duxcartan(j,i)=0.0d0
18479 cdummy(j,i)=dc(j,i+nres)
18480 dc(j,i+nres)=dc(j,i+nres)+delta
18481 call chainbuild_cart
18484 qfrag(ii)=qwolynes(ifrag(1,ii,iset),ifrag(2,ii,iset),.true.,&
18486 uzap2=uzap2+wfrag(ii,iset)*harmonic(qfrag(ii),&
18490 kstart=ifrag(1,ipair(1,ii,iset),iset)
18491 kend=ifrag(2,ipair(1,ii,iset),iset)
18492 lstart=ifrag(1,ipair(2,ii,iset),iset)
18493 lend=ifrag(2,ipair(2,ii,iset),iset)
18494 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
18495 uzap2=uzap2+wpair(ii,iset)*harmonic(qpair(ii),&
18498 dc(j,i+nres)=cdummy(j,i)
18499 call chainbuild_cart
18502 qfrag(ii)=qwolynes(ifrag(1,ii,iset),&
18503 ifrag(2,ii,iset),.true.,idummy,idummy)
18504 uzap1=uzap1+wfrag(ii,iset)*harmonic(qfrag(ii),&
18508 kstart=ifrag(1,ipair(1,ii,iset),iset)
18509 kend=ifrag(2,ipair(1,ii,iset),iset)
18510 lstart=ifrag(1,ipair(2,ii,iset),iset)
18511 lend=ifrag(2,ipair(2,ii,iset),iset)
18512 qpair(ii)=qwolynes(kstart,kend,.false.,lstart,lend)
18513 uzap1=uzap1+wpair(ii,iset)*harmonic(qpair(ii),&
18516 duxcartan(j,i)=(uzap2-uzap1)/(delta)
18519 write(iout,*) "Numerical dUconst/ddc backbone "
18521 write(iout,'(i5,3e15.5)') ii,(dUcartan(j,ii),j=1,3)
18523 ! write(iout,*) "Numerical dUconst/ddx side-chain "
18525 ! write(iout,'(i5,3e15.5)') ii,(dUxcartan(j,ii),j=1,3)
18528 end subroutine dEconstrQ_num
18529 !-----------------------------------------------------------------------------
18531 !-----------------------------------------------------------------------------
18532 subroutine check_energies
18534 ! use random, only: ran_number
18538 ! include 'DIMENSIONS'
18539 ! include 'COMMON.CHAIN'
18540 ! include 'COMMON.VAR'
18541 ! include 'COMMON.IOUNITS'
18542 ! include 'COMMON.SBRIDGE'
18543 ! include 'COMMON.LOCAL'
18544 ! include 'COMMON.GEO'
18546 ! External functions
18547 !EL double precision ran_number
18548 !EL external ran_number
18551 integer :: i,j,k,l,lmax,p,pmax
18552 real(kind=8) :: rmin,rmax
18553 real(kind=8) :: eij
18556 real(kind=8) :: wi,rij,tj,pj
18578 !t wi=ran_number(0.0D0,pi)
18579 ! wi=ran_number(0.0D0,pi/6.0D0)
18581 !t tj=ran_number(0.0D0,pi)
18582 !t pj=ran_number(0.0D0,pi)
18583 ! pj=ran_number(0.0D0,pi/6.0D0)
18587 !t rij=ran_number(rmin,rmax)
18589 c(1,j)=d*sin(pj)*cos(tj)
18590 c(2,j)=d*sin(pj)*sin(tj)
18596 c(3,i)=-rij-d*cos(wi)
18599 dc(k,nres+i)=c(k,nres+i)-c(k,i)
18600 dc_norm(k,nres+i)=dc(k,nres+i)/d
18601 dc(k,nres+j)=c(k,nres+j)-c(k,j)
18602 dc_norm(k,nres+j)=dc(k,nres+j)/d
18605 call dyn_ssbond_ene(i,j,eij)
18610 end subroutine check_energies
18611 !-----------------------------------------------------------------------------
18612 subroutine dyn_ssbond_ene(resi,resj,eij)
18617 ! include 'DIMENSIONS'
18618 ! include 'COMMON.SBRIDGE'
18619 ! include 'COMMON.CHAIN'
18620 ! include 'COMMON.DERIV'
18621 ! include 'COMMON.LOCAL'
18622 ! include 'COMMON.INTERACT'
18623 ! include 'COMMON.VAR'
18624 ! include 'COMMON.IOUNITS'
18625 ! include 'COMMON.CALC'
18629 ! include 'COMMON.MD'
18630 ! use MD, only: totT,t_bath
18633 ! External functions
18634 !EL double precision h_base
18635 !EL external h_base
18638 integer :: resi,resj
18641 real(kind=8) :: eij
18644 logical :: havebond
18645 integer itypi,itypj
18646 real(kind=8) :: rrij,ssd,deltat1,deltat2,deltat12,cosphi
18647 real(kind=8) :: sig0ij,ljd,sig,fac,e1,e2
18648 real(kind=8),dimension(3) :: dcosom1,dcosom2
18650 real(kind=8) :: pom1,pom2
18651 real(kind=8) :: ljA,ljB,ljXs
18652 real(kind=8),dimension(1:3) :: d_ljB
18653 real(kind=8) :: ssA,ssB,ssC,ssXs
18654 real(kind=8) :: ssxm,ljxm,ssm,ljm
18655 real(kind=8),dimension(1:3) :: d_ssxm,d_ljxm,d_ssm,d_ljm
18656 real(kind=8) :: f1,f2,h1,h2,hd1,hd2
18657 real(kind=8) :: omega,delta_inv,deltasq_inv,fac1,fac2
18658 !-------FIRST METHOD
18660 real(kind=8),dimension(1:3) :: d_xm
18661 !-------END FIRST METHOD
18662 !-------SECOND METHOD
18663 !$$$ double precision ss,d_ss(0:3),ljf,d_ljf(0:3)
18664 !-------END SECOND METHOD
18666 !-------TESTING CODE
18667 !el logical :: checkstop,transgrad
18668 !el common /sschecks/ checkstop,transgrad
18670 integer :: icheck,nicheck,jcheck,njcheck
18671 real(kind=8),dimension(-1:1) :: echeck
18672 real(kind=8) :: deps,ssx0,ljx0
18673 !-------END TESTING CODE
18679 !el allocate(dyn_ssbond_ij(iatsc_s:iatsc_e,nres))
18680 !el allocate(dyn_ssbond_ij(0:nres+4,nres))
18683 dxi=dc_norm(1,nres+i)
18684 dyi=dc_norm(2,nres+i)
18685 dzi=dc_norm(3,nres+i)
18686 dsci_inv=vbld_inv(i+nres)
18689 xj=c(1,nres+j)-c(1,nres+i)
18690 yj=c(2,nres+j)-c(2,nres+i)
18691 zj=c(3,nres+j)-c(3,nres+i)
18692 dxj=dc_norm(1,nres+j)
18693 dyj=dc_norm(2,nres+j)
18694 dzj=dc_norm(3,nres+j)
18695 dscj_inv=vbld_inv(j+nres)
18697 chi1=chi(itypi,itypj)
18698 chi2=chi(itypj,itypi)
18705 alf12=0.5D0*(alf1+alf2)
18707 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
18708 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
18709 ! The following are set in sc_angular
18713 ! om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
18714 ! om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
18715 ! om12=dxi*dxj+dyi*dyj+dzi*dzj
18717 rij=1.0D0/rij ! Reset this so it makes sense
18719 sig0ij=sigma(itypi,itypj)
18720 sig=sig0ij*dsqrt(1.0D0/sigsq)
18723 ljA=eps1*eps2rt**2*eps3rt**2
18724 ljB=ljA*bb_aq(itypi,itypj)
18725 ljA=ljA*aa_aq(itypi,itypj)
18726 ljxm=ljXs+(-2.0D0*aa_aq(itypi,itypj)/bb_aq(itypi,itypj))**(1.0D0/6.0D0)
18731 deltat12=om2-om1+2.0d0
18732 cosphi=om12-om1*om2
18736 +akth*(deltat1*deltat1+deltat2*deltat2) &
18737 +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
18738 ssxm=ssXs-0.5D0*ssB/ssA
18740 !-------TESTING CODE
18741 !$$$c Some extra output
18742 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
18743 !$$$ ljm=-0.25D0*ljB*bb(itypi,itypj)/aa(itypi,itypj)
18744 !$$$ ssx0=ssB*ssB-4.0d0*ssA*ssC
18745 !$$$ if (ssx0.gt.0.0d0) then
18746 !$$$ ssx0=ssXs+0.5d0*(-ssB+sqrt(ssx0))/ssA
18750 !$$$ ljx0=ljXs+(-aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
18751 !$$$ write(iout,'(a,4f8.2,2f15.2,3f6.2)')"SSENERGIES ",
18752 !$$$ & ssxm,ljxm,ssx0,ljx0,ssm,ljm,om1,om2,om12
18754 !-------END TESTING CODE
18756 !-------TESTING CODE
18757 ! Stop and plot energy and derivative as a function of distance
18758 if (checkstop) then
18759 ssm=ssC-0.25D0*ssB*ssB/ssA
18760 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
18761 if (ssm.lt.ljm .and. &
18762 dabs(rij-0.5d0*(ssxm+ljxm)).lt.0.35d0*(ljxm-ssxm)) then
18770 if (.not.checkstop) then
18775 do icheck=0,nicheck
18776 do jcheck=-1,njcheck
18777 if (checkstop) rij=(ssxm-1.0d0)+ &
18778 ((ljxm-ssxm+2.0d0)*icheck)/nicheck+jcheck*deps
18779 !-------END TESTING CODE
18781 if (rij.gt.ljxm) then
18784 fac=(1.0D0/ljd)**expon
18785 e1=fac*fac*aa_aq(itypi,itypj)
18786 e2=fac*bb_aq(itypi,itypj)
18787 eij=eps1*eps2rt*eps3rt*(e1+e2)
18790 eij=eij*eps2rt*eps3rt
18793 e1=e1*eps1*eps2rt**2*eps3rt**2
18794 ed=-expon*(e1+eij)/ljd
18796 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
18797 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
18798 eom12=eij*eps1_om12+eps2der*eps2rt_om12 &
18799 -2.0D0*alf12*eps3der+sigder*sigsq_om12
18800 else if (rij.lt.ssxm) then
18803 eij=ssA*ssd*ssd+ssB*ssd+ssC
18805 ed=2*akcm*ssd+akct*deltat12
18807 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
18808 eom1=-2*akth*deltat1-pom1-om2*pom2
18809 eom2= 2*akth*deltat2+pom1-om1*pom2
18812 omega=v1ss+2.0d0*v2ss*cosphi+3.0d0*v3ss*cosphi*cosphi
18814 d_ssxm(1)=0.5D0*akct/ssA
18815 d_ssxm(2)=-d_ssxm(1)
18818 d_ljxm(1)=sig0ij/sqrt(sigsq**3)
18819 d_ljxm(2)=d_ljxm(1)*sigsq_om2
18820 d_ljxm(3)=d_ljxm(1)*sigsq_om12
18821 d_ljxm(1)=d_ljxm(1)*sigsq_om1
18823 !-------FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
18824 xm=0.5d0*(ssxm+ljxm)
18826 d_xm(k)=0.5d0*(d_ssxm(k)+d_ljxm(k))
18828 if (rij.lt.xm) then
18830 ssm=ssC-0.25D0*ssB*ssB/ssA
18831 d_ssm(1)=0.5D0*akct*ssB/ssA
18832 d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
18833 d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
18835 f1=(rij-xm)/(ssxm-xm)
18836 f2=(rij-ssxm)/(xm-ssxm)
18840 delta_inv=1.0d0/(xm-ssxm)
18841 deltasq_inv=delta_inv*delta_inv
18843 fac1=deltasq_inv*fac*(xm-rij)
18844 fac2=deltasq_inv*fac*(rij-ssxm)
18845 ed=delta_inv*(Ht*hd2-ssm*hd1)
18846 eom1=fac1*d_ssxm(1)+fac2*d_xm(1)+h1*d_ssm(1)
18847 eom2=fac1*d_ssxm(2)+fac2*d_xm(2)+h1*d_ssm(2)
18848 eom12=fac1*d_ssxm(3)+fac2*d_xm(3)+h1*d_ssm(3)
18851 ljm=-0.25D0*ljB*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)
18852 d_ljm(1)=-0.5D0*bb_aq(itypi,itypj)/aa_aq(itypi,itypj)*ljB
18853 d_ljm(2)=d_ljm(1)*(0.5D0*eps2rt_om2/eps2rt+alf2/eps3rt)
18854 d_ljm(3)=d_ljm(1)*(0.5D0*eps1_om12+0.5D0*eps2rt_om12/eps2rt- &
18856 d_ljm(1)=d_ljm(1)*(0.5D0*eps2rt_om1/eps2rt-alf1/eps3rt)
18857 f1=(rij-ljxm)/(xm-ljxm)
18858 f2=(rij-xm)/(ljxm-xm)
18862 delta_inv=1.0d0/(ljxm-xm)
18863 deltasq_inv=delta_inv*delta_inv
18865 fac1=deltasq_inv*fac*(ljxm-rij)
18866 fac2=deltasq_inv*fac*(rij-xm)
18867 ed=delta_inv*(ljm*hd2-Ht*hd1)
18868 eom1=fac1*d_xm(1)+fac2*d_ljxm(1)+h2*d_ljm(1)
18869 eom2=fac1*d_xm(2)+fac2*d_ljxm(2)+h2*d_ljm(2)
18870 eom12=fac1*d_xm(3)+fac2*d_ljxm(3)+h2*d_ljm(3)
18872 !-------END FIRST METHOD, DISCONTINUOUS SECOND DERIVATIVE
18874 !-------SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
18880 !$$$ d_ljB(1)=ljB*(eps2rt_om1/eps2rt-2.0d0*alf1/eps3rt)
18881 !$$$ d_ljB(2)=ljB*(eps2rt_om2/eps2rt+2.0d0*alf2/eps3rt)
18882 !$$$ d_ljB(3)=ljB*(eps1_om12+eps2rt_om12/eps2rt-2.0d0*alf12/eps3rt)
18884 !$$$ ssm=ssC-0.25D0*ssB*ssB/ssA
18885 !$$$ d_ssm(1)=0.5D0*akct*ssB/ssA
18886 !$$$ d_ssm(2)=2.0D0*akth*deltat2-om1*omega-d_ssm(1)
18887 !$$$ d_ssm(1)=-2.0D0*akth*deltat1-om2*omega+d_ssm(1)
18888 !$$$ d_ssm(3)=omega
18890 !$$$ ljm=-0.25D0*bb(itypi,itypj)/aa(itypi,itypj)
18892 !$$$ d_ljm(k)=ljm*d_ljB(k)
18896 !$$$ ss=ssA*ssd*ssd+ssB*ssd+ssC
18897 !$$$ d_ss(0)=2.0d0*ssA*ssd+ssB
18898 !$$$ d_ss(2)=akct*ssd
18899 !$$$ d_ss(1)=-d_ss(2)-2.0d0*akth*deltat1-om2*omega
18900 !$$$ d_ss(2)=d_ss(2)+2.0d0*akth*deltat2-om1*omega
18903 !$$$ ljf=bb(itypi,itypj)/aa(itypi,itypj)
18904 !$$$ ljf=9.0d0*ljf*(-0.5d0*ljf)**(1.0d0/3.0d0)
18905 !$$$ d_ljf(0)=ljf*2.0d0*ljB*fac1
18907 !$$$ d_ljf(k)=d_ljm(k)+ljf*(d_ljB(k)*fac1*fac1-
18908 !$$$ & 2.0d0*ljB*fac1*d_ljxm(k))
18910 !$$$ ljf=ljm+ljf*ljB*fac1*fac1
18912 !$$$ f1=(rij-ljxm)/(ssxm-ljxm)
18913 !$$$ f2=(rij-ssxm)/(ljxm-ssxm)
18914 !$$$ h1=h_base(f1,hd1)
18915 !$$$ h2=h_base(f2,hd2)
18916 !$$$ eij=ss*h1+ljf*h2
18917 !$$$ delta_inv=1.0d0/(ljxm-ssxm)
18918 !$$$ deltasq_inv=delta_inv*delta_inv
18919 !$$$ fac=ljf*hd2-ss*hd1
18920 !$$$ ed=d_ss(0)*h1+d_ljf(0)*h2+delta_inv*fac
18921 !$$$ eom1=d_ss(1)*h1+d_ljf(1)*h2+deltasq_inv*fac*
18922 !$$$ & (fac1*d_ssxm(1)-fac2*(d_ljxm(1)))
18923 !$$$ eom2=d_ss(2)*h1+d_ljf(2)*h2+deltasq_inv*fac*
18924 !$$$ & (fac1*d_ssxm(2)-fac2*(d_ljxm(2)))
18925 !$$$ eom12=d_ss(3)*h1+d_ljf(3)*h2+deltasq_inv*fac*
18926 !$$$ & (fac1*d_ssxm(3)-fac2*(d_ljxm(3)))
18928 !$$$ havebond=.false.
18929 !$$$ if (ed.gt.0.0d0) havebond=.true.
18930 !-------END SECOND METHOD, CONTINUOUS SECOND DERIVATIVE
18937 ! if (dyn_ssbond_ij(i,j).eq.1.0d300) then
18938 ! write(iout,'(a15,f12.2,f8.1,2i5)')
18939 ! & "SSBOND_E_FORM",totT,t_bath,i,j
18943 dyn_ssbond_ij(i,j)=eij
18944 else if (.not.havebond .and. dyn_ssbond_ij(i,j).lt.1.0d300) then
18945 dyn_ssbond_ij(i,j)=1.0d300
18948 ! write(iout,'(a15,f12.2,f8.1,2i5)')
18949 ! & "SSBOND_E_BREAK",totT,t_bath,i,j
18954 !-------TESTING CODE
18955 !el if (checkstop) then
18956 if (jcheck.eq.0) write(iout,'(a,3f15.8,$)') &
18957 "CHECKSTOP",rij,eij,ed
18961 if (checkstop) then
18962 write(iout,'(f15.8)')(echeck(1)-echeck(-1))*0.5d0/deps
18965 if (checkstop) then
18969 !-------END TESTING CODE
18972 dcosom1(k)=(dc_norm(k,nres+i)-om1*erij(k))/rij
18973 dcosom2(k)=(dc_norm(k,nres+j)-om2*erij(k))/rij
18976 gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
18979 gvdwx(k,i)=gvdwx(k,i)-gg(k) &
18980 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
18981 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
18982 gvdwx(k,j)=gvdwx(k,j)+gg(k) &
18983 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
18984 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
18988 !grad gvdwc(l,k)=gvdwc(l,k)+gg(l)
18993 gvdwc(l,i)=gvdwc(l,i)-gg(l)
18994 gvdwc(l,j)=gvdwc(l,j)+gg(l)
18998 end subroutine dyn_ssbond_ene
18999 !--------------------------------------------------------------------------
19000 subroutine triple_ssbond_ene(resi,resj,resk,eij)
19005 ! include 'DIMENSIONS'
19006 ! include 'COMMON.SBRIDGE'
19007 ! include 'COMMON.CHAIN'
19008 ! include 'COMMON.DERIV'
19009 ! include 'COMMON.LOCAL'
19010 ! include 'COMMON.INTERACT'
19011 ! include 'COMMON.VAR'
19012 ! include 'COMMON.IOUNITS'
19013 ! include 'COMMON.CALC'
19017 ! include 'COMMON.MD'
19018 ! use MD, only: totT,t_bath
19021 double precision h_base
19025 integer resi,resj,resk,m,itypi,itypj,itypk
19027 !c Output arguments
19028 double precision eij,eij1,eij2,eij3
19032 !c integer itypi,itypj,k,l
19033 double precision rrij,ssd,deltat1,deltat2,deltat12,cosphi
19034 double precision rrik,rrjk,rik,rjk,xi,xk,yi,yk,zi,zk,xij,yij,zij
19035 double precision xik,yik,zik,xjk,yjk,zjk,dxk,dyk,dzk
19036 double precision sig0ij,ljd,sig,fac,e1,e2
19037 double precision dcosom1(3),dcosom2(3),ed
19038 double precision pom1,pom2
19039 double precision ljA,ljB,ljXs
19040 double precision d_ljB(1:3)
19041 double precision ssA,ssB,ssC,ssXs
19042 double precision ssxm,ljxm,ssm,ljm
19043 double precision d_ssxm(1:3),d_ljxm(1:3),d_ssm(1:3),d_ljm(1:3)
19045 if (dtriss.eq.0) return
19049 !C write(iout,*) resi,resj,resk
19051 dxi=dc_norm(1,nres+i)
19052 dyi=dc_norm(2,nres+i)
19053 dzi=dc_norm(3,nres+i)
19054 dsci_inv=vbld_inv(i+nres)
19063 dxj=dc_norm(1,nres+j)
19064 dyj=dc_norm(2,nres+j)
19065 dzj=dc_norm(3,nres+j)
19066 dscj_inv=vbld_inv(j+nres)
19072 dxk=dc_norm(1,nres+k)
19073 dyk=dc_norm(2,nres+k)
19074 dzk=dc_norm(3,nres+k)
19075 dscj_inv=vbld_inv(k+nres)
19085 rrij=(xij*xij+yij*yij+zij*zij)
19086 rij=dsqrt(rrij) ! sc_angular needs rij to really be the inverse
19087 rrik=(xik*xik+yik*yik+zik*zik)
19089 rrjk=(xjk*xjk+yjk*yjk+zjk*zjk)
19091 !C there are three combination of distances for each trisulfide bonds
19092 !C The first case the ith atom is the center
19093 !C Energy function is E=d/(a*(x-y)**2+b*(x+y)**2+c) where x is first
19094 !C distance y is second distance the a,b,c,d are parameters derived for
19095 !C this problem d parameter was set as a penalty currenlty set to 1.
19096 if ((iabs(j-i).le.2).or.(iabs(i-k).le.2)) then
19099 eij1=dtriss/(atriss*(rij-rik)**2+btriss*(rij+rik)**6+ctriss)
19101 !C second case jth atom is center
19102 if ((iabs(j-i).le.2).or.(iabs(j-k).le.2)) then
19105 eij2=dtriss/(atriss*(rij-rjk)**2+btriss*(rij+rjk)**6+ctriss)
19107 !C the third case kth atom is the center
19108 if ((iabs(i-k).le.2).or.(iabs(j-k).le.2)) then
19111 eij3=dtriss/(atriss*(rik-rjk)**2+btriss*(rik+rjk)**6+ctriss)
19117 !C write(iout,*)i,j,k,eij
19118 !C The energy penalty calculated now time for the gradient part
19119 !C derivative over rij
19120 fac=-eij1**2/dtriss*(2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
19121 -eij2**2/dtriss*(2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)
19126 gvdwx(m,i)=gvdwx(m,i)-gg(m)
19127 gvdwx(m,j)=gvdwx(m,j)+gg(m)
19131 gvdwc(l,i)=gvdwc(l,i)-gg(l)
19132 gvdwc(l,j)=gvdwc(l,j)+gg(l)
19134 !C now derivative over rik
19135 fac=-eij1**2/dtriss* &
19136 (-2.0*atriss*(rij-rik)+6.0*btriss*(rij+rik)**5) &
19137 -eij3**2/dtriss*(2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
19142 gvdwx(m,i)=gvdwx(m,i)-gg(m)
19143 gvdwx(m,k)=gvdwx(m,k)+gg(m)
19146 gvdwc(l,i)=gvdwc(l,i)-gg(l)
19147 gvdwc(l,k)=gvdwc(l,k)+gg(l)
19149 !C now derivative over rjk
19150 fac=-eij2**2/dtriss* &
19151 (-2.0*atriss*(rij-rjk)+6.0*btriss*(rij+rjk)**5)- &
19152 eij3**2/dtriss*(-2.0*atriss*(rik-rjk)+6.0*btriss*(rik+rjk)**5)
19157 gvdwx(m,j)=gvdwx(m,j)-gg(m)
19158 gvdwx(m,k)=gvdwx(m,k)+gg(m)
19161 gvdwc(l,j)=gvdwc(l,j)-gg(l)
19162 gvdwc(l,k)=gvdwc(l,k)+gg(l)
19165 end subroutine triple_ssbond_ene
19169 !-----------------------------------------------------------------------------
19170 real(kind=8) function h_base(x,deriv)
19171 ! A smooth function going 0->1 in range [0,1]
19172 ! It should NOT be called outside range [0,1], it will not work there.
19179 real(kind=8) :: deriv
19182 real(kind=8) :: xsq
19185 ! Two parabolas put together. First derivative zero at extrema
19186 !$$$ if (x.lt.0.5D0) then
19187 !$$$ h_base=2.0D0*x*x
19191 !$$$ h_base=1.0D0-2.0D0*deriv*deriv
19192 !$$$ deriv=4.0D0*deriv
19195 ! Third degree polynomial. First derivative zero at extrema
19196 h_base=x*x*(3.0d0-2.0d0*x)
19197 deriv=6.0d0*x*(1.0d0-x)
19199 ! Fifth degree polynomial. First and second derivatives zero at extrema
19201 !$$$ h_base=x*xsq*(6.0d0*xsq-15.0d0*x+10.0d0)
19203 !$$$ deriv=deriv*deriv
19204 !$$$ deriv=30.0d0*xsq*deriv
19207 end function h_base
19208 !-----------------------------------------------------------------------------
19209 subroutine dyn_set_nss
19210 ! Adjust nss and other relevant variables based on dyn_ssbond_ij
19212 use MD_data, only: totT,t_bath
19214 ! include 'DIMENSIONS'
19218 ! include 'COMMON.SBRIDGE'
19219 ! include 'COMMON.CHAIN'
19220 ! include 'COMMON.IOUNITS'
19221 ! include 'COMMON.SETUP'
19222 ! include 'COMMON.MD'
19224 real(kind=8) :: emin
19225 integer :: i,j,imin,ierr
19226 integer :: diff,allnss,newnss
19227 integer,dimension(maxdim) :: allflag,allihpb,alljhpb,& !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
19230 integer,dimension(0:nfgtasks) :: i_newnss
19231 integer,dimension(0:nfgtasks) :: displ
19232 integer,dimension(maxdim) :: g_newihpb,g_newjhpb !(maxdim)(maxdim=(maxres-1)*(maxres-2)/2)
19233 integer :: g_newnss
19238 if (dyn_ssbond_ij(i,j).lt.1.0d300) then
19247 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
19251 if (allflag(i).eq.0 .and. &
19252 dyn_ssbond_ij(allihpb(i),alljhpb(i)).lt.emin) then
19253 emin=dyn_ssbond_ij(allihpb(i),alljhpb(i))
19257 if (emin.lt.1.0d300) then
19260 if (allflag(i).eq.0 .and. &
19261 (allihpb(i).eq.allihpb(imin) .or. &
19262 alljhpb(i).eq.allihpb(imin) .or. &
19263 allihpb(i).eq.alljhpb(imin) .or. &
19264 alljhpb(i).eq.alljhpb(imin))) then
19271 !mc write(iout,*)"ALLNSS ",allnss,(allihpb(i),alljhpb(i),i=1,allnss)
19275 if (allflag(i).eq.1) then
19277 newihpb(newnss)=allihpb(i)
19278 newjhpb(newnss)=alljhpb(i)
19283 if (nfgtasks.gt.1)then
19285 call MPI_Reduce(newnss,g_newnss,1,&
19286 MPI_INTEGER,MPI_SUM,king,FG_COMM,IERR)
19287 call MPI_Gather(newnss,1,MPI_INTEGER,&
19288 i_newnss,1,MPI_INTEGER,king,FG_COMM,IERR)
19290 do i=1,nfgtasks-1,1
19291 displ(i)=i_newnss(i-1)+displ(i-1)
19293 call MPI_Gatherv(newihpb,newnss,MPI_INTEGER,&
19294 g_newihpb,i_newnss,displ,MPI_INTEGER,&
19296 call MPI_Gatherv(newjhpb,newnss,MPI_INTEGER,&
19297 g_newjhpb,i_newnss,displ,MPI_INTEGER,&
19299 if(fg_rank.eq.0) then
19300 ! print *,'g_newnss',g_newnss
19301 ! print *,'g_newihpb',(g_newihpb(i),i=1,g_newnss)
19302 ! print *,'g_newjhpb',(g_newjhpb(i),i=1,g_newnss)
19305 newihpb(i)=g_newihpb(i)
19306 newjhpb(i)=g_newjhpb(i)
19314 !mc write(iout,*)"NEWNSS ",newnss,(newihpb(i),newjhpb(i),i=1,newnss)
19315 ! print *,newnss,nss,maxdim
19321 if (idssb(i).eq.newihpb(j) .and. &
19322 jdssb(i).eq.newjhpb(j)) found=.true.
19326 ! write(iout,*) "found",found,i,j
19327 if (.not.found.and.fg_rank.eq.0) &
19328 write(iout,'(a15,f12.2,f8.1,2i5)') &
19329 "SSBOND_BREAK",totT,t_bath,idssb(i),jdssb(i)
19338 if (newihpb(i).eq.idssb(j) .and. &
19339 newjhpb(i).eq.jdssb(j)) found=.true.
19343 ! write(iout,*) "found",found,i,j
19344 if (.not.found.and.fg_rank.eq.0) &
19345 write(iout,'(a15,f12.2,f8.1,2i5)') &
19346 "SSBOND_FORM",totT,t_bath,newihpb(i),newjhpb(i)
19353 idssb(i)=newihpb(i)
19354 jdssb(i)=newjhpb(i)
19358 end subroutine dyn_set_nss
19359 ! Lipid transfer energy function
19360 subroutine Eliptransfer(eliptran)
19361 !C this is done by Adasko
19362 !C print *,"wchodze"
19363 !C structure of box:
19365 !C--bordliptop-- buffore starts
19366 !C--bufliptop--- here true lipid starts
19368 !C--buflipbot--- lipid ends buffore starts
19369 !C--bordlipbot--buffore ends
19370 real(kind=8) :: fracinbuf,eliptran,sslip,positi,ssgradlip
19373 ! print *, "I am in eliptran"
19374 do i=ilip_start,ilip_end
19376 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1).or.(i.eq.nres))&
19379 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
19380 if (positi.le.0.0) positi=positi+boxzsize
19382 !C first for peptide groups
19383 !c for each residue check if it is in lipid or lipid water border area
19384 if ((positi.gt.bordlipbot) &
19385 .and.(positi.lt.bordliptop)) then
19386 !C the energy transfer exist
19387 if (positi.lt.buflipbot) then
19388 !C what fraction I am in
19390 ((positi-bordlipbot)/lipbufthick)
19391 !C lipbufthick is thickenes of lipid buffore
19392 sslip=sscalelip(fracinbuf)
19393 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
19394 eliptran=eliptran+sslip*pepliptran
19395 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
19396 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
19397 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
19399 !C print *,"doing sccale for lower part"
19400 !C print *,i,sslip,fracinbuf,ssgradlip
19401 elseif (positi.gt.bufliptop) then
19402 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
19403 sslip=sscalelip(fracinbuf)
19404 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
19405 eliptran=eliptran+sslip*pepliptran
19406 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
19407 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
19408 !C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
19409 !C print *, "doing sscalefor top part"
19410 !C print *,i,sslip,fracinbuf,ssgradlip
19412 eliptran=eliptran+pepliptran
19413 !C print *,"I am in true lipid"
19416 !C eliptran=elpitran+0.0 ! I am in water
19418 if (energy_dec) write(iout,*) i,"eliptran=",eliptran,positi,sslip
19420 ! here starts the side chain transfer
19421 do i=ilip_start,ilip_end
19422 if (itype(i,1).eq.ntyp1) cycle
19423 positi=(mod(c(3,i+nres),boxzsize))
19424 if (positi.le.0) positi=positi+boxzsize
19425 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
19426 !c for each residue check if it is in lipid or lipid water border area
19427 !C respos=mod(c(3,i+nres),boxzsize)
19428 !C print *,positi,bordlipbot,buflipbot
19429 if ((positi.gt.bordlipbot) &
19430 .and.(positi.lt.bordliptop)) then
19431 !C the energy transfer exist
19432 if (positi.lt.buflipbot) then
19434 ((positi-bordlipbot)/lipbufthick)
19435 !C lipbufthick is thickenes of lipid buffore
19436 sslip=sscalelip(fracinbuf)
19437 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
19438 eliptran=eliptran+sslip*liptranene(itype(i,1))
19439 gliptranx(3,i)=gliptranx(3,i) &
19440 +ssgradlip*liptranene(itype(i,1))
19441 gliptranc(3,i-1)= gliptranc(3,i-1) &
19442 +ssgradlip*liptranene(itype(i,1))
19443 !C print *,"doing sccale for lower part"
19444 elseif (positi.gt.bufliptop) then
19446 ((bordliptop-positi)/lipbufthick)
19447 sslip=sscalelip(fracinbuf)
19448 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
19449 eliptran=eliptran+sslip*liptranene(itype(i,1))
19450 gliptranx(3,i)=gliptranx(3,i) &
19451 +ssgradlip*liptranene(itype(i,1))
19452 gliptranc(3,i-1)= gliptranc(3,i-1) &
19453 +ssgradlip*liptranene(itype(i,1))
19454 !C print *, "doing sscalefor top part",sslip,fracinbuf
19456 eliptran=eliptran+liptranene(itype(i,1))
19457 !C print *,"I am in true lipid"
19459 endif ! if in lipid or buffor
19461 !C eliptran=elpitran+0.0 ! I am in water
19462 if (energy_dec) write(iout,*) i,"eliptran=",eliptran
19465 end subroutine Eliptransfer
19466 !----------------------------------NANO FUNCTIONS
19467 !C-----------------------------------------------------------------------
19468 !C-----------------------------------------------------------
19469 !C This subroutine is to mimic the histone like structure but as well can be
19470 !C utilizet to nanostructures (infinit) small modification has to be used to
19471 !C make it finite (z gradient at the ends has to be changes as well as the x,y
19472 !C gradient has to be modified at the ends
19473 !C The energy function is Kihara potential
19474 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
19475 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
19476 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
19477 !C simple Kihara potential
19478 subroutine calctube(Etube)
19479 real(kind=8),dimension(3) :: vectube
19480 real(kind=8) :: Etube,xtemp,xminact,yminact,&
19481 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi, &
19482 sc_aa_tube,sc_bb_tube
19485 do i=itube_start,itube_end
19487 enetube(i+nres)=0.0d0
19489 !C first we calculate the distance from tube center
19491 do i=itube_start,itube_end
19492 !C lets ommit dummy atoms for now
19493 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
19494 !C now calculate distance from center of tube and direction vectors
19497 ! Find minimum distance in periodic box
19499 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19500 vectube(1)=vectube(1)+boxxsize*j
19501 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19502 vectube(2)=vectube(2)+boxysize*j
19503 xminact=abs(vectube(1)-tubecenter(1))
19504 yminact=abs(vectube(2)-tubecenter(2))
19505 if (xmin.gt.xminact) then
19509 if (ymin.gt.yminact) then
19516 vectube(1)=vectube(1)-tubecenter(1)
19517 vectube(2)=vectube(2)-tubecenter(2)
19519 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
19520 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
19522 !C as the tube is infinity we do not calculate the Z-vector use of Z
19525 !C now calculte the distance
19526 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19527 !C now normalize vector
19528 vectube(1)=vectube(1)/tub_r
19529 vectube(2)=vectube(2)/tub_r
19530 !C calculte rdiffrence between r and r0
19533 rdiff6=rdiff**6.0d0
19534 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19535 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
19536 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
19537 !C print *,rdiff,rdiff6,pep_aa_tube
19538 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19539 !C now we calculate gradient
19540 fac=(-12.0d0*pep_aa_tube/rdiff6- &
19541 6.0d0*pep_bb_tube)/rdiff6/rdiff
19542 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
19544 !C now direction of gg_tube vector
19546 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
19547 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
19550 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
19551 !C print *,gg_tube(1,0),"TU"
19554 do i=itube_start,itube_end
19555 !C Lets not jump over memory as we use many times iti
19557 !C lets ommit dummy atoms for now
19558 if ((iti.eq.ntyp1) &
19559 !C in UNRES uncomment the line below as GLY has no side-chain...
19565 vectube(1)=mod((c(1,i+nres)),boxxsize)
19566 vectube(1)=vectube(1)+boxxsize*j
19567 vectube(2)=mod((c(2,i+nres)),boxysize)
19568 vectube(2)=vectube(2)+boxysize*j
19570 xminact=abs(vectube(1)-tubecenter(1))
19571 yminact=abs(vectube(2)-tubecenter(2))
19572 if (xmin.gt.xminact) then
19576 if (ymin.gt.yminact) then
19583 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
19585 vectube(1)=vectube(1)-tubecenter(1)
19586 vectube(2)=vectube(2)-tubecenter(2)
19588 !C as the tube is infinity we do not calculate the Z-vector use of Z
19591 !C now calculte the distance
19592 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19593 !C now normalize vector
19594 vectube(1)=vectube(1)/tub_r
19595 vectube(2)=vectube(2)/tub_r
19597 !C calculte rdiffrence between r and r0
19600 rdiff6=rdiff**6.0d0
19601 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19602 sc_aa_tube=sc_aa_tube_par(iti)
19603 sc_bb_tube=sc_bb_tube_par(iti)
19604 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
19605 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
19606 6.0d0*sc_bb_tube/rdiff6/rdiff
19607 !C now direction of gg_tube vector
19609 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19610 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19613 do i=itube_start,itube_end
19614 Etube=Etube+enetube(i)+enetube(i+nres)
19616 !C print *,"ETUBE", etube
19618 end subroutine calctube
19619 !C TO DO 1) add to total energy
19620 !C 2) add to gradient summation
19621 !C 3) add reading parameters (AND of course oppening of PARAM file)
19622 !C 4) add reading the center of tube
19624 !C 6) add to zerograd
19625 !C 7) allocate matrices
19628 !C-----------------------------------------------------------------------
19629 !C-----------------------------------------------------------
19630 !C This subroutine is to mimic the histone like structure but as well can be
19631 !C utilizet to nanostructures (infinit) small modification has to be used to
19632 !C make it finite (z gradient at the ends has to be changes as well as the x,y
19633 !C gradient has to be modified at the ends
19634 !C The energy function is Kihara potential
19635 !C E=4esp*((sigma/(r-r0))^12 - (sigma/(r-r0))^6)
19636 !C 4eps is depth of well sigma is r_minimum r is distance from center of tube
19637 !C and r0 is the excluded size of nanotube (can be set to 0 if we want just a
19638 !C simple Kihara potential
19639 subroutine calctube2(Etube)
19640 real(kind=8),dimension(3) :: vectube
19641 real(kind=8) :: Etube,xtemp,xminact,yminact,&
19642 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,positi,fracinbuf,&
19643 sstube,ssgradtube,sc_aa_tube,sc_bb_tube
19646 do i=itube_start,itube_end
19648 enetube(i+nres)=0.0d0
19650 !C first we calculate the distance from tube center
19651 !C first sugare-phosphate group for NARES this would be peptide group
19653 do i=itube_start,itube_end
19654 !C lets ommit dummy atoms for now
19656 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
19657 !C now calculate distance from center of tube and direction vectors
19658 !C vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19659 !C if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
19660 !C vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19661 !C if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
19665 vectube(1)=mod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19666 vectube(1)=vectube(1)+boxxsize*j
19667 vectube(2)=mod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19668 vectube(2)=vectube(2)+boxysize*j
19670 xminact=abs(vectube(1)-tubecenter(1))
19671 yminact=abs(vectube(2)-tubecenter(2))
19672 if (xmin.gt.xminact) then
19676 if (ymin.gt.yminact) then
19683 vectube(1)=vectube(1)-tubecenter(1)
19684 vectube(2)=vectube(2)-tubecenter(2)
19686 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
19687 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
19689 !C as the tube is infinity we do not calculate the Z-vector use of Z
19692 !C now calculte the distance
19693 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19694 !C now normalize vector
19695 vectube(1)=vectube(1)/tub_r
19696 vectube(2)=vectube(2)/tub_r
19697 !C calculte rdiffrence between r and r0
19700 rdiff6=rdiff**6.0d0
19701 !C THIS FRAGMENT MAKES TUBE FINITE
19702 positi=mod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
19703 if (positi.le.0) positi=positi+boxzsize
19704 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
19705 !c for each residue check if it is in lipid or lipid water border area
19706 !C respos=mod(c(3,i+nres),boxzsize)
19707 !C print *,positi,bordtubebot,buftubebot,bordtubetop
19708 if ((positi.gt.bordtubebot) &
19709 .and.(positi.lt.bordtubetop)) then
19710 !C the energy transfer exist
19711 if (positi.lt.buftubebot) then
19713 ((positi-bordtubebot)/tubebufthick)
19714 !C lipbufthick is thickenes of lipid buffore
19715 sstube=sscalelip(fracinbuf)
19716 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
19717 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
19718 enetube(i)=enetube(i)+sstube*tubetranenepep
19719 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19720 !C &+ssgradtube*tubetranene(itype(i,1))
19721 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19722 !C &+ssgradtube*tubetranene(itype(i,1))
19723 !C print *,"doing sccale for lower part"
19724 elseif (positi.gt.buftubetop) then
19726 ((bordtubetop-positi)/tubebufthick)
19727 sstube=sscalelip(fracinbuf)
19728 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
19729 enetube(i)=enetube(i)+sstube*tubetranenepep
19730 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19731 !C &+ssgradtube*tubetranene(itype(i,1))
19732 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19733 !C &+ssgradtube*tubetranene(itype(i,1))
19734 !C print *, "doing sscalefor top part",sslip,fracinbuf
19738 enetube(i)=enetube(i)+sstube*tubetranenepep
19739 !C print *,"I am in true lipid"
19743 !C ssgradtube=0.0d0
19745 endif ! if in lipid or buffor
19747 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19748 enetube(i)=enetube(i)+sstube* &
19749 (pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6)
19750 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
19751 !C print *,rdiff,rdiff6,pep_aa_tube
19752 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19753 !C now we calculate gradient
19754 fac=(-12.0d0*pep_aa_tube/rdiff6- &
19755 6.0d0*pep_bb_tube)/rdiff6/rdiff*sstube
19756 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
19759 !C now direction of gg_tube vector
19761 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
19762 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
19764 gg_tube(3,i)=gg_tube(3,i) &
19765 +ssgradtube*enetube(i)/sstube/2.0d0
19766 gg_tube(3,i-1)= gg_tube(3,i-1) &
19767 +ssgradtube*enetube(i)/sstube/2.0d0
19770 !C basically thats all code now we split for side-chains (REMEMBER to sum up at the END)
19771 !C print *,gg_tube(1,0),"TU"
19772 do i=itube_start,itube_end
19773 !C Lets not jump over memory as we use many times iti
19775 !C lets ommit dummy atoms for now
19776 if ((iti.eq.ntyp1) &
19777 !!C in UNRES uncomment the line below as GLY has no side-chain...
19780 vectube(1)=c(1,i+nres)
19781 vectube(1)=mod(vectube(1),boxxsize)
19782 if (vectube(1).lt.0) vectube(1)=vectube(1)+boxxsize
19783 vectube(2)=c(2,i+nres)
19784 vectube(2)=mod(vectube(2),boxysize)
19785 if (vectube(2).lt.0) vectube(2)=vectube(2)+boxysize
19787 vectube(1)=vectube(1)-tubecenter(1)
19788 vectube(2)=vectube(2)-tubecenter(2)
19789 !C THIS FRAGMENT MAKES TUBE FINITE
19790 positi=(mod(c(3,i+nres),boxzsize))
19791 if (positi.le.0) positi=positi+boxzsize
19792 !C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
19793 !c for each residue check if it is in lipid or lipid water border area
19794 !C respos=mod(c(3,i+nres),boxzsize)
19795 !C print *,positi,bordtubebot,buftubebot,bordtubetop
19797 if ((positi.gt.bordtubebot) &
19798 .and.(positi.lt.bordtubetop)) then
19799 !C the energy transfer exist
19800 if (positi.lt.buftubebot) then
19802 ((positi-bordtubebot)/tubebufthick)
19803 !C lipbufthick is thickenes of lipid buffore
19804 sstube=sscalelip(fracinbuf)
19805 ssgradtube=-sscagradlip(fracinbuf)/tubebufthick
19806 !C print *,ssgradtube, sstube,tubetranene(itype(i,1))
19807 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19808 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19809 !C &+ssgradtube*tubetranene(itype(i,1))
19810 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19811 !C &+ssgradtube*tubetranene(itype(i,1))
19812 !C print *,"doing sccale for lower part"
19813 elseif (positi.gt.buftubetop) then
19815 ((bordtubetop-positi)/tubebufthick)
19817 sstube=sscalelip(fracinbuf)
19818 ssgradtube=sscagradlip(fracinbuf)/tubebufthick
19819 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19820 !C gg_tube_SC(3,i)=gg_tube_SC(3,i)
19821 !C &+ssgradtube*tubetranene(itype(i,1))
19822 !C gg_tube(3,i-1)= gg_tube(3,i-1)
19823 !C &+ssgradtube*tubetranene(itype(i,1))
19824 !C print *, "doing sscalefor top part",sslip,fracinbuf
19828 enetube(i+nres)=enetube(i+nres)+sstube*tubetranene(itype(i,1))
19829 !C print *,"I am in true lipid"
19833 !C ssgradtube=0.0d0
19835 endif ! if in lipid or buffor
19836 !CEND OF FINITE FRAGMENT
19837 !C as the tube is infinity we do not calculate the Z-vector use of Z
19840 !C now calculte the distance
19841 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19842 !C now normalize vector
19843 vectube(1)=vectube(1)/tub_r
19844 vectube(2)=vectube(2)/tub_r
19845 !C calculte rdiffrence between r and r0
19848 rdiff6=rdiff**6.0d0
19849 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19850 sc_aa_tube=sc_aa_tube_par(iti)
19851 sc_bb_tube=sc_bb_tube_par(iti)
19852 enetube(i+nres)=(sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6)&
19853 *sstube+enetube(i+nres)
19854 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19855 !C now we calculate gradient
19856 fac=(-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff-&
19857 6.0d0*sc_bb_tube/rdiff6/rdiff)*sstube
19858 !C now direction of gg_tube vector
19860 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
19861 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
19863 gg_tube_SC(3,i)=gg_tube_SC(3,i) &
19864 +ssgradtube*enetube(i+nres)/sstube
19865 gg_tube(3,i-1)= gg_tube(3,i-1) &
19866 +ssgradtube*enetube(i+nres)/sstube
19869 do i=itube_start,itube_end
19870 Etube=Etube+enetube(i)+enetube(i+nres)
19872 !C print *,"ETUBE", etube
19874 end subroutine calctube2
19875 !=====================================================================================================================================
19876 subroutine calcnano(Etube)
19877 real(kind=8),dimension(3) :: vectube
19879 real(kind=8) :: Etube,xtemp,xminact,yminact,&
19880 ytemp,xmin,ymin,tub_r,rdiff,rdiff6,fac,denominator,faccav,&
19881 sc_aa_tube,sc_bb_tube,zmin,ztemp,zminact
19882 integer:: i,j,iti,r
19885 ! print *,itube_start,itube_end,"poczatek"
19886 do i=itube_start,itube_end
19888 enetube(i+nres)=0.0d0
19890 !C first we calculate the distance from tube center
19891 !C first sugare-phosphate group for NARES this would be peptide group
19893 do i=itube_start,itube_end
19894 !C lets ommit dummy atoms for now
19895 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle
19896 !C now calculate distance from center of tube and direction vectors
19902 vectube(1)=dmod((c(1,i)+c(1,i+1))/2.0d0,boxxsize)
19903 vectube(1)=vectube(1)+boxxsize*j
19904 vectube(2)=dmod((c(2,i)+c(2,i+1))/2.0d0,boxysize)
19905 vectube(2)=vectube(2)+boxysize*j
19906 vectube(3)=dmod((c(3,i)+c(3,i+1))/2.0d0,boxzsize)
19907 vectube(3)=vectube(3)+boxzsize*j
19910 xminact=dabs(vectube(1)-tubecenter(1))
19911 yminact=dabs(vectube(2)-tubecenter(2))
19912 zminact=dabs(vectube(3)-tubecenter(3))
19914 if (xmin.gt.xminact) then
19918 if (ymin.gt.yminact) then
19922 if (zmin.gt.zminact) then
19931 vectube(1)=vectube(1)-tubecenter(1)
19932 vectube(2)=vectube(2)-tubecenter(2)
19933 vectube(3)=vectube(3)-tubecenter(3)
19935 !C print *,"x",(c(1,i)+c(1,i+1))/2.0d0,tubecenter(1)
19936 !C print *,"y",(c(2,i)+c(2,i+1))/2.0d0,tubecenter(2)
19937 !C as the tube is infinity we do not calculate the Z-vector use of Z
19939 !C vectube(3)=0.0d0
19940 !C now calculte the distance
19941 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
19942 !C now normalize vector
19943 vectube(1)=vectube(1)/tub_r
19944 vectube(2)=vectube(2)/tub_r
19945 vectube(3)=vectube(3)/tub_r
19946 !C calculte rdiffrence between r and r0
19949 rdiff6=rdiff**6.0d0
19950 !C for vectorization reasons we will sumup at the end to avoid depenence of previous
19951 enetube(i)=pep_aa_tube/rdiff6**2.0d0+pep_bb_tube/rdiff6
19952 !C write(iout,*) "TU13",i,rdiff6,enetube(i)
19953 !C print *,rdiff,rdiff6,pep_aa_tube
19954 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
19955 !C now we calculate gradient
19956 fac=(-12.0d0*pep_aa_tube/rdiff6- &
19957 6.0d0*pep_bb_tube)/rdiff6/rdiff
19958 !C write(iout,'(a5,i4,f12.1,3f12.5)') "TU13",i,rdiff6,enetube(i),
19960 if (acavtubpep.eq.0.0d0) then
19965 denominator=(1.0d0+dcavtubpep*rdiff6*rdiff6)
19967 (bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff)+ccavtubpep) &
19970 faccav=((bcavtubpep*1.0d0+acavtubpep/2.0d0/dsqrt(rdiff)) &
19971 *denominator-(bcavtubpep*rdiff+acavtubpep*dsqrt(rdiff) &
19972 +ccavtubpep)*rdiff6**2.0d0/rdiff*dcavtubpep*12.0d0) &
19973 /denominator**2.0d0
19978 if (energy_dec) write(iout,*),i,rdiff,enetube(i),enecavtube(i)
19980 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac/2.0d0
19981 gg_tube(j,i)=gg_tube(j,i)+vectube(j)*fac/2.0d0
19985 do i=itube_start,itube_end
19986 enecavtube(i)=0.0d0
19987 !C Lets not jump over memory as we use many times iti
19989 !C lets ommit dummy atoms for now
19990 if ((iti.eq.ntyp1) &
19991 !C in UNRES uncomment the line below as GLY has no side-chain...
19998 vectube(1)=dmod((c(1,i+nres)),boxxsize)
19999 vectube(1)=vectube(1)+boxxsize*j
20000 vectube(2)=dmod((c(2,i+nres)),boxysize)
20001 vectube(2)=vectube(2)+boxysize*j
20002 vectube(3)=dmod((c(3,i+nres)),boxzsize)
20003 vectube(3)=vectube(3)+boxzsize*j
20006 xminact=dabs(vectube(1)-tubecenter(1))
20007 yminact=dabs(vectube(2)-tubecenter(2))
20008 zminact=dabs(vectube(3)-tubecenter(3))
20010 if (xmin.gt.xminact) then
20014 if (ymin.gt.yminact) then
20018 if (zmin.gt.zminact) then
20027 !C write(iout,*), "tututu", vectube(1),tubecenter(1),vectube(2),
20029 vectube(1)=vectube(1)-tubecenter(1)
20030 vectube(2)=vectube(2)-tubecenter(2)
20031 vectube(3)=vectube(3)-tubecenter(3)
20032 !C now calculte the distance
20033 tub_r=dsqrt(vectube(1)**2+vectube(2)**2+vectube(3)**2)
20034 !C now normalize vector
20035 vectube(1)=vectube(1)/tub_r
20036 vectube(2)=vectube(2)/tub_r
20037 vectube(3)=vectube(3)/tub_r
20039 !C calculte rdiffrence between r and r0
20042 rdiff6=rdiff**6.0d0
20043 sc_aa_tube=sc_aa_tube_par(iti)
20044 sc_bb_tube=sc_bb_tube_par(iti)
20045 enetube(i+nres)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
20046 !C enetube(i+nres)=0.0d0
20047 !C pep_aa_tube and pep_bb_tube are precomputed values A=4eps*sigma^12 B=4eps*sigma^6
20048 !C now we calculate gradient
20049 fac=-12.0d0*sc_aa_tube/rdiff6**2.0d0/rdiff- &
20050 6.0d0*sc_bb_tube/rdiff6/rdiff
20052 !C now direction of gg_tube vector
20053 !C Now cavity term E=a(x+bsqrt(x)+c)/(1+dx^12)
20054 if (acavtub(iti).eq.0.0d0) then
20056 enecavtube(i+nres)=0.0d0
20059 denominator=(1.0d0+dcavtub(iti)*rdiff6*rdiff6)
20060 enecavtube(i+nres)= &
20061 (bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff)+ccavtub(iti)) &
20063 !C enecavtube(i)=0.0
20064 faccav=((bcavtub(iti)*1.0d0+acavtub(iti)/2.0d0/dsqrt(rdiff)) &
20065 *denominator-(bcavtub(iti)*rdiff+acavtub(iti)*dsqrt(rdiff) &
20066 +ccavtub(iti))*rdiff6**2.0d0/rdiff*dcavtub(iti)*12.0d0) &
20067 /denominator**2.0d0
20072 !C print *,"TUT",i,iti,rdiff,rdiff6,acavtub(iti),denominator,
20073 !C & enecavtube(i),faccav
20074 !C print *,"licz=",
20075 !C & (bcavtub(iti)*rdiff+acavtub(iti)*sqrt(rdiff)+ccavtub(iti))
20076 !C print *,"finene=",enetube(i+nres)+enecavtube(i)
20078 gg_tube_SC(j,i)=gg_tube_SC(j,i)+vectube(j)*fac
20079 gg_tube(j,i-1)=gg_tube(j,i-1)+vectube(j)*fac
20081 if (energy_dec) write(iout,*),i,rdiff,enetube(i+nres),enecavtube(i+nres)
20086 do i=itube_start,itube_end
20087 Etube=Etube+enetube(i)+enetube(i+nres)+enecavtube(i) &
20088 +enecavtube(i+nres)
20091 ! print *,"begin", i,"a"
20094 ! rdiff6=rdiff**6.0d0
20095 ! sc_aa_tube=sc_aa_tube_par(i)
20096 ! sc_bb_tube=sc_bb_tube_par(i)
20097 ! enetube(i)=sc_aa_tube/rdiff6**2.0d0+sc_bb_tube/rdiff6
20098 ! denominator=(1.0d0+dcavtub(i)*rdiff6*rdiff6)
20100 ! (bcavtub(i)*rdiff+acavtub(i)*dsqrt(rdiff)+ccavtub(i)) &
20103 ! print '(5(f10.3,1x))',rdiff,enetube(i),enecavtube(i),enecavtube(i)+enetube(i)
20105 ! print *,"end",i,"a"
20107 !C print *,"ETUBE", etube
20109 end subroutine calcnano
20111 !===============================================
20112 !--------------------------------------------------------------------------------
20113 !C first for shielding is setting of function of side-chains
20115 subroutine set_shield_fac2
20116 real(kind=8) :: div77_81=0.974996043d0, &
20117 div4_81=0.2222222222d0
20118 real (kind=8) :: dist_pep_side,dist_side_calf,dist_pept_group, &
20119 scale_fac_dist,fac_help_scale,VofOverlap,VolumeTotal,costhet,&
20120 short,long,sinthet,costhet_fac,sh_frac_dist,rkprim,cosphi, &
20121 sinphi,cosphi_fac,pep_side0pept_group,cosalfa,fac_alfa_sin
20122 !C the vector between center of side_chain and peptide group
20123 real(kind=8),dimension(3) :: pep_side_long,side_calf, &
20124 pept_group,costhet_grad,cosphi_grad_long, &
20125 cosphi_grad_loc,pep_side_norm,side_calf_norm, &
20126 sh_frac_dist_grad,pep_side
20128 !C write(2,*) "ivec",ivec_start,ivec_end
20130 fac_shield(i)=0.0d0
20133 grad_shield(j,i)=0.0d0
20136 do i=ivec_start,ivec_end
20138 !C if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
20139 ! ishield_list(i)=0
20140 if ((itype(i,1).eq.ntyp1).and.itype(i+1,1).eq.ntyp1) cycle
20141 !Cif there two consequtive dummy atoms there is no peptide group between them
20142 !C the line below has to be changed for FGPROC>1
20145 if ((itype(k,1).eq.ntyp1).or.(itype(k,1).eq.10)) cycle
20149 !C first lets set vector conecting the ithe side-chain with kth side-chain
20150 pep_side(j)=c(j,k+nres)-(c(j,i)+c(j,i+1))/2.0d0
20151 !C pep_side(j)=2.0d0
20152 !C and vector conecting the side-chain with its proper calfa
20153 side_calf(j)=c(j,k+nres)-c(j,k)
20154 !C side_calf(j)=2.0d0
20155 pept_group(j)=c(j,i)-c(j,i+1)
20156 !C lets have their lenght
20157 dist_pep_side=pep_side(j)**2+dist_pep_side
20158 dist_side_calf=dist_side_calf+side_calf(j)**2
20159 dist_pept_group=dist_pept_group+pept_group(j)**2
20161 dist_pep_side=sqrt(dist_pep_side)
20162 dist_pept_group=sqrt(dist_pept_group)
20163 dist_side_calf=sqrt(dist_side_calf)
20165 pep_side_norm(j)=pep_side(j)/dist_pep_side
20166 side_calf_norm(j)=dist_side_calf
20168 !C now sscale fraction
20169 sh_frac_dist=-(dist_pep_side-rpp(1,1)-buff_shield)/buff_shield
20170 ! print *,buff_shield,"buff",sh_frac_dist
20172 if (sh_frac_dist.le.0.0) cycle
20173 !C print *,ishield_list(i),i
20174 !C If we reach here it means that this side chain reaches the shielding sphere
20175 !C Lets add him to the list for gradient
20176 ishield_list(i)=ishield_list(i)+1
20177 !C ishield_list is a list of non 0 side-chain that contribute to factor gradient
20178 !C this list is essential otherwise problem would be O3
20179 shield_list(ishield_list(i),i)=k
20180 !C Lets have the sscale value
20181 if (sh_frac_dist.gt.1.0) then
20182 scale_fac_dist=1.0d0
20184 sh_frac_dist_grad(j)=0.0d0
20187 scale_fac_dist=-sh_frac_dist*sh_frac_dist &
20188 *(2.0d0*sh_frac_dist-3.0d0)
20189 fac_help_scale=6.0d0*(sh_frac_dist-sh_frac_dist**2) &
20190 /dist_pep_side/buff_shield*0.5d0
20192 sh_frac_dist_grad(j)=fac_help_scale*pep_side(j)
20193 !C sh_frac_dist_grad(j)=0.0d0
20194 !C scale_fac_dist=1.0d0
20195 !C print *,"jestem",scale_fac_dist,fac_help_scale,
20196 !C & sh_frac_dist_grad(j)
20199 !C this is what is now we have the distance scaling now volume...
20200 short=short_r_sidechain(itype(k,1))
20201 long=long_r_sidechain(itype(k,1))
20202 costhet=1.0d0/dsqrt(1.0d0+short**2/dist_pep_side**2)
20203 sinthet=short/dist_pep_side*costhet
20204 ! print *,"SORT",short,long,sinthet,costhet
20205 !C now costhet_grad
20208 costhet_fac=costhet**3*short**2*(-0.5d0)/dist_pep_side**4
20209 !C sinthet_fac=costhet**2*0.5d0*(short**3/dist_pep_side**4*costhet
20210 !C & -short/dist_pep_side**2/costhet)
20211 !C costhet_fac=0.0d0
20213 costhet_grad(j)=costhet_fac*pep_side(j)
20215 !C remember for the final gradient multiply costhet_grad(j)
20216 !C for side_chain by factor -2 !
20217 !C fac alfa is angle between CB_k,CA_k, CA_i,CA_i+1
20218 !C pep_side0pept_group is vector multiplication
20219 pep_side0pept_group=0.0d0
20221 pep_side0pept_group=pep_side0pept_group+pep_side(j)*side_calf(j)
20223 cosalfa=(pep_side0pept_group/ &
20224 (dist_pep_side*dist_side_calf))
20225 fac_alfa_sin=1.0d0-cosalfa**2
20226 fac_alfa_sin=dsqrt(fac_alfa_sin)
20227 rkprim=fac_alfa_sin*(long-short)+short
20230 !C now costhet_grad
20231 cosphi=1.0d0/dsqrt(1.0d0+rkprim**2/dist_pep_side**2)
20233 cosphi_fac=cosphi**3*rkprim**2*(-0.5d0)/dist_pep_side**4
20234 sinphi=rkprim/dist_pep_side/dsqrt(1.0d0+rkprim**2/ &
20238 cosphi_grad_long(j)=cosphi_fac*pep_side(j) &
20239 +cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
20240 *(long-short)/fac_alfa_sin*cosalfa/ &
20241 ((dist_pep_side*dist_side_calf))* &
20242 ((side_calf(j))-cosalfa* &
20243 ((pep_side(j)/dist_pep_side)*dist_side_calf))
20244 !C cosphi_grad_long(j)=0.0d0
20245 cosphi_grad_loc(j)=cosphi**3*0.5d0/dist_pep_side**2*(-rkprim) &
20246 *(long-short)/fac_alfa_sin*cosalfa &
20247 /((dist_pep_side*dist_side_calf))* &
20249 cosalfa*side_calf(j)/dist_side_calf*dist_pep_side)
20250 !C cosphi_grad_loc(j)=0.0d0
20252 !C print *,sinphi,sinthet
20253 VofOverlap=VSolvSphere/2.0d0*(1.0d0-dsqrt(1.0d0-sinphi*sinthet)) &
20256 !C now the gradient...
20258 grad_shield(j,i)=grad_shield(j,i) &
20259 !C gradient po skalowaniu
20260 +(sh_frac_dist_grad(j)*VofOverlap &
20261 !C gradient po costhet
20262 +scale_fac_dist*VSolvSphere/VSolvSphere_div/4.0d0* &
20263 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*( &
20264 sinphi/sinthet*costhet*costhet_grad(j) &
20265 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
20267 !C grad_shield_side is Cbeta sidechain gradient
20268 grad_shield_side(j,ishield_list(i),i)=&
20269 (sh_frac_dist_grad(j)*-2.0d0&
20271 -scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
20272 (1.0d0/(-dsqrt(1.0d0-sinphi*sinthet))*(&
20273 sinphi/sinthet*costhet*costhet_grad(j)&
20274 +sinthet/sinphi*cosphi*cosphi_grad_long(j))) &
20276 ! print *, 1.0d0/(-dsqrt(1.0d0-sinphi*sinthet)),&
20278 ! +sinthet/sinphi,"HERE"
20279 grad_shield_loc(j,ishield_list(i),i)= &
20280 scale_fac_dist*VSolvSphere/VSolvSphere_div/2.0d0*&
20281 (1.0d0/(dsqrt(1.0d0-sinphi*sinthet))*(&
20282 sinthet/sinphi*cosphi*cosphi_grad_loc(j)&
20285 ! print *,grad_shield_loc(j,ishield_list(i),i)
20287 VolumeTotal=VolumeTotal+VofOverlap*scale_fac_dist
20289 fac_shield(i)=VolumeTotal*wshield+(1.0d0-wshield)
20291 ! write(2,*) "TOTAL VOLUME",i,itype(i,1),fac_shield(i)
20294 end subroutine set_shield_fac2
20295 !----------------------------------------------------------------------------
20296 ! SOUBROUTINE FOR AFM
20297 subroutine AFMvel(Eafmforce)
20298 use MD_data, only:totTafm
20299 real(kind=8),dimension(3) :: diffafm
20300 real(kind=8) :: afmdist,Eafmforce
20302 !C Only for check grad COMMENT if not used for checkgrad
20304 !C--------------------------------------------------------
20305 !C print *,"wchodze"
20309 diffafm(i)=c(i,afmend)-c(i,afmbeg)
20310 afmdist=afmdist+diffafm(i)**2
20312 afmdist=dsqrt(afmdist)
20314 Eafmforce=0.5d0*forceAFMconst &
20315 *(distafminit+totTafm*velAFMconst-afmdist)**2
20316 !C Eafmforce=-forceAFMconst*(dist-distafminit)
20318 gradafm(i,afmend-1)=-forceAFMconst* &
20319 (distafminit+totTafm*velAFMconst-afmdist) &
20320 *diffafm(i)/afmdist
20321 gradafm(i,afmbeg-1)=forceAFMconst* &
20322 (distafminit+totTafm*velAFMconst-afmdist) &
20323 *diffafm(i)/afmdist
20325 ! print *,'AFM',Eafmforce,totTafm*velAFMconst,afmdist
20327 end subroutine AFMvel
20328 !---------------------------------------------------------
20329 subroutine AFMforce(Eafmforce)
20331 real(kind=8),dimension(3) :: diffafm
20332 ! real(kind=8) ::afmdist
20333 real(kind=8) :: afmdist,Eafmforce
20338 diffafm(i)=c(i,afmend)-c(i,afmbeg)
20339 afmdist=afmdist+diffafm(i)**2
20341 afmdist=dsqrt(afmdist)
20342 ! print *,afmdist,distafminit
20343 Eafmforce=-forceAFMconst*(afmdist-distafminit)
20345 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/afmdist
20346 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/afmdist
20348 !C print *,'AFM',Eafmforce
20350 end subroutine AFMforce
20352 !-----------------------------------------------------------------------------
20354 subroutine read_ssHist
20357 ! include 'DIMENSIONS'
20358 ! include "DIMENSIONS.FREE"
20359 ! include 'COMMON.FREE'
20362 character(len=80) :: controlcard
20365 call card_concat(controlcard,.true.)
20366 read(controlcard,*) &
20367 dyn_ssHist(i,0),(dyn_ssHist(i,j),j=1,2*dyn_ssHist(i,0))
20371 end subroutine read_ssHist
20373 !-----------------------------------------------------------------------------
20374 integer function indmat(i,j)
20376 ! get the position of the jth ijth fragment of the chain coordinate system
20377 ! in the fromto array.
20380 indmat=((2*(nres-2)-i)*(i-1))/2+j-1
20382 end function indmat
20383 !-----------------------------------------------------------------------------
20384 real(kind=8) function sigm(x)
20390 !-----------------------------------------------------------------------------
20391 !-----------------------------------------------------------------------------
20392 subroutine alloc_ener_arrays
20393 !EL Allocation of arrays used by module energy
20394 use MD_data, only: mset
20395 !el local variables
20398 if(nres.lt.100) then
20400 elseif(nres.lt.200) then
20401 maxconts=0.8*nres ! Max. number of contacts per residue
20403 maxconts=0.6*nres ! (maxconts=maxres/4)
20405 maxcont=12*nres ! Max. number of SC contacts
20406 maxvar=6*nres ! Max. number of variables
20407 !el maxdim=(nres-1)*(nres-2)/2 ! Max. number of derivatives of virtual-bond
20408 maxdim=nres*(nres-2)/2 ! Max. number of derivatives of virtual-bond
20409 !----------------------
20410 ! arrays in subroutine init_int_table
20412 !el allocate(itask_cont_from(0:nfgtasks-1)) !(0:max_fg_procs-1)
20413 !el allocate(itask_cont_to(0:nfgtasks-1)) !(0:max_fg_procs-1)
20415 allocate(nint_gr(nres))
20416 allocate(nscp_gr(nres))
20417 allocate(ielstart(nres))
20418 allocate(ielend(nres))
20420 allocate(istart(nres,maxint_gr))
20421 allocate(iend(nres,maxint_gr))
20422 !(maxres,maxint_gr)
20423 allocate(iscpstart(nres,maxint_gr))
20424 allocate(iscpend(nres,maxint_gr))
20425 !(maxres,maxint_gr)
20426 allocate(ielstart_vdw(nres))
20427 allocate(ielend_vdw(nres))
20429 allocate(nint_gr_nucl(nres))
20430 allocate(nscp_gr_nucl(nres))
20431 allocate(ielstart_nucl(nres))
20432 allocate(ielend_nucl(nres))
20434 allocate(istart_nucl(nres,maxint_gr))
20435 allocate(iend_nucl(nres,maxint_gr))
20436 !(maxres,maxint_gr)
20437 allocate(iscpstart_nucl(nres,maxint_gr))
20438 allocate(iscpend_nucl(nres,maxint_gr))
20439 !(maxres,maxint_gr)
20440 allocate(ielstart_vdw_nucl(nres))
20441 allocate(ielend_vdw_nucl(nres))
20443 allocate(lentyp(0:nfgtasks-1))
20445 !----------------------
20447 ! common /contacts/
20448 if(.not.allocated(icont_ref)) allocate(icont_ref(2,maxcont))
20449 allocate(icont(2,maxcont))
20451 ! common /contacts1/
20452 allocate(num_cont(0:nres+4))
20454 allocate(jcont(maxconts,nres))
20456 allocate(facont(maxconts,nres))
20458 allocate(gacont(3,maxconts,nres))
20459 !(3,maxconts,maxres)
20460 ! common /contacts_hb/
20461 allocate(gacontp_hb1(3,maxconts,nres))
20462 allocate(gacontp_hb2(3,maxconts,nres))
20463 allocate(gacontp_hb3(3,maxconts,nres))
20464 allocate(gacontm_hb1(3,maxconts,nres))
20465 allocate(gacontm_hb2(3,maxconts,nres))
20466 allocate(gacontm_hb3(3,maxconts,nres))
20467 allocate(gacont_hbr(3,maxconts,nres))
20468 allocate(grij_hb_cont(3,maxconts,nres))
20469 !(3,maxconts,maxres)
20470 allocate(facont_hb(maxconts,nres))
20472 allocate(ees0p(maxconts,nres))
20473 allocate(ees0m(maxconts,nres))
20474 allocate(d_cont(maxconts,nres))
20475 allocate(ees0plist(maxconts,nres))
20478 allocate(num_cont_hb(nres))
20480 allocate(jcont_hb(maxconts,nres))
20483 allocate(Ug(2,2,nres))
20484 allocate(Ugder(2,2,nres))
20485 allocate(Ug2(2,2,nres))
20486 allocate(Ug2der(2,2,nres))
20488 allocate(obrot(2,nres))
20489 allocate(obrot2(2,nres))
20490 allocate(obrot_der(2,nres))
20491 allocate(obrot2_der(2,nres))
20493 ! common /precomp1/
20494 allocate(mu(2,nres))
20495 allocate(muder(2,nres))
20496 allocate(Ub2(2,nres))
20499 allocate(Ub2der(2,nres))
20500 allocate(Ctobr(2,nres))
20501 allocate(Ctobrder(2,nres))
20502 allocate(Dtobr2(2,nres))
20503 allocate(Dtobr2der(2,nres))
20505 allocate(EUg(2,2,nres))
20506 allocate(EUgder(2,2,nres))
20507 allocate(CUg(2,2,nres))
20508 allocate(CUgder(2,2,nres))
20509 allocate(DUg(2,2,nres))
20510 allocate(Dugder(2,2,nres))
20511 allocate(DtUg2(2,2,nres))
20512 allocate(DtUg2der(2,2,nres))
20514 ! common /precomp2/
20515 allocate(Ug2Db1t(2,nres))
20516 allocate(Ug2Db1tder(2,nres))
20517 allocate(CUgb2(2,nres))
20518 allocate(CUgb2der(2,nres))
20520 allocate(EUgC(2,2,nres))
20521 allocate(EUgCder(2,2,nres))
20522 allocate(EUgD(2,2,nres))
20523 allocate(EUgDder(2,2,nres))
20524 allocate(DtUg2EUg(2,2,nres))
20525 allocate(Ug2DtEUg(2,2,nres))
20527 allocate(Ug2DtEUgder(2,2,2,nres))
20528 allocate(DtUg2EUgder(2,2,2,nres))
20530 allocate(b1(2,nres)) !(2,-maxtor:maxtor)
20531 allocate(b2(2,nres)) !(2,-maxtor:maxtor)
20532 allocate(b1tilde(2,nres)) !(2,-maxtor:maxtor)
20533 allocate(b2tilde(2,nres)) !(2,-maxtor:maxtor)
20535 allocate(ctilde(2,2,nres))
20536 allocate(dtilde(2,2,nres)) !(2,2,-maxtor:maxtor)
20537 allocate(gtb1(2,nres))
20538 allocate(gtb2(2,nres))
20539 allocate(cc(2,2,nres))
20540 allocate(dd(2,2,nres))
20541 allocate(ee(2,2,nres))
20542 allocate(gtcc(2,2,nres))
20543 allocate(gtdd(2,2,nres))
20544 allocate(gtee(2,2,nres))
20545 allocate(gUb2(2,nres))
20546 allocate(gteUg(2,2,nres))
20548 ! common /rotat_old/
20549 allocate(costab(nres))
20550 allocate(sintab(nres))
20551 allocate(costab2(nres))
20552 allocate(sintab2(nres))
20555 allocate(a_chuj(2,2,maxconts,nres))
20556 !(2,2,maxconts,maxres)(maxconts=maxres/4)
20557 allocate(a_chuj_der(2,2,3,5,maxconts,nres))
20558 !(2,2,3,5,maxconts,maxres)(maxconts=maxres/4)
20559 ! common /contdistrib/
20560 allocate(ncont_sent(nres))
20561 allocate(ncont_recv(nres))
20563 allocate(iat_sent(nres))
20565 allocate(iint_sent(4,nres,nres))
20566 allocate(iint_sent_local(4,nres,nres))
20568 allocate(iturn3_sent(4,0:nres+4))
20569 allocate(iturn4_sent(4,0:nres+4))
20570 allocate(iturn3_sent_local(4,nres))
20571 allocate(iturn4_sent_local(4,nres))
20573 allocate(itask_cont_from(0:nfgtasks-1))
20574 allocate(itask_cont_to(0:nfgtasks-1))
20575 !(0:max_fg_procs-1)
20579 !----------------------
20582 allocate(dcdv(6,maxdim))
20583 allocate(dxdv(6,maxdim))
20585 allocate(dxds(6,nres))
20587 allocate(gradx(3,-1:nres,0:2))
20588 allocate(gradc(3,-1:nres,0:2))
20590 allocate(gvdwx(3,-1:nres))
20591 allocate(gvdwc(3,-1:nres))
20592 allocate(gelc(3,-1:nres))
20593 allocate(gelc_long(3,-1:nres))
20594 allocate(gvdwpp(3,-1:nres))
20595 allocate(gvdwc_scpp(3,-1:nres))
20596 allocate(gradx_scp(3,-1:nres))
20597 allocate(gvdwc_scp(3,-1:nres))
20598 allocate(ghpbx(3,-1:nres))
20599 allocate(ghpbc(3,-1:nres))
20600 allocate(gradcorr(3,-1:nres))
20601 allocate(gradcorr_long(3,-1:nres))
20602 allocate(gradcorr5_long(3,-1:nres))
20603 allocate(gradcorr6_long(3,-1:nres))
20604 allocate(gcorr6_turn_long(3,-1:nres))
20605 allocate(gradxorr(3,-1:nres))
20606 allocate(gradcorr5(3,-1:nres))
20607 allocate(gradcorr6(3,-1:nres))
20608 allocate(gliptran(3,-1:nres))
20609 allocate(gliptranc(3,-1:nres))
20610 allocate(gliptranx(3,-1:nres))
20611 allocate(gshieldx(3,-1:nres))
20612 allocate(gshieldc(3,-1:nres))
20613 allocate(gshieldc_loc(3,-1:nres))
20614 allocate(gshieldx_ec(3,-1:nres))
20615 allocate(gshieldc_ec(3,-1:nres))
20616 allocate(gshieldc_loc_ec(3,-1:nres))
20617 allocate(gshieldx_t3(3,-1:nres))
20618 allocate(gshieldc_t3(3,-1:nres))
20619 allocate(gshieldc_loc_t3(3,-1:nres))
20620 allocate(gshieldx_t4(3,-1:nres))
20621 allocate(gshieldc_t4(3,-1:nres))
20622 allocate(gshieldc_loc_t4(3,-1:nres))
20623 allocate(gshieldx_ll(3,-1:nres))
20624 allocate(gshieldc_ll(3,-1:nres))
20625 allocate(gshieldc_loc_ll(3,-1:nres))
20626 allocate(grad_shield(3,-1:nres))
20627 allocate(gg_tube_sc(3,-1:nres))
20628 allocate(gg_tube(3,-1:nres))
20629 allocate(gradafm(3,-1:nres))
20630 allocate(gradb_nucl(3,-1:nres))
20631 allocate(gradbx_nucl(3,-1:nres))
20632 allocate(gvdwpsb1(3,-1:nres))
20633 allocate(gelpp(3,-1:nres))
20634 allocate(gvdwpsb(3,-1:nres))
20635 allocate(gelsbc(3,-1:nres))
20636 allocate(gelsbx(3,-1:nres))
20637 allocate(gvdwsbx(3,-1:nres))
20638 allocate(gvdwsbc(3,-1:nres))
20639 allocate(gsbloc(3,-1:nres))
20640 allocate(gsblocx(3,-1:nres))
20641 allocate(gradcorr_nucl(3,-1:nres))
20642 allocate(gradxorr_nucl(3,-1:nres))
20643 allocate(gradcorr3_nucl(3,-1:nres))
20644 allocate(gradxorr3_nucl(3,-1:nres))
20645 allocate(gvdwpp_nucl(3,-1:nres))
20646 allocate(gradpepcat(3,-1:nres))
20647 allocate(gradpepcatx(3,-1:nres))
20648 allocate(gradcatcat(3,-1:nres))
20650 allocate(grad_shield_side(3,maxcontsshi,-1:nres))
20651 allocate(grad_shield_loc(3,maxcontsshi,-1:nres))
20652 ! grad for shielding surroing
20653 allocate(gloc(0:maxvar,0:2))
20654 allocate(gloc_x(0:maxvar,2))
20656 allocate(gel_loc(3,-1:nres))
20657 allocate(gel_loc_long(3,-1:nres))
20658 allocate(gcorr3_turn(3,-1:nres))
20659 allocate(gcorr4_turn(3,-1:nres))
20660 allocate(gcorr6_turn(3,-1:nres))
20661 allocate(gradb(3,-1:nres))
20662 allocate(gradbx(3,-1:nres))
20664 allocate(gel_loc_loc(maxvar))
20665 allocate(gel_loc_turn3(maxvar))
20666 allocate(gel_loc_turn4(maxvar))
20667 allocate(gel_loc_turn6(maxvar))
20668 allocate(gcorr_loc(maxvar))
20669 allocate(g_corr5_loc(maxvar))
20670 allocate(g_corr6_loc(maxvar))
20672 allocate(gsccorc(3,-1:nres))
20673 allocate(gsccorx(3,-1:nres))
20675 allocate(gsccor_loc(-1:nres))
20677 allocate(gvdwx_scbase(3,-1:nres))
20678 allocate(gvdwc_scbase(3,-1:nres))
20679 allocate(gvdwx_pepbase(3,-1:nres))
20680 allocate(gvdwc_pepbase(3,-1:nres))
20681 allocate(gvdwx_scpho(3,-1:nres))
20682 allocate(gvdwc_scpho(3,-1:nres))
20683 allocate(gvdwc_peppho(3,-1:nres))
20685 allocate(dtheta(3,2,-1:nres))
20687 allocate(gscloc(3,-1:nres))
20688 allocate(gsclocx(3,-1:nres))
20690 allocate(dphi(3,3,-1:nres))
20691 allocate(dalpha(3,3,-1:nres))
20692 allocate(domega(3,3,-1:nres))
20694 ! common /deriv_scloc/
20695 allocate(dXX_C1tab(3,nres))
20696 allocate(dYY_C1tab(3,nres))
20697 allocate(dZZ_C1tab(3,nres))
20698 allocate(dXX_Ctab(3,nres))
20699 allocate(dYY_Ctab(3,nres))
20700 allocate(dZZ_Ctab(3,nres))
20701 allocate(dXX_XYZtab(3,nres))
20702 allocate(dYY_XYZtab(3,nres))
20703 allocate(dZZ_XYZtab(3,nres))
20706 allocate(jgrad_start(nres))
20707 allocate(jgrad_end(nres))
20709 !----------------------
20712 allocate(ibond_displ(0:nfgtasks-1))
20713 allocate(ibond_count(0:nfgtasks-1))
20714 allocate(ithet_displ(0:nfgtasks-1))
20715 allocate(ithet_count(0:nfgtasks-1))
20716 allocate(iphi_displ(0:nfgtasks-1))
20717 allocate(iphi_count(0:nfgtasks-1))
20718 allocate(iphi1_displ(0:nfgtasks-1))
20719 allocate(iphi1_count(0:nfgtasks-1))
20720 allocate(ivec_displ(0:nfgtasks-1))
20721 allocate(ivec_count(0:nfgtasks-1))
20722 allocate(iset_displ(0:nfgtasks-1))
20723 allocate(iset_count(0:nfgtasks-1))
20724 allocate(iint_count(0:nfgtasks-1))
20725 allocate(iint_displ(0:nfgtasks-1))
20726 !(0:max_fg_procs-1)
20727 !----------------------
20730 allocate(gcart(3,-1:nres))
20731 allocate(gxcart(3,-1:nres))
20733 allocate(gradcag(3,-1:nres))
20734 allocate(gradxag(3,-1:nres))
20736 ! common /back_constr/
20737 !el in energy:Econstr_back allocate((:),allocatable :: utheta,ugamma,uscdiff !(maxfrag_back)
20738 allocate(dutheta(nres))
20739 allocate(dugamma(nres))
20741 allocate(duscdiff(3,nres))
20742 allocate(duscdiffx(3,nres))
20744 !el i io:read_fragments
20745 ! allocate((:,:,:),allocatable :: wfrag_back !(3,maxfrag_back,maxprocs/20)
20746 ! allocate((:,:,:),allocatable :: ifrag_back !(3,maxfrag_back,maxprocs/20)
20748 ! allocate(qinfrag(50,nprocs/20),wfrag(50,nprocs/20)) !(50,maxprocs/20)
20749 ! allocate(qinpair(100,nprocs/20),wpair(100,nprocs/20)) !(100,maxprocs/20)
20750 allocate(mset(0:nprocs)) !(maxprocs/20)
20752 ! allocate(ifrag(2,50,nprocs/20)) !(2,50,maxprocs/20)
20753 ! allocate(ipair(2,100,nprocs/20)) !(2,100,maxprocs/20)
20754 allocate(dUdconst(3,0:nres))
20755 allocate(dUdxconst(3,0:nres))
20756 allocate(dqwol(3,0:nres))
20757 allocate(dxqwol(3,0:nres))
20759 !----------------------
20761 ! common /sbridge/ in io_common: read_bridge
20762 !el allocate((:),allocatable :: iss !(maxss)
20763 ! common /links/ in io_common: read_bridge
20764 !el real(kind=8),dimension(:),allocatable :: dhpb,forcon,dhpb1 !(maxdim) !el dhpb1 !!! nie używane
20765 !el integer,dimension(:),allocatable :: ihpb,jhpb,ibecarb !(maxdim) !el ibecarb !!! nie używane
20766 ! common /dyn_ssbond/
20767 ! and side-chain vectors in theta or phi.
20768 allocate(dyn_ssbond_ij(0:nres+4,0:nres+4))
20772 dyn_ssbond_ij(:,:)=1.0d300
20776 ! if (nss.gt.0) then
20777 allocate(idssb(maxdim),jdssb(maxdim))
20778 ! allocate(newihpb(nss),newjhpb(nss))
20781 allocate(ishield_list(-1:nres))
20782 allocate(shield_list(maxcontsshi,-1:nres))
20783 allocate(dyn_ss_mask(nres))
20784 allocate(fac_shield(-1:nres))
20785 allocate(enetube(nres*2))
20786 allocate(enecavtube(nres*2))
20789 dyn_ss_mask(:)=.false.
20790 !----------------------
20792 ! Parameters of the SCCOR term
20794 !el in io_conf: parmread
20795 ! allocate(v1sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp))
20796 ! allocate(v2sccor(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,3,-ntyp:ntyp,-ntyp:ntyp)
20797 ! allocate(v0sccor(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)) !(maxterm_sccor,-ntyp:ntyp,-ntyp:ntyp)
20798 ! allocate(isccortyp(-ntyp:ntyp)) !(-ntyp:ntyp)
20799 ! allocate(nterm_sccor(-ntyp:ntyp,-ntyp:ntyp))
20800 ! allocate(nlor_sccor(-ntyp:ntyp,-ntyp:ntyp)) !(-ntyp:ntyp,-ntyp:ntyp)
20801 ! allocate(vlor1sccor(maxterm_sccor,20,20))
20802 ! allocate(vlor2sccor(maxterm_sccor,20,20))
20803 ! allocate(vlor3sccor(maxterm_sccor,20,20)) !(maxterm_sccor,20,20)
20805 allocate(gloc_sc(3,0:2*nres,0:10))
20806 !(3,0:maxres2,10)maxres2=2*maxres
20807 allocate(dcostau(3,3,3,2*nres))
20808 allocate(dsintau(3,3,3,2*nres))
20809 allocate(dtauangle(3,3,3,2*nres))
20810 allocate(dcosomicron(3,3,3,2*nres))
20811 allocate(domicron(3,3,3,2*nres))
20812 !(3,3,3,maxres2)maxres2=2*maxres
20813 !----------------------
20816 allocate(varall(maxvar))
20817 !(maxvar)(maxvar=6*maxres)
20818 allocate(mask_theta(nres))
20819 allocate(mask_phi(nres))
20820 allocate(mask_side(nres))
20822 !----------------------
20825 allocate(uy(3,nres))
20826 allocate(uz(3,nres))
20828 allocate(uygrad(3,3,2,nres))
20829 allocate(uzgrad(3,3,2,nres))
20833 end subroutine alloc_ener_arrays
20834 !-----------------------------------------------------------------
20835 subroutine ebond_nucl(estr_nucl)
20837 !c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
20840 real(kind=8),dimension(3) :: u,ud
20841 real(kind=8) :: usum,uprod,uprod1,uprod2,usumsqder
20842 real(kind=8) :: estr_nucl,diff
20843 integer :: iti,i,j,k,nbi
20845 !C print *,"I enter ebond"
20847 write (iout,*) "ibondp_start,ibondp_end",&
20848 ibondp_nucl_start,ibondp_nucl_end
20849 do i=ibondp_nucl_start,ibondp_nucl_end
20850 if (itype(i-1,2).eq.ntyp1_molec(2) .or. &
20851 itype(i,2).eq.ntyp1_molec(2)) cycle
20852 ! estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
20854 ! gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
20855 ! & *dc(j,i-1)/vbld(i)
20857 ! if (energy_dec) write(iout,*)
20858 ! & "estr1",i,vbld(i),distchainmax,
20859 ! & gnmr1(vbld(i),-1.0d0,distchainmax)
20861 diff = vbld(i)-vbldp0_nucl
20862 if(energy_dec)write(iout,*) "estr_nucl_bb" , i,vbld(i),&
20863 vbldp0_nucl,diff,AKP_nucl*diff*diff
20864 estr_nucl=estr_nucl+diff*diff
20865 ! print *,estr_nucl
20867 gradb_nucl(j,i-1)=AKP_nucl*diff*dc(j,i-1)/vbld(i)
20869 !c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
20871 estr_nucl=0.5d0*AKP_nucl*estr_nucl
20872 ! print *,"partial sum", estr_nucl,AKP_nucl
20875 write (iout,*) "ibondp_start,ibondp_end",&
20876 ibond_nucl_start,ibond_nucl_end
20878 do i=ibond_nucl_start,ibond_nucl_end
20879 !C print *, "I am stuck",i
20881 if (iti.eq.ntyp1_molec(2)) cycle
20882 nbi=nbondterm_nucl(iti)
20885 diff=vbld(i+nres)-vbldsc0_nucl(1,iti)
20888 write (iout,*) "estr_nucl_sc", i,iti,vbld(i+nres),vbldsc0_nucl(1,iti),diff, &
20889 AKSC_nucl(1,iti),AKSC_nucl(1,iti)*diff*diff
20890 estr_nucl=estr_nucl+0.5d0*AKSC_nucl(1,iti)*diff*diff
20891 ! print *,estr_nucl
20893 gradbx_nucl(j,i)=AKSC_nucl(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
20897 diff=vbld(i+nres)-vbldsc0_nucl(j,iti)
20898 ud(j)=aksc_nucl(j,iti)*diff
20899 u(j)=abond0_nucl(j,iti)+0.5d0*ud(j)*diff
20913 uprod2=uprod2*u(k)*u(k)
20917 usumsqder=usumsqder+ud(j)*uprod2
20919 estr_nucl=estr_nucl+uprod/usum
20921 gradbx_nucl(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
20925 !C print *,"I am about to leave ebond"
20927 end subroutine ebond_nucl
20929 !-----------------------------------------------------------------------------
20930 subroutine ebend_nucl(etheta_nucl)
20931 real(kind=8),dimension(nntheterm_nucl+1) :: coskt,sinkt !mmaxtheterm
20932 real(kind=8),dimension(nsingle_nucl+1) :: cosph1,sinph1,cosph2,sinph2 !maxsingle
20933 real(kind=8),dimension(ndouble_nucl+1,ndouble_nucl+1) :: cosph1ph2,sinph1ph2 !maxdouble,maxdouble
20934 logical :: lprn=.false., lprn1=.false.
20935 !el local variables
20936 integer :: i,k,iblock,ityp1,ityp2,ityp3,l,m
20937 real(kind=8) :: dethetai,dephii,dephii1,theti2,phii,phii1,ethetai
20938 real(kind=8) :: aux,etheta_nucl,ccl,ssl,scl,csl,ethetacnstr
20939 ! local variables for constrains
20940 real(kind=8) :: difi,thetiii
20943 ! print *,"ithet_start",ithet_nucl_start," ithet_end",ithet_nucl_end,nres
20944 do i=ithet_nucl_start,ithet_nucl_end
20945 if ((itype(i-1,2).eq.ntyp1_molec(2)).or.&
20946 (itype(i-2,2).eq.ntyp1_molec(2)).or. &
20947 (itype(i,2).eq.ntyp1_molec(2))) cycle
20951 theti2=0.5d0*theta(i)
20952 ityp2=ithetyp_nucl(itype(i-1,2))
20953 do k=1,nntheterm_nucl
20954 coskt(k)=dcos(k*theti2)
20955 sinkt(k)=dsin(k*theti2)
20957 if (i.gt.3 .and. itype(i-2,2).ne.ntyp1_molec(2)) then
20960 if (phii.ne.phii) phii=150.0
20964 ityp1=ithetyp_nucl(itype(i-2,2))
20965 do k=1,nsingle_nucl
20966 cosph1(k)=dcos(k*phii)
20967 sinph1(k)=dsin(k*phii)
20971 ityp1=nthetyp_nucl+1
20972 do k=1,nsingle_nucl
20978 if (i.lt.nres .and. itype(i,2).ne.ntyp1_molec(2)) then
20981 if (phii1.ne.phii1) phii1=150.0
20982 phii1=pinorm(phii1)
20986 ityp3=ithetyp_nucl(itype(i,2))
20987 do k=1,nsingle_nucl
20988 cosph2(k)=dcos(k*phii1)
20989 sinph2(k)=dsin(k*phii1)
20993 ityp3=nthetyp_nucl+1
20994 do k=1,nsingle_nucl
20999 ethetai=aa0thet_nucl(ityp1,ityp2,ityp3)
21000 do k=1,ndouble_nucl
21002 ccl=cosph1(l)*cosph2(k-l)
21003 ssl=sinph1(l)*sinph2(k-l)
21004 scl=sinph1(l)*cosph2(k-l)
21005 csl=cosph1(l)*sinph2(k-l)
21006 cosph1ph2(l,k)=ccl-ssl
21007 cosph1ph2(k,l)=ccl+ssl
21008 sinph1ph2(l,k)=scl+csl
21009 sinph1ph2(k,l)=scl-csl
21013 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,&
21014 " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
21015 write (iout,*) "coskt and sinkt",nntheterm_nucl
21016 do k=1,nntheterm_nucl
21017 write (iout,*) k,coskt(k),sinkt(k)
21020 do k=1,ntheterm_nucl
21021 ethetai=ethetai+aathet_nucl(k,ityp1,ityp2,ityp3)*sinkt(k)
21022 dethetai=dethetai+0.5d0*k*aathet_nucl(k,ityp1,ityp2,ityp3)&
21025 write (iout,*) "k",k," aathet",aathet_nucl(k,ityp1,ityp2,ityp3),&
21029 write (iout,*) "cosph and sinph"
21030 do k=1,nsingle_nucl
21031 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
21033 write (iout,*) "cosph1ph2 and sinph2ph2"
21034 do k=2,ndouble_nucl
21036 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),&
21037 sinph1ph2(l,k),sinph1ph2(k,l)
21040 write(iout,*) "ethetai",ethetai
21042 do m=1,ntheterm2_nucl
21043 do k=1,nsingle_nucl
21044 aux=bbthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)&
21045 +ccthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k)&
21046 +ddthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)&
21047 +eethet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k)
21048 ethetai=ethetai+sinkt(m)*aux
21049 dethetai=dethetai+0.5d0*m*aux*coskt(m)
21050 dephii=dephii+k*sinkt(m)*(&
21051 ccthet_nucl(k,m,ityp1,ityp2,ityp3)*cosph1(k)-&
21052 bbthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph1(k))
21053 dephii1=dephii1+k*sinkt(m)*(&
21054 eethet_nucl(k,m,ityp1,ityp2,ityp3)*cosph2(k)-&
21055 ddthet_nucl(k,m,ityp1,ityp2,ityp3)*sinph2(k))
21057 write (iout,*) "m",m," k",k," bbthet",&
21058 bbthet_nucl(k,m,ityp1,ityp2,ityp3)," ccthet",&
21059 ccthet_nucl(k,m,ityp1,ityp2,ityp3)," ddthet",&
21060 ddthet_nucl(k,m,ityp1,ityp2,ityp3)," eethet",&
21061 eethet_nucl(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
21065 write(iout,*) "ethetai",ethetai
21066 do m=1,ntheterm3_nucl
21067 do k=2,ndouble_nucl
21069 aux=ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
21070 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+&
21071 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
21072 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
21073 ethetai=ethetai+sinkt(m)*aux
21074 dethetai=dethetai+0.5d0*m*coskt(m)*aux
21075 dephii=dephii+l*sinkt(m)*(&
21076 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-&
21077 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
21078 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+&
21079 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
21080 dephii1=dephii1+(k-l)*sinkt(m)*( &
21081 -ffthet_nucl(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+&
21082 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+&
21083 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-&
21084 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
21086 write (iout,*) "m",m," k",k," l",l," ffthet", &
21087 ffthet_nucl(l,k,m,ityp1,ityp2,ityp3), &
21088 ffthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ggthet",&
21089 ggthet_nucl(l,k,m,ityp1,ityp2,ityp3),&
21090 ggthet_nucl(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
21091 write (iout,*) cosph1ph2(l,k)*sinkt(m), &
21092 cosph1ph2(k,l)*sinkt(m),&
21093 sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
21099 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)') &
21100 i,theta(i)*rad2deg,phii*rad2deg, &
21101 phii1*rad2deg,ethetai
21102 etheta_nucl=etheta_nucl+ethetai
21103 ! print *,i,"partial sum",etheta_nucl
21104 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang_nucl*dephii
21105 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang_nucl*dephii1
21106 gloc(nphi+i-2,icg)=wang_nucl*dethetai
21109 end subroutine ebend_nucl
21110 !----------------------------------------------------
21111 subroutine etor_nucl(etors_nucl)
21112 ! implicit real*8 (a-h,o-z)
21113 ! include 'DIMENSIONS'
21114 ! include 'COMMON.VAR'
21115 ! include 'COMMON.GEO'
21116 ! include 'COMMON.LOCAL'
21117 ! include 'COMMON.TORSION'
21118 ! include 'COMMON.INTERACT'
21119 ! include 'COMMON.DERIV'
21120 ! include 'COMMON.CHAIN'
21121 ! include 'COMMON.NAMES'
21122 ! include 'COMMON.IOUNITS'
21123 ! include 'COMMON.FFIELD'
21124 ! include 'COMMON.TORCNSTR'
21125 ! include 'COMMON.CONTROL'
21126 real(kind=8) :: etors_nucl,edihcnstr
21128 !el local variables
21129 integer :: i,j,iblock,itori,itori1
21130 real(kind=8) :: phii,gloci,v1ij,v2ij,cosphi,sinphi,&
21131 vl1ij,vl2ij,vl3ij,pom1,difi,etors_ii,pom
21132 ! Set lprn=.true. for debugging
21136 ! print *,"iphi_nucl_start/end", iphi_nucl_start,iphi_nucl_end
21137 do i=iphi_nucl_start,iphi_nucl_end
21138 if (itype(i-2,2).eq.ntyp1_molec(2) .or. itype(i-1,2).eq.ntyp1_molec(2) &
21139 .or. itype(i-3,2).eq.ntyp1_molec(2) &
21140 .or. itype(i,2).eq.ntyp1_molec(2)) cycle
21142 itori=itortyp_nucl(itype(i-2,2))
21143 itori1=itortyp_nucl(itype(i-1,2))
21145 ! print *,i,itori,itori1
21147 !C Regular cosine and sine terms
21148 do j=1,nterm_nucl(itori,itori1)
21149 v1ij=v1_nucl(j,itori,itori1)
21150 v2ij=v2_nucl(j,itori,itori1)
21151 cosphi=dcos(j*phii)
21152 sinphi=dsin(j*phii)
21153 etors_nucl=etors_nucl+v1ij*cosphi+v2ij*sinphi
21154 if (energy_dec) etors_ii=etors_ii+&
21155 v1ij*cosphi+v2ij*sinphi
21156 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
21160 !C E = SUM ----------------------------------- - v1
21161 !C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
21163 cosphi=dcos(0.5d0*phii)
21164 sinphi=dsin(0.5d0*phii)
21165 do j=1,nlor_nucl(itori,itori1)
21166 vl1ij=vlor1_nucl(j,itori,itori1)
21167 vl2ij=vlor2_nucl(j,itori,itori1)
21168 vl3ij=vlor3_nucl(j,itori,itori1)
21169 pom=vl2ij*cosphi+vl3ij*sinphi
21170 pom1=1.0d0/(pom*pom+1.0d0)
21171 etors_nucl=etors_nucl+vl1ij*pom1
21172 if (energy_dec) etors_ii=etors_ii+ &
21175 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
21177 !C Subtract the constant term
21178 etors_nucl=etors_nucl-v0_nucl(itori,itori1)
21179 if (energy_dec) write (iout,'(a6,i5,0pf7.3)') &
21180 'etor',i,etors_ii-v0_nucl(itori,itori1)
21182 write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)') &
21183 restyp(itype(i-2,2),2),i-2,restyp(itype(i-1,2),2),i-1,itori,itori1, &
21184 (v1_nucl(j,itori,itori1),j=1,6),(v2_nucl(j,itori,itori1),j=1,6)
21185 gloc(i-3,icg)=gloc(i-3,icg)+wtor_nucl*gloci
21186 !c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
21189 end subroutine etor_nucl
21190 !------------------------------------------------------------
21191 subroutine epp_nucl_sub(evdw1,ees)
21193 !C This subroutine calculates the average interaction energy and its gradient
21194 !C in the virtual-bond vectors between non-adjacent peptide groups, based on
21195 !C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
21196 !C The potential depends both on the distance of peptide-group centers and on
21197 !C the orientation of the CA-CA virtual bonds.
21199 integer :: i,j,k,iteli,itelj,num_conti,isubchap,ind
21200 real(kind=8) :: dxi,dyi,dzi,dxj,dyj,dzj,aaa,bbb
21201 real(kind=8) :: xj,yj,zj,rij,rrmij,sss,r3ij,r6ij,evdw1,&
21202 dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,&
21203 dx_normj,dy_normj,dz_normj,rmij,ev1,ev2,evdwij,facvdw
21204 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
21205 dist_temp, dist_init,sss_grad,fac,evdw1ij
21206 integer xshift,yshift,zshift
21207 real(kind=8),dimension(3):: ggg,gggp,gggm,erij
21208 real(kind=8) :: ees,eesij
21209 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
21210 real(kind=8) scal_el /0.5d0/
21216 !c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
21218 ! print *,"iatel_s_nucl,iatel_e_nucl",iatel_s_nucl,iatel_e_nucl
21219 do i=iatel_s_nucl,iatel_e_nucl
21220 if (itype(i,2).eq.ntyp1_molec(2) .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
21224 dx_normi=dc_norm(1,i)
21225 dy_normi=dc_norm(2,i)
21226 dz_normi=dc_norm(3,i)
21227 xmedi=c(1,i)+0.5d0*dxi
21228 ymedi=c(2,i)+0.5d0*dyi
21229 zmedi=c(3,i)+0.5d0*dzi
21230 xmedi=dmod(xmedi,boxxsize)
21231 if (xmedi.lt.0) xmedi=xmedi+boxxsize
21232 ymedi=dmod(ymedi,boxysize)
21233 if (ymedi.lt.0) ymedi=ymedi+boxysize
21234 zmedi=dmod(zmedi,boxzsize)
21235 if (zmedi.lt.0) zmedi=zmedi+boxzsize
21237 do j=ielstart_nucl(i),ielend_nucl(i)
21238 if (itype(j,2).eq.ntyp1_molec(2) .or. itype(j+1,2).eq.ntyp1_molec(2)) cycle
21243 ! xj=c(1,j)+0.5D0*dxj-xmedi
21244 ! yj=c(2,j)+0.5D0*dyj-ymedi
21245 ! zj=c(3,j)+0.5D0*dzj-zmedi
21246 xj=c(1,j)+0.5D0*dxj
21247 yj=c(2,j)+0.5D0*dyj
21248 zj=c(3,j)+0.5D0*dzj
21249 xj=mod(xj,boxxsize)
21250 if (xj.lt.0) xj=xj+boxxsize
21251 yj=mod(yj,boxysize)
21252 if (yj.lt.0) yj=yj+boxysize
21253 zj=mod(zj,boxzsize)
21254 if (zj.lt.0) zj=zj+boxzsize
21256 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
21263 xj=xj_safe+xshift*boxxsize
21264 yj=yj_safe+yshift*boxysize
21265 zj=zj_safe+zshift*boxzsize
21266 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
21267 if(dist_temp.lt.dist_init) then
21268 dist_init=dist_temp
21277 if (isubchap.eq.1) then
21288 rij=xj*xj+yj*yj+zj*zj
21289 !c write (2,*)"ij",i,j," r0pp",r0pp," rij",rij," epspp",epspp
21290 fac=(r0pp**2/rij)**3
21294 fac=(-ev1-evdw1ij)/rij
21295 ! write (2,*)"fac",fac," ev1",ev1," ev2",ev2," evdw1ij",evdw1ij
21296 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"evdw1ij",evdw1ij
21297 evdw1=evdw1+evdw1ij
21299 !C Calculate contributions to the Cartesian gradient.
21305 gvdwpp_nucl(k,i)=gvdwpp_nucl(k,i)-ggg(k)
21306 gvdwpp_nucl(k,j)=gvdwpp_nucl(k,j)+ggg(k)
21308 !c phoshate-phosphate electrostatic interactions
21311 eesij=dexp(-BEES*rij)*fac
21312 ! write (2,*)"fac",fac," eesijpp",eesij
21313 if (energy_dec) write(iout,'(2i5,a9,f10.4)') i,j,"eesijpp",eesij
21316 fac=-(fac+BEES)*eesij*fac
21320 !c write(2,*) "ggg",i,j,ggg(1),ggg(2),ggg(3)
21321 !c write(2,*) "gelpp",i,(gelpp(k,i),k=1,3)
21322 !c write(2,*) "gelpp",j,(gelpp(k,j),k=1,3)
21324 gelpp(k,i)=gelpp(k,i)-ggg(k)
21325 gelpp(k,j)=gelpp(k,j)+ggg(k)
21332 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
21334 gvdwpp_nucl(k,i)=6*gvdwpp_nucl(k,i)
21335 !c gelpp(k,i)=332.0d0*gelpp(k,i)
21336 gelpp(k,i)=AEES*gelpp(k,i)
21338 !c write (2,*) "i",i," gelpp",(gelpp(k,i),k=1,3)
21340 !c write (2,*) "total EES",ees
21342 end subroutine epp_nucl_sub
21343 !---------------------------------------------------------------------
21344 subroutine epsb(evdwpsb,eelpsb)
21347 !C This subroutine calculates the excluded-volume interaction energy between
21348 !C peptide-group centers and side chains and its gradient in virtual-bond and
21349 !C side-chain vectors.
21351 real(kind=8),dimension(3):: ggg
21352 integer :: i,iint,j,k,iteli,itypj,subchap
21353 real(kind=8) :: evdw2,evdw2_14,xi,yi,zi,xj,yj,zj,rrij,fac,&
21354 e1,e2,evdwij,rij,evdwpsb,eelpsb
21355 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
21356 dist_temp, dist_init
21357 integer xshift,yshift,zshift
21359 !cd print '(a)','Enter ESCP'
21360 !cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
21363 ! print *,"iatscp_s_nucl,iatscp_e_nucl",iatscp_s_nucl,iatscp_e_nucl
21364 do i=iatscp_s_nucl,iatscp_e_nucl
21365 if (itype(i,2).eq.ntyp1_molec(2) &
21366 .or. itype(i+1,2).eq.ntyp1_molec(2)) cycle
21367 xi=0.5D0*(c(1,i)+c(1,i+1))
21368 yi=0.5D0*(c(2,i)+c(2,i+1))
21369 zi=0.5D0*(c(3,i)+c(3,i+1))
21370 xi=mod(xi,boxxsize)
21371 if (xi.lt.0) xi=xi+boxxsize
21372 yi=mod(yi,boxysize)
21373 if (yi.lt.0) yi=yi+boxysize
21374 zi=mod(zi,boxzsize)
21375 if (zi.lt.0) zi=zi+boxzsize
21377 do iint=1,nscp_gr_nucl(i)
21379 do j=iscpstart_nucl(i,iint),iscpend_nucl(i,iint)
21381 if (itypj.eq.ntyp1_molec(2)) cycle
21382 !C Uncomment following three lines for SC-p interactions
21383 !c xj=c(1,nres+j)-xi
21384 !c yj=c(2,nres+j)-yi
21385 !c zj=c(3,nres+j)-zi
21386 !C Uncomment following three lines for Ca-p interactions
21393 xj=mod(xj,boxxsize)
21394 if (xj.lt.0) xj=xj+boxxsize
21395 yj=mod(yj,boxysize)
21396 if (yj.lt.0) yj=yj+boxysize
21397 zj=mod(zj,boxzsize)
21398 if (zj.lt.0) zj=zj+boxzsize
21399 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21407 xj=xj_safe+xshift*boxxsize
21408 yj=yj_safe+yshift*boxysize
21409 zj=zj_safe+zshift*boxzsize
21410 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21411 if(dist_temp.lt.dist_init) then
21412 dist_init=dist_temp
21421 if (subchap.eq.1) then
21431 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
21433 e1=fac*fac*aad_nucl(itypj)
21434 e2=fac*bad_nucl(itypj)
21435 if (iabs(j-i) .le. 2) then
21440 evdwpsb=evdwpsb+evdwij
21441 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a4)') &
21442 'evdw2',i,j,evdwij,"tu4"
21444 !C Calculate contributions to the gradient in the virtual-bond and SC vectors.
21446 fac=-(evdwij+e1)*rrij
21451 gvdwpsb1(k,i)=gvdwpsb1(k,i)-ggg(k)
21452 gvdwpsb(k,j)=gvdwpsb(k,j)+ggg(k)
21460 gvdwpsb(j,i)=expon*gvdwpsb(j,i)
21461 gvdwpsb1(j,i)=expon*gvdwpsb1(j,i)
21465 end subroutine epsb
21467 !------------------------------------------------------
21468 subroutine esb_gb(evdwsb,eelsb)
21471 integer :: iint,itypi,itypi1,itypj,subchap,num_conti2
21472 real(kind=8) :: xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
21473 real(kind=8) :: evdw,sig0iji,evdwsb,eelsb,ecorr,eelij
21474 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
21475 dist_temp, dist_init,aa,bb,faclip,sig0ij
21484 ! print *,"iastsc_nucl",iatsc_s_nucl,iatsc_e_nucl
21485 do i=iatsc_s_nucl,iatsc_e_nucl
21489 ! PRINT *,"I=",i,itypi
21490 if (itypi.eq.ntyp1_molec(2)) cycle
21491 itypi1=itype(i+1,2)
21495 xi=dmod(xi,boxxsize)
21496 if (xi.lt.0) xi=xi+boxxsize
21497 yi=dmod(yi,boxysize)
21498 if (yi.lt.0) yi=yi+boxysize
21499 zi=dmod(zi,boxzsize)
21500 if (zi.lt.0) zi=zi+boxzsize
21502 dxi=dc_norm(1,nres+i)
21503 dyi=dc_norm(2,nres+i)
21504 dzi=dc_norm(3,nres+i)
21505 dsci_inv=vbld_inv(i+nres)
21507 !C Calculate SC interaction energy.
21509 do iint=1,nint_gr_nucl(i)
21510 ! print *,"tu?",i,istart_nucl(i,iint),iend_nucl(i,iint)
21511 do j=istart_nucl(i,iint),iend_nucl(i,iint)
21515 if (itypj.eq.ntyp1_molec(2)) cycle
21516 dscj_inv=vbld_inv(j+nres)
21517 sig0ij=sigma_nucl(itypi,itypj)
21518 chi1=chi_nucl(itypi,itypj)
21519 chi2=chi_nucl(itypj,itypi)
21521 chip1=chip_nucl(itypi,itypj)
21522 chip2=chip_nucl(itypj,itypi)
21524 ! xj=c(1,nres+j)-xi
21525 ! yj=c(2,nres+j)-yi
21526 ! zj=c(3,nres+j)-zi
21530 xj=dmod(xj,boxxsize)
21531 if (xj.lt.0) xj=xj+boxxsize
21532 yj=dmod(yj,boxysize)
21533 if (yj.lt.0) yj=yj+boxysize
21534 zj=dmod(zj,boxzsize)
21535 if (zj.lt.0) zj=zj+boxzsize
21536 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21544 xj=xj_safe+xshift*boxxsize
21545 yj=yj_safe+yshift*boxysize
21546 zj=zj_safe+zshift*boxzsize
21547 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
21548 if(dist_temp.lt.dist_init) then
21549 dist_init=dist_temp
21558 if (subchap.eq.1) then
21568 dxj=dc_norm(1,nres+j)
21569 dyj=dc_norm(2,nres+j)
21570 dzj=dc_norm(3,nres+j)
21571 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
21573 !C Calculate angle-dependent terms of energy and contributions to their
21578 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
21579 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
21580 om12=dxi*dxj+dyi*dyj+dzi*dzj
21581 call sc_angular_nucl
21583 sig=sig0ij*dsqrt(sigsq)
21584 rij_shift=1.0D0/rij-sig+sig0ij
21585 ! print *,rij_shift,"rij_shift"
21586 !c write (2,*) " rij",1.0D0/rij," sig",sig," sig0ij",sig0ij,
21587 !c & " rij_shift",rij_shift
21588 if (rij_shift.le.0.0D0) then
21593 !c---------------------------------------------------------------
21594 rij_shift=1.0D0/rij_shift
21595 fac=rij_shift**expon
21596 e1=fac*fac*aa_nucl(itypi,itypj)
21597 e2=fac*bb_nucl(itypi,itypj)
21598 evdwij=eps1*eps2rt*(e1+e2)
21599 !c write (2,*) "eps1",eps1," eps2rt",eps2rt,
21600 !c & " e1",e1," e2",e2," evdwij",evdwij
21602 evdwij=evdwij*eps2rt
21603 evdwsb=evdwsb+evdwij
21605 sigm=dabs(aa_nucl(itypi,itypj)/bb_nucl(itypi,itypj))**(1.0D0/6.0D0)
21606 epsi=bb_nucl(itypi,itypj)**2/aa_nucl(itypi,itypj)
21607 write (iout,'(2(a3,i3,2x),17(0pf7.3))') &
21608 restyp(itypi,2),i,restyp(itypj,2),j, &
21609 epsi,sigm,chi1,chi2,chip1,chip2, &
21610 eps1,eps2rt**2,sig,sig0ij, &
21611 om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,&
21613 write (iout,*) "aa",aa_nucl(itypi,itypj)," bb",bb_nucl(itypi,itypj)
21616 if (energy_dec) write (iout,'(a6,2i5,e15.3,a4)') &
21617 'evdw',i,j,evdwij,"tu3"
21620 !C Calculate gradient components.
21621 e1=e1*eps1*eps2rt**2
21622 fac=-expon*(e1+evdwij)*rij_shift
21626 !C Calculate the radial part of the gradient
21630 !C Calculate angular part of the gradient.
21632 call eelsbij(eelij,num_conti2)
21633 if (energy_dec .and. &
21634 (j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2)) &
21635 write (istat,'(e14.5)') evdwij
21639 num_cont_hb(i)=num_conti2
21641 !c write (iout,*) "Number of loop steps in EGB:",ind
21642 !cccc energy_dec=.false.
21644 end subroutine esb_gb
21645 !-------------------------------------------------------------------------------
21646 subroutine eelsbij(eesij,num_conti2)
21649 real(kind=8),dimension(3) :: ggg,gggp,gggm,dcosb,dcosg
21650 real(kind=8),dimension(3,3) :: erder,uryg,urzg,vryg,vrzg
21651 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
21652 dist_temp, dist_init,rlocshield,fracinbuf
21653 integer xshift,yshift,zshift,ilist,iresshield,num_conti2
21655 !c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
21656 real(kind=8) scal_el /0.5d0/
21657 integer :: iteli,itelj,kkk,kkll,m,isubchap
21658 real(kind=8) :: ael6i,rrmij,rmij,r0ij,fcont,fprimcont,ees0tmp,facfac
21659 real(kind=8) :: ees,evdw1,eel_loc,aaa,bbb,ael3i,ael63i,ael32i
21660 real(kind=8) :: dx_normj,dy_normj,dz_normj,&
21661 r3ij,r6ij,cosa,cosb,cosg,fac,ev1,ev2,fac3,fac4,fac5,fac6,&
21662 el1,el2,el3,el4,eesij,ees0ij,facvdw,facel,fac1,ecosa,&
21663 ecosb,ecosg,ury,urz,vry,vrz,facr,a22der,a23der,a32der,&
21664 a33der,eel_loc_ij,cosa4,wij,cosbg1,cosbg2,ees0pij,&
21665 ees0pij1,ees0mij,ees0mij1,fac3p,ees0mijp,ees0pijp,&
21666 ecosa1,ecosb1,ecosg1,ecosa2,ecosb2,ecosg2,ecosap,ecosbp,&
21667 ecosgp,ecosam,ecosbm,ecosgm,ghalf,itypi,itypj
21671 ! print *,i,j,itypi,itypj,istype(i),istype(j),"????"
21672 ael6i=ael6_nucl(itypi,itypj)
21673 ael3i=ael3_nucl(itypi,itypj)
21674 ael63i=ael63_nucl(itypi,itypj)
21675 ael32i=ael32_nucl(itypi,itypj)
21676 !c write (iout,*) "eelecij",i,j,itype(i),itype(j),
21677 !c & ael6i,ael3i,ael63i,al32i,rij,rrij
21681 dx_normi=dc_norm(1,i+nres)
21682 dy_normi=dc_norm(2,i+nres)
21683 dz_normi=dc_norm(3,i+nres)
21684 dx_normj=dc_norm(1,j+nres)
21685 dy_normj=dc_norm(2,j+nres)
21686 dz_normj=dc_norm(3,j+nres)
21687 !c xj=c(1,j)+0.5D0*dxj-xmedi
21688 !c yj=c(2,j)+0.5D0*dyj-ymedi
21689 !c zj=c(3,j)+0.5D0*dzj-zmedi
21690 if (ipot_nucl.ne.2) then
21691 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
21692 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
21693 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
21701 fac=cosa-3.0D0*cosb*cosg
21703 fac1=3.0d0*(cosb*cosb+cosg*cosg)
21708 !c write (iout,*) "r3ij",r3ij," r6ij",r6ij," fac",fac," fac1",fac1,
21709 !c & " fac2",fac2," fac3",fac3," fac4",fac4," fac5",fac5," fac6",fac6
21710 el1=fac3*(4.0D0+facfac-fac1)
21712 el3=fac5*(2.0d0-2.0d0*facfac+fac1)
21714 eesij=el1+el2+el3+el4
21715 !C 12/26/95 - for the evaluation of multi-body H-bonding interactions
21716 ees0ij=4.0D0+facfac-fac1
21718 if (energy_dec) then
21719 if(j.eq.i+1.or.j.eq.nres-i+1.or.j.eq.nres-i.or.j.eq.nres-i+2) &
21720 write (istat,'(2a1,i4,1x,2a1,i4,4f10.5,3e12.5,$)') &
21721 sugartyp(istype(i)),restyp(itypi,2),i,sugartyp(istype(j)),&
21722 restyp(itypj,2),j,1.0d0/rij,cosa,cosb,cosg,fac*r3ij, &
21723 (4.0D0+facfac-fac1)*r6ij,(2.0d0-2.0d0*facfac+fac1)*r6ij
21724 write (iout,'(a6,2i5,e15.3)') 'ees',i,j,eesij
21728 !C Calculate contributions to the Cartesian gradient.
21730 facel=-3.0d0*rrij*(eesij+el1+el3+el4)
21736 !* Radial derivatives. First process both termini of the fragment (i,j)
21742 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
21743 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
21744 gelsbx(k,j)=gelsbx(k,j)+ggg(k)
21745 gelsbx(k,i)=gelsbx(k,i)-ggg(k)
21750 ecosa=2.0D0*fac3*fac1+fac4+(-4.0d0*fac5+2.0d0*fac6)*fac1
21755 ecosb=fac3*(fac1*cosg+cosb)+cosg*fac4+(cosb+2*fac1*cosg)*fac5+&
21757 ecosg=fac3*(fac1*cosb+cosg)+cosb*fac4+(cosg+2*fac1*cosb)*fac5+&
21760 dcosb(k)=rij*(dc_norm(k,i+nres)-erij(k)*cosb)
21761 dcosg(k)=rij*(dc_norm(k,j+nres)-erij(k)*cosg)
21764 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
21767 gelsbx(k,i)=gelsbx(k,i)-ggg(k) &
21768 +(ecosa*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres))&
21769 + ecosb*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21770 gelsbx(k,j)=gelsbx(k,j)+ggg(k) &
21771 +(ecosa*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
21772 + ecosg*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21773 gelsbc(k,j)=gelsbc(k,j)+ggg(k)
21774 gelsbc(k,i)=gelsbc(k,i)-ggg(k)
21776 ! IF ( (wcorr_nucl.gt.0.0d0.or.wcorr3_nucl.gt.0.0d0) .and.
21777 IF ( j.gt.i+1 .and.&
21778 num_conti.le.maxconts) THEN
21780 !C Calculate the contact function. The ith column of the array JCONT will
21781 !C contain the numbers of atoms that make contacts with the atom I (of numbers
21782 !C greater than I). The arrays FACONT and GACONT will contain the values of
21783 !C the contact function and its derivative.
21784 r0ij=2.20D0*sigma(itypi,itypj)
21785 !c write (2,*) "ij",i,j," rij",1.0d0/rij," r0ij",r0ij
21786 call gcont(rij,r0ij,1.0D0,0.2d0/r0ij,fcont,fprimcont)
21787 !c write (2,*) "fcont",fcont
21788 if (fcont.gt.0.0D0) then
21789 num_conti=num_conti+1
21790 num_conti2=num_conti2+1
21792 if (num_conti.gt.maxconts) then
21793 write (iout,*) 'WARNING - max. # of contacts exceeded;',&
21794 ' will skip next contacts for this conf.'
21796 jcont_hb(num_conti,i)=j
21797 !c write (iout,*) "num_conti",num_conti,
21798 !c & " jcont_hb",jcont_hb(num_conti,i)
21799 !C Calculate contact energies
21801 wij=cosa-3.0D0*cosb*cosg
21804 fac3=dsqrt(-ael6i)*r3ij
21805 !c write (2,*) "ael6i",ael6i," r3ij",r3ij," fac3",fac3
21806 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
21807 if (ees0tmp.gt.0) then
21808 ees0pij=dsqrt(ees0tmp)
21812 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
21813 if (ees0tmp.gt.0) then
21814 ees0mij=dsqrt(ees0tmp)
21818 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
21819 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
21820 !c write (iout,*) "i",i," j",j,
21821 !c & " ees0m",ees0m(num_conti,i)," ees0p",ees0p(num_conti,i)
21822 ees0pij1=fac3/ees0pij
21823 ees0mij1=fac3/ees0mij
21824 fac3p=-3.0D0*fac3*rrij
21825 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
21826 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
21827 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
21828 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
21829 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
21830 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
21831 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
21832 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
21833 ecosap=ecosa1+ecosa2
21834 ecosbp=ecosb1+ecosb2
21835 ecosgp=ecosg1+ecosg2
21836 ecosam=ecosa1-ecosa2
21837 ecosbm=ecosb1-ecosb2
21838 ecosgm=ecosg1-ecosg2
21840 facont_hb(num_conti,i)=fcont
21841 fprimcont=fprimcont/rij
21843 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
21844 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
21846 gggp(1)=gggp(1)+ees0pijp*xj
21847 gggp(2)=gggp(2)+ees0pijp*yj
21848 gggp(3)=gggp(3)+ees0pijp*zj
21849 gggm(1)=gggm(1)+ees0mijp*xj
21850 gggm(2)=gggm(2)+ees0mijp*yj
21851 gggm(3)=gggm(3)+ees0mijp*zj
21852 !C Derivatives due to the contact function
21853 gacont_hbr(1,num_conti,i)=fprimcont*xj
21854 gacont_hbr(2,num_conti,i)=fprimcont*yj
21855 gacont_hbr(3,num_conti,i)=fprimcont*zj
21858 !c Gradient of the correlation terms
21860 gacontp_hb1(k,num_conti,i)= &
21861 (ecosap*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
21862 + ecosbp*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21863 gacontp_hb2(k,num_conti,i)= &
21864 (ecosap*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres)) &
21865 + ecosgp*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21866 gacontp_hb3(k,num_conti,i)=gggp(k)
21867 gacontm_hb1(k,num_conti,i)= &
21868 (ecosam*(dc_norm(k,j+nres)-cosa*dc_norm(k,i+nres)) &
21869 + ecosbm*(erij(k)-cosb*dc_norm(k,i+nres)))*vbld_inv(i+nres)
21870 gacontm_hb2(k,num_conti,i)= &
21871 (ecosam*(dc_norm(k,i+nres)-cosa*dc_norm(k,j+nres))&
21872 + ecosgm*(erij(k)-cosg*dc_norm(k,j+nres)))*vbld_inv(j+nres)
21873 gacontm_hb3(k,num_conti,i)=gggm(k)
21879 end subroutine eelsbij
21880 !------------------------------------------------------------------
21881 subroutine sc_grad_nucl
21884 real(kind=8),dimension(3) :: dcosom1,dcosom2
21885 eom1=eps2der*eps2rt_om1+sigder*sigsq_om1
21886 eom2=eps2der*eps2rt_om2+sigder*sigsq_om2
21887 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12+sigder*sigsq_om12
21889 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
21890 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
21893 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
21896 gvdwsbx(k,i)=gvdwsbx(k,i)-gg(k) &
21897 +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
21898 +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
21899 gvdwsbx(k,j)=gvdwsbx(k,j)+gg(k) &
21900 +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
21901 +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
21904 !C Calculate the components of the gradient in DC and X
21907 gvdwsbc(l,i)=gvdwsbc(l,i)-gg(l)
21908 gvdwsbc(l,j)=gvdwsbc(l,j)+gg(l)
21911 end subroutine sc_grad_nucl
21912 !-----------------------------------------------------------------------
21913 subroutine esb(esbloc)
21914 !C Calculate the local energy of a side chain and its derivatives in the
21915 !C corresponding virtual-bond valence angles THETA and the spherical angles
21916 !C ALPHA and OMEGA derived from AM1 all-atom calculations.
21917 !C added by Urszula Kozlowska. 07/11/2007
21919 real(kind=8),dimension(3):: x_prime,y_prime,z_prime
21920 real(kind=8),dimension(9):: x
21921 real(kind=8) :: sumene,dsc_i,dp2_i,xx,yy,zz,sumene1, &
21922 sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,&
21923 de_dxx,de_dyy,de_dzz,de_dt,s1_t,s1_6_t,s2_t,s2_6_t
21924 real(kind=8),dimension(3):: dXX_Ci1,dYY_Ci1,dZZ_Ci1,dXX_Ci,&
21925 dYY_Ci,dZZ_Ci,dXX_XYZ,dYY_XYZ,dZZ_XYZ,dt_dCi,dt_dCi1
21926 real(kind=8) :: esbloc,delta,cosfac2,cosfac,sinfac2,sinfac,de_dtt,&
21927 cossc,cossc1,cosfac2xx,sinfac2yy,pom1,pom
21928 integer::it,nlobit,i,j,k
21929 ! common /sccalc/ time11,time12,time112,theti,it,nlobit
21932 do i=loc_start_nucl,loc_end_nucl
21933 if (itype(i,2).eq.ntyp1_molec(2)) cycle
21934 costtab(i+1) =dcos(theta(i+1))
21935 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
21936 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
21937 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
21938 cosfac2=0.5d0/(1.0d0+costtab(i+1))
21939 cosfac=dsqrt(cosfac2)
21940 sinfac2=0.5d0/(1.0d0-costtab(i+1))
21941 sinfac=dsqrt(sinfac2)
21943 if (it.eq.10) goto 1
21946 !C Compute the axes of tghe local cartesian coordinates system; store in
21947 !c x_prime, y_prime and z_prime
21954 !C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
21955 !C & dc_norm(3,i+nres)
21957 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
21958 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
21961 z_prime(j) = -uz(j,i-1)
21969 xx = xx + x_prime(j)*dc_norm(j,i+nres)
21970 yy = yy + y_prime(j)*dc_norm(j,i+nres)
21971 zz = zz + z_prime(j)*dc_norm(j,i+nres)
21979 x(j) = sc_parmin_nucl(j,it)
21982 !Cc diagnostics - remove later
21983 xx1 = dcos(alph(2))
21984 yy1 = dsin(alph(2))*dcos(omeg(2))
21985 zz1 = -dsin(alph(2))*dsin(omeg(2))
21986 write(2,'(3f8.1,3f9.3,1x,3f9.3)') &
21987 alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,&
21989 !C," --- ", xx_w,yy_w,zz_w
21992 sumene = enesc_nucl(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
21993 esbloc = esbloc + sumene
21994 sumene2= enesc_nucl(x,xx,yy,0.0d0,cost2tab(i+1),sint2tab(i+1))
21995 ! print *,"enecomp",sumene,sumene2
21996 ! if (energy_dec) write(iout,*) "i",i," esbloc",sumene,esbloc,xx,yy,zz
21997 ! if (energy_dec) write(iout,*) "x",(x(k),k=1,9)
21999 write (2,*) "x",(x(k),k=1,9)
22001 !C This section to check the numerical derivatives of the energy of ith side
22002 !C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
22003 !C #define DEBUG in the code to turn it on.
22005 write (2,*) "sumene =",sumene
22009 write (2,*) xx,yy,zz
22010 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
22011 de_dxx_num=(sumenep-sumene)/aincr
22013 write (2,*) "xx+ sumene from enesc=",sumenep,sumene
22016 write (2,*) xx,yy,zz
22017 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
22018 de_dyy_num=(sumenep-sumene)/aincr
22020 write (2,*) "yy+ sumene from enesc=",sumenep,sumene
22023 write (2,*) xx,yy,zz
22024 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
22025 de_dzz_num=(sumenep-sumene)/aincr
22027 write (2,*) "zz+ sumene from enesc=",sumenep,sumene
22028 costsave=cost2tab(i+1)
22029 sintsave=sint2tab(i+1)
22030 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
22031 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
22032 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
22033 de_dt_num=(sumenep-sumene)/aincr
22034 write (2,*) " t+ sumene from enesc=",sumenep,sumene
22035 cost2tab(i+1)=costsave
22036 sint2tab(i+1)=sintsave
22037 !C End of diagnostics section.
22040 !C Compute the gradient of esc
22042 de_dxx=x(1)+2*x(4)*xx+x(7)*zz+x(8)*yy
22043 de_dyy=x(2)+2*x(5)*yy+x(8)*xx+x(9)*zz
22044 de_dzz=x(3)+2*x(6)*zz+x(7)*xx+x(9)*yy
22047 write (2,*) "x",(x(k),k=1,9)
22048 write (2,*) "xx",xx," yy",yy," zz",zz
22049 write (2,*) "de_xx ",de_xx," de_yy ",de_yy,&
22050 " de_zz ",de_zz," de_tt ",de_tt
22051 write (2,*) "de_xx_num",de_dxx_num," de_yy_num",de_dyy_num,&
22052 " de_zz_num",de_dzz_num," de_dt_num",de_dt_num
22055 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
22056 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
22057 cosfac2xx=cosfac2*xx
22058 sinfac2yy=sinfac2*yy
22060 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*&
22062 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*&
22064 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
22065 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
22066 !c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
22067 !c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
22068 !c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
22069 !c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
22070 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
22071 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
22072 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
22073 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
22077 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
22078 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
22081 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
22082 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
22083 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
22085 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
22086 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
22090 dXX_Ctab(k,i)=dXX_Ci(k)
22091 dXX_C1tab(k,i)=dXX_Ci1(k)
22092 dYY_Ctab(k,i)=dYY_Ci(k)
22093 dYY_C1tab(k,i)=dYY_Ci1(k)
22094 dZZ_Ctab(k,i)=dZZ_Ci(k)
22095 dZZ_C1tab(k,i)=dZZ_Ci1(k)
22096 dXX_XYZtab(k,i)=dXX_XYZ(k)
22097 dYY_XYZtab(k,i)=dYY_XYZ(k)
22098 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
22101 !c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
22102 !c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
22103 !c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
22104 !c & dyy_ci(k)," dzz_ci",dzz_ci(k)
22105 !c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
22107 !c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
22108 !c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
22109 gsbloc(k,i-1)=gsbloc(k,i-1)+(de_dxx*dxx_ci1(k) &
22110 +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k))
22111 gsbloc(k,i)=gsbloc(k,i)+(de_dxx*dxx_Ci(k) &
22112 +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k))
22113 gsblocx(k,i)= de_dxx*dxx_XYZ(k)&
22114 +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
22115 ! print *,i,de_dxx*dxx_ci1(k)+de_dyy*dyy_ci1(k),de_dzz*dzz_ci1(k)*2
22117 !c write(iout,*) "ENERGY GRAD = ", (gsbloc(k,i-1),k=1,3),
22118 !c & (gsbloc(k,i),k=1,3),(gsblocx(k,i),k=1,3)
22120 !C to check gradient call subroutine check_grad
22126 !=-------------------------------------------------------
22127 real(kind=8) function enesc_nucl(x,xx,yy,zz,cost2,sint2)
22129 real(kind=8),dimension(9):: x(9)
22130 real(kind=8) :: xx,yy,zz,cost2,sint2,sumene1,sumene2, &
22131 sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
22133 !c write (2,*) "enesc"
22134 !c write (2,*) "x",(x(i),i=1,9)
22135 !c write(2,*)"xx",xx," yy",yy," zz",zz," cost2",cost2," sint2",sint2
22136 sumene=x(1)*xx+x(2)*yy+x(3)*zz+x(4)*xx**2 &
22137 + x(5)*yy**2+x(6)*zz**2+x(7)*xx*zz+x(8)*xx*yy &
22141 end function enesc_nucl
22142 !-----------------------------------------------------------------------------
22143 subroutine multibody_hb_nucl(ecorr,ecorr3,n_corr,n_corr1)
22146 integer,parameter :: max_cont=2000
22147 integer,parameter:: max_dim=2*(8*3+6)
22148 integer, parameter :: msglen1=max_cont*max_dim
22149 integer,parameter :: msglen2=2*msglen1
22150 integer source,CorrelType,CorrelID,Error
22151 real(kind=8) :: buffer(max_cont,max_dim)
22152 integer status(MPI_STATUS_SIZE)
22153 integer :: ierror,nbytes
22155 real(kind=8),dimension(3):: gx(3),gx1(3)
22156 real(kind=8) :: time00
22158 integer i,j,i1,j1,jj,kk,num_conti,num_conti1,nn
22159 real(kind=8) ecorr,ecorr3
22160 integer :: n_corr,n_corr1,mm,msglen
22161 !C Set lprn=.true. for debugging
22166 if(.not.allocated(zapas2)) allocate(zapas2(3,maxconts,nres,8))
22168 if (nfgtasks.le.1) goto 30
22170 write (iout,'(a)') 'Contact function values:'
22172 write (iout,'(2i3,50(1x,i2,f5.2))') &
22173 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
22174 j=1,num_cont_hb(i))
22177 !C Caution! Following code assumes that electrostatic interactions concerning
22178 !C a given atom are split among at most two processors!
22188 !c write (*,*) 'MyRank',MyRank,' mm',mm
22191 !c write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
22192 if (fg_rank.gt.0) then
22193 !C Send correlation contributions to the preceding processor
22195 nn=num_cont_hb(iatel_s_nucl)
22196 call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
22197 !c write (*,*) 'The BUFFER array:'
22199 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
22201 if (ielstart_nucl(iatel_s_nucl).gt.iatel_s_nucl+ispp) then
22203 call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
22204 !C Clear the contacts of the atom passed to the neighboring processor
22205 nn=num_cont_hb(iatel_s_nucl+1)
22207 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
22209 num_cont_hb(iatel_s_nucl)=0
22211 !cd write (iout,*) 'Processor ',fg_rank,MyRank,
22212 !cd & ' is sending correlation contribution to processor',fg_rank-1,
22213 !cd & ' msglen=',msglen
22214 !c write (*,*) 'Processor ',fg_rank,MyRank,
22215 !c & ' is sending correlation contribution to processor',fg_rank-1,
22216 !c & ' msglen=',msglen,' CorrelType=',CorrelType
22218 call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1, &
22219 CorrelType,FG_COMM,IERROR)
22220 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
22221 !cd write (iout,*) 'Processor ',fg_rank,
22222 !cd & ' has sent correlation contribution to processor',fg_rank-1,
22223 !cd & ' msglen=',msglen,' CorrelID=',CorrelID
22224 !c write (*,*) 'Processor ',fg_rank,
22225 !c & ' has sent correlation contribution to processor',fg_rank-1,
22226 !c & ' msglen=',msglen,' CorrelID=',CorrelID
22228 endif ! (fg_rank.gt.0)
22232 !c write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
22233 if (fg_rank.lt.nfgtasks-1) then
22234 !C Receive correlation contributions from the next processor
22236 if (ielend_nucl(iatel_e_nucl).lt.nct_molec(2)-1) msglen=msglen2
22237 !cd write (iout,*) 'Processor',fg_rank,
22238 !cd & ' is receiving correlation contribution from processor',fg_rank+1,
22239 !cd & ' msglen=',msglen,' CorrelType=',CorrelType
22240 !c write (*,*) 'Processor',fg_rank,
22241 !c &' is receiving correlation contribution from processor',fg_rank+1,
22242 !c & ' msglen=',msglen,' CorrelType=',CorrelType
22245 do while (nbytes.le.0)
22246 call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
22247 call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
22249 !c print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
22250 call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION, &
22251 fg_rank+1,CorrelType,FG_COMM,status,IERROR)
22252 time_sendrecv=time_sendrecv+MPI_Wtime()-time00
22253 !c write (*,*) 'Processor',fg_rank,
22254 !c &' has received correlation contribution from processor',fg_rank+1,
22255 !c & ' msglen=',msglen,' nbytes=',nbytes
22256 !c write (*,*) 'The received BUFFER array:'
22258 !c write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
22260 if (msglen.eq.msglen1) then
22261 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,0,buffer)
22262 else if (msglen.eq.msglen2) then
22263 call unpack_buffer(max_cont,max_dim,iatel_e_nucl,0,buffer)
22264 call unpack_buffer(max_cont,max_dim,iatel_e_nucl+1,30,buffer)
22267 'ERROR!!!! message length changed while processing correlations.'
22269 'ERROR!!!! message length changed while processing correlations.'
22270 call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
22271 endif ! msglen.eq.msglen1
22272 endif ! fg_rank.lt.nfgtasks-1
22279 write (iout,'(a)') 'Contact function values:'
22280 do i=nnt_molec(2),nct_molec(2)-1
22281 write (iout,'(2i3,50(1x,i2,f5.2))') &
22282 i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i), &
22283 j=1,num_cont_hb(i))
22288 !C Remove the loop below after debugging !!!
22289 ! do i=nnt_molec(2),nct_molec(2)
22291 ! gradcorr_nucl(j,i)=0.0D0
22292 ! gradxorr_nucl(j,i)=0.0D0
22293 ! gradcorr3_nucl(j,i)=0.0D0
22294 ! gradxorr3_nucl(j,i)=0.0D0
22297 ! print *,"iatsc_s_nucl,iatsc_e_nucl",iatsc_s_nucl,iatsc_e_nucl
22298 !C Calculate the local-electrostatic correlation terms
22299 do i=iatsc_s_nucl,iatsc_e_nucl
22301 num_conti=num_cont_hb(i)
22302 num_conti1=num_cont_hb(i+1)
22303 ! print *,i,num_conti,num_conti1
22308 !c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
22309 !c & ' jj=',jj,' kk=',kk
22310 if (j1.eq.j+1 .or. j1.eq.j-1) then
22312 !C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
22313 !C The system gains extra energy.
22314 !C Tentative expression & coefficients; assumed d(stacking)=4.5 A,
22315 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
22316 !C Need to implement full formulas 34 and 35 from Liwo et al., 1998.
22318 ecorr=ecorr+ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
22319 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)') &
22320 'ecorrh',i,j,ehbcorr_nucl(i,j,i+1,j1,jj,kk,0.528D0,0.132D0)
22322 else if (j1.eq.j) then
22324 !C Contacts I-J and I-(J+1) occur simultaneously.
22325 !C The system loses extra energy.
22326 !C Tentative expression & c?oefficients; assumed d(stacking)=4.5 A,
22327 !C parallel dipoles of stacknig bases and sin(mui)sin(muj)/eps/d^3=0.7
22328 !C Need to implement full formulas 32 from Liwo et al., 1998.
22330 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
22331 !c & ' jj=',jj,' kk=',kk
22332 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i+1,j,jj,kk,0.310D0,-0.155D0)
22337 !c write (iout,*) 'ecorr3: i=',i,' j=',j,' i1=',i1,' j1=',j1,
22338 !c & ' jj=',jj,' kk=',kk
22339 if (j1.eq.j+1) then
22340 !C Contacts I-J and (I+1)-J occur simultaneously.
22341 !C The system loses extra energy.
22342 ecorr3=ecorr3+ehbcorr3_nucl(i,j,i,j+1,jj,kk,0.310D0,-0.155D0)
22348 end subroutine multibody_hb_nucl
22349 !-----------------------------------------------------------
22350 real(kind=8) function ehbcorr_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
22351 ! implicit real*8 (a-h,o-z)
22352 ! include 'DIMENSIONS'
22353 ! include 'COMMON.IOUNITS'
22354 ! include 'COMMON.DERIV'
22355 ! include 'COMMON.INTERACT'
22356 ! include 'COMMON.CONTACTS'
22357 real(kind=8),dimension(3) :: gx,gx1
22359 !el local variables
22360 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
22361 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
22362 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
22363 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
22367 eij=facont_hb(jj,i)
22368 ekl=facont_hb(kk,k)
22369 ees0pij=ees0p(jj,i)
22370 ees0pkl=ees0p(kk,k)
22371 ees0mij=ees0m(jj,i)
22372 ees0mkl=ees0m(kk,k)
22374 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
22375 ! print *,"ehbcorr_nucl",ekont,ees
22376 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
22377 !C Following 4 lines for diagnostics.
22382 !cd write (iout,*)'Contacts have occurred for nucleic bases',
22383 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
22384 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
22385 !C Calculate the multi-body contribution to energy.
22386 ! ecorr_nucl=ecorr_nucl+ekont*ees
22387 !C Calculate multi-body contributions to the gradient.
22388 coeffpees0pij=coeffp*ees0pij
22389 coeffmees0mij=coeffm*ees0mij
22390 coeffpees0pkl=coeffp*ees0pkl
22391 coeffmees0mkl=coeffm*ees0mkl
22393 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i) &
22394 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
22395 coeffmees0mkl*gacontm_hb1(ll,jj,i))
22396 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j) &
22397 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+&
22398 coeffmees0mkl*gacontm_hb2(ll,jj,i))
22399 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k) &
22400 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+&
22401 coeffmees0mij*gacontm_hb1(ll,kk,k))
22402 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l) &
22403 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
22404 coeffmees0mij*gacontm_hb2(ll,kk,k))
22405 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
22406 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
22407 coeffmees0mkl*gacontm_hb3(ll,jj,i))
22408 gradcorr_nucl(ll,j)=gradcorr_nucl(ll,j)+gradlongij
22409 gradcorr_nucl(ll,i)=gradcorr_nucl(ll,i)-gradlongij
22410 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
22411 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
22412 coeffmees0mij*gacontm_hb3(ll,kk,k))
22413 gradcorr_nucl(ll,l)=gradcorr_nucl(ll,l)+gradlongkl
22414 gradcorr_nucl(ll,k)=gradcorr_nucl(ll,k)-gradlongkl
22415 gradxorr_nucl(ll,i)=gradxorr_nucl(ll,i)-gradlongij
22416 gradxorr_nucl(ll,j)=gradxorr_nucl(ll,j)+gradlongij
22417 gradxorr_nucl(ll,k)=gradxorr_nucl(ll,k)-gradlongkl
22418 gradxorr_nucl(ll,l)=gradxorr_nucl(ll,l)+gradlongkl
22420 ehbcorr_nucl=ekont*ees
22422 end function ehbcorr_nucl
22423 !-------------------------------------------------------------------------
22425 real(kind=8) function ehbcorr3_nucl(i,j,k,l,jj,kk,coeffp,coeffm)
22426 ! implicit real*8 (a-h,o-z)
22427 ! include 'DIMENSIONS'
22428 ! include 'COMMON.IOUNITS'
22429 ! include 'COMMON.DERIV'
22430 ! include 'COMMON.INTERACT'
22431 ! include 'COMMON.CONTACTS'
22432 real(kind=8),dimension(3) :: gx,gx1
22434 !el local variables
22435 integer :: i,j,k,l,jj,kk,ll,ilist,m, iresshield
22436 real(kind=8) :: coeffp,coeffm,eij,ekl,ees0pij,ees0pkl,ees0mij,&
22437 ees0mkl,ees,coeffpees0pij,coeffmees0mij,&
22438 coeffpees0pkl,coeffmees0mkl,gradlongij,gradlongkl, &
22442 eij=facont_hb(jj,i)
22443 ekl=facont_hb(kk,k)
22444 ees0pij=ees0p(jj,i)
22445 ees0pkl=ees0p(kk,k)
22446 ees0mij=ees0m(jj,i)
22447 ees0mkl=ees0m(kk,k)
22449 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
22450 !cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
22451 !C Following 4 lines for diagnostics.
22456 !cd write (iout,*)'Contacts have occurred for nucleic bases',
22457 !cd & i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
22458 !cd & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
22459 !C Calculate the multi-body contribution to energy.
22460 ! ecorr=ecorr+ekont*ees
22461 !C Calculate multi-body contributions to the gradient.
22462 coeffpees0pij=coeffp*ees0pij
22463 coeffmees0mij=coeffm*ees0mij
22464 coeffpees0pkl=coeffp*ees0pkl
22465 coeffmees0mkl=coeffm*ees0mkl
22467 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i) &
22468 -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+&
22469 coeffmees0mkl*gacontm_hb1(ll,jj,i))
22470 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j) &
22471 -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+ &
22472 coeffmees0mkl*gacontm_hb2(ll,jj,i))
22473 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k) &
22474 -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+ &
22475 coeffmees0mij*gacontm_hb1(ll,kk,k))
22476 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l) &
22477 -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+ &
22478 coeffmees0mij*gacontm_hb2(ll,kk,k))
22479 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)- &
22480 ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+ &
22481 coeffmees0mkl*gacontm_hb3(ll,jj,i))
22482 gradcorr3_nucl(ll,j)=gradcorr3_nucl(ll,j)+gradlongij
22483 gradcorr3_nucl(ll,i)=gradcorr3_nucl(ll,i)-gradlongij
22484 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)- &
22485 ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+ &
22486 coeffmees0mij*gacontm_hb3(ll,kk,k))
22487 gradcorr3_nucl(ll,l)=gradcorr3_nucl(ll,l)+gradlongkl
22488 gradcorr3_nucl(ll,k)=gradcorr3_nucl(ll,k)-gradlongkl
22489 gradxorr3_nucl(ll,i)=gradxorr3_nucl(ll,i)-gradlongij
22490 gradxorr3_nucl(ll,j)=gradxorr3_nucl(ll,j)+gradlongij
22491 gradxorr3_nucl(ll,k)=gradxorr3_nucl(ll,k)-gradlongkl
22492 gradxorr3_nucl(ll,l)=gradxorr3_nucl(ll,l)+gradlongkl
22494 ehbcorr3_nucl=ekont*ees
22496 end function ehbcorr3_nucl
22498 subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
22499 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
22500 real(kind=8):: buffer(dimen1,dimen2)
22501 num_kont=num_cont_hb(atom)
22505 buffer(i,indx+(k-1)*3+j)=zapas2(j,i,atom,k)
22508 buffer(i,indx+25)=facont_hb(i,atom)
22509 buffer(i,indx+26)=ees0p(i,atom)
22510 buffer(i,indx+27)=ees0m(i,atom)
22511 buffer(i,indx+28)=d_cont(i,atom)
22512 buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
22514 buffer(1,indx+30)=dfloat(num_kont)
22516 end subroutine pack_buffer
22517 !c------------------------------------------------------------------------------
22518 subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
22519 integer dimen1,dimen2,atom,indx,numcont,i,ii,k,j,num_kont,num_kont_old
22520 real(kind=8):: buffer(dimen1,dimen2)
22521 ! double precision zapas
22522 ! common /contacts_hb/ zapas(3,maxconts,maxres,8),
22523 ! & facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
22524 ! & ees0m(maxconts,maxres),d_cont(maxconts,maxres),
22525 ! & num_cont_hb(maxres),jcont_hb(maxconts,maxres)
22526 num_kont=buffer(1,indx+30)
22527 num_kont_old=num_cont_hb(atom)
22528 num_cont_hb(atom)=num_kont+num_kont_old
22533 zapas2(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
22536 facont_hb(ii,atom)=buffer(i,indx+25)
22537 ees0p(ii,atom)=buffer(i,indx+26)
22538 ees0m(ii,atom)=buffer(i,indx+27)
22539 d_cont(i,atom)=buffer(i,indx+28)
22540 jcont_hb(ii,atom)=buffer(i,indx+29)
22543 end subroutine unpack_buffer
22544 !c------------------------------------------------------------------------------
22546 subroutine ecatcat(ecationcation)
22547 integer :: i,j,itmp,xshift,yshift,zshift,subchap,k
22548 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
22549 r7,r4,ecationcation,k0,rcal
22550 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
22551 dist_init,dist_temp,Evan1cat,Evan2cat,Eeleccat
22552 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
22555 ecationcation=0.0d0
22556 if (nres_molec(5).eq.0) return
22561 k0 = 332.0*(2.0*2.0)/80.0
22565 itmp=itmp+nres_molec(i)
22567 ! write(iout,*) "itmp",itmp
22568 do i=itmp+1,itmp+nres_molec(5)-1
22574 xi=mod(xi,boxxsize)
22575 if (xi.lt.0) xi=xi+boxxsize
22576 yi=mod(yi,boxysize)
22577 if (yi.lt.0) yi=yi+boxysize
22578 zi=mod(zi,boxzsize)
22579 if (zi.lt.0) zi=zi+boxzsize
22581 do j=i+1,itmp+nres_molec(5)
22582 ! print *,i,j,'catcat'
22586 xj=dmod(xj,boxxsize)
22587 if (xj.lt.0) xj=xj+boxxsize
22588 yj=dmod(yj,boxysize)
22589 if (yj.lt.0) yj=yj+boxysize
22590 zj=dmod(zj,boxzsize)
22591 if (zj.lt.0) zj=zj+boxzsize
22592 ! write(iout,*) c(1,i),xi,xj,"xy",boxxsize
22593 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22601 xj=xj_safe+xshift*boxxsize
22602 yj=yj_safe+yshift*boxysize
22603 zj=zj_safe+zshift*boxzsize
22604 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22605 if(dist_temp.lt.dist_init) then
22606 dist_init=dist_temp
22615 if (subchap.eq.1) then
22624 rcal =xj**2+yj**2+zj**2
22630 ! k0 = 332*(2*2)/80
22631 Evan1cat=epscalc*(r012/rcal**6)
22632 Evan2cat=epscalc*2*(r06/rcal**3)
22640 dEvan1Cmcat(k)=-12*r(k)*epscalc*r012/r7
22641 dEvan2Cmcat(k)=-12*r(k)*epscalc*r06/r4
22642 dEeleccat(k)=-k0*r(k)/ract**3
22645 gg(k) = dEvan1Cmcat(k)+dEvan2Cmcat(k)+dEeleccat(k)
22646 gradcatcat(k,i)=gradcatcat(k,i)-gg(k)
22647 gradcatcat(k,j)=gradcatcat(k,j)+gg(k)
22650 ! write(iout,*) "ecatcat",i,j, ecationcation,xj,yj,zj
22651 ecationcation=ecationcation+Evan1cat+Evan2cat+Eeleccat
22655 end subroutine ecatcat
22656 !---------------------------------------------------------------------------
22657 subroutine ecat_prot(ecation_prot)
22658 integer i,j,k,subchap,itmp,inum
22659 real(kind=8) :: xi,yi,zi,xj,yj,zj,ract,rcat0,epscalc,r06,r012,&
22660 r7,r4,ecationcation
22661 real(kind=8) xj_temp,yj_temp,zj_temp,xj_safe,yj_safe,zj_safe, &
22662 dist_init,dist_temp,ecation_prot,rcal,rocal, &
22663 Evan1,Evan2,EC,cm1mag,DASGL,delta,r0p,Epepcat, &
22664 catl,cml,calpl, Etotal_p, Etotal_m,rtab,wdip,wmodquad,wquad1, &
22665 wquad2,wvan1,E1,E2,wconst,wvan2,rcpm,dcmag,sin2thet,sinthet, &
22666 costhet,v1m,v2m,wh2o,wc,rsecp,Ir,Irsecp,Irthrp,Irfourp,Irfiftp,&
22667 Irsistp,Irseven,Irtwelv,Irthir,dE1dr,dE2dr,dEdcos,wquad2p,opt, &
22668 rs,rthrp,rfourp,rsixp,reight,Irsixp,Ireight,Irtw,Irfourt, &
22669 opt1,opt2,opt3,opt4,opt5,opt6,opt7,opt8,opt9,opt10,opt11,opt12,&
22670 opt13,opt14,opt15,opt16,opt17,opt18,opt19, &
22671 Equad1,Equad2,dscmag,v1dpv2,dscmag3,constA,constB,Edip,&
22673 real(kind=8),dimension(3) ::dEvan1Cmcat,dEvan2Cmcat,dEeleccat,&
22674 gg,r,EtotalCat,dEtotalCm,dEtotalCalp,dEvan1Cm,dEvan2Cm, &
22675 dEtotalpep,dEtotalcat_num,dEddci,dEtotalcm_num,dEtotalcalp_num, &
22676 tab1,tab2,tab3,diff,cm1,sc,p,tcat,talp,cm,drcp,drcp_norm,vcat, &
22677 v1,v2,v3,myd_norm,dx,vcm,valpha,drdpep,dcosdpep,dcosddci,dEdpep,&
22678 dEcCat,dEdipCm,dEdipCalp,dEquad1Cat,dEquad1Cm,dEquad1Calp, &
22679 dEquad2Cat,dEquad2Cm,dEquad2Calpd,Evan1Cat,dEvan1Calp,dEvan2Cat,&
22680 dEvan2Calp,dEtotalCat,dscvec,dEcCm,dEcCalp,dEdipCat,dEquad2Calp,&
22682 real(kind=8),dimension(6) :: vcatprm
22684 ! first lets calculate interaction with peptide groups
22685 if (nres_molec(5).eq.0) return
22688 itmp=itmp+nres_molec(i)
22690 ! do i=1,nres_molec(1)-1 ! loop over all peptide groups needs parralelization
22691 do i=ibond_start,ibond_end
22693 if ((itype(i,1).eq.ntyp1).or.(itype(i+1,1).eq.ntyp1)) cycle ! leave dummy atoms
22694 xi=0.5d0*(c(1,i)+c(1,i+1))
22695 yi=0.5d0*(c(2,i)+c(2,i+1))
22696 zi=0.5d0*(c(3,i)+c(3,i+1))
22697 xi=mod(xi,boxxsize)
22698 if (xi.lt.0) xi=xi+boxxsize
22699 yi=mod(yi,boxysize)
22700 if (yi.lt.0) yi=yi+boxysize
22701 zi=mod(zi,boxzsize)
22702 if (zi.lt.0) zi=zi+boxzsize
22704 do j=itmp+1,itmp+nres_molec(5)
22705 ! print *,"WTF",itmp,j,i
22706 ! all parameters were for Ca2+ to approximate single charge divide by two
22708 if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
22710 wdip =1.092777950857032D2
22712 wmodquad=-2.174122713004870D4
22713 wmodquad=wmodquad/wconst
22714 wquad1 = 3.901232068562804D1
22715 wquad1=wquad1/wconst
22717 wquad2=wquad2/wconst
22725 xj=dmod(xj,boxxsize)
22726 if (xj.lt.0) xj=xj+boxxsize
22727 yj=dmod(yj,boxysize)
22728 if (yj.lt.0) yj=yj+boxysize
22729 zj=dmod(zj,boxzsize)
22730 if (zj.lt.0) zj=zj+boxzsize
22731 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22739 xj=xj_safe+xshift*boxxsize
22740 yj=yj_safe+yshift*boxysize
22741 zj=zj_safe+zshift*boxzsize
22742 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22743 if(dist_temp.lt.dist_init) then
22744 dist_init=dist_temp
22753 if (subchap.eq.1) then
22764 rcpm = sqrt(xj**2+yj**2+zj**2)
22765 drcp_norm(1)=xj/rcpm
22766 drcp_norm(2)=yj/rcpm
22767 drcp_norm(3)=zj/rcpm
22770 dcmag=dcmag+dc(k,i)**2
22774 myd_norm(k)=dc(k,i)/dcmag
22776 costhet=drcp_norm(1)*myd_norm(1)+drcp_norm(2)*myd_norm(2)+&
22777 drcp_norm(3)*myd_norm(3)
22780 Irsecp = 1.0d0/rsecp
22781 Irthrp = Irsecp/rcpm
22782 Irfourp = Irthrp/rcpm
22783 Irfiftp = Irfourp/rcpm
22784 Irsistp=Irfiftp/rcpm
22785 Irseven=Irsistp/rcpm
22786 Irtwelv=Irsistp*Irsistp
22787 Irthir=Irtwelv/rcpm
22788 sin2thet = (1-costhet*costhet)
22789 sinthet=sqrt(sin2thet)
22790 E1 = wdip*Irsecp*costhet+(wmodquad*Irfourp+wquad1*Irthrp)&
22792 E2 = -wquad1*Irthrp*wquad2+wvan1*(wvan2**12*Irtwelv-&
22793 2*wvan2**6*Irsistp)
22794 ecation_prot = ecation_prot+E1+E2
22795 ! print *,"ecatprot",i,j,ecation_prot,rcpm
22796 dE1dr = -2*costhet*wdip*Irthrp-&
22797 (4*wmodquad*Irfiftp+3*wquad1*Irfourp)*sin2thet
22798 dE2dr = 3*wquad1*wquad2*Irfourp- &
22799 12*wvan1*wvan2**6*(wvan2**6*Irthir-Irseven)
22800 dEdcos = wdip*Irsecp-2*(wmodquad*Irfourp+wquad1*Irthrp)*costhet
22802 drdpep(k) = -drcp_norm(k)
22803 dcosdpep(k) = Ir*(costhet*drcp_norm(k)-myd_norm(k))
22804 dcosddci(k) = drcp_norm(k)/dcmag-costhet*myd_norm(k)/dcmag
22805 dEdpep(k) = (dE1dr+dE2dr)*drdpep(k)+dEdcos*dcosdpep(k)
22806 dEddci(k) = dEdcos*dcosddci(k)
22809 gradpepcat(k,i)=gradpepcat(k,i)+0.5D0*dEdpep(k)-dEddci(k)
22810 gradpepcat(k,i+1)=gradpepcat(k,i+1)+0.5D0*dEdpep(k)+dEddci(k)
22811 gradpepcat(k,j)=gradpepcat(k,j)-dEdpep(k)
22815 !------------------------------------------sidechains
22816 ! do i=1,nres_molec(1)
22817 do i=ibond_start,ibond_end
22818 if ((itype(i,1).eq.ntyp1)) cycle ! leave dummy atoms
22820 ! print *,i,ecation_prot
22824 xi=mod(xi,boxxsize)
22825 if (xi.lt.0) xi=xi+boxxsize
22826 yi=mod(yi,boxysize)
22827 if (yi.lt.0) yi=yi+boxysize
22828 zi=mod(zi,boxzsize)
22829 if (zi.lt.0) zi=zi+boxzsize
22831 cm1(k)=dc(k,i+nres)
22833 cm1mag=sqrt(cm1(1)**2+cm1(2)**2+cm1(3)**2)
22834 do j=itmp+1,itmp+nres_molec(5)
22836 if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
22841 xj=dmod(xj,boxxsize)
22842 if (xj.lt.0) xj=xj+boxxsize
22843 yj=dmod(yj,boxysize)
22844 if (yj.lt.0) yj=yj+boxysize
22845 zj=dmod(zj,boxzsize)
22846 if (zj.lt.0) zj=zj+boxzsize
22847 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22855 xj=xj_safe+xshift*boxxsize
22856 yj=yj_safe+yshift*boxysize
22857 zj=zj_safe+zshift*boxzsize
22858 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
22859 if(dist_temp.lt.dist_init) then
22860 dist_init=dist_temp
22869 if (subchap.eq.1) then
22881 if((itype(i,1).eq.15.or.itype(i,1).eq.16).or.&
22882 ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.&
22883 (itype(i,1).eq.25))) then
22884 if(itype(i,1).eq.16) then
22890 vcatprm(k)=catprm(k,inum)
22892 dASGL=catprm(7,inum)
22894 ! vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
22895 vcm(1)=(cm1(1)/cm1mag)*dASGL+xi
22896 vcm(2)=(cm1(2)/cm1mag)*dASGL+yi
22897 vcm(3)=(cm1(3)/cm1mag)*dASGL+zi
22901 if (subchap.eq.1) then
22910 valpha(1)=xi-c(1,i+nres)+c(1,i)
22911 valpha(2)=yi-c(2,i+nres)+c(2,i)
22912 valpha(3)=zi-c(3,i+nres)+c(3,i)
22916 dx(k) = vcat(k)-vcm(k)
22919 v1(k)=(vcm(k)-valpha(k))
22920 v2(k)=(vcat(k)-valpha(k))
22922 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
22923 v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
22924 v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
22926 ! The weights of the energy function calculated from
22927 !The quantum mechanical GAMESS simulations of calcium with ASP/GLU
22928 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
22934 if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
22943 wquad2 = vcatprm(4)
22945 wquad2p = 1.0d0-wquad2
22948 opt = dx(1)**2+dx(2)**2
22949 rsecp = opt+dx(3)**2
22953 rsixp = rfourp*rsecp
22956 Irsecp = 1.0d0/rsecp
22958 Irfourp = Irthrp/rs
22959 Irsixp = 1.0d0/rsixp
22960 Ireight=1.0d0/reight
22964 opt1 = (4*rs*dx(3)*wdip)
22965 opt2 = 6*rsecp*wquad1*opt
22966 opt3 = wquad1*wquad2p*Irsixp
22967 opt4 = (wvan1*wvan2**12)
22968 opt5 = opt4*12*Irfourt
22969 opt6 = 2*wvan1*wvan2**6
22970 opt7 = 6*opt6*Ireight
22973 opt11 = (rsecp*v2m)**2
22974 opt12 = (rsecp*v1m)**2
22975 opt14 = (v1m*v2m*rsecp)**2
22976 opt15 = -wquad1/v2m**2
22977 opt16 = (rthrp*(v1m*v2m)**2)**2
22978 opt17 = (v1m**2*rthrp)**2
22979 opt18 = -wquad1/rthrp
22980 opt19 = (v1m**2*v2m**2)**2
22983 dEcCat(k) = -(dx(k)*wc)*Irthrp
22984 dEcCm(k)=(dx(k)*wc)*Irthrp
22987 Edip=opt8*(v1dpv2)/(rsecp*v2m)
22989 dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m &
22990 *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
22991 dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m &
22992 *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
22993 dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m &
22994 *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp) &
22997 Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
22999 dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp* &
23000 (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2* &
23001 v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
23002 dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp* &
23003 (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2* &
23004 v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
23005 dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
23006 v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)* &
23009 Equad2=wquad1*wquad2p*Irthrp
23011 dEquad2Cat(k)=-3*dx(k)*rs*opt3
23012 dEquad2Cm(k)=3*dx(k)*rs*opt3
23013 dEquad2Calp(k)=0.0d0
23017 dEvan1Cat(k)=-dx(k)*opt5
23018 dEvan1Cm(k)=dx(k)*opt5
23019 dEvan1Calp(k)=0.0d0
23023 dEvan2Cat(k)=dx(k)*opt7
23024 dEvan2Cm(k)=-dx(k)*opt7
23025 dEvan2Calp(k)=0.0d0
23027 ecation_prot=ecation_prot+Ec+Edip+Equad1+Equad2+Evan1+Evan2
23028 ! print *,ecation_prot,Ec+Edip+Equad1+Equad2+Evan1+Evan2
23031 dEtotalCat(k)=dEcCat(k)+dEdipCat(k)+dEquad1Cat(k)+ &
23032 dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
23033 !c write(*,*) 'dEtotalCat inside', (dEtotalCat(l),l=1,3)
23034 dEtotalCm(k)=dEcCm(k)+dEdipCm(k)+dEquad1Cm(k)+ &
23035 dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
23036 dEtotalCalp(k)=dEcCalp(k)+dEdipCalp(k)+dEquad1Calp(k) &
23037 +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
23041 dscvec(k) = dc(k,i+nres)
23042 dscmag = dscmag+dscvec(k)*dscvec(k)
23045 dscmag = sqrt(dscmag)
23046 dscmag3 = dscmag3*dscmag
23047 constA = 1.0d0+dASGL/dscmag
23050 constB = constB+dscvec(k)*dEtotalCm(k)
23052 constB = constB*dASGL/dscmag3
23054 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
23055 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
23056 constA*dEtotalCm(k)-constB*dscvec(k)
23057 ! print *,j,constA,dEtotalCm(k),constB,dscvec(k)
23058 gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
23059 gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
23061 else if (itype(i,1).eq.13.or.itype(i,1).eq.14) then
23062 if(itype(i,1).eq.14) then
23068 vcatprm(k)=catprm(k,inum)
23070 dASGL=catprm(7,inum)
23072 ! vcm(k)=(cm1(k)/cm1mag)*dASGL+c(k,i+nres)
23076 vcm(1)=(cm1(1)/cm1mag)*dASGL+xi
23077 vcm(2)=(cm1(2)/cm1mag)*dASGL+yi
23078 vcm(3)=(cm1(3)/cm1mag)*dASGL+zi
23079 if (subchap.eq.1) then
23088 valpha(1)=xi-c(1,i+nres)+c(1,i)
23089 valpha(2)=yi-c(2,i+nres)+c(2,i)
23090 valpha(3)=zi-c(3,i+nres)+c(3,i)
23094 dx(k) = vcat(k)-vcm(k)
23097 v1(k)=(vcm(k)-valpha(k))
23098 v2(k)=(vcat(k)-valpha(k))
23100 v1m = sqrt(v1(1)**2+v1(2)**2+v1(3)**2)
23101 v2m = sqrt(v2(1)**2+v2(2)**2+v2(3)**2)
23102 v1dpv2 = v1(1)*v2(1)+v1(2)*v2(2)+v1(3)*v2(3)
23103 ! The weights of the energy function calculated from
23104 !The quantum mechanical GAMESS simulations of ASN/GLN with calcium
23106 if ((itype(j,5).eq.1).or.(itype(j,5).eq.3)) ndiv=2.0
23113 wquad2 = vcatprm(4)
23118 opt = dx(1)**2+dx(2)**2
23119 rsecp = opt+dx(3)**2
23123 rsixp = rfourp*rsecp
23128 Irfourp = Irthrp/rs
23134 opt1 = (4*rs*dx(3)*wdip)
23135 opt2 = 6*rsecp*wquad1*opt
23136 opt3 = wquad1*wquad2p*Irsixp
23137 opt4 = (wvan1*wvan2**12)
23138 opt5 = opt4*12*Irfourt
23139 opt6 = 2*wvan1*wvan2**6
23140 opt7 = 6*opt6*Ireight
23143 opt11 = (rsecp*v2m)**2
23144 opt12 = (rsecp*v1m)**2
23145 opt14 = (v1m*v2m*rsecp)**2
23146 opt15 = -wquad1/v2m**2
23147 opt16 = (rthrp*(v1m*v2m)**2)**2
23148 opt17 = (v1m**2*rthrp)**2
23149 opt18 = -wquad1/rthrp
23150 opt19 = (v1m**2*v2m**2)**2
23151 Edip=opt8*(v1dpv2)/(rsecp*v2m)
23153 dEdipCat(k)=opt8*(v1(k)*rsecp*v2m-((v2(k)/v2m&
23154 *rsecp+2*dx(k)*v2m)*v1dpv2))/opt11
23155 dEdipCm(k)=opt10*(v2(k)*rsecp*v1m-((v1(k)/v1m&
23156 *rsecp-2*dx(k)*v1m)*v1dpv2))/opt12
23157 dEdipCalp(k)=wdip*((-v1(k)-v2(k))*rsecp*v1m&
23158 *v2m-(-v1(k)/v1m*v2m*rsecp-v2(k)/v2m*v1m*rsecp)&
23161 Equad1=-wquad1*v1dpv2**2/(rthrp*(v1m*v2m)**2)
23163 dEquad1Cat(k)=-wquad1*(2*v1(k)*v1dpv2*(rthrp*&
23164 (v1m*v2m)**2)-(3*dx(k)*rs*(v1m*v2m)**2+2*v1m*2*&
23165 v2(k)*1/2*1/v2m*v1m*v2m*rthrp)*v1dpv2**2)/opt16
23166 dEquad1Cm(k)=-wquad1*(2*v2(k)*v1dpv2*(rthrp*&
23167 (v1m*v2m)**2)-(-3*dx(k)*rs*(v1m*v2m)**2+2*v2m*2*&
23168 v1(k)*1/2*1/v1m*v2m*v1m*rthrp)*v1dpv2**2)/opt16
23169 dEquad1Calp(k)=opt18*(2*(-v1(k)-v2(k))*v1dpv2* &
23170 v1m**2*v2m**2-(-2*v1(k)*v2m**2-2*v2(k)*v1m**2)*&
23173 Equad2=wquad1*wquad2p*Irthrp
23175 dEquad2Cat(k)=-3*dx(k)*rs*opt3
23176 dEquad2Cm(k)=3*dx(k)*rs*opt3
23177 dEquad2Calp(k)=0.0d0
23181 dEvan1Cat(k)=-dx(k)*opt5
23182 dEvan1Cm(k)=dx(k)*opt5
23183 dEvan1Calp(k)=0.0d0
23187 dEvan2Cat(k)=dx(k)*opt7
23188 dEvan2Cm(k)=-dx(k)*opt7
23189 dEvan2Calp(k)=0.0d0
23191 ecation_prot = ecation_prot+Edip+Equad1+Equad2+Evan1+Evan2
23193 dEtotalCat(k)=dEdipCat(k)+dEquad1Cat(k)+ &
23194 dEquad2Cat(k)+dEvan1Cat(k)+dEvan2Cat(k)
23195 dEtotalCm(k)=dEdipCm(k)+dEquad1Cm(k)+ &
23196 dEquad2Cm(k)+dEvan1Cm(k)+dEvan2Cm(k)
23197 dEtotalCalp(k)=dEdipCalp(k)+dEquad1Calp(k) &
23198 +dEquad2Calp(k)+dEvan1Calp(k)+dEvan2Calp(k)
23202 dscvec(k) = c(k,i+nres)-c(k,i)
23208 dscmag = dscmag+dscvec(k)*dscvec(k)
23211 dscmag = sqrt(dscmag)
23212 dscmag3 = dscmag3*dscmag
23213 constA = 1+dASGL/dscmag
23216 constB = constB+dscvec(k)*dEtotalCm(k)
23218 constB = constB*dASGL/dscmag3
23220 gg(k) = dEtotalCm(k)+dEtotalCalp(k)
23221 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
23222 constA*dEtotalCm(k)-constB*dscvec(k)
23223 gradpepcat(k,i)=gradpepcat(k,i)+gg(k)
23224 gradpepcat(k,j)=gradpepcat(k,j)+dEtotalCat(k)
23229 ! r(k) = c(k,j)-c(k,i+nres)
23233 rcal = rcal+r(k)*r(k)
23238 r0p=0.5*(rocal+sig0(itype(i,1)))
23241 Evan1=epscalc*(r012/rcal**6)
23242 Evan2=epscalc*2*(r06/rcal**3)
23246 dEvan1Cm(k) = 12*r(k)*epscalc*r012/r7
23247 dEvan2Cm(k) = 12*r(k)*epscalc*r06/r4
23250 dEtotalCm(k)=dEvan1Cm(k)+dEvan2Cm(k)
23252 ecation_prot = ecation_prot+ Evan1+Evan2
23254 gradpepcatx(k,i)=gradpepcatx(k,i)+ &
23256 gradpepcat(k,i)=gradpepcat(k,i)+dEtotalCm(k)
23257 gradpepcat(k,j)=gradpepcat(k,j)-dEtotalCm(k)
23259 endif ! 13-16 residues
23263 end subroutine ecat_prot
23265 !----------------------------------------------------------------------------
23266 !-----------------------------------------------------------------------------
23267 !-----------------------------------------------------------------------------
23268 subroutine eprot_sc_base(escbase)
23270 ! implicit real*8 (a-h,o-z)
23271 ! include 'DIMENSIONS'
23272 ! include 'COMMON.GEO'
23273 ! include 'COMMON.VAR'
23274 ! include 'COMMON.LOCAL'
23275 ! include 'COMMON.CHAIN'
23276 ! include 'COMMON.DERIV'
23277 ! include 'COMMON.NAMES'
23278 ! include 'COMMON.INTERACT'
23279 ! include 'COMMON.IOUNITS'
23280 ! include 'COMMON.CALC'
23281 ! include 'COMMON.CONTROL'
23282 ! include 'COMMON.SBRIDGE'
23284 !el local variables
23285 integer :: iint,itypi,itypi1,itypj,subchap
23286 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
23287 real(kind=8) :: evdw,sig0ij
23288 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
23289 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
23290 sslipi,sslipj,faclip
23292 real(kind=8) :: fracinbuf
23293 real (kind=8) :: escbase
23294 real (kind=8),dimension(4):: ener
23295 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
23296 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
23297 sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
23298 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
23299 dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
23300 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
23301 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
23302 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
23303 real(kind=8),dimension(3,2)::chead,erhead_tail
23304 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
23308 ! do i=1,nres_molec(1)
23309 do i=ibond_start,ibond_end
23310 if (itype(i,1).eq.ntyp1_molec(1)) cycle
23312 dxi = dc_norm(1,nres+i)
23313 dyi = dc_norm(2,nres+i)
23314 dzi = dc_norm(3,nres+i)
23315 dsci_inv = vbld_inv(i+nres)
23319 xi=mod(xi,boxxsize)
23320 if (xi.lt.0) xi=xi+boxxsize
23321 yi=mod(yi,boxysize)
23322 if (yi.lt.0) yi=yi+boxysize
23323 zi=mod(zi,boxzsize)
23324 if (zi.lt.0) zi=zi+boxzsize
23325 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
23327 if (itype(j,2).eq.ntyp1_molec(2))cycle
23331 xj=dmod(xj,boxxsize)
23332 if (xj.lt.0) xj=xj+boxxsize
23333 yj=dmod(yj,boxysize)
23334 if (yj.lt.0) yj=yj+boxysize
23335 zj=dmod(zj,boxzsize)
23336 if (zj.lt.0) zj=zj+boxzsize
23337 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23346 xj=xj_safe+xshift*boxxsize
23347 yj=yj_safe+yshift*boxysize
23348 zj=zj_safe+zshift*boxzsize
23349 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23350 if(dist_temp.lt.dist_init) then
23351 dist_init=dist_temp
23360 if (subchap.eq.1) then
23369 dxj = dc_norm( 1, nres+j )
23370 dyj = dc_norm( 2, nres+j )
23371 dzj = dc_norm( 3, nres+j )
23372 ! print *,i,j,itypi,itypj
23373 d1i = dhead_scbasei(itypi,itypj) !this is shift of dipole/charge
23374 d1j = dhead_scbasej(itypi,itypj) !this is shift of dipole/charge
23377 ! BetaT = 1.0d0 / (298.0d0 * Rb)
23379 sig0ij = sigma_scbase( itypi,itypj )
23380 chi1 = chi_scbase( itypi, itypj,1 )
23381 chi2 = chi_scbase( itypi, itypj,2 )
23384 chi12 = chi1 * chi2
23385 chip1 = chipp_scbase( itypi, itypj,1 )
23386 chip2 = chipp_scbase( itypi, itypj,2 )
23389 chip12 = chip1 * chip2
23390 ! not used by momo potential, but needed by sc_angular which is shared
23391 ! by all energy_potential subroutines
23395 a12sq = rborn_scbasei(itypi,itypj) * rborn_scbasej(itypi,itypj)
23396 ! a12sq = a12sq * a12sq
23397 ! charge of amino acid itypi is...
23398 chis1 = chis_scbase(itypi,itypj,1)
23399 chis2 = chis_scbase(itypi,itypj,2)
23400 chis12 = chis1 * chis2
23401 sig1 = sigmap1_scbase(itypi,itypj)
23402 sig2 = sigmap2_scbase(itypi,itypj)
23403 ! write (*,*) "sig1 = ", sig1
23404 ! write (*,*) "sig2 = ", sig2
23405 ! alpha factors from Fcav/Gcav
23406 b1 = alphasur_scbase(1,itypi,itypj)
23408 b2 = alphasur_scbase(2,itypi,itypj)
23409 b3 = alphasur_scbase(3,itypi,itypj)
23410 b4 = alphasur_scbase(4,itypi,itypj)
23411 ! used to determine whether we want to do quadrupole calculations
23413 eps_in = epsintab_scbase(itypi,itypj)
23414 if (eps_in.eq.0.0) eps_in=1.0
23415 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
23416 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
23417 !-------------------------------------------------------------------
23418 ! tail location and distance calculations
23420 ! location of polar head is computed by taking hydrophobic centre
23421 ! and moving by a d1 * dc_norm vector
23422 ! see unres publications for very informative images
23423 chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
23424 chead(k,2) = c(k, j+nres) + d1j * dc_norm(k, j+nres)
23426 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
23427 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
23428 Rhead_distance(k) = chead(k,2) - chead(k,1)
23430 ! pitagoras (root of sum of squares)
23432 (Rhead_distance(1)*Rhead_distance(1)) &
23433 + (Rhead_distance(2)*Rhead_distance(2)) &
23434 + (Rhead_distance(3)*Rhead_distance(3)))
23435 !-------------------------------------------------------------------
23436 ! zero everything that should be zero'ed
23454 dscj_inv = vbld_inv(j+nres)
23455 ! print *,i,j,dscj_inv,dsci_inv
23456 ! rij holds 1/(distance of Calpha atoms)
23457 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23459 !----------------------------
23461 ! this should be in elgrad_init but om's are calculated by sc_angular
23462 ! which in turn is used by older potentials
23463 ! om = omega, sqom = om^2
23466 sqom12 = om12 * om12
23468 ! now we calculate EGB - Gey-Berne
23469 ! It will be summed up in evdwij and saved in evdw
23470 sigsq = 1.0D0 / sigsq
23471 sig = sig0ij * dsqrt(sigsq)
23472 ! rij_shift = 1.0D0 / rij - sig + sig0ij
23473 rij_shift = 1.0/rij - sig + sig0ij
23474 IF (rij_shift.le.0.0D0) THEN
23478 sigder = -sig * sigsq
23479 rij_shift = 1.0D0 / rij_shift
23480 fac = rij_shift**expon
23481 c1 = fac * fac * aa_scbase(itypi,itypj)
23483 c2 = fac * bb_scbase(itypi,itypj)
23485 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
23486 eps2der = eps3rt * evdwij
23487 eps3der = eps2rt * evdwij
23488 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
23489 evdwij = eps2rt * eps3rt * evdwij
23490 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
23491 fac = -expon * (c1 + evdwij) * rij_shift
23492 sigder = fac * sigder
23494 ! Calculate distance derivative
23498 ! if (b2.gt.0.0) then
23499 fac = chis1 * sqom1 + chis2 * sqom2 &
23500 - 2.0d0 * chis12 * om1 * om2 * om12
23501 ! we will use pom later in Gcav, so dont mess with it!
23502 pom = 1.0d0 - chis1 * chis2 * sqom12
23503 Lambf = (1.0d0 - (fac / pom))
23504 Lambf = dsqrt(Lambf)
23505 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
23506 ! write (*,*) "sparrow = ", sparrow
23507 Chif = 1.0d0/rij * sparrow
23508 ChiLambf = Chif * Lambf
23509 eagle = dsqrt(ChiLambf)
23510 bat = ChiLambf ** 11.0d0
23511 top = b1 * ( eagle + b2 * ChiLambf - b3 )
23512 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
23516 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
23517 dbot = 12.0d0 * b4 * bat * Lambf
23518 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
23520 ! write (*,*) "dFcav/dR = ", dFdR
23521 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
23522 dbot = 12.0d0 * b4 * bat * Chif
23523 eagle = Lambf * pom
23524 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
23525 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
23526 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
23527 * (chis2 * om2 * om12 - om1) / (eagle * pom)
23529 dFdL = ((dtop * bot - top * dbot) / botsq)
23531 dCAVdOM1 = dFdL * ( dFdOM1 )
23532 dCAVdOM2 = dFdL * ( dFdOM2 )
23533 dCAVdOM12 = dFdL * ( dFdOM12 )
23538 ! eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
23539 ! eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
23540 ! eom12=evdwij*eps1_om12+eps2der*eps2rt_om12 &
23541 ! -2.0D0*alf12*eps3der+sigder*sigsq_om12
23542 ! print *,"EOMY",eom1,eom2,eom12
23543 ! erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
23544 ! erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
23546 ! facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
23547 ! facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
23549 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23550 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23552 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
23553 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
23554 - (( dFdR + gg(k) ) * pom)
23555 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
23556 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
23557 ! & - ( dFdR * pom )
23559 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
23560 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
23561 + (( dFdR + gg(k) ) * pom)
23562 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
23563 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23564 !c! & + ( dFdR * pom )
23566 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
23567 - (( dFdR + gg(k) ) * ertail(k))
23568 !c! & - ( dFdR * ertail(k))
23570 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
23571 + (( dFdR + gg(k) ) * ertail(k))
23572 !c! & + ( dFdR * ertail(k))
23575 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
23576 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
23583 if (wdipdip_scbase(2,itypi,itypj).gt.0.0d0) then
23584 w1 = wdipdip_scbase(1,itypi,itypj)
23585 w2 = -wdipdip_scbase(3,itypi,itypj)/2.0
23586 w3 = wdipdip_scbase(2,itypi,itypj)
23587 !c!-------------------------------------------------------------------
23589 fac = (om12 - 3.0d0 * om1 * om2)
23590 c1 = (w1 / (Rhead**3.0d0)) * fac
23591 c2 = (w2 / Rhead ** 6.0d0) &
23592 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
23593 c3= (w3/ Rhead ** 6.0d0) &
23594 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
23596 !c! write (*,*) "w1 = ", w1
23597 !c! write (*,*) "w2 = ", w2
23598 !c! write (*,*) "om1 = ", om1
23599 !c! write (*,*) "om2 = ", om2
23600 !c! write (*,*) "om12 = ", om12
23601 !c! write (*,*) "fac = ", fac
23602 !c! write (*,*) "c1 = ", c1
23603 !c! write (*,*) "c2 = ", c2
23604 !c! write (*,*) "Ecl = ", Ecl
23605 !c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
23606 !c! write (*,*) "c2_2 = ",
23607 !c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
23608 !c!-------------------------------------------------------------------
23609 !c! dervative of ECL is GCL...
23611 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
23612 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
23613 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
23614 c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
23615 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
23616 dGCLdR = c1 - c2 + c3
23618 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
23619 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
23620 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
23621 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
23622 dGCLdOM1 = c1 - c2 + c3
23624 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
23625 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
23626 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
23627 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
23628 dGCLdOM2 = c1 - c2 + c3
23630 c1 = w1 / (Rhead ** 3.0d0)
23631 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
23632 c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
23633 dGCLdOM12 = c1 - c2 + c3
23635 erhead(k) = Rhead_distance(k)/Rhead
23637 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
23638 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
23639 facd1 = d1i * vbld_inv(i+nres)
23640 facd2 = d1j * vbld_inv(j+nres)
23643 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
23644 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
23646 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
23647 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
23650 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
23651 - dGCLdR * erhead(k)
23652 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
23653 + dGCLdR * erhead(k)
23656 !now charge with dipole eg. ARG-dG
23657 if (wqdip_scbase(2,itypi,itypj).gt.0.0d0) then
23658 alphapol1 = alphapol_scbase(itypi,itypj)
23659 w1 = wqdip_scbase(1,itypi,itypj)
23660 w2 = wqdip_scbase(2,itypi,itypj)
23663 ! pis = sig0head_scbase(itypi,itypj)
23664 ! eps_head = epshead_scbase(itypi,itypj)
23665 !c!-------------------------------------------------------------------
23666 !c! R1 - distance between head of ith side chain and tail of jth sidechain
23669 !c! Calculate head-to-tail distances tail is center of side-chain
23670 R1=R1+(c(k,j+nres)-chead(k,1))**2
23675 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
23676 !c! & +dhead(1,1,itypi,itypj))**2))
23677 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
23678 !c! & +dhead(2,1,itypi,itypj))**2))
23680 !c!-------------------------------------------------------------------
23683 hawk = w2 * (1.0d0 - sqom2)
23684 Ecl = sparrow / Rhead**2.0d0 &
23685 - hawk / Rhead**4.0d0
23686 !c!-------------------------------------------------------------------
23687 !c! derivative of ecl is Gcl
23689 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
23690 + 4.0d0 * hawk / Rhead**5.0d0
23692 dGCLdOM1 = (w1) / (Rhead**2.0d0)
23694 dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
23695 !c--------------------------------------------------------------------
23696 !c Polarization energy
23698 MomoFac1 = (1.0d0 - chi1 * sqom2)
23699 RR1 = R1 * R1 / MomoFac1
23700 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
23701 fgb1 = sqrt( RR1 + a12sq * ee1)
23702 ! eps_inout_fac=0.0d0
23703 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
23704 ! derivative of Epol is Gpol...
23705 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
23707 dFGBdR1 = ( (R1 / MomoFac1) &
23708 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
23710 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
23711 * (2.0d0 - 0.5d0 * ee1) ) &
23713 dPOLdR1 = dPOLdFGB1 * dFGBdR1
23716 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
23718 erhead(k) = Rhead_distance(k)/Rhead
23719 erhead_tail(k,1) = ((c(k,j+nres)-chead(k,1))/R1)
23722 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
23723 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
23724 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
23726 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
23727 facd1 = d1i * vbld_inv(i+nres)
23728 facd2 = d1j * vbld_inv(j+nres)
23729 ! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
23732 hawk = (erhead_tail(k,1) + &
23733 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
23736 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
23737 gvdwx_scbase(k,i) = gvdwx_scbase(k,i) &
23739 - dPOLdR1 * (erhead_tail(k,1))
23742 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
23743 gvdwx_scbase(k,j) = gvdwx_scbase(k,j) &
23745 + dPOLdR1 * (erhead_tail(k,1))
23749 gvdwc_scbase(k,i) = gvdwc_scbase(k,i) &
23750 - dGCLdR * erhead(k) &
23751 - dPOLdR1 * erhead_tail(k,1)
23752 ! & - dGLJdR * erhead(k)
23754 gvdwc_scbase(k,j) = gvdwc_scbase(k,j) &
23755 + dGCLdR * erhead(k) &
23756 + dPOLdR1 * erhead_tail(k,1)
23757 ! & + dGLJdR * erhead(k)
23761 ! print *,i,j,evdwij,epol,Fcav,ECL
23762 escbase=escbase+evdwij+epol+Fcav+ECL
23763 call sc_grad_scbase
23768 end subroutine eprot_sc_base
23769 SUBROUTINE sc_grad_scbase
23772 real (kind=8) :: dcosom1(3),dcosom2(3)
23774 eps2der * eps2rt_om1 &
23775 - 2.0D0 * alf1 * eps3der &
23776 + sigder * sigsq_om1 &
23782 eps2der * eps2rt_om2 &
23783 + 2.0D0 * alf2 * eps3der &
23784 + sigder * sigsq_om2 &
23790 evdwij * eps1_om12 &
23791 + eps2der * eps2rt_om12 &
23792 - 2.0D0 * alf12 * eps3der &
23793 + sigder *sigsq_om12 &
23797 ! print *,eom1,eom2,eom12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
23798 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
23799 ! gg(1),gg(2),"rozne"
23801 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
23802 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
23803 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
23804 gvdwx_scbase(k,i)= gvdwx_scbase(k,i) - gg(k) &
23805 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
23806 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
23807 gvdwx_scbase(k,j)= gvdwx_scbase(k,j) + gg(k) &
23808 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
23809 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
23810 gvdwc_scbase(k,i)=gvdwc_scbase(k,i)-gg(k)
23811 gvdwc_scbase(k,j)=gvdwc_scbase(k,j)+gg(k)
23814 END SUBROUTINE sc_grad_scbase
23817 subroutine epep_sc_base(epepbase)
23820 !el local variables
23821 integer :: iint,itypi,itypi1,itypj,subchap
23822 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
23823 real(kind=8) :: evdw,sig0ij
23824 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
23825 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
23826 sslipi,sslipj,faclip
23828 real(kind=8) :: fracinbuf
23829 real (kind=8) :: epepbase
23830 real (kind=8),dimension(4):: ener
23831 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
23832 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
23833 sqom1,sqom2,sqom12,c1,c2,c3,pom,Lambf,sparrow,&
23834 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
23835 dFdOM2,w1,w2,w3,dGCLdR,dFdL,dFdOM12,dbot ,&
23836 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
23837 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
23838 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1
23839 real(kind=8),dimension(3,2)::chead,erhead_tail
23840 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
23844 ! do i=1,nres_molec(1)-1
23845 do i=ibond_start,ibond_end
23846 if (itype(i,1).eq.ntyp1_molec(1).or.itype(i+1,1).eq.ntyp1_molec(1)) cycle
23847 !C itypi = itype(i,1)
23851 ! print *,dxi,(-c(1,i)+c(1,i+1))*vbld_inv(i+1)
23852 dsci_inv = vbld_inv(i+1)/2.0
23853 xi=(c(1,i)+c(1,i+1))/2.0
23854 yi=(c(2,i)+c(2,i+1))/2.0
23855 zi=(c(3,i)+c(3,i+1))/2.0
23856 xi=mod(xi,boxxsize)
23857 if (xi.lt.0) xi=xi+boxxsize
23858 yi=mod(yi,boxysize)
23859 if (yi.lt.0) yi=yi+boxysize
23860 zi=mod(zi,boxzsize)
23861 if (zi.lt.0) zi=zi+boxzsize
23862 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)
23864 if (itype(j,2).eq.ntyp1_molec(2))cycle
23868 xj=dmod(xj,boxxsize)
23869 if (xj.lt.0) xj=xj+boxxsize
23870 yj=dmod(yj,boxysize)
23871 if (yj.lt.0) yj=yj+boxysize
23872 zj=dmod(zj,boxzsize)
23873 if (zj.lt.0) zj=zj+boxzsize
23874 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23883 xj=xj_safe+xshift*boxxsize
23884 yj=yj_safe+yshift*boxysize
23885 zj=zj_safe+zshift*boxzsize
23886 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
23887 if(dist_temp.lt.dist_init) then
23888 dist_init=dist_temp
23897 if (subchap.eq.1) then
23906 dxj = dc_norm( 1, nres+j )
23907 dyj = dc_norm( 2, nres+j )
23908 dzj = dc_norm( 3, nres+j )
23909 ! d1i = dhead_scbasei(itypi) !this is shift of dipole/charge
23910 ! d1j = dhead_scbasej(itypi) !this is shift of dipole/charge
23913 sig0ij = sigma_pepbase(itypj )
23914 chi1 = chi_pepbase(itypj,1 )
23915 chi2 = chi_pepbase(itypj,2 )
23918 chi12 = chi1 * chi2
23919 chip1 = chipp_pepbase(itypj,1 )
23920 chip2 = chipp_pepbase(itypj,2 )
23923 chip12 = chip1 * chip2
23924 chis1 = chis_pepbase(itypj,1)
23925 chis2 = chis_pepbase(itypj,2)
23926 chis12 = chis1 * chis2
23927 sig1 = sigmap1_pepbase(itypj)
23928 sig2 = sigmap2_pepbase(itypj)
23929 ! write (*,*) "sig1 = ", sig1
23930 ! write (*,*) "sig2 = ", sig2
23932 ! location of polar head is computed by taking hydrophobic centre
23933 ! and moving by a d1 * dc_norm vector
23934 ! see unres publications for very informative images
23935 chead(k,1) = (c(k,i)+c(k,i+1))/2.0
23936 ! + d1i * dc_norm(k, i+nres)
23937 chead(k,2) = c(k, j+nres)
23938 ! + d1j * dc_norm(k, j+nres)
23940 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
23941 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
23942 Rhead_distance(k) = chead(k,2) - chead(k,1)
23943 ! print *,gvdwc_pepbase(k,i)
23947 (Rhead_distance(1)*Rhead_distance(1)) &
23948 + (Rhead_distance(2)*Rhead_distance(2)) &
23949 + (Rhead_distance(3)*Rhead_distance(3)))
23951 ! alpha factors from Fcav/Gcav
23952 b1 = alphasur_pepbase(1,itypj)
23954 b2 = alphasur_pepbase(2,itypj)
23955 b3 = alphasur_pepbase(3,itypj)
23956 b4 = alphasur_pepbase(4,itypj)
23960 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
23963 !----------------------------
23981 dscj_inv = vbld_inv(j+nres)
23983 ! this should be in elgrad_init but om's are calculated by sc_angular
23984 ! which in turn is used by older potentials
23985 ! om = omega, sqom = om^2
23988 sqom12 = om12 * om12
23990 ! now we calculate EGB - Gey-Berne
23991 ! It will be summed up in evdwij and saved in evdw
23992 sigsq = 1.0D0 / sigsq
23993 sig = sig0ij * dsqrt(sigsq)
23994 rij_shift = 1.0/rij - sig + sig0ij
23995 IF (rij_shift.le.0.0D0) THEN
23999 sigder = -sig * sigsq
24000 rij_shift = 1.0D0 / rij_shift
24001 fac = rij_shift**expon
24002 c1 = fac * fac * aa_pepbase(itypj)
24004 c2 = fac * bb_pepbase(itypj)
24006 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
24007 eps2der = eps3rt * evdwij
24008 eps3der = eps2rt * evdwij
24009 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
24010 evdwij = eps2rt * eps3rt * evdwij
24011 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
24012 fac = -expon * (c1 + evdwij) * rij_shift
24013 sigder = fac * sigder
24015 ! Calculate distance derivative
24019 fac = chis1 * sqom1 + chis2 * sqom2 &
24020 - 2.0d0 * chis12 * om1 * om2 * om12
24021 ! we will use pom later in Gcav, so dont mess with it!
24022 pom = 1.0d0 - chis1 * chis2 * sqom12
24023 Lambf = (1.0d0 - (fac / pom))
24024 Lambf = dsqrt(Lambf)
24025 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
24026 ! write (*,*) "sparrow = ", sparrow
24027 Chif = 1.0d0/rij * sparrow
24028 ChiLambf = Chif * Lambf
24029 eagle = dsqrt(ChiLambf)
24030 bat = ChiLambf ** 11.0d0
24031 top = b1 * ( eagle + b2 * ChiLambf - b3 )
24032 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
24036 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
24037 dbot = 12.0d0 * b4 * bat * Lambf
24038 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
24040 ! write (*,*) "dFcav/dR = ", dFdR
24041 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
24042 dbot = 12.0d0 * b4 * bat * Chif
24043 eagle = Lambf * pom
24044 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
24045 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
24046 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
24047 * (chis2 * om2 * om12 - om1) / (eagle * pom)
24049 dFdL = ((dtop * bot - top * dbot) / botsq)
24051 dCAVdOM1 = dFdL * ( dFdOM1 )
24052 dCAVdOM2 = dFdL * ( dFdOM2 )
24053 dCAVdOM12 = dFdL * ( dFdOM12 )
24059 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24060 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24062 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
24063 gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
24064 - (( dFdR + gg(k) ) * pom)/2.0
24065 ! print *,gvdwc_pepbase(k,i),i,(( dFdR + gg(k) ) * pom)/2.0
24066 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
24067 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
24068 ! & - ( dFdR * pom )
24070 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
24071 gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
24072 + (( dFdR + gg(k) ) * pom)
24073 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
24074 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
24075 !c! & + ( dFdR * pom )
24077 gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
24078 - (( dFdR + gg(k) ) * ertail(k))/2.0
24079 ! print *,gvdwc_pepbase(k,i+1),i+1,(( dFdR + gg(k) ) * pom)/2.0
24081 !c! & - ( dFdR * ertail(k))
24083 gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
24084 + (( dFdR + gg(k) ) * ertail(k))
24085 !c! & + ( dFdR * ertail(k))
24088 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24089 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24093 w1 = wdipdip_pepbase(1,itypj)
24094 w2 = -wdipdip_pepbase(3,itypj)/2.0
24095 w3 = wdipdip_pepbase(2,itypj)
24098 !c!-------------------------------------------------------------------
24101 fac = (om12 - 3.0d0 * om1 * om2)
24102 c1 = (w1 / (Rhead**3.0d0)) * fac
24103 c2 = (w2 / Rhead ** 6.0d0) &
24104 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
24105 c3= (w3/ Rhead ** 6.0d0) &
24106 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
24110 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
24111 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
24112 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
24113 c3= (-6.0d0 * w3) / (Rhead ** 7.0d0) &
24114 * (2.0d0 - 2.0d0*fac*fac +3.0d0*(sqom1 + sqom2))
24116 dGCLdR = c1 - c2 + c3
24118 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
24119 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
24120 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
24121 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om1-2.0d0*(fac)*(-om2))
24122 dGCLdOM1 = c1 - c2 + c3
24124 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
24125 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
24126 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
24127 c3 =(6.0d0*w3/ Rhead ** 6.0d0)*(om2-2.0d0*(fac)*(-om1))
24129 dGCLdOM2 = c1 - c2 + c3
24131 c1 = w1 / (Rhead ** 3.0d0)
24132 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
24133 c3 = (w3/ Rhead ** 6.0d0)*(-4.0d0*fac)
24134 dGCLdOM12 = c1 - c2 + c3
24136 erhead(k) = Rhead_distance(k)/Rhead
24138 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
24139 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
24140 ! facd1 = d1 * vbld_inv(i+nres)
24141 ! facd2 = d2 * vbld_inv(j+nres)
24145 !+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
24146 ! gvdwx_pepbase(k,i) = gvdwx_scbase(k,i) &
24149 !+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
24150 gvdwx_pepbase(k,j) = gvdwx_pepbase(k,j) &
24153 gvdwc_pepbase(k,i) = gvdwc_pepbase(k,i) &
24154 - dGCLdR * erhead(k)/2.0d0
24155 ! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
24156 gvdwc_pepbase(k,i+1) = gvdwc_pepbase(k,i+1) &
24157 - dGCLdR * erhead(k)/2.0d0
24158 ! print *,gvdwc_pepbase(k,i+1),i+1,- dGCLdR * erhead(k)/2.0d0
24159 gvdwc_pepbase(k,j) = gvdwc_pepbase(k,j) &
24160 + dGCLdR * erhead(k)
24162 ! print *,i,j,evdwij,Fcav,ECL,"vdw,cav,ecl"
24163 epepbase=epepbase+evdwij+Fcav+ECL
24164 call sc_grad_pepbase
24167 END SUBROUTINE epep_sc_base
24168 SUBROUTINE sc_grad_pepbase
24171 real (kind=8) :: dcosom1(3),dcosom2(3)
24173 eps2der * eps2rt_om1 &
24174 - 2.0D0 * alf1 * eps3der &
24175 + sigder * sigsq_om1 &
24181 eps2der * eps2rt_om2 &
24182 + 2.0D0 * alf2 * eps3der &
24183 + sigder * sigsq_om2 &
24189 evdwij * eps1_om12 &
24190 + eps2der * eps2rt_om12 &
24191 - 2.0D0 * alf12 * eps3der &
24192 + sigder *sigsq_om12 &
24197 ! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
24198 ! if (i.eq.30) print *,gvdwc_pepbase(k,i),- gg(k),&
24199 ! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
24201 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
24202 ! gg(1),gg(2),"rozne"
24204 dcosom1(k) = rij * (dc_norm(k,i) - om1 * erij(k))
24205 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
24206 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
24207 gvdwc_pepbase(k,i)= gvdwc_pepbase(k,i) +0.5*(- gg(k)) &
24208 + (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
24210 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
24211 gvdwc_pepbase(k,i+1)= gvdwc_pepbase(k,i+1) +0.5*(- gg(k)) &
24212 - (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i))) &
24214 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
24215 ! print *,eom12,eom2,om12,om2
24216 !eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
24217 ! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
24218 gvdwx_pepbase(k,j)= gvdwx_pepbase(k,j) + gg(k) &
24219 + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
24220 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
24221 gvdwc_pepbase(k,j)=gvdwc_pepbase(k,j)+gg(k)
24224 END SUBROUTINE sc_grad_pepbase
24225 subroutine eprot_sc_phosphate(escpho)
24227 ! implicit real*8 (a-h,o-z)
24228 ! include 'DIMENSIONS'
24229 ! include 'COMMON.GEO'
24230 ! include 'COMMON.VAR'
24231 ! include 'COMMON.LOCAL'
24232 ! include 'COMMON.CHAIN'
24233 ! include 'COMMON.DERIV'
24234 ! include 'COMMON.NAMES'
24235 ! include 'COMMON.INTERACT'
24236 ! include 'COMMON.IOUNITS'
24237 ! include 'COMMON.CALC'
24238 ! include 'COMMON.CONTROL'
24239 ! include 'COMMON.SBRIDGE'
24241 !el local variables
24242 integer :: iint,itypi,itypi1,itypj,subchap
24243 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
24244 real(kind=8) :: evdw,sig0ij
24245 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
24246 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
24247 sslipi,sslipj,faclip,alpha_sco
24249 real(kind=8) :: fracinbuf
24250 real (kind=8) :: escpho
24251 real (kind=8),dimension(4):: ener
24252 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
24253 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
24254 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
24255 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
24256 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
24257 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
24258 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
24259 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
24260 real(kind=8),dimension(3,2)::chead,erhead_tail
24261 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
24265 ! do i=1,nres_molec(1)
24266 do i=ibond_start,ibond_end
24267 if (itype(i,1).eq.ntyp1_molec(1)) cycle
24269 dxi = dc_norm(1,nres+i)
24270 dyi = dc_norm(2,nres+i)
24271 dzi = dc_norm(3,nres+i)
24272 dsci_inv = vbld_inv(i+nres)
24276 xi=mod(xi,boxxsize)
24277 if (xi.lt.0) xi=xi+boxxsize
24278 yi=mod(yi,boxysize)
24279 if (yi.lt.0) yi=yi+boxysize
24280 zi=mod(zi,boxzsize)
24281 if (zi.lt.0) zi=zi+boxzsize
24282 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
24284 if ((itype(j,2).eq.ntyp1_molec(2)).or.&
24285 (itype(j+1,2).eq.ntyp1_molec(2))) cycle
24286 xj=(c(1,j)+c(1,j+1))/2.0
24287 yj=(c(2,j)+c(2,j+1))/2.0
24288 zj=(c(3,j)+c(3,j+1))/2.0
24289 xj=dmod(xj,boxxsize)
24290 if (xj.lt.0) xj=xj+boxxsize
24291 yj=dmod(yj,boxysize)
24292 if (yj.lt.0) yj=yj+boxysize
24293 zj=dmod(zj,boxzsize)
24294 if (zj.lt.0) zj=zj+boxzsize
24295 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
24303 xj=xj_safe+xshift*boxxsize
24304 yj=yj_safe+yshift*boxysize
24305 zj=zj_safe+zshift*boxzsize
24306 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
24307 if(dist_temp.lt.dist_init) then
24308 dist_init=dist_temp
24317 if (subchap.eq.1) then
24326 dxj = dc_norm( 1,j )
24327 dyj = dc_norm( 2,j )
24328 dzj = dc_norm( 3,j )
24329 dscj_inv = vbld_inv(j+1)
24332 sig0ij = sigma_scpho(itypi )
24333 chi1 = chi_scpho(itypi,1 )
24334 chi2 = chi_scpho(itypi,2 )
24337 chi12 = chi1 * chi2
24338 chip1 = chipp_scpho(itypi,1 )
24339 chip2 = chipp_scpho(itypi,2 )
24342 chip12 = chip1 * chip2
24343 chis1 = chis_scpho(itypi,1)
24344 chis2 = chis_scpho(itypi,2)
24345 chis12 = chis1 * chis2
24346 sig1 = sigmap1_scpho(itypi)
24347 sig2 = sigmap2_scpho(itypi)
24348 ! write (*,*) "sig1 = ", sig1
24349 ! write (*,*) "sig1 = ", sig1
24350 ! write (*,*) "sig2 = ", sig2
24351 ! alpha factors from Fcav/Gcav
24355 a12sq = rborn_scphoi(itypi) * rborn_scphoj(itypi)
24357 b1 = alphasur_scpho(1,itypi)
24359 b2 = alphasur_scpho(2,itypi)
24360 b3 = alphasur_scpho(3,itypi)
24361 b4 = alphasur_scpho(4,itypi)
24362 ! used to determine whether we want to do quadrupole calculations
24364 eps_in = epsintab_scpho(itypi)
24365 if (eps_in.eq.0.0) eps_in=1.0
24366 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
24367 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
24368 !-------------------------------------------------------------------
24369 ! tail location and distance calculations
24370 d1i = dhead_scphoi(itypi) !this is shift of dipole/charge
24373 ! location of polar head is computed by taking hydrophobic centre
24374 ! and moving by a d1 * dc_norm vector
24375 ! see unres publications for very informative images
24376 chead(k,1) = c(k, i+nres) + d1i * dc_norm(k, i+nres)
24377 chead(k,2) = (c(k, j) + c(k, j+1))/2.0
24379 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
24380 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
24381 Rhead_distance(k) = chead(k,2) - chead(k,1)
24383 ! pitagoras (root of sum of squares)
24385 (Rhead_distance(1)*Rhead_distance(1)) &
24386 + (Rhead_distance(2)*Rhead_distance(2)) &
24387 + (Rhead_distance(3)*Rhead_distance(3)))
24388 Rhead_sq=Rhead**2.0
24389 !-------------------------------------------------------------------
24390 ! zero everything that should be zero'ed
24409 dscj_inv = vbld_inv(j+1)/2.0
24410 !dhead_scbasej(itypi,itypj)
24411 ! print *,i,j,dscj_inv,dsci_inv
24412 ! rij holds 1/(distance of Calpha atoms)
24413 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
24415 !----------------------------
24417 ! this should be in elgrad_init but om's are calculated by sc_angular
24418 ! which in turn is used by older potentials
24419 ! om = omega, sqom = om^2
24422 sqom12 = om12 * om12
24424 ! now we calculate EGB - Gey-Berne
24425 ! It will be summed up in evdwij and saved in evdw
24426 sigsq = 1.0D0 / sigsq
24427 sig = sig0ij * dsqrt(sigsq)
24428 ! rij_shift = 1.0D0 / rij - sig + sig0ij
24429 rij_shift = 1.0/rij - sig + sig0ij
24430 IF (rij_shift.le.0.0D0) THEN
24434 sigder = -sig * sigsq
24435 rij_shift = 1.0D0 / rij_shift
24436 fac = rij_shift**expon
24437 c1 = fac * fac * aa_scpho(itypi)
24439 c2 = fac * bb_scpho(itypi)
24441 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
24442 eps2der = eps3rt * evdwij
24443 eps3der = eps2rt * evdwij
24444 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
24445 evdwij = eps2rt * eps3rt * evdwij
24446 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
24447 fac = -expon * (c1 + evdwij) * rij_shift
24448 sigder = fac * sigder
24450 ! Calculate distance derivative
24454 fac = chis1 * sqom1 + chis2 * sqom2 &
24455 - 2.0d0 * chis12 * om1 * om2 * om12
24456 ! we will use pom later in Gcav, so dont mess with it!
24457 pom = 1.0d0 - chis1 * chis2 * sqom12
24458 Lambf = (1.0d0 - (fac / pom))
24459 Lambf = dsqrt(Lambf)
24460 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
24461 ! write (*,*) "sparrow = ", sparrow
24462 Chif = 1.0d0/rij * sparrow
24463 ChiLambf = Chif * Lambf
24464 eagle = dsqrt(ChiLambf)
24465 bat = ChiLambf ** 11.0d0
24466 top = b1 * ( eagle + b2 * ChiLambf - b3 )
24467 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
24470 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
24471 dbot = 12.0d0 * b4 * bat * Lambf
24472 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
24474 ! write (*,*) "dFcav/dR = ", dFdR
24475 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
24476 dbot = 12.0d0 * b4 * bat * Chif
24477 eagle = Lambf * pom
24478 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
24479 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
24480 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
24481 * (chis2 * om2 * om12 - om1) / (eagle * pom)
24483 dFdL = ((dtop * bot - top * dbot) / botsq)
24485 dCAVdOM1 = dFdL * ( dFdOM1 )
24486 dCAVdOM2 = dFdL * ( dFdOM2 )
24487 dCAVdOM12 = dFdL * ( dFdOM12 )
24493 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24494 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24495 ! if (i.eq.3) print *,'decl0',gvdwx_scpho(k,i),i
24498 ! print *,pom,gg(k),dFdR
24499 !-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
24500 gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
24501 - (( dFdR + gg(k) ) * pom)
24502 ! +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i)) &
24503 ! +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
24504 ! & - ( dFdR * pom )
24506 !-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
24507 ! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
24508 ! + (( dFdR + gg(k) ) * pom)
24509 ! +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
24510 ! +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
24511 !c! & + ( dFdR * pom )
24513 gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
24514 - (( dFdR + gg(k) ) * ertail(k))
24515 !c! & - ( dFdR * ertail(k))
24517 gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
24518 + (( dFdR + gg(k) ) * ertail(k))/2.0
24520 gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
24521 + (( dFdR + gg(k) ) * ertail(k))/2.0
24523 !c! & + ( dFdR * ertail(k))
24527 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
24528 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
24529 ! alphapol1 = alphapol_scpho(itypi)
24530 if (wqq_scpho(itypi).ne.0.0) then
24531 Qij=wqq_scpho(itypi)/eps_in
24532 alpha_sco=1.d0/alphi_scpho(itypi)
24534 Ecl = (332.0d0 * Qij*dexp(-Rhead*alpha_sco)) / Rhead
24535 !c! derivative of Ecl is Gcl...
24536 dGCLdR = (-332.0d0 * Qij*dexp(-Rhead*alpha_sco)* &
24537 (Rhead*alpha_sco+1) ) / Rhead_sq
24538 if (energy_dec) write(iout,*) "ECL",ECL,Rhead,1.0/rij
24539 else if (wqdip_scpho(2,itypi).gt.0.0d0) then
24540 w1 = wqdip_scpho(1,itypi)
24541 w2 = wqdip_scpho(2,itypi)
24544 ! pis = sig0head_scbase(itypi,itypj)
24545 ! eps_head = epshead_scbase(itypi,itypj)
24546 !c!-------------------------------------------------------------------
24548 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
24549 !c! & +dhead(1,1,itypi,itypj))**2))
24550 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
24551 !c! & +dhead(2,1,itypi,itypj))**2))
24553 !c!-------------------------------------------------------------------
24556 hawk = w2 * (1.0d0 - sqom2)
24557 Ecl = sparrow / Rhead**2.0d0 &
24558 - hawk / Rhead**4.0d0
24559 !c!-------------------------------------------------------------------
24560 if (energy_dec) write(iout,*) "ECLdipdip",ECL,Rhead,&
24563 !c! derivative of ecl is Gcl
24565 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
24566 + 4.0d0 * hawk / Rhead**5.0d0
24568 dGCLdOM1 = (w1) / (Rhead**2.0d0)
24570 dGCLdOM2 = (2.0d0 * w2 * om2) / (Rhead ** 4.0d0)
24573 !c--------------------------------------------------------------------
24574 !c Polarization energy
24578 !c! Calculate head-to-tail distances tail is center of side-chain
24579 R1=R1+((c(k,j)+c(k,j+1))/2.0-chead(k,1))**2
24584 alphapol1 = alphapol_scpho(itypi)
24586 MomoFac1 = (1.0d0 - chi2 * sqom1)
24587 RR1 = R1 * R1 / MomoFac1
24588 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
24589 ! print *,"ee1",ee1,a12sq,alphapol1,eps_inout_fac
24590 fgb1 = sqrt( RR1 + a12sq * ee1)
24591 ! eps_inout_fac=0.0d0
24592 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
24593 ! derivative of Epol is Gpol...
24594 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
24596 dFGBdR1 = ( (R1 / MomoFac1) &
24597 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
24599 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
24600 * (2.0d0 - 0.5d0 * ee1) ) &
24602 dPOLdR1 = dPOLdFGB1 * dFGBdR1
24605 dFGBdOM1 = (((R1 * R1 * chi2 * om1) / (MomoFac1 * MomoFac1)) &
24606 * (2.0d0 - 0.5d0 * ee1) ) &
24609 dPOLdOM1 = dPOLdFGB1 * dFGBdOM1
24612 erhead(k) = Rhead_distance(k)/Rhead
24613 erhead_tail(k,1) = (((c(k,j)+c(k,j+1))/2.0-chead(k,1))/R1)
24616 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
24617 erdxj = scalar( erhead(1), dC_norm(1,j) )
24618 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
24620 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j))
24621 facd1 = d1i * vbld_inv(i+nres)
24622 facd2 = d1j * vbld_inv(j)
24623 ! facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
24626 hawk = (erhead_tail(k,1) + &
24627 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
24630 ! if (i.eq.3) print *,'decl1',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i,&
24631 ! pom,(erhead_tail(k,1))
24633 ! print *,'decl',dGCLdR,dPOLdR1,gvdwc_scpho(k,i)
24634 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
24635 gvdwx_scpho(k,i) = gvdwx_scpho(k,i) &
24637 - dPOLdR1 * (erhead_tail(k,1))
24640 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j))
24641 ! gvdwx_scpho(k,j) = gvdwx_scpho(k,j) &
24643 ! + dPOLdR1 * (erhead_tail(k,1))
24647 gvdwc_scpho(k,i) = gvdwc_scpho(k,i) &
24648 - dGCLdR * erhead(k) &
24649 - dPOLdR1 * erhead_tail(k,1)
24650 ! & - dGLJdR * erhead(k)
24652 gvdwc_scpho(k,j) = gvdwc_scpho(k,j) &
24653 + (dGCLdR * erhead(k) &
24654 + dPOLdR1 * erhead_tail(k,1))/2.0
24655 gvdwc_scpho(k,j+1) = gvdwc_scpho(k,j+1) &
24656 + (dGCLdR * erhead(k) &
24657 + dPOLdR1 * erhead_tail(k,1))/2.0
24659 ! & + dGLJdR * erhead(k)
24660 ! if (i.eq.3) print *,'decl2',dGCLdR,dPOLdR1,gvdwc_scpho(k,i),i
24663 ! if (i.eq.3) print *,i,j,evdwij,epol,Fcav,ECL
24664 if (energy_dec) write (iout,'(a22,2i5,4f8.3,f16.3)'), &
24665 "escpho:evdw,pol,cav,CL",i,j,evdwij,epol,Fcav,ECL,escpho
24666 escpho=escpho+evdwij+epol+Fcav+ECL
24673 end subroutine eprot_sc_phosphate
24674 SUBROUTINE sc_grad_scpho
24677 real (kind=8) :: dcosom1(3),dcosom2(3)
24679 eps2der * eps2rt_om1 &
24680 - 2.0D0 * alf1 * eps3der &
24681 + sigder * sigsq_om1 &
24687 eps2der * eps2rt_om2 &
24688 + 2.0D0 * alf2 * eps3der &
24689 + sigder * sigsq_om2 &
24695 evdwij * eps1_om12 &
24696 + eps2der * eps2rt_om12 &
24697 - 2.0D0 * alf12 * eps3der &
24698 + sigder *sigsq_om12 &
24703 ! print *,eom1,eom2,eom12,om12,i,j,"eom1,2,12",erij(1),erij(2),erij(3)
24704 ! if (i.eq.30) print *,gvdwc_scpho(k,i),- gg(k),&
24705 ! (-eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,i)))&
24707 ! print *,dsci_inv,dscj_inv,dc_norm(2,nres+j),dc_norm(2,nres+i),&
24708 ! gg(1),gg(2),"rozne"
24710 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
24711 dcosom2(k) = rij * (dc_norm(k,j) - om2 * erij(k))
24712 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
24713 gvdwc_scpho(k,j)= gvdwc_scpho(k,j) +0.5*( gg(k)) &
24714 + (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j)))&
24716 - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
24717 gvdwc_scpho(k,j+1)= gvdwc_scpho(k,j+1) +0.5*( gg(k)) &
24718 - (-eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,j))) &
24720 + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
24721 gvdwx_scpho(k,i)= gvdwx_scpho(k,i) - gg(k) &
24722 + (eom12*(dc_norm(k,j)-om12*dc_norm(k,nres+i)) &
24723 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
24725 ! print *,eom12,eom2,om12,om2
24726 !eom12*(-dc_norm(k,i)/2.0-om12*dc_norm(k,nres+j)),&
24727 ! (eom2*(erij(k)-om2*dc_norm(k,nres+j)))
24728 ! gvdwx_scpho(k,j)= gvdwx_scpho(k,j) + gg(k) &
24729 ! + (eom12*(dc_norm(k,i)-om12*dc_norm(k,nres+j))&
24730 ! + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
24731 gvdwc_scpho(k,i)=gvdwc_scpho(k,i)-gg(k)
24734 END SUBROUTINE sc_grad_scpho
24735 subroutine eprot_pep_phosphate(epeppho)
24737 ! implicit real*8 (a-h,o-z)
24738 ! include 'DIMENSIONS'
24739 ! include 'COMMON.GEO'
24740 ! include 'COMMON.VAR'
24741 ! include 'COMMON.LOCAL'
24742 ! include 'COMMON.CHAIN'
24743 ! include 'COMMON.DERIV'
24744 ! include 'COMMON.NAMES'
24745 ! include 'COMMON.INTERACT'
24746 ! include 'COMMON.IOUNITS'
24747 ! include 'COMMON.CALC'
24748 ! include 'COMMON.CONTROL'
24749 ! include 'COMMON.SBRIDGE'
24751 !el local variables
24752 integer :: iint,itypi,itypi1,itypj,subchap
24753 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,fac,e1,e2,sigm,epsi
24754 real(kind=8) :: evdw,sig0ij
24755 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
24756 dist_temp, dist_init,aa,bb,ssgradlipi,ssgradlipj, &
24757 sslipi,sslipj,faclip
24759 real(kind=8) :: fracinbuf
24760 real (kind=8) :: epeppho
24761 real (kind=8),dimension(4):: ener
24762 real(kind=8) :: b1,b2,b3,b4,egb,eps_in,eps_inout_fac,eps_out
24763 real(kind=8) :: ECL,Elj,Equad,Epol,eheadtail,rhead,dGCLOM2,&
24764 sqom1,sqom2,sqom12,c1,c2,pom,Lambf,sparrow,&
24765 Chif,ChiLambf,bat,eagle,top,bot,botsq,Fcav,dtop,dFdR,dFdOM1,&
24766 dFdOM2,w1,w2,dGCLdR,dFdL,dFdOM12,dbot ,&
24767 r1,eps_head,alphapol1,pis,facd2,d2,facd1,d1,erdxj,erdxi,federmaus,&
24768 dPOLdR1,dFGBdOM2,dFGBdR1,dPOLdFGB1,RR1,MomoFac1,hawk,d1i,d1j,&
24769 sig1,sig2,chis12,chis2,ee1,fgb1,a12sq,chis1,Rhead_sq,Qij,dFGBdOM1
24770 real(kind=8),dimension(3,2)::chead,erhead_tail
24771 real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead
24773 real (kind=8) :: dcosom1(3),dcosom2(3)
24775 ! do i=1,nres_molec(1)
24776 do i=ibond_start,ibond_end
24777 if (itype(i,1).eq.ntyp1_molec(1)) cycle
24779 dsci_inv = vbld_inv(i+1)/2.0
24783 xi=(c(1,i)+c(1,i+1))/2.0
24784 yi=(c(2,i)+c(2,i+1))/2.0
24785 zi=(c(3,i)+c(3,i+1))/2.0
24786 xi=mod(xi,boxxsize)
24787 if (xi.lt.0) xi=xi+boxxsize
24788 yi=mod(yi,boxysize)
24789 if (yi.lt.0) yi=yi+boxysize
24790 zi=mod(zi,boxzsize)
24791 if (zi.lt.0) zi=zi+boxzsize
24792 do j=nres_molec(1)+1,nres_molec(2)+nres_molec(1)-1
24794 if ((itype(j,2).eq.ntyp1_molec(2)).or.&
24795 (itype(j+1,2).eq.ntyp1_molec(2))) cycle
24796 xj=(c(1,j)+c(1,j+1))/2.0
24797 yj=(c(2,j)+c(2,j+1))/2.0
24798 zj=(c(3,j)+c(3,j+1))/2.0
24799 xj=dmod(xj,boxxsize)
24800 if (xj.lt.0) xj=xj+boxxsize
24801 yj=dmod(yj,boxysize)
24802 if (yj.lt.0) yj=yj+boxysize
24803 zj=dmod(zj,boxzsize)
24804 if (zj.lt.0) zj=zj+boxzsize
24805 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
24813 xj=xj_safe+xshift*boxxsize
24814 yj=yj_safe+yshift*boxysize
24815 zj=zj_safe+zshift*boxzsize
24816 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
24817 if(dist_temp.lt.dist_init) then
24818 dist_init=dist_temp
24827 if (subchap.eq.1) then
24836 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
24838 dxj = dc_norm( 1,j )
24839 dyj = dc_norm( 2,j )
24840 dzj = dc_norm( 3,j )
24841 dscj_inv = vbld_inv(j+1)/2.0
24843 sig0ij = sigma_peppho
24846 chi12 = chi1 * chi2
24849 chip12 = chip1 * chip2
24852 chis12 = chis1 * chis2
24853 sig1 = sigmap1_peppho
24854 sig2 = sigmap2_peppho
24855 ! write (*,*) "sig1 = ", sig1
24856 ! write (*,*) "sig1 = ", sig1
24857 ! write (*,*) "sig2 = ", sig2
24858 ! alpha factors from Fcav/Gcav
24862 b1 = alphasur_peppho(1)
24864 b2 = alphasur_peppho(2)
24865 b3 = alphasur_peppho(3)
24866 b4 = alphasur_peppho(4)
24888 fac = rij_shift**expon
24889 c1 = fac * fac * aa_peppho
24891 c2 = fac * bb_peppho
24894 ! Now cavity....................
24895 eagle = dsqrt(1.0/rij_shift)
24896 top = b1 * ( eagle + b2 * 1.0/rij_shift - b3 )
24897 bot = 1.0d0 + b4 * (1.0/rij_shift ** 12.0d0)
24900 dtop = b1 * ((1.0/ (2.0d0 * eagle)) + (b2))
24901 dbot = 12.0d0 * b4 * (1.0/rij_shift) ** 11.0d0
24902 dFdR = ((dtop * bot - top * dbot) / botsq)
24903 w1 = wqdip_peppho(1)
24904 w2 = wqdip_peppho(2)
24907 ! pis = sig0head_scbase(itypi,itypj)
24908 ! eps_head = epshead_scbase(itypi,itypj)
24909 !c!-------------------------------------------------------------------
24911 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
24912 !c! & +dhead(1,1,itypi,itypj))**2))
24913 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
24914 !c! & +dhead(2,1,itypi,itypj))**2))
24916 !c!-------------------------------------------------------------------
24919 hawk = w2 * (1.0d0 - sqom1)
24920 Ecl = sparrow * rij_shift**2.0d0 &
24921 - hawk * rij_shift**4.0d0
24922 !c!-------------------------------------------------------------------
24923 !c! derivative of ecl is Gcl
24926 dGCLdR = - 2.0d0 * sparrow * rij_shift**3.0d0 &
24927 + 4.0d0 * hawk * rij_shift**5.0d0
24929 dGCLdOM1 = (w1) * (rij_shift**2.0d0)
24931 dGCLdOM2 = (2.0d0 * w2 * om1) * (rij_shift ** 4.0d0)
24932 eom1 = dGCLdOM1+dGCLdOM2
24935 fac = -expon * (c1 + evdwij) * rij_shift+dFdR+dGCLdR
24941 gvdwc_peppho(k,j) = gvdwc_peppho(k,j) +gg(k)/2.0
24942 gvdwc_peppho(k,j+1) = gvdwc_peppho(k,j+1) +gg(k)/2.0
24943 gvdwc_peppho(k,i) = gvdwc_peppho(k,i) -gg(k)/2.0
24944 gvdwc_peppho(k,i+1) = gvdwc_peppho(k,i+1) -gg(k)/2.0
24949 dcosom1(k) = rij* (dc_norm(k,i) - om1 * erij(k))
24950 dcosom2(k) = rij* (dc_norm(k,j) - om2 * erij(k))
24951 gg(k) = gg(k) + eom1 * dcosom1(k)! + eom2 * dcosom2(k)
24952 gvdwc_peppho(k,j)= gvdwc_peppho(k,j) +0.5*( gg(k)) !&
24953 ! - (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
24954 gvdwc_peppho(k,j+1)= gvdwc_peppho(k,j+1) +0.5*( gg(k)) !&
24955 ! + (eom2*(erij(k)-om2*dc_norm(k,j)))*dscj_inv*2.0
24956 gvdwc_peppho(k,i)= gvdwc_peppho(k,i) -0.5*( gg(k)) &
24957 - (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
24958 gvdwc_peppho(k,i+1)= gvdwc_peppho(k,i+1) - 0.5*( gg(k)) &
24959 + (eom1*(erij(k)-om1*dc_norm(k,i)))*dsci_inv*2.0
24961 epeppho=epeppho+evdwij+Fcav+ECL
24962 ! print *,i,j,evdwij,Fcav,ECL,rij_shift
24965 end subroutine eprot_pep_phosphate
24966 !!!!!!!!!!!!!!!!-------------------------------------------------------------
24967 subroutine emomo(evdw)
24970 ! implicit real*8 (a-h,o-z)
24971 ! include 'DIMENSIONS'
24972 ! include 'COMMON.GEO'
24973 ! include 'COMMON.VAR'
24974 ! include 'COMMON.LOCAL'
24975 ! include 'COMMON.CHAIN'
24976 ! include 'COMMON.DERIV'
24977 ! include 'COMMON.NAMES'
24978 ! include 'COMMON.INTERACT'
24979 ! include 'COMMON.IOUNITS'
24980 ! include 'COMMON.CALC'
24981 ! include 'COMMON.CONTROL'
24982 ! include 'COMMON.SBRIDGE'
24984 !el local variables
24985 integer :: iint,itypi1,subchap,isel
24986 real(kind=8) :: rrij,xi,yi,zi,sig,rij_shift,e1,e2,sigm,epsi
24987 real(kind=8) :: evdw
24988 real(kind=8) :: xj_safe,yj_safe,zj_safe,xj_temp,yj_temp,zj_temp,&
24989 dist_temp, dist_init,ssgradlipi,ssgradlipj, &
24990 sslipi,sslipj,faclip,alpha_sco
24992 real(kind=8) :: fracinbuf
24993 real (kind=8) :: escpho
24994 real (kind=8),dimension(4):: ener
24995 real(kind=8) :: b1,b2,egb
24996 real(kind=8) :: Fisocav,ECL,Elj,Equad,Epol,eheadtail,&
24998 Chif,ChiLambf,Fcav,dFdR,dFdOM1,&
24999 dFdOM2,dFdL,dFdOM12,&
25002 ! real(kind=8),dimension(3,2)::erhead_tail
25003 ! real(kind=8),dimension(3) :: Rhead_distance,ertail,erhead,Rtail_distance
25004 real(kind=8) :: facd4, adler, Fgb, facd3
25005 integer troll,jj,istate
25006 real (kind=8) :: dcosom1(3),dcosom2(3)
25009 ! print *,"EVDW KURW",evdw,nres
25010 do i=iatsc_s,iatsc_e
25011 ! print *,"I am in EVDW",i
25012 itypi=iabs(itype(i,1))
25013 ! if (i.ne.47) cycle
25014 if (itypi.eq.ntyp1) cycle
25015 itypi1=iabs(itype(i+1,1))
25019 xi=dmod(xi,boxxsize)
25020 if (xi.lt.0) xi=xi+boxxsize
25021 yi=dmod(yi,boxysize)
25022 if (yi.lt.0) yi=yi+boxysize
25023 zi=dmod(zi,boxzsize)
25024 if (zi.lt.0) zi=zi+boxzsize
25026 if ((zi.gt.bordlipbot) &
25027 .and.(zi.lt.bordliptop)) then
25028 !C the energy transfer exist
25029 if (zi.lt.buflipbot) then
25030 !C what fraction I am in
25032 ((zi-bordlipbot)/lipbufthick)
25033 !C lipbufthick is thickenes of lipid buffore
25034 sslipi=sscalelip(fracinbuf)
25035 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
25036 elseif (zi.gt.bufliptop) then
25037 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
25038 sslipi=sscalelip(fracinbuf)
25039 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
25048 ! print *, sslipi,ssgradlipi
25049 dxi=dc_norm(1,nres+i)
25050 dyi=dc_norm(2,nres+i)
25051 dzi=dc_norm(3,nres+i)
25052 ! dsci_inv=dsc_inv(itypi)
25053 dsci_inv=vbld_inv(i+nres)
25054 ! write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
25055 ! write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
25057 ! Calculate SC interaction energy.
25059 do iint=1,nint_gr(i)
25060 do j=istart(i,iint),iend(i,iint)
25061 ! print *,"JA PIER",i,j,iint,istart(i,iint),iend(i,iint)
25062 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
25063 call dyn_ssbond_ene(i,j,evdwij)
25065 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
25066 'evdw',i,j,evdwij,' ss'
25067 ! if (energy_dec) write (iout,*) &
25068 ! 'evdw',i,j,evdwij,' ss'
25069 do k=j+1,iend(i,iint)
25070 !C search over all next residues
25071 if (dyn_ss_mask(k)) then
25072 !C check if they are cysteins
25073 !C write(iout,*) 'k=',k
25075 !c write(iout,*) "PRZED TRI", evdwij
25076 ! evdwij_przed_tri=evdwij
25077 call triple_ssbond_ene(i,j,k,evdwij)
25078 !c if(evdwij_przed_tri.ne.evdwij) then
25079 !c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
25082 !c write(iout,*) "PO TRI", evdwij
25083 !C call the energy function that removes the artifical triple disulfide
25084 !C bond the soubroutine is located in ssMD.F
25086 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)') &
25087 'evdw',i,j,evdwij,'tss'
25088 endif!dyn_ss_mask(k)
25092 itypj=iabs(itype(j,1))
25093 if (itypj.eq.ntyp1) cycle
25094 CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
25096 ! if (j.ne.78) cycle
25097 ! dscj_inv=dsc_inv(itypj)
25098 dscj_inv=vbld_inv(j+nres)
25102 xj=dmod(xj,boxxsize)
25103 if (xj.lt.0) xj=xj+boxxsize
25104 yj=dmod(yj,boxysize)
25105 if (yj.lt.0) yj=yj+boxysize
25106 zj=dmod(zj,boxzsize)
25107 if (zj.lt.0) zj=zj+boxzsize
25108 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
25117 xj=xj_safe+xshift*boxxsize
25118 yj=yj_safe+yshift*boxysize
25119 zj=zj_safe+zshift*boxzsize
25120 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
25121 if(dist_temp.lt.dist_init) then
25122 dist_init=dist_temp
25131 if (subchap.eq.1) then
25140 dxj = dc_norm( 1, nres+j )
25141 dyj = dc_norm( 2, nres+j )
25142 dzj = dc_norm( 3, nres+j )
25143 ! print *,i,j,itypi,itypj
25146 ! BetaT = 1.0d0 / (298.0d0 * Rb)
25148 !1! sig0ij = sigma_scsc( itypi,itypj )
25153 ! not used by momo potential, but needed by sc_angular which is shared
25154 ! by all energy_potential subroutines
25158 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
25159 ! a12sq = a12sq * a12sq
25160 ! charge of amino acid itypi is...
25161 chis1 = chis(itypi,itypj)
25162 chis2 = chis(itypj,itypi)
25163 chis12 = chis1 * chis2
25164 sig1 = sigmap1(itypi,itypj)
25165 sig2 = sigmap2(itypi,itypj)
25166 ! write (*,*) "sig1 = ", sig1
25169 ! chis12 = chis1 * chis2
25172 ! write (*,*) "sig2 = ", sig2
25173 ! alpha factors from Fcav/Gcav
25174 b1cav = alphasur(1,itypi,itypj)
25176 b2cav = alphasur(2,itypi,itypj)
25177 b3cav = alphasur(3,itypi,itypj)
25178 b4cav = alphasur(4,itypi,itypj)
25179 ! used to determine whether we want to do quadrupole calculations
25180 eps_in = epsintab(itypi,itypj)
25181 if (eps_in.eq.0.0) eps_in=1.0
25183 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
25185 ! dtail(1,itypi,itypj)=0.0
25186 ! dtail(2,itypi,itypj)=0.0
25189 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
25190 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
25192 !c! tail distances will be themselves usefull elswhere
25193 !c1 (in Gcav, for example)
25194 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
25195 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
25196 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
25198 (Rtail_distance(1)*Rtail_distance(1)) &
25199 + (Rtail_distance(2)*Rtail_distance(2)) &
25200 + (Rtail_distance(3)*Rtail_distance(3)))
25202 ! write (*,*) "eps_inout_fac = ", eps_inout_fac
25203 !-------------------------------------------------------------------
25204 ! tail location and distance calculations
25205 d1 = dhead(1, 1, itypi, itypj)
25206 d2 = dhead(2, 1, itypi, itypj)
25209 ! location of polar head is computed by taking hydrophobic centre
25210 ! and moving by a d1 * dc_norm vector
25211 ! see unres publications for very informative images
25212 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
25213 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
25215 ! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
25216 ! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
25217 Rhead_distance(k) = chead(k,2) - chead(k,1)
25219 ! pitagoras (root of sum of squares)
25221 (Rhead_distance(1)*Rhead_distance(1)) &
25222 + (Rhead_distance(2)*Rhead_distance(2)) &
25223 + (Rhead_distance(3)*Rhead_distance(3)))
25224 !-------------------------------------------------------------------
25225 ! zero everything that should be zero'ed
25243 dscj_inv = vbld_inv(j+nres)
25244 ! print *,i,j,dscj_inv,dsci_inv
25245 ! rij holds 1/(distance of Calpha atoms)
25246 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
25248 !----------------------------
25250 ! this should be in elgrad_init but om's are calculated by sc_angular
25251 ! which in turn is used by older potentials
25252 ! om = omega, sqom = om^2
25255 sqom12 = om12 * om12
25257 ! now we calculate EGB - Gey-Berne
25258 ! It will be summed up in evdwij and saved in evdw
25259 sigsq = 1.0D0 / sigsq
25260 sig = sig0ij * dsqrt(sigsq)
25261 ! rij_shift = 1.0D0 / rij - sig + sig0ij
25262 rij_shift = Rtail - sig + sig0ij
25263 IF (rij_shift.le.0.0D0) THEN
25267 sigder = -sig * sigsq
25268 rij_shift = 1.0D0 / rij_shift
25269 fac = rij_shift**expon
25270 c1 = fac * fac * aa_aq(itypi,itypj)
25271 ! print *,"ADAM",aa_aq(itypi,itypj)
25274 c2 = fac * bb_aq(itypi,itypj)
25276 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
25277 eps2der = eps3rt * evdwij
25278 eps3der = eps2rt * evdwij
25279 ! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
25280 evdwij = eps2rt * eps3rt * evdwij
25282 ! IF (bb_aq(itypi,itypj).gt.0) THEN
25283 ! evdw_p = evdw_p + evdwij
25285 ! evdw_m = evdw_m + evdwij
25292 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
25293 fac = -expon * (c1 + evdwij) * rij_shift
25294 sigder = fac * sigder
25296 ! Calculate distance derivative
25300 ! if (b2.gt.0.0) then
25301 fac = chis1 * sqom1 + chis2 * sqom2 &
25302 - 2.0d0 * chis12 * om1 * om2 * om12
25303 ! we will use pom later in Gcav, so dont mess with it!
25304 pom = 1.0d0 - chis1 * chis2 * sqom12
25305 Lambf = (1.0d0 - (fac / pom))
25306 ! print *,"fac,pom",fac,pom,Lambf
25307 Lambf = dsqrt(Lambf)
25308 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
25309 ! print *,"sig1,sig2",sig1,sig2,itypi,itypj
25310 ! write (*,*) "sparrow = ", sparrow
25311 Chif = Rtail * sparrow
25312 ! print *,"rij,sparrow",rij , sparrow
25313 ChiLambf = Chif * Lambf
25314 eagle = dsqrt(ChiLambf)
25315 bat = ChiLambf ** 11.0d0
25316 top = b1cav * ( eagle + b2cav * ChiLambf - b3cav )
25317 bot = 1.0d0 + b4cav * (ChiLambf ** 12.0d0)
25319 ! print *,top,bot,"bot,top",ChiLambf,Chif
25322 dtop = b1cav * ((Lambf / (2.0d0 * eagle)) + (b2cav * Lambf))
25323 dbot = 12.0d0 * b4cav * bat * Lambf
25324 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
25326 dtop = b1cav * ((Chif / (2.0d0 * eagle)) + (b2cav * Chif))
25327 dbot = 12.0d0 * b4cav * bat * Chif
25328 eagle = Lambf * pom
25329 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
25330 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
25331 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2) &
25332 * (chis2 * om2 * om12 - om1) / (eagle * pom)
25334 dFdL = ((dtop * bot - top * dbot) / botsq)
25336 dCAVdOM1 = dFdL * ( dFdOM1 )
25337 dCAVdOM2 = dFdL * ( dFdOM2 )
25338 dCAVdOM12 = dFdL * ( dFdOM12 )
25341 ertail(k) = Rtail_distance(k)/Rtail
25343 erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
25344 erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
25345 facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
25346 facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
25348 !c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
25349 !c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
25350 pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
25351 gvdwx(k,i) = gvdwx(k,i) &
25352 - (( dFdR + gg(k) ) * pom)
25353 !c! & - ( dFdR * pom )
25354 pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
25355 gvdwx(k,j) = gvdwx(k,j) &
25356 + (( dFdR + gg(k) ) * pom)
25357 !c! & + ( dFdR * pom )
25359 gvdwc(k,i) = gvdwc(k,i) &
25360 - (( dFdR + gg(k) ) * ertail(k))
25361 !c! & - ( dFdR * ertail(k))
25363 gvdwc(k,j) = gvdwc(k,j) &
25364 + (( dFdR + gg(k) ) * ertail(k))
25365 !c! & + ( dFdR * ertail(k))
25368 ! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
25369 ! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
25373 !c! Compute head-head and head-tail energies for each state
25375 isel = iabs(Qi) + iabs(Qj)
25376 ! double charge for Phophorylated! itype - 25,27,27
25377 ! if ((itype(i).eq.27).or.(itype(i).eq.26).or.(itype(i).eq.25)) then
25381 ! if ((itype(j).eq.27).or.(itype(j).eq.26).or.(itype(j).eq.25)) then
25387 IF (isel.eq.0) THEN
25388 !c! No charges - do nothing
25391 ELSE IF (isel.eq.4) THEN
25392 !c! Calculate dipole-dipole interactions
25395 ! eheadtail = 0.0d0
25397 ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
25398 !c! Charge-nonpolar interactions
25399 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
25403 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
25410 ! eheadtail = 0.0d0
25412 ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
25413 !c! Nonpolar-charge interactions
25414 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
25418 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
25425 ! eheadtail = 0.0d0
25427 ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
25428 !c! Charge-dipole interactions
25429 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
25433 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
25438 CALL eqd(ecl, elj, epol)
25439 eheadtail = ECL + elj + epol
25440 ! eheadtail = 0.0d0
25442 ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
25443 !c! Dipole-charge interactions
25444 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
25448 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
25452 CALL edq(ecl, elj, epol)
25453 eheadtail = ECL + elj + epol
25454 ! eheadtail = 0.0d0
25456 ELSE IF ((isel.eq.2.and. &
25457 iabs(Qi).eq.1).and. &
25458 nstate(itypi,itypj).eq.1) THEN
25459 !c! Same charge-charge interaction ( +/+ or -/- )
25460 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
25464 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
25469 CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
25470 eheadtail = ECL + Egb + Epol + Fisocav + Elj
25471 ! eheadtail = 0.0d0
25473 ELSE IF ((isel.eq.2.and. &
25474 iabs(Qi).eq.1).and. &
25475 nstate(itypi,itypj).ne.1) THEN
25476 !c! Different charge-charge interaction ( +/- or -/+ )
25477 if ((itype(i,1).eq.27).or.(itype(i,1).eq.26).or.(itype(i,1).eq.25)) then
25481 if ((itype(j,1).eq.27).or.(itype(j,1).eq.26).or.(itype(j,1).eq.25)) then
25486 CALL energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
25488 END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
25489 evdw = evdw + Fcav + eheadtail
25491 IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,10f16.7)') &
25492 restyp(itype(i,1),1),i,restyp(itype(j,1),1),j,&
25493 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,&
25494 Equad,evdwij+Fcav+eheadtail,evdw
25495 ! evdw = evdw + Fcav + eheadtail
25497 iF (nstate(itypi,itypj).eq.1) THEN
25500 !c!-------------------------------------------------------------------
25505 !c write (iout,*) "Number of loop steps in EGB:",ind
25506 !c energy_dec=.false.
25507 ! print *,"EVDW KURW",evdw,nres
25510 END SUBROUTINE emomo
25511 !C------------------------------------------------------------------------------------
25512 SUBROUTINE eqq(Ecl,Egb,Epol,Fisocav,Elj)
25515 real (kind=8) :: facd3, facd4, federmaus, adler,&
25516 Ecl,Egb,Epol,Fisocav,Elj,Fgb
25518 !c! Epol and Gpol analytical parameters
25519 alphapol1 = alphapol(itypi,itypj)
25520 alphapol2 = alphapol(itypj,itypi)
25521 !c! Fisocav and Gisocav analytical parameters
25522 al1 = alphiso(1,itypi,itypj)
25523 al2 = alphiso(2,itypi,itypj)
25524 al3 = alphiso(3,itypi,itypj)
25525 al4 = alphiso(4,itypi,itypj)
25527 / dsqrt(sigiso1(itypi, itypj)**2.0d0 &
25528 + sigiso2(itypi,itypj)**2.0d0))
25530 pis = sig0head(itypi,itypj)
25531 eps_head = epshead(itypi,itypj)
25532 Rhead_sq = Rhead * Rhead
25533 !c! R1 - distance between head of ith side chain and tail of jth sidechain
25534 !c! R2 - distance between head of jth side chain and tail of ith sidechain
25538 !c! Calculate head-to-tail distances needed by Epol
25539 R1=R1+(ctail(k,2)-chead(k,1))**2
25540 R2=R2+(chead(k,2)-ctail(k,1))**2
25546 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
25547 !c! & +dhead(1,1,itypi,itypj))**2))
25548 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
25549 !c! & +dhead(2,1,itypi,itypj))**2))
25551 !c!-------------------------------------------------------------------
25552 !c! Coulomb electrostatic interaction
25553 Ecl = (332.0d0 * Qij) / Rhead
25554 !c! derivative of Ecl is Gcl...
25555 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
25559 ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
25560 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
25561 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
25562 ! print *,"EGB WTF",Qij,eps_inout_fac,Fgb,itypi,itypj,eps_in,eps_out
25563 !c! Derivative of Egb is Ggb...
25564 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
25565 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )/ ( 2.0d0 * Fgb )
25566 dGGBdR = dGGBdFGB * dFGBdR
25567 !c!-------------------------------------------------------------------
25568 !c! Fisocav - isotropic cavity creation term
25569 !c! or "how much energy it costs to put charged head in water"
25571 top = al1 * (dsqrt(pom) + al2 * pom - al3)
25572 bot = (1.0d0 + al4 * pom**12.0d0)
25574 FisoCav = top / bot
25575 ! write (*,*) "Rhead = ",Rhead
25576 ! write (*,*) "csig = ",csig
25577 ! write (*,*) "pom = ",pom
25578 ! write (*,*) "al1 = ",al1
25579 ! write (*,*) "al2 = ",al2
25580 ! write (*,*) "al3 = ",al3
25581 ! write (*,*) "al4 = ",al4
25582 ! write (*,*) "top = ",top
25583 ! write (*,*) "bot = ",bot
25584 !c! Derivative of Fisocav is GCV...
25585 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
25586 dbot = 12.0d0 * al4 * pom ** 11.0d0
25587 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
25588 !c!-------------------------------------------------------------------
25590 !c! Polarization energy - charged heads polarize hydrophobic "neck"
25591 MomoFac1 = (1.0d0 - chi1 * sqom2)
25592 MomoFac2 = (1.0d0 - chi2 * sqom1)
25593 RR1 = ( R1 * R1 ) / MomoFac1
25594 RR2 = ( R2 * R2 ) / MomoFac2
25595 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
25596 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
25597 fgb1 = sqrt( RR1 + a12sq * ee1 )
25598 fgb2 = sqrt( RR2 + a12sq * ee2 )
25599 epol = 332.0d0 * eps_inout_fac * ( &
25600 (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
25602 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
25604 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
25606 dFGBdR1 = ( (R1 / MomoFac1)* ( 2.0d0 - (0.5d0 * ee1) ) )&
25608 dFGBdR2 = ( (R2 / MomoFac2)* ( 2.0d0 - (0.5d0 * ee2) ) )&
25610 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))&
25611 * ( 2.0d0 - 0.5d0 * ee1) ) / ( 2.0d0 * fgb1 )
25612 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))&
25613 * ( 2.0d0 - 0.5d0 * ee2) ) / ( 2.0d0 * fgb2 )
25614 dPOLdR1 = dPOLdFGB1 * dFGBdR1
25615 !c! dPOLdR1 = 0.0d0
25616 dPOLdR2 = dPOLdFGB2 * dFGBdR2
25617 !c! dPOLdR2 = 0.0d0
25618 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
25619 !c! dPOLdOM1 = 0.0d0
25620 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
25621 !c! dPOLdOM2 = 0.0d0
25622 !c!-------------------------------------------------------------------
25624 !c! Lennard-Jones 6-12 interaction between heads
25625 pom = (pis / Rhead)**6.0d0
25626 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
25627 !c! derivative of Elj is Glj
25628 dGLJdR = 4.0d0 * eps_head*(((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))&
25629 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
25630 !c!-------------------------------------------------------------------
25631 !c! Return the results
25632 !c! These things do the dRdX derivatives, that is
25633 !c! allow us to change what we see from function that changes with
25634 !c! distance to function that changes with LOCATION (of the interaction
25637 erhead(k) = Rhead_distance(k)/Rhead
25638 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
25639 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
25642 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
25643 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
25644 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
25645 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
25646 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
25647 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
25648 facd1 = d1 * vbld_inv(i+nres)
25649 facd2 = d2 * vbld_inv(j+nres)
25650 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
25651 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
25653 !c! Now we add appropriate partial derivatives (one in each dimension)
25655 hawk = (erhead_tail(k,1) + &
25656 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
25657 condor = (erhead_tail(k,2) + &
25658 facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
25660 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
25661 gvdwx(k,i) = gvdwx(k,i) &
25666 - dPOLdR2 * (erhead_tail(k,2)&
25667 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
25670 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
25671 gvdwx(k,j) = gvdwx(k,j)+ dGCLdR * pom&
25672 + dGGBdR * pom+ dGCVdR * pom&
25673 + dPOLdR1 * (erhead_tail(k,1)&
25674 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))&
25675 + dPOLdR2 * condor + dGLJdR * pom
25677 gvdwc(k,i) = gvdwc(k,i) &
25678 - dGCLdR * erhead(k)&
25679 - dGGBdR * erhead(k)&
25680 - dGCVdR * erhead(k)&
25681 - dPOLdR1 * erhead_tail(k,1)&
25682 - dPOLdR2 * erhead_tail(k,2)&
25683 - dGLJdR * erhead(k)
25685 gvdwc(k,j) = gvdwc(k,j) &
25686 + dGCLdR * erhead(k) &
25687 + dGGBdR * erhead(k) &
25688 + dGCVdR * erhead(k) &
25689 + dPOLdR1 * erhead_tail(k,1) &
25690 + dPOLdR2 * erhead_tail(k,2)&
25691 + dGLJdR * erhead(k)
25696 !c!-------------------------------------------------------------------
25697 SUBROUTINE energy_quad(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
25701 double precision eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad
25702 double precision ener(4)
25703 double precision dcosom1(3),dcosom2(3)
25704 !c! used in Epol derivatives
25705 double precision facd3, facd4
25706 double precision federmaus, adler
25707 integer istate,ii,jj
25708 real (kind=8) :: Fgb
25709 ! print *,"CALLING EQUAD"
25710 !c! Epol and Gpol analytical parameters
25711 alphapol1 = alphapol(itypi,itypj)
25712 alphapol2 = alphapol(itypj,itypi)
25713 !c! Fisocav and Gisocav analytical parameters
25714 al1 = alphiso(1,itypi,itypj)
25715 al2 = alphiso(2,itypi,itypj)
25716 al3 = alphiso(3,itypi,itypj)
25717 al4 = alphiso(4,itypi,itypj)
25718 csig = (1.0d0 / dsqrt(sigiso1(itypi, itypj)**2.0d0&
25719 + sigiso2(itypi,itypj)**2.0d0))
25721 w1 = wqdip(1,itypi,itypj)
25722 w2 = wqdip(2,itypi,itypj)
25723 pis = sig0head(itypi,itypj)
25724 eps_head = epshead(itypi,itypj)
25725 !c! First things first:
25726 !c! We need to do sc_grad's job with GB and Fcav
25727 eom1 = eps2der * eps2rt_om1 &
25728 - 2.0D0 * alf1 * eps3der&
25729 + sigder * sigsq_om1&
25731 eom2 = eps2der * eps2rt_om2 &
25732 + 2.0D0 * alf2 * eps3der&
25733 + sigder * sigsq_om2&
25735 eom12 = evdwij * eps1_om12 &
25736 + eps2der * eps2rt_om12 &
25737 - 2.0D0 * alf12 * eps3der&
25738 + sigder *sigsq_om12&
25740 !c! now some magical transformations to project gradient into
25741 !c! three cartesian vectors
25743 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
25744 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
25745 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
25746 !c! this acts on hydrophobic center of interaction
25747 gvdwx(k,i)= gvdwx(k,i) - gg(k) &
25748 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
25749 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
25750 gvdwx(k,j)= gvdwx(k,j) + gg(k) &
25751 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))&
25752 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
25753 !c! this acts on Calpha
25754 gvdwc(k,i)=gvdwc(k,i)-gg(k)
25755 gvdwc(k,j)=gvdwc(k,j)+gg(k)
25757 !c! sc_grad is done, now we will compute
25762 DO istate = 1, nstate(itypi,itypj)
25763 !c*************************************************************
25764 IF (istate.ne.1) THEN
25765 IF (istate.lt.3) THEN
25771 d1 = dhead(1,ii,itypi,itypj)
25772 d2 = dhead(2,jj,itypi,itypj)
25774 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
25775 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
25776 Rhead_distance(k) = chead(k,2) - chead(k,1)
25778 !c! pitagoras (root of sum of squares)
25780 (Rhead_distance(1)*Rhead_distance(1)) &
25781 + (Rhead_distance(2)*Rhead_distance(2)) &
25782 + (Rhead_distance(3)*Rhead_distance(3)))
25784 Rhead_sq = Rhead * Rhead
25786 !c! R1 - distance between head of ith side chain and tail of jth sidechain
25787 !c! R2 - distance between head of jth side chain and tail of ith sidechain
25791 !c! Calculate head-to-tail distances
25792 R1=R1+(ctail(k,2)-chead(k,1))**2
25793 R2=R2+(chead(k,2)-ctail(k,1))**2
25798 Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
25800 !c! write (*,*) "Ecl = ", Ecl
25801 !c! derivative of Ecl is Gcl...
25802 dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
25807 !c!-------------------------------------------------------------------
25808 !c! Generalised Born Solvent Polarization
25809 ee0 = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
25810 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee0)
25811 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
25813 !c! write (*,*) "a1*a2 = ", a12sq
25814 !c! write (*,*) "Rhead = ", Rhead
25815 !c! write (*,*) "Rhead_sq = ", Rhead_sq
25816 !c! write (*,*) "ee = ", ee
25817 !c! write (*,*) "Fgb = ", Fgb
25818 !c! write (*,*) "fac = ", eps_inout_fac
25819 !c! write (*,*) "Qij = ", Qij
25820 !c! write (*,*) "Egb = ", Egb
25821 !c! Derivative of Egb is Ggb...
25822 !c! dFGBdR is used by Quad's later...
25823 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
25824 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee0) ) )&
25826 dGGBdR = dGGBdFGB * dFGBdR
25828 !c!-------------------------------------------------------------------
25829 !c! Fisocav - isotropic cavity creation term
25831 top = al1 * (dsqrt(pom) + al2 * pom - al3)
25832 bot = (1.0d0 + al4 * pom**12.0d0)
25834 FisoCav = top / bot
25835 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
25836 dbot = 12.0d0 * al4 * pom ** 11.0d0
25837 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
25839 !c!-------------------------------------------------------------------
25840 !c! Polarization energy
25842 MomoFac1 = (1.0d0 - chi1 * sqom2)
25843 MomoFac2 = (1.0d0 - chi2 * sqom1)
25844 RR1 = ( R1 * R1 ) / MomoFac1
25845 RR2 = ( R2 * R2 ) / MomoFac2
25846 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
25847 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
25848 fgb1 = sqrt( RR1 + a12sq * ee1 )
25849 fgb2 = sqrt( RR2 + a12sq * ee2 )
25850 epol = 332.0d0 * eps_inout_fac * (&
25851 (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
25853 !c! derivative of Epol is Gpol...
25854 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)&
25856 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)&
25858 dFGBdR1 = ( (R1 / MomoFac1) &
25859 * ( 2.0d0 - (0.5d0 * ee1) ) )&
25861 dFGBdR2 = ( (R2 / MomoFac2) &
25862 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
25864 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
25865 * ( 2.0d0 - 0.5d0 * ee1) ) &
25867 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
25868 * ( 2.0d0 - 0.5d0 * ee2) ) &
25870 dPOLdR1 = dPOLdFGB1 * dFGBdR1
25871 !c! dPOLdR1 = 0.0d0
25872 dPOLdR2 = dPOLdFGB2 * dFGBdR2
25873 !c! dPOLdR2 = 0.0d0
25874 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
25875 !c! dPOLdOM1 = 0.0d0
25876 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
25877 pom = (pis / Rhead)**6.0d0
25878 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
25880 !c! derivative of Elj is Glj
25881 dGLJdR = 4.0d0 * eps_head &
25882 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
25883 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
25885 !c!-------------------------------------------------------------------
25887 IF (Wqd.ne.0.0d0) THEN
25888 Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0) &
25889 - 37.5d0 * ( sqom1 + sqom2 ) &
25890 + 157.5d0 * ( sqom1 * sqom2 ) &
25891 - 45.0d0 * om1*om2*om12
25892 fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
25893 Equad = fac * Beta1
25895 !c! derivative of Equad...
25896 dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
25897 !c! dQUADdR = 0.0d0
25898 dQUADdOM1 = fac* (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
25899 !c! dQUADdOM1 = 0.0d0
25900 dQUADdOM2 = fac* (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
25901 !c! dQUADdOM2 = 0.0d0
25902 dQUADdOM12 = fac * ( 6.0d0*om12 - 45.0d0*om1*om2 )
25907 !c!-------------------------------------------------------------------
25908 !c! Return the results
25910 eom1 = dPOLdOM1 + dQUADdOM1
25911 eom2 = dPOLdOM2 + dQUADdOM2
25913 !c! now some magical transformations to project gradient into
25914 !c! three cartesian vectors
25916 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
25917 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
25918 tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
25922 erhead(k) = Rhead_distance(k)/Rhead
25923 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
25924 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
25926 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
25927 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
25928 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
25929 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
25930 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
25931 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
25932 facd1 = d1 * vbld_inv(i+nres)
25933 facd2 = d2 * vbld_inv(j+nres)
25934 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
25935 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
25937 hawk = erhead_tail(k,1) + &
25938 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
25939 condor = erhead_tail(k,2) + &
25940 facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
25942 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
25943 !c! this acts on hydrophobic center of interaction
25944 gheadtail(k,1,1) = gheadtail(k,1,1) &
25949 - dPOLdR2 * (erhead_tail(k,2) &
25950 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))&
25954 + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))&
25955 + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
25957 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
25958 !c! this acts on hydrophobic center of interaction
25959 gheadtail(k,2,1) = gheadtail(k,2,1) &
25963 + dPOLdR1 * (erhead_tail(k,1) &
25964 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
25965 + dPOLdR2 * condor &
25969 + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j)) &
25970 + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
25972 !c! this acts on Calpha
25973 gheadtail(k,3,1) = gheadtail(k,3,1) &
25974 - dGCLdR * erhead(k)&
25975 - dGGBdR * erhead(k)&
25976 - dGCVdR * erhead(k)&
25977 - dPOLdR1 * erhead_tail(k,1)&
25978 - dPOLdR2 * erhead_tail(k,2)&
25979 - dGLJdR * erhead(k) &
25980 - dQUADdR * erhead(k)&
25982 !c! this acts on Calpha
25983 gheadtail(k,4,1) = gheadtail(k,4,1) &
25984 + dGCLdR * erhead(k) &
25985 + dGGBdR * erhead(k) &
25986 + dGCVdR * erhead(k) &
25987 + dPOLdR1 * erhead_tail(k,1) &
25988 + dPOLdR2 * erhead_tail(k,2) &
25989 + dGLJdR * erhead(k) &
25990 + dQUADdR * erhead(k)&
25993 ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
25994 eheadtail = eheadtail &
25995 + wstate(istate, itypi, itypj) &
25996 * dexp(-betaT * ener(istate))
25997 !c! foreach cartesian dimension
25999 !c! foreach of two gvdwx and gvdwc
26001 gheadtail(k,l,2) = gheadtail(k,l,2) &
26002 + wstate( istate, itypi, itypj ) &
26003 * dexp(-betaT * ener(istate)) &
26005 gheadtail(k,l,1) = 0.0d0
26009 !c! Here ended the gigantic DO istate = 1, 4, which starts
26010 !c! at the beggining of the subroutine
26014 gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
26016 gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
26017 gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
26018 gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
26019 gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
26021 gheadtail(k,l,1) = 0.0d0
26022 gheadtail(k,l,2) = 0.0d0
26025 eheadtail = (-dlog(eheadtail)) / betaT
26032 END SUBROUTINE energy_quad
26033 !!-----------------------------------------------------------
26034 SUBROUTINE eqn(Epol)
26038 double precision facd4, federmaus,epol
26039 alphapol1 = alphapol(itypi,itypj)
26040 !c! R1 - distance between head of ith side chain and tail of jth sidechain
26043 !c! Calculate head-to-tail distances
26044 R1=R1+(ctail(k,2)-chead(k,1))**2
26049 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
26050 !c! & +dhead(1,1,itypi,itypj))**2))
26051 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
26052 !c! & +dhead(2,1,itypi,itypj))**2))
26053 !c--------------------------------------------------------------------
26054 !c Polarization energy
26056 MomoFac1 = (1.0d0 - chi1 * sqom2)
26057 RR1 = R1 * R1 / MomoFac1
26058 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
26059 fgb1 = sqrt( RR1 + a12sq * ee1)
26060 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
26061 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
26063 dFGBdR1 = ( (R1 / MomoFac1) &
26064 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
26066 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
26067 * (2.0d0 - 0.5d0 * ee1) ) &
26069 dPOLdR1 = dPOLdFGB1 * dFGBdR1
26070 !c! dPOLdR1 = 0.0d0
26072 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
26074 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
26076 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
26077 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
26078 facd1 = d1 * vbld_inv(i+nres)
26079 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
26082 hawk = (erhead_tail(k,1) + &
26083 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
26085 gvdwx(k,i) = gvdwx(k,i) &
26087 gvdwx(k,j) = gvdwx(k,j) &
26088 + dPOLdR1 * (erhead_tail(k,1) &
26089 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
26091 gvdwc(k,i) = gvdwc(k,i) - dPOLdR1 * erhead_tail(k,1)
26092 gvdwc(k,j) = gvdwc(k,j) + dPOLdR1 * erhead_tail(k,1)
26097 SUBROUTINE enq(Epol)
26100 double precision facd3, adler,epol
26101 alphapol2 = alphapol(itypj,itypi)
26102 !c! R2 - distance between head of jth side chain and tail of ith sidechain
26105 !c! Calculate head-to-tail distances
26106 R2=R2+(chead(k,2)-ctail(k,1))**2
26111 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
26112 !c! & +dhead(1,1,itypi,itypj))**2))
26113 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
26114 !c! & +dhead(2,1,itypi,itypj))**2))
26115 !c------------------------------------------------------------------------
26116 !c Polarization energy
26117 MomoFac2 = (1.0d0 - chi2 * sqom1)
26118 RR2 = R2 * R2 / MomoFac2
26119 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
26120 fgb2 = sqrt(RR2 + a12sq * ee2)
26121 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
26122 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
26124 dFGBdR2 = ( (R2 / MomoFac2) &
26125 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
26127 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
26128 * (2.0d0 - 0.5d0 * ee2) ) &
26130 dPOLdR2 = dPOLdFGB2 * dFGBdR2
26131 !c! dPOLdR2 = 0.0d0
26132 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
26133 !c! dPOLdOM1 = 0.0d0
26135 !c!-------------------------------------------------------------------
26136 !c! Return the results
26137 !c! (See comments in Eqq)
26139 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
26141 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
26142 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
26143 facd2 = d2 * vbld_inv(j+nres)
26144 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
26146 condor = (erhead_tail(k,2) &
26147 + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
26149 gvdwx(k,i) = gvdwx(k,i) &
26150 - dPOLdR2 * (erhead_tail(k,2) &
26151 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
26152 gvdwx(k,j) = gvdwx(k,j) &
26155 gvdwc(k,i) = gvdwc(k,i) &
26156 - dPOLdR2 * erhead_tail(k,2)
26157 gvdwc(k,j) = gvdwc(k,j) &
26158 + dPOLdR2 * erhead_tail(k,2)
26163 SUBROUTINE eqd(Ecl,Elj,Epol)
26166 double precision facd4, federmaus,ecl,elj,epol
26167 alphapol1 = alphapol(itypi,itypj)
26168 w1 = wqdip(1,itypi,itypj)
26169 w2 = wqdip(2,itypi,itypj)
26170 pis = sig0head(itypi,itypj)
26171 eps_head = epshead(itypi,itypj)
26172 !c!-------------------------------------------------------------------
26173 !c! R1 - distance between head of ith side chain and tail of jth sidechain
26176 !c! Calculate head-to-tail distances
26177 R1=R1+(ctail(k,2)-chead(k,1))**2
26182 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
26183 !c! & +dhead(1,1,itypi,itypj))**2))
26184 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
26185 !c! & +dhead(2,1,itypi,itypj))**2))
26187 !c!-------------------------------------------------------------------
26189 sparrow = w1 * Qi * om1
26190 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
26191 Ecl = sparrow / Rhead**2.0d0 &
26192 - hawk / Rhead**4.0d0
26193 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
26194 + 4.0d0 * hawk / Rhead**5.0d0
26196 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
26198 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
26199 !c--------------------------------------------------------------------
26200 !c Polarization energy
26202 MomoFac1 = (1.0d0 - chi1 * sqom2)
26203 RR1 = R1 * R1 / MomoFac1
26204 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
26205 fgb1 = sqrt( RR1 + a12sq * ee1)
26206 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
26208 !c!------------------------------------------------------------------
26209 !c! derivative of Epol is Gpol...
26210 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0) &
26212 dFGBdR1 = ( (R1 / MomoFac1) &
26213 * ( 2.0d0 - (0.5d0 * ee1) ) ) &
26215 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1)) &
26216 * (2.0d0 - 0.5d0 * ee1) ) &
26218 dPOLdR1 = dPOLdFGB1 * dFGBdR1
26219 !c! dPOLdR1 = 0.0d0
26221 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
26222 !c! dPOLdOM2 = 0.0d0
26223 !c!-------------------------------------------------------------------
26225 pom = (pis / Rhead)**6.0d0
26226 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
26227 !c! derivative of Elj is Glj
26228 dGLJdR = 4.0d0 * eps_head &
26229 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
26230 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
26232 erhead(k) = Rhead_distance(k)/Rhead
26233 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
26236 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
26237 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
26238 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
26239 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
26240 facd1 = d1 * vbld_inv(i+nres)
26241 facd2 = d2 * vbld_inv(j+nres)
26242 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
26245 hawk = (erhead_tail(k,1) + &
26246 facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
26248 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
26249 gvdwx(k,i) = gvdwx(k,i) &
26254 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
26255 gvdwx(k,j) = gvdwx(k,j) &
26257 + dPOLdR1 * (erhead_tail(k,1) &
26258 -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres))) &
26262 gvdwc(k,i) = gvdwc(k,i) &
26263 - dGCLdR * erhead(k) &
26264 - dPOLdR1 * erhead_tail(k,1) &
26265 - dGLJdR * erhead(k)
26267 gvdwc(k,j) = gvdwc(k,j) &
26268 + dGCLdR * erhead(k) &
26269 + dPOLdR1 * erhead_tail(k,1) &
26270 + dGLJdR * erhead(k)
26275 SUBROUTINE edq(Ecl,Elj,Epol)
26280 double precision facd3, adler,ecl,elj,epol
26281 alphapol2 = alphapol(itypj,itypi)
26282 w1 = wqdip(1,itypi,itypj)
26283 w2 = wqdip(2,itypi,itypj)
26284 pis = sig0head(itypi,itypj)
26285 eps_head = epshead(itypi,itypj)
26286 !c!-------------------------------------------------------------------
26287 !c! R2 - distance between head of jth side chain and tail of ith sidechain
26290 !c! Calculate head-to-tail distances
26291 R2=R2+(chead(k,2)-ctail(k,1))**2
26296 !c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
26297 !c! & +dhead(1,1,itypi,itypj))**2))
26298 !c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
26299 !c! & +dhead(2,1,itypi,itypj))**2))
26302 !c!-------------------------------------------------------------------
26304 sparrow = w1 * Qi * om1
26305 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
26306 ECL = sparrow / Rhead**2.0d0 &
26307 - hawk / Rhead**4.0d0
26308 !c!-------------------------------------------------------------------
26309 !c! derivative of ecl is Gcl
26311 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0 &
26312 + 4.0d0 * hawk / Rhead**5.0d0
26314 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
26316 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
26317 !c--------------------------------------------------------------------
26318 !c Polarization energy
26320 MomoFac2 = (1.0d0 - chi2 * sqom1)
26321 RR2 = R2 * R2 / MomoFac2
26322 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
26323 fgb2 = sqrt(RR2 + a12sq * ee2)
26324 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
26325 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0) &
26327 dFGBdR2 = ( (R2 / MomoFac2) &
26328 * ( 2.0d0 - (0.5d0 * ee2) ) ) &
26330 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2)) &
26331 * (2.0d0 - 0.5d0 * ee2) ) &
26333 dPOLdR2 = dPOLdFGB2 * dFGBdR2
26334 !c! dPOLdR2 = 0.0d0
26335 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
26336 !c! dPOLdOM1 = 0.0d0
26338 !c!-------------------------------------------------------------------
26340 pom = (pis / Rhead)**6.0d0
26341 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
26342 !c! derivative of Elj is Glj
26343 dGLJdR = 4.0d0 * eps_head &
26344 * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0)) &
26345 + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
26346 !c!-------------------------------------------------------------------
26347 !c! Return the results
26348 !c! (see comments in Eqq)
26350 erhead(k) = Rhead_distance(k)/Rhead
26351 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
26353 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
26354 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
26355 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
26356 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
26357 facd1 = d1 * vbld_inv(i+nres)
26358 facd2 = d2 * vbld_inv(j+nres)
26359 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
26361 condor = (erhead_tail(k,2) &
26362 + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
26364 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
26365 gvdwx(k,i) = gvdwx(k,i) &
26367 - dPOLdR2 * (erhead_tail(k,2) &
26368 -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres))) &
26371 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
26372 gvdwx(k,j) = gvdwx(k,j) &
26374 + dPOLdR2 * condor &
26378 gvdwc(k,i) = gvdwc(k,i) &
26379 - dGCLdR * erhead(k) &
26380 - dPOLdR2 * erhead_tail(k,2) &
26381 - dGLJdR * erhead(k)
26383 gvdwc(k,j) = gvdwc(k,j) &
26384 + dGCLdR * erhead(k) &
26385 + dPOLdR2 * erhead_tail(k,2) &
26386 + dGLJdR * erhead(k)
26391 SUBROUTINE edd(ECL)
26396 double precision ecl
26397 !c! csig = sigiso(itypi,itypj)
26398 w1 = wqdip(1,itypi,itypj)
26399 w2 = wqdip(2,itypi,itypj)
26400 !c!-------------------------------------------------------------------
26402 fac = (om12 - 3.0d0 * om1 * om2)
26403 c1 = (w1 / (Rhead**3.0d0)) * fac
26404 c2 = (w2 / Rhead ** 6.0d0) &
26405 * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
26407 !c! write (*,*) "w1 = ", w1
26408 !c! write (*,*) "w2 = ", w2
26409 !c! write (*,*) "om1 = ", om1
26410 !c! write (*,*) "om2 = ", om2
26411 !c! write (*,*) "om12 = ", om12
26412 !c! write (*,*) "fac = ", fac
26413 !c! write (*,*) "c1 = ", c1
26414 !c! write (*,*) "c2 = ", c2
26415 !c! write (*,*) "Ecl = ", Ecl
26416 !c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
26417 !c! write (*,*) "c2_2 = ",
26418 !c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
26419 !c!-------------------------------------------------------------------
26420 !c! dervative of ECL is GCL...
26422 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
26423 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0) &
26424 * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
26427 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
26428 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
26429 * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
26432 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
26433 c2 = (-6.0d0 * w2) / (Rhead**6.0d0) &
26434 * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
26437 c1 = w1 / (Rhead ** 3.0d0)
26438 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
26439 dGCLdOM12 = c1 - c2
26440 !c!-------------------------------------------------------------------
26441 !c! Return the results
26442 !c! (see comments in Eqq)
26444 erhead(k) = Rhead_distance(k)/Rhead
26446 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
26447 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
26448 facd1 = d1 * vbld_inv(i+nres)
26449 facd2 = d2 * vbld_inv(j+nres)
26452 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
26453 gvdwx(k,i) = gvdwx(k,i) - dGCLdR * pom
26454 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
26455 gvdwx(k,j) = gvdwx(k,j) + dGCLdR * pom
26457 gvdwc(k,i) = gvdwc(k,i) - dGCLdR * erhead(k)
26458 gvdwc(k,j) = gvdwc(k,j) + dGCLdR * erhead(k)
26462 SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
26467 real(kind=8) :: eheadtail,Egb,Ecl,Elj,Equad,Epol,Rb
26471 !c! 1/(Gas Constant * Thermostate temperature) = BetaT
26472 !c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
26474 !c! BetaT = 1.0d0 / (t_bath * Rb)i
26476 BetaT = 1.0d0 / (298.0d0 * Rb)
26477 !c! Gay-berne var's
26478 sig0ij = sigma( itypi,itypj )
26479 chi1 = chi( itypi, itypj )
26480 chi2 = chi( itypj, itypi )
26481 chi12 = chi1 * chi2
26482 chip1 = chipp( itypi, itypj )
26483 chip2 = chipp( itypj, itypi )
26484 chip12 = chip1 * chip2
26491 !c! not used by momo potential, but needed by sc_angular which is shared
26492 !c! by all energy_potential subroutines
26496 !c! location, location, location
26497 ! xj = c( 1, nres+j ) - xi
26498 ! yj = c( 2, nres+j ) - yi
26499 ! zj = c( 3, nres+j ) - zi
26500 dxj = dc_norm( 1, nres+j )
26501 dyj = dc_norm( 2, nres+j )
26502 dzj = dc_norm( 3, nres+j )
26503 !c! distance from center of chain(?) to polar/charged head
26504 !c! write (*,*) "istate = ", 1
26505 !c! write (*,*) "ii = ", 1
26506 !c! write (*,*) "jj = ", 1
26507 d1 = dhead(1, 1, itypi, itypj)
26508 d2 = dhead(2, 1, itypi, itypj)
26510 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
26511 !c! a12sq = a12sq * a12sq
26512 !c! charge of amino acid itypi is...
26513 Qi = icharge(itypi)
26514 Qj = icharge(itypj)
26517 chis1 = chis(itypi,itypj)
26518 chis2 = chis(itypj,itypi)
26519 chis12 = chis1 * chis2
26520 sig1 = sigmap1(itypi,itypj)
26521 sig2 = sigmap2(itypi,itypj)
26522 !c! write (*,*) "sig1 = ", sig1
26523 !c! write (*,*) "sig2 = ", sig2
26524 !c! alpha factors from Fcav/Gcav
26525 b1cav = alphasur(1,itypi,itypj)
26527 b2cav = alphasur(2,itypi,itypj)
26528 b3cav = alphasur(3,itypi,itypj)
26529 b4cav = alphasur(4,itypi,itypj)
26530 wqd = wquad(itypi, itypj)
26532 eps_in = epsintab(itypi,itypj)
26533 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
26534 !c! write (*,*) "eps_inout_fac = ", eps_inout_fac
26535 !c!-------------------------------------------------------------------
26536 !c! tail location and distance calculations
26539 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
26540 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
26542 !c! tail distances will be themselves usefull elswhere
26543 !c1 (in Gcav, for example)
26544 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
26545 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
26546 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
26548 (Rtail_distance(1)*Rtail_distance(1)) &
26549 + (Rtail_distance(2)*Rtail_distance(2)) &
26550 + (Rtail_distance(3)*Rtail_distance(3)))
26551 !c!-------------------------------------------------------------------
26552 !c! Calculate location and distance between polar heads
26553 !c! distance between heads
26554 !c! for each one of our three dimensional space...
26555 d1 = dhead(1, 1, itypi, itypj)
26556 d2 = dhead(2, 1, itypi, itypj)
26559 !c! location of polar head is computed by taking hydrophobic centre
26560 !c! and moving by a d1 * dc_norm vector
26561 !c! see unres publications for very informative images
26562 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
26563 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
26565 !c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
26566 !c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
26567 Rhead_distance(k) = chead(k,2) - chead(k,1)
26569 !c! pitagoras (root of sum of squares)
26571 (Rhead_distance(1)*Rhead_distance(1)) &
26572 + (Rhead_distance(2)*Rhead_distance(2)) &
26573 + (Rhead_distance(3)*Rhead_distance(3)))
26574 !c!-------------------------------------------------------------------
26575 !c! zero everything that should be zero'ed
26588 END SUBROUTINE elgrad_init
26590 double precision function tschebyshev(m,n,x,y)
26593 double precision x(n),y,yy(0:maxvar),aux
26594 !c Tschebyshev polynomial. Note that the first term is omitted
26595 !c m=0: the constant term is included
26596 !c m=1: the constant term is not included
26600 yy(i)=2*yy(1)*yy(i-1)-yy(i-2)
26608 end function tschebyshev
26609 !C--------------------------------------------------------------------------
26610 double precision function gradtschebyshev(m,n,x,y)
26613 double precision x(n+1),y,yy(0:maxvar),aux
26614 !c Tschebyshev polynomial. Note that the first term is omitted
26615 !c m=0: the constant term is included
26616 !c m=1: the constant term is not included
26620 yy(i)=2*y*yy(i-1)-yy(i-2)
26624 aux=aux+x(i+1)*yy(i)*(i+1)
26625 !C print *, x(i+1),yy(i),i
26627 gradtschebyshev=aux
26629 end function gradtschebyshev